CODEWITHSUNDEEP
delphiunicodedelphi-xe
Roman Marusyk
Roman Marusyk

Reputation: 24569

Delphi XE and Unicode

I have a one function that was working in Delphi 6. Now I trying to migrate the old project to Delphi XE8, but this function doesn't work properly.

Please help me.

old function:

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;

I try to changed it to uncode, but it doesn't work:

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

The function use in:

GetIntfMetaData(Myobj as 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;

Upvotes: 0

Views: 838

Answers (2)

Roman Marusyk
Roman Marusyk

Reputation: 24569

This is solution that I found in internet and it work(but I do not know if it's proper):

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;

Upvotes: 0

LU RD
LU RD

Reputation: 34889

If you want the name of the type through the PTypeInfo structure:

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

Or better to fully qualify the pointer:

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

Or use the built in function: TypInfo.GetTypeName.

What David was pointing out in the comments, the TTypeInfo record starts with an enum, Kind. Next comes the Name string. The offset to this field is better left for the compiler to calculate.

In your updated question it is clear that you increment the pointer with 1 (ReadByte) before calling the function to get the name. Don't do that. Do this:

IntfMD.Name := GetTypeName(Info);

Now, use this knowledge to handle the methods of the TTypeInfo, which needs an update too.

Upvotes: 3

Related Questions