2015-06-19 2 views
0

У меня есть одна функция, работающая в Delphi 6. Теперь я пытаюсь перенести старый проект в Delphi XE8, но эта функция работает неправильно.Delphi XE и Unicode

Пожалуйста, помогите мне.

старая функция:

function ReadString(var P: Pointer): String; 
var 
    B: Byte; 
begin 
    B := Byte(P^); 
    SetLength(Result, B); 
    P := Pointer(Integer(P) + 1); 
    Move(P^, Result[1], Integer(B)); 
    P := Pointer(Integer(P) + B); 
end; 

Стараюсь изменил его uncode, но он не работает:

function ReadString(var P: Pointer): String; 
var 
    B: Byte; 
    LResult: AnsiString; 
begin 
    B := Byte(P^); 
    SetLength(LResult, B); 
    P := Pointer(Integer(P) + 1); 
    Move(P^, LResult[1], Integer(B)); 
    P := Pointer(Integer(P) + B); 
    Result := String(LResult); 
end 

Функция использования в:

GetIntfMetaData (Myobj как IFController , IntfMD, True);

procedure GetIntfMetaData(Info: PTypeInfo; var IntfMD: TIntfMetaData; MethodArrayOpt: TFillMethodArrayOpt); 
var 
    I, Offset: Integer; 
    Methods: Integer; 
    BaseRTTIMethods: Integer; 
    HasRTTI: Integer; 
    PP: PPTypeInfo; 
    P: Pointer; 
    SelfMethCount: Integer; 
    IntfMethod: PIntfMethEntry; 
begin 
    P := Pointer(Info); 
    IntfMD.Info := Info; 
    { tkKind } 
    ReadByte(P); 
    IntfMD.Name := ReadString(P); 
    { Interface flags } 
    ReadByte(P); 
    IntfMD.UnitName := ReadString(P); 
    Methods := ReadWord(P); { # methods } 
    HasRTTI := ReadWord(P); { $FFFF if no RTTI, # methods again if has RTTI } 
    if HasRTTI = $FFFF then 
    raise EInterfaceRTTIException.CreateFmt(SNoRTTI, [IntfMD.UnitName + '.' + IntfMd.Name]); 
    { Save my method count } 
    SelfMethCount := Methods; 
    Offset := 0; 
    { Size array and fill in information } 
    SetLength(IntfMD.MDA, Methods); 
    FillMethodArray(P, @IntfMD, Offset, SelfMethCount); 
end; 

procedure FillMethodArray(P: Pointer; IntfMD: PIntfMetaData; Offset, Methods: Integer); 
var 
    S: Ansistring; 
    I, J, K, L: Integer; 
    ParamCount: Integer; 
    Kind, Flags: Byte; 
    ParamInfo: PTypeInfo; 
    ParamName: Ansistring; 
    IntfMethod: PIntfMethEntry; 
    IntfParam: PIntfParamEntry; 
begin 
    for I := 0 to Methods -1 do 
    begin 
    IntfMethod := @IntfMD.MDA[Offset]; 
    IntfMethod.Name := ReadString(P); 
    Kind := ReadByte(P);   { tkKind } 
    IntfMethod.CC := CCMap[ReadByte(P)]; 
    ParamCount := ReadByte(P);  { Param count including self } 
    IntfMethod.ParamCount := ParamCount - 1; 
    IntfMethod.Pos := Offset; 
    IntfMethod.HasRTTI := True; 

    SetLength(IntfMethod.Params, ParamCount); 
    K := 0; 
    for J := 0 to ParamCount - 1 do 
    begin 
     Flags := ReadByte(P);  { Flags } 
     ParamName := ReadString(P); { Param name } 
     S := ReadString(P);   { Param type name } 
     L := ReadLong(P);   { Param Type Info } 
     if L <> 0 then 
     ParamInfo := PPTypeInfo(L)^ 
     else 
     raise EInterfaceRTTIException.CreateFmt(SNoRTTIParam, [ParamName, IntfMethod.Name, IntfMD.UnitName + '.' + IntfMd.Name]); 
     if J = 0 then 
     IntfMethod.SelfInfo := ParamInfo 
     else 
     begin 
     IntfParam := @IntfMethod.Params[K]; 
     IntfParam.Flags := TParamFlags(Flags); 
     IntfParam.Name := ParamName; 
     IntfParam.Info := ParamInfo; 
     Inc(K); 
     end; 
    end; 
    if Kind = Byte(mkFunction) then 
    begin 
     S := ReadString(P); 
     IntfMethod.ResultInfo := PPTypeInfo(ReadLong(P))^; 
    end; 
    Inc(Offset); 
    end; 
end; 

function ReadByte(var P: Pointer): Byte; 
begin 
    Result := Byte(P^); 
    P := Pointer(Integer(P) + 1); 
end; 
+0

Что такое определение структуры, что P указывает на? Пожалуйста, дайте полный пример. –

+0

var Информация: PTypeInfo; P: = Указатель (информация); – Marusyk

+0

Пусть компилятор вычисляет смещения. Это сделает их правильными. Не запускайте этот код в процессе x64. –

ответ

0

Это решение, которое я нашел в Интернете, и это работает (но я не знаю, если это правильное):

function ReadString(var P: Pointer): String; 
var 
    B: Byte; 
{$IFDEF UNICODE} 
{$IFDEF NEXTGEN} 
    AStr: TBytes; 
{$ELSE !NEXTGEN} 
    AStr: AnsiString; 
{$ENDIF NEXTGEN} 
{$ENDIF} 
begin 
    B := Byte(P^); 
{$IFDEF UNICODE} 
    SetLength(AStr, B); 
    P := Pointer(NativeInt(P)+1); 
{$IFDEF NEXTGEN} 
    Move(P^, AStr[0], Integer(B)); 
    Result := Tencoding.UTF8.GetString(AStr); 
{$ELSE !NEXTGEN} 
    Move(P^, AStr[1], Integer(B)); 
    Result := UTF8ToString(AStr); 
{$ENDIF NEXTGEN} 
{$ELSE} 
    SetLength(Result, B); 
    P := Pointer(NativeInt(P) + 1); 
    Move(P^, Result[1], Integer(B)); 
{$ENDIF} 
    P := Pointer(NativeInt(P) + B); 
end; 
3

Если вы хотите, чтобы имя типа через PTypeInfo структуры:

function GetName(p: Pointer): String; 
begin 
    Result := PTypeInfo(P)^.Name; 
end; 

Или лучше, чтобы полностью определить указатель:

function GetName(p: PTypeInfo): String; 
begin 
    Result := P^.Name; 
end; 

Или использовать встроенную функцию: TypInfo.GetTypeName.


Что Давид указывал в комментариях TTypeInfo запись начинается с перечисления, Kind. Далее идет строка Name. Смещение к этому полю лучше оставить для вычисления компилятором.


В обновленном вопросе, ясно, что вы увеличиваете указатель с 1 (ReadByte) перед вызовом функции, чтобы получить имя. Не делай этого. ли это:

IntfMD.Name := GetTypeName(Info); 

Теперь, использовать эти знания для обработки методов TTypeInfo, который нуждается в обновлении тоже.

+0

Я думал, что это, но то, что я не могу, является типом типа перечисления в записи. –

+0

@DavidHeffernan, код OP не соответствует виду, конечно. –

+0

Благодарим за помощь. После изменения у меня получилось что-то вроде «leaseLeave» # 0 # 3 # 1 # 8 # 4'Self '# $ 10'IFController' # $ 14'ѓL '# 0 # 2 # 0 # 2 # 0 # 4'Kill' # 0 # 3 # 1 # 8 # 4'Self '# $ 10'IFController' # $ 14'ѓL '# 0 # 2' – Marusyk

Смежные вопросы