unit TntWideStrPropHelper;

interface

uses
  Classes, TypInfo;

type
  TTntWideStringUTFPropertyFiler = class
  private
    FInstance: TPersistent;
    FPropInfo: PPropInfo;
    procedure ReadDataUTF8(Reader: TReader);
    procedure ReadDataUTF7(Reader: TReader);
    procedure WriteDataUTF7(Writer: TWriter);
  public
    procedure DefineProperties(Filer: TFiler; Instance: TPersistent; PropName: AnsiString);
  end;

procedure DefineWideProperties(Filer: TFiler; Instance: TPersistent);

{$IFDEF VER130}
function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
{$ENDIF}

implementation

uses
  ConvertUTF7, {$IFDEF JCL} JclUnicode; {$ELSE} Unicode; {$ENDIF}

//===========================================================================
//   The Delphi 5 Classes.pas has no support for streaming WideStrings.
//   The Delphi 6 Classes.pas works great.  Too bad the Delphi 6 IDE doesn't not use
//     the updated Classes.pas.  Switching between Form/Text mode corrupts extended
//       characters in WideStrings even under Delphi 6.
//
//   The purpose of this solution is to store WideString properties which contain
//     non-ASCII chars in the form of UTF8 under the old property name + 'W'.
//
//   Special thanks go to Francisco Leong for helping to develop this solution.
//

procedure DefineWideProperties(Filer: TFiler; Instance: TPersistent);
var
  I, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
  WideStringFiler: TTntWideStringUTFPropertyFiler;
begin
  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    WideStringFiler := TTntWideStringUTFPropertyFiler.Create;
    try
      GetMem(PropList, Count * SizeOf(Pointer));
      try
        GetPropInfos(Instance.ClassInfo, PropList);
        for I := 0 to Count - 1 do
        begin
          PropInfo := PropList^[I];
          if (PropInfo = nil) then
            break;
          if (PropInfo.PropType^.Kind = tkWString) then
            WideStringFiler.DefineProperties(Filer, Instance, PropInfo.Name);
        end;
      finally
        FreeMem(PropList, Count * SizeOf(Pointer));
      end;
    finally
      WideStringFiler.Free;
    end;
  end;
end;

{ TTntWideStringUTFPropertyFiler }

{$IFDEF VER130}
const IsDelphi5 = True;
{$ELSE}
const IsDelphi5 = False;
{$ENDIF}

procedure TTntWideStringUTFPropertyFiler.ReadDataUTF8(Reader: TReader);
begin
  // Delphi 6 runtime does not need to read UTF.
  if IsDelphi5 or (csDesigning in Reader.Owner.ComponentState) then
    SetWideStrProp(FInstance, FPropInfo, UTF8ToWideString(Reader.ReadString))
  else
    Reader.ReadString; { do nothing with result }
end;

procedure TTntWideStringUTFPropertyFiler.ReadDataUTF7(Reader: TReader);
begin
  // Delphi 6 runtime does not need to read UTF.
  if IsDelphi5 or (csDesigning in Reader.Owner.ComponentState) then
    SetWideStrProp(FInstance, FPropInfo, UTF7ToWideString(Reader.ReadString))
  else
    Reader.ReadString; { do nothing with result }
end;

procedure TTntWideStringUTFPropertyFiler.WriteDataUTF7(Writer: TWriter);
begin
  Writer.WriteString(WideStringToUTF7(GetWideStrProp(FInstance, FPropInfo)));
end;

procedure TTntWideStringUTFPropertyFiler.DefineProperties(Filer: TFiler; Instance: TPersistent;
  PropName: AnsiString);

  function HasData: Boolean;
  var
    CurrPropValue: WideString;
  begin
    // must be stored
    Result := IsStoredProp(Instance, FPropInfo);
    if Result
    and (Filer.Ancestor <> nil)
    and (GetPropInfo(Filer.Ancestor, PropName, [tkWString]) <> nil) then
    begin
      // must be different than ancestor
      CurrPropValue := GetWideStrProp(Instance, FPropInfo);
      Result := CurrPropValue <> GetWideStrProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
    end;
    if Result then begin
      // must be non-blank and different than UTF8 (implies all ASCII <= 127)
      CurrPropValue := GetWideStrProp(Instance, FPropInfo);
      Result := (CurrPropValue <> '') and (WideStringToUTF8(CurrPropValue) <> CurrPropValue);
    end;
  end;

begin
  FInstance := Instance;
  FPropInfo := GetPropInfo(Instance, PropName, [tkWString]);
  if FPropInfo <> nil then begin
    // must be published (and of type WideString)
    Filer.DefineProperty(PropName + 'W', ReadDataUTF8, nil, False);
    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, WriteDataUTF7, HasData);
  end;
  FInstance := nil;
  FPropInfo := nil;
end;

{$IFDEF VER130}
procedure AssignWideStr(var Dest: WideString; const Source: WideString);
begin
  Dest := Source;
end;
procedure IntGetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  var Value: WideString); assembler;
asm
        { ->    EAX Pointer to instance         }
        {       EDX Pointer to property info    }
        {       ECX Pointer to result string    }

        PUSH    ESI
        PUSH    EDI
        MOV     EDI,EDX

        MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
        CMP     EDX,$80000000
        JNE     @@hasIndex
        MOV     EDX,ECX                         { pass value in EDX }
@@hasIndex:
        MOV     ESI,[EDI].TPropInfo.GetProc
        CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
        JA      @@isField
        JB      @@isStaticMethod

@@isVirtualMethod:
        MOVSX   ESI,SI                          { sign extend slot offset }
        ADD     ESI,[EAX]                       { vmt + slot offset }
        CALL    DWORD PTR [ESI]
        JMP     @@exit

@@isStaticMethod:
        CALL    ESI
        JMP     @@exit

@@isField:
  AND  ESI,$00FFFFFF
  MOV  EDX,[EAX+ESI]
  MOV  EAX,ECX
  CALL  AssignWideStr

@@exit:
        POP     EDI
        POP     ESI
end;
function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
begin
  IntGetWideStrProp(Instance, PropInfo, Result);
end;
procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  const Value: WideString); assembler;
asm
        { ->    EAX Pointer to instance         }
        {       EDX Pointer to property info    }
        {       ECX Pointer to string value     }

        PUSH    ESI
        PUSH    EDI
        MOV     ESI,EDX

        MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
        CMP     EDX,$80000000
        JNE     @@hasIndex
        MOV     EDX,ECX                         { pass value in EDX }
@@hasIndex:
        MOV     EDI,[ESI].TPropInfo.SetProc
        CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
        JA      @@isField
        JB      @@isStaticMethod

@@isVirtualMethod:
        MOVSX   EDI,DI
        ADD     EDI,[EAX]
        CALL    DWORD PTR [EDI]
        JMP     @@exit

@@isStaticMethod:
        CALL    EDI
        JMP     @@exit

@@isField:
  AND  EDI,$00FFFFFF
  ADD  EAX,EDI
  MOV  EDX,ECX
  CALL  AssignWideStr

@@exit:
        POP     EDI
        POP     ESI
end;
{$ENDIF}

end.