tntclasses.pas

TNT Components Source

      Result :=  (Default <> LongInt($80000000)) and (Value = Default);
    end;
  end;
end;

procedure TTntWideCharPropertyFiler.GetLookupInfo(var Ancestor: TPersistent;
  var Root, LookupRoot, RootAncestor: TComponent);
begin
  Ancestor := FWriter.Ancestor;
  Root := FWriter.Root;
  LookupRoot := FWriter.LookupRoot;
  RootAncestor := FWriter.RootAncestor;
end;
{$ENDIF}

function TTntWideCharPropertyFiler.ReadChar(Reader: TReader): WideChar;
var
  Temp: WideString;
begin
  case Reader.NextValue of
    vaWString:
      Temp := Reader.ReadWideString;
    vaString:
      Temp := Reader.ReadString;
    else
      raise EReadError.Create(SInvalidPropertyValue);
  end;

  if Length(Temp) > 1 then
    raise EReadError.Create(SInvalidPropertyValue);
  Result := Temp[1];
end;

procedure TTntWideCharPropertyFiler.ReadData_W(Reader: TReader);
begin
  SetOrdProp(FInstance, FPropInfo, Ord(ReadChar(Reader)));
end;

procedure TTntWideCharPropertyFiler.ReadDataUTF7(Reader: TReader);
var
  S: WideString;
begin
  S := UTF7ToWideString(Reader.ReadString);
  if S = '' then
    SetOrdProp(FInstance, FPropInfo, 0)
  else
    SetOrdProp(FInstance, FPropInfo, Ord(S[1]))
end;

type TAccessWriter = class(TWriter);

procedure TTntWideCharPropertyFiler.WriteData_W(Writer: TWriter);
var
  L: Integer;
  Temp: WideString;
begin
  Temp := WideChar(GetOrdProp(FInstance, FPropInfo));

  TAccessWriter(Writer).WriteValue(vaWString);
  L := Length(Temp);
  Writer.Write(L, SizeOf(Integer));
  Writer.Write(Pointer(@Temp[1])^, L * 2);
end;

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

  {$IFNDEF COMPILER_9_UP}
  function HasData: Boolean;
  var
    CurrPropValue: Integer;
  begin
    // must be stored
    Result := IsStoredProp(Instance, FPropInfo);
    if Result and (Filer.Ancestor <> nil) and
      (GetPropInfo(Filer.Ancestor, PropName, [tkWChar]) <> nil) then
    begin
      // must be different than ancestor
      CurrPropValue := GetOrdProp(Instance, FPropInfo);
      Result := CurrPropValue <> GetOrdProp(Filer.Ancestor, GetPropInfo(Filer.Ancestor, PropName));
    end;
    if Result and (Filer is TWriter) then
    begin
      FWriter := TWriter(Filer);
      Result := not IsDefaultOrdPropertyValue(Instance, FPropInfo, GetLookupInfo);
    end;
  end;
  {$ENDIF}

begin
  FInstance := Instance;
  FPropInfo := GetPropInfo(Instance, PropName, [tkWChar]);
  if FPropInfo <> nil then
  begin
    // must be published (and of type WideChar)
    {$IFDEF COMPILER_9_UP}
    Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, False);
    {$ELSE}
    Filer.DefineProperty(PropName + 'W', ReadData_W, WriteData_W, HasData);
    {$ENDIF}
    Filer.DefineProperty(PropName + '_UTF7', ReadDataUTF7, nil, False);
  end;
  FInstance := nil;
  FPropInfo := nil;
end;

procedure TntPersistent_AfterInherited_DefineProperties(Filer: TFiler; Instance: TPersistent);
var
  I, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
  WideStringFiler: TTntWideStringPropertyFiler;
  WideCharFiler: TTntWideCharPropertyFiler;
begin
  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    WideStringFiler := TTntWideStringPropertyFiler.Create;
    try
      WideCharFiler := TTntWideCharPropertyFiler.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)
            else if (PropInfo.PropType^.Kind = tkWChar) then
              WideCharFiler.DefineProperties(Filer, Instance, PropInfo.Name)
          end;
        finally
          FreeMem(PropList, Count * SizeOf(Pointer));
        end;
      finally
        WideCharFiler.Free;
      end;
    finally
      WideStringFiler.Free;
    end;
  end;
end;

{ TTntFileStream }

constructor TTntFileStream.Create(const FileName: WideString; Mode: Word);
var
  CreateHandle: Integer;
  {$IFDEF DELPHI_7_UP}
  ErrorMessage: WideString;
  {$ENDIF}
begin
  if Mode = fmCreate then
  begin
    CreateHandle := WideFileCreate(FileName);
    if CreateHandle < 0 then begin
      {$IFDEF DELPHI_7_UP}
      ErrorMessage := WideSysErrorMessage(GetLastError);
      raise EFCreateError.CreateFmt(SFCreateErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
      {$ELSE}
      raise EFCreateError.CreateFmt(SFCreateError, [WideExpandFileName(FileName)]);
      {$ENDIF}
    end;
  end else
  begin
    CreateHandle := WideFileOpen(FileName, Mode);
    if CreateHandle < 0 then begin
      {$IFDEF DELPHI_7_UP}
      ErrorMessage := WideSysErrorMessage(GetLastError);
      raise EFOpenError.CreateFmt(SFOpenErrorEx, [WideExpandFileName(FileName), ErrorMessage]);
      {$ELSE}
      raise EFOpenError.CreateFmt(SFOpenError, [WideExpandFileName(FileName)]);
      {$ENDIF}
    end;
  end;
  inherited Create(CreateHandle);
end;

destructor TTntFileStream.Destroy;
begin
  if Handle >= 0 then FileClose(Handle);
end;

{ TTntMemoryStream }

procedure TTntMemoryStream.LoadFromFile(const FileName: WideString);
var
  Stream: TStream;
begin
  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TTntMemoryStream.SaveToFile(const FileName: WideString);
var
  Stream: TStream;
begin
  Stream := TTntFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

{ TTntResourceStream }

constructor TTntResourceStream.Create(Instance: THandle; const ResName: WideString;
  ResType: PWideChar);
begin
  inherited Create;
  Initialize(Instance, PWideChar(ResName), ResType);
end;

constructor TTntResourceStream.CreateFromID(Instance: THandle; ResID: Word;
  ResType: PWideChar);
begin
  inherited Create;
  Initialize(Instance, PWideChar(ResID), ResType);
end;

procedure TTntResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);

  procedure Error;
  begin
    raise EResNotFound.CreateFmt(SResNotFound, [Name]);
  end;

begin
  HResInfo := FindResourceW(Instance, Name, ResType);
  if HResInfo = 0 then Error;
  HGlobal := LoadResource(Instance, HResInfo);
  if HGlobal = 0 then Error;
  SetPointer(LockResource(HGlobal), SizeOfResource(Instance, HResInfo));
end;

destructor TTntResourceStream.Destroy;
begin
  UnlockResource(HGlobal);
  FreeResource(HGlobal); { Technically this is not necessary (MS KB #193678) }
  inherited Destroy;
end;

function TTntResourceStream.Write(const Buffer; Count: Longint): Longint;
begin
  raise EStreamError.CreateRes(PResStringRec(@SCantWriteResourceStreamError));
end;

procedure TTntResourceStream.SaveToFile(const FileName: WideString);
var
  Stream: TStream;
begin
  Stream := TTntFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

{ TAnsiStrings }

procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFile(const FileName: WideString);
var
  Stream: TStream;
begin
  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFile(const FileName: WideString);
var
  Stream: TStream;
begin
  Stream := TTntFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.LoadFromFileEx(const FileName: WideString; CodePage: Cardinal);
var
  Stream: TStream;
begin
  Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStreamEx(Stream, CodePage);
  finally
    Stream.Free;
  end;
end;

procedure TAnsiStrings{TNT-ALLOW TAnsiStrings}.SaveToFileEx(const FileName: WideString; CodePage: Cardinal);
var
  Stream: TStream;
begin
  Stream := TTntFileStream.Create(FileName, fmCreate);
  try
    if (CodePage = CP_UTF8) then
      Stream.WriteBuffer(PAnsiChar(UTF8_BOM)^, Length(UTF8_BOM));
    SaveToStreamEx(Stream, CodePage);
  finally
    Stream.Free;
  end;
end;

{ TAnsiStringsForWideStringsAdapter }

constructor TAnsiStringsForWideStringsAdapter.Create(AWideStrings: TTntStrings; _AdapterCodePage: Cardinal);
begin
  inherited Create;
  FWideStrings := AWideStrings;
  FAdapterCodePage := _AdapterCodePage;
end;

function TAnsiStringsForWideStringsAdapter.AdapterCodePage: Cardinal;
begin
  if FAdapterCodePage = 0 then
    Result := TntSystem.DefaultSystemCodePage
  else
    Result := FAdapterCodePage;
end;

procedure TAnsiStringsForWideStringsAdapter.Clear;
begin
  FWideStrings.Clear;
end;

procedure TAnsiStringsForWideStringsAdapter.Delete(Index: Integer);
begin
  FWideStrings.Delete(Index);
end;

function TAnsiStringsForWideStringsAdapter.Get(Index: Integer): AnsiString;
begin
  Result := WideStringToStringEx(FWideStrings.Get(Index), AdapterCodePage);
end;

procedure TAnsiStringsForWideStringsAdapter.Put(Index: Integer; const S: AnsiString);
begin
  FWideStrings.Put(Index, StringToWideStringEx(S, AdapterCodePage));
end;

function TAnsiStringsForWideStringsAdapter.GetCount: Integer;
begin
  Result := FWideStrings.GetCount;
end;

procedure TAnsiStringsForWideStringsAdapter.Insert(Index: Integer; const S: AnsiString);
begin
  FWideStrings.Insert(Index, StringToWideStringEx(S, AdapterCodePage));
end;

function TAnsiStringsForWideStringsAdapter.GetObject(Index: Integer): TObject;
begin
  Result := FWideStrings.GetObject(Index);
end;

procedure TAnsiStringsForWideStringsAdapter.PutObject(Index: Integer; AObject: TObject);
begin
  FWideStrings.PutObject(Index, AObject);
end;

procedure TAnsiStringsForWideStringsAdapter.SetUpdateState(Updating: Boolean);
begin
  FWideStrings.SetUpdateState(Updating);
end;

procedure TAnsiStringsForWideStringsAdapter.LoadFromStreamEx(Stream: TStream; CodePage: Cardinal);
var
  Size: Integer;
  S: AnsiString;
begin
  BeginUpdate;
  try
    Size := Stream.Size - Stream.Position;
    SetString(S, nil, Size);
    Stream.Read(Pointer(S)^, Size);
    FWideStrings.SetTextStr(StringToWideStringEx(S, CodePage));
  finally
    EndUpdate;
  end;
end;

procedure TAnsiStringsForWideStringsAdapter.SaveToStreamEx(Stream: TStream; CodePage: Cardinal);
var
  S: AnsiString;
begin
  S := WideStringToStringEx(FWideStrings.GetTextStr, CodePage);
  Stream.WriteBuffer(Pointer(S)^, Length(S));
end;

{ TTntStrings }

constructor TTntStrings.Create;
begin
  inherited;
  FAnsiStrings := TAnsiStringsForWideStringsAdapter.Create(Self);
  FLastFileCharSet := csUnicode;
end;

destructor TTntStrings.Destroy;
begin
  FreeAndNil(FAnsiStrings);
  inherited;
end;

procedure TTntStrings.SetAnsiStrings(const Value: TAnsiStrings{TNT-ALLOW TAnsiStrings});
begin
  FAnsiStrings.Assign(Value);
end;

procedure TTntStrings.DefineProperties(Filer: TFiler);

  {$IFNDEF COMPILER_7_UP}
  function DoWrite: Boolean;
  begin
    if Filer.Ancestor <> nil then
    begin
      Result := True;
      if Filer.Ancestor is TWideStrings then
        Result := not Equals(TWideStrings(Filer.Ancestor))
    end
    else Result := Count > 0;
  end;

  function DoWriteAsUTF7: Boolean;
  var
    i: integer;
  begin
    Result := False;
    for i := 0 to Count - 1 do begin
      if (Strings[i] <> '') and (WideStringToUTF8(Strings[i]) <> Strings[i]) then begin