propstorageeh.pas

最新的 DBGRIDEH4.0

        StreamWriteBytes(ss, BytesOf(sl[i]));
      ss.Position := 0;

{$IFDEF CIL}
      HexToBinEh(ss.Memory, Buffer, ss.Size);
{$ELSE}
//      SetString(Buffer, nil, ss.Size div 2);
//      SetLength(Buffer, ss.Size div 2);
//      HexToBin(PChar(ss.DataString), PChar(Buffer), ss.Size);
      HexToBinEh(ss.Memory, Buffer, ss.Size);
{$ENDIF}
      ss.Size := 0;
//      ss.WriteString(Buffer);
      StreamWriteBytes(ss, Buffer);
      ss.Position := 0;
    end else
    begin
      ss.Position := 0;
//      ss.WriteString(sl.Text);
      StreamWriteBytes(ss, BytesOf(sl.Text));
      ss.Position := 0;
    end;

    ReadPropertiesStream(ss, PropStorage);

  finally
    ss.Free;
    sl.Free;
    ini.Free;
  end;
end;

procedure TIniPropStorageManEh.WritePropertiesStream(PropStorage: TPropStorageEh; Stream: TStream);
var
  ini: TCustomIniFile;
  Buffer: TBytes;
  Text, Line: String;
  i, Pos: Integer;
begin
  ini := nil;
  Buffer := nil;
  try
    ini := TIniFile.Create(IniFileName);
//    GetMem(Buffer, Stream.Size);
//    SetString(Text, nil, Stream.Size*2);
//    Stream.ReadBuffer(Buffer^, Stream.Size);
    StreamReadBytes(Stream, Buffer, Stream.Size);
//    BinToHex(Buffer, PChar(Text), Stream.Size);
    BinToHexEh(Buffer, Text, Stream.Size);
    i := 0;
    Pos := 1;
    while Pos <= Length(Text) do
    begin
      Line := Copy(Text, Pos, 80);
      ini.WriteString(PropStorage.Section, 'Line' + IntToStr(i), '''' + Line + '''');
      Inc(Pos, 80);
      Inc(i);
    end;

    while ini.ValueExists(PropStorage.Section, 'Line' + IntToStr(i)) do
    begin
      ini.DeleteKey(PropStorage.Section, 'Line' + IntToStr(i));
      Inc(i);
    end;
  finally
//    FreeMem(Buffer);
    ini.Free;
  end;
end;

procedure TIniPropStorageManEh.WritePropertiesText(PropStorage: TPropStorageEh; Text: String);
var
  sl: TStrings;
  ini: TCustomIniFile;
  i: Integer;
begin
  sl := nil;
  ini := nil;
  try
    sl := TStringList.Create;
    sl.Text := Text;

    ini := TIniFile.Create(IniFileName);

    for i := 0 to sl.Count - 1 do
      ini.WriteString(PropStorage.Section, 'Line' + IntToStr(i), '''' + sl[i] + '''');

    i := sl.Count;
    while ini.ValueExists(PropStorage.Section, 'Line' + IntToStr(i)) do
    begin
      ini.DeleteKey(PropStorage.Section, 'Line' + IntToStr(i));
      Inc(i);
    end;
  finally
    sl.Free;
    ini.Free;
  end;
end;

{$IFNDEF EH_LIB_CLX}

{ TRegPropStorageManEh }

const
  RegistryKeys: array[0..6] of TIdentMapEntry = (
    (Value: Integer(HKEY_CLASSES_ROOT); Name: 'HKEY_CLASSES_ROOT'),
    (Value: Integer(HKEY_CURRENT_USER); Name: 'HKEY_CURRENT_USER'),
    (Value: Integer(HKEY_LOCAL_MACHINE); Name: 'HKEY_LOCAL_MACHINE'),
    (Value: Integer(HKEY_USERS); Name: 'HKEY_USERS'),
    (Value: Integer(HKEY_PERFORMANCE_DATA); Name: 'HKEY_PERFORMANCE_DATA'),
    (Value: Integer(HKEY_CURRENT_CONFIG); Name: 'HKEY_CURRENT_CONFIG'),
    (Value: Integer(HKEY_DYN_DATA); Name: 'HKEY_DYN_DATA'));

function RegistryKeyToIdent(RootKey: Longint; var Ident: string): Boolean;
begin
  Result := IntToIdent(RootKey, Ident, RegistryKeys);
end;

function IdentToRegistryKey(const Ident: string; var RootKey: Longint): Boolean;
begin
  Result := IdentToInt(Ident, RootKey, RegistryKeys);
end;

procedure GetRegistryKeyValues(Proc: TGetStrProc);
var
  I: Integer;
begin
  for I := Low(RegistryKeys) to High(RegistryKeys) do Proc(RegistryKeys[I].Name);
end;

constructor TRegPropStorageManEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FKey := HKEY_CURRENT_USER;
  FRegistryKey := rkCurrentUserEh;
end;

destructor TRegPropStorageManEh.Destroy;
begin
  inherited Destroy;
end;

procedure TRegPropStorageManEh.ReadProperties(PropStorage: TPropStorageEh);
var
  ss: TMemoryStream;
  reg: TRegistry;
  IsPresent: Boolean;
  Buffer: TBytes;
  sKeys, sVals, sl: TStringList;
  i, LinePos: Integer;
begin
  ss := nil;
  reg := nil;
  sKeys := nil;
  sVals := nil;
  sl := nil;
  try

    reg := TRegistry.Create;

    reg.RootKey := Key;
    if Path = ''
      then IsPresent := reg.KeyExists(GetDefaultRegKey)
      else IsPresent := reg.KeyExists(Path);

    if IsPresent then
    begin
      if Path = ''
        then reg.OpenKey(GetDefaultRegKey, False)
        else reg.OpenKey(Path, False);
      if reg.ValueExists(PropStorage.Section) then
      begin
        ReadPropertiesOld(PropStorage);
        reg.DeleteValue(PropStorage.Section);
        Exit;
      end;
      reg.CloseKey;
    end;

    if Path = ''
      then IsPresent := reg.OpenKey(GetDefaultRegKey + '\' + PropStorage.Section, False)
      else IsPresent := reg.OpenKey(Path + '\' + PropStorage.Section, False);

    if not IsPresent then Exit;

//    sKeys := TStringList.Create;
    sVals := TStringList.Create;
    sl := TStringList.Create;

//    reg.GetKeyNames(sKeys);
    reg.GetValueNames(sVals);

    for i := 0 to sVals.Count - 1 do
    begin
      LinePos := sVals.IndexOf('Line' + FormatFloat('0000000000', i));
      if LinePos < 0  then Break;
      sl.Add(reg.ReadString(sVals[LinePos]));
    end;

    if sl.Count = 0 then Exit;

    ss := TMemoryStream.Create;
    StreamWriteBytes(ss, BytesOf(sl[0]));
    ss.Position := 0;

    if TestStreamFormat(ss) <> sofText then
    begin
      ss.Seek(0, soFromEnd);
      for i := 1 to sl.Count - 1 do
//        ss.WriteString(sl[i]);
        StreamWriteBytes(ss, BytesOf(sl[i]));
      ss.Position := 0;

//      SetString(Buffer, nil, ss.Size div 2);
//      HexToBin(PChar(ss.DataString), PChar(Buffer), ss.Size);
      HexToBinEh(ss.Memory, Buffer, ss.Size);

      ss.Size := 0;
//      ss.WriteString(Buffer);
      StreamWriteBytes(ss, Buffer);
      ss.Position := 0;
    end else
    begin
      ss.Position := 0;
//      ss.WriteString(sl.Text);
      StreamWriteBytes(ss, BytesOf(sl.Text));
      ss.Position := 0;
    end;

    ReadPropertiesStream(ss, PropStorage);

  finally
    ss.Free;
    reg.Free;
    sKeys.Free;
    sVals.Free;
    sl.Free;
  end;
end;

procedure TRegPropStorageManEh.ReadPropertiesOld(PropStorage: TPropStorageEh);
var
  ss: TMemoryStream;
  reg: TRegistry;
  IsPresent: Boolean;
//  Buffer: String;
  Buffer: TBytes;
begin
  ss := nil;
  reg := nil;
  try

    reg := TRegistry.Create;

    reg.RootKey := Key;
    if Path = ''
      then IsPresent := reg.OpenKey(GetDefaultRegKey, False)
      else IsPresent := reg.OpenKey(Path, False);
    if not IsPresent then Exit;

    if not reg.ValueExists(PropStorage.Section) then Exit;

    ss := TMemoryStream.Create;

    if reg.GetDataType(PropStorage.Section) = rdBinary then
    begin
//      SetString(Buffer, nil, reg.GetDataSize(PropStorage.Section));
      { TODO : Check it }
      SetLength(Buffer, reg.GetDataSize(PropStorage.Section));
{$IFDEF CIL}
      reg.ReadBinaryData(PropStorage.Section, Buffer, Length(Buffer));
{$ELSE}
      reg.ReadBinaryData(PropStorage.Section, PChar(Buffer)^, Length(Buffer));
{$ENDIF}
      StreamWriteBytes(ss, Buffer);
    end else
      StreamWriteBytes(ss, BytesOf(reg.ReadString(PropStorage.Section)));

    ss.Position := 0;

    ReadPropertiesStream(ss, PropStorage);

  finally
    ss.Free;
    reg.Free;
  end;
end;

procedure TRegPropStorageManEh.SerRegistryKey(const Value: TRegistryKeyEh);
const RegistryKeyToHKeyArr: array [TRegistryKeyEh] of HKEY =
  (HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS,
   HKEY_PERFORMANCE_DATA, HKEY_CURRENT_CONFIG, HKEY_DYN_DATA, 0);
begin
  if FRegistryKey <> Value then
  begin
    FRegistryKey := Value;
    if FRegistryKey <> rkCustomRegistryKeyEh then
      FKey := RegistryKeyToHKeyArr[FRegistryKey];
  end;
end;

procedure TRegPropStorageManEh.SetKey(const Value: HKEY);
begin
  if FKey <> Value then
  begin
    FKey := Value;
    case FKey of
      HKEY_CLASSES_ROOT: FRegistryKey := rkClassesRootEh;
      HKEY_CURRENT_USER: FRegistryKey := rkCurrentUserEh;
      HKEY_LOCAL_MACHINE: FRegistryKey := rkLocalMachineEh;
      HKEY_USERS: FRegistryKey := rkUsersEh;
      HKEY_PERFORMANCE_DATA: FRegistryKey := rkPerformanceDataEh;
      HKEY_CURRENT_CONFIG: FRegistryKey := rkCurrentConfigEh;
      HKEY_DYN_DATA: FRegistryKey := rkDynDataEh;
    else
      FRegistryKey := rkCustomRegistryKeyEh;
    end;
  end;
end;

procedure TRegPropStorageManEh.WritePropertiesStream(PropStorage: TPropStorageEh; Stream: TStream);
var
  reg: TRegistry;
  Buffer: TBytes;
  Text, Line: String;
  i, Pos: Integer;
begin
  reg := nil;
  Buffer := nil;
  try
    reg := TRegistry.Create;
    reg.RootKey := Key;

    if Path = ''
      then reg.OpenKey(GetDefaultRegKey + '\' + PropStorage.Section, True)
      else reg.OpenKey(Path + '\' + PropStorage.Section, True);
//    GetMem(Buffer, Stream.Size);

//    SetString(Text, nil, Stream.Size*2);
//    Stream.ReadBuffer(Buffer^, Stream.Size);
//    BinToHex(Buffer, PChar(Text), Stream.Size);
    StreamReadBytes(Stream, Buffer, Stream.Size);
    BinToHexEh(Buffer, Text, Stream.Size);

    i := 0;
    Pos := 1;
    while Pos <= Length(Text) do
    begin
      Line := Copy(Text, Pos, 80);
      reg.WriteString('Line' + FormatFloat('0000000000', i), Line );
      Inc(Pos, 80);
      Inc(i);
    end;


    while reg.ValueExists('Line' + FormatFloat('0000000000', i)) do
    begin
      reg.DeleteValue('Line' + FormatFloat('0000000000', i));
      Inc(i);
    end;

//    SetString(Buffer, nil, Stream.Size - Stream.Position);
//    Stream.ReadBuffer(PChar(Buffer)^, Stream.Size - Stream.Position);
//    reg.WriteBinaryData(PropStorage.Section, PChar(Buffer)^, Length(Buffer));

  finally
//    FreeMem(Buffer);
    reg.Free;
  end;

end;

procedure TRegPropStorageManEh.WritePropertiesText(PropStorage: TPropStorageEh; Text: String);
var
  reg: TRegistry;
  sl: TStrings;
  i: Integer;
begin
  reg := nil;
  sl := nil;
  try
    sl := TStringList.Create;
    sl.Text := Text;

    reg := TRegistry.Create;
    reg.RootKey := Key;

    if Path = ''
      then reg.OpenKey(GetDefaultRegKey + '\' + PropStorage.Section, True)
      else reg.OpenKey(Path + '\' + PropStorage.Section, True);


    for i := 0 to sl.Count - 1 do
      reg.WriteString('Line' + FormatFloat('0000000000', i), sl[i] );

    i := sl.Count;
    while reg.ValueExists('Line' + FormatFloat('0000000000', i)) do
    begin
      reg.DeleteValue('Line' + FormatFloat('0000000000', i));
      Inc(i);
    end;

//    reg.WriteString(PropStorage.Section, Text);

  finally
    sl.Free;
    reg.Free;
  end;
end;

{$ENDIF}

{ TPropStorageEh }

constructor TPropStorageEh.Create(AOwner: TComponent);

{$ifdef eval}
  {$INCLUDE eval}
{$else}
begin
{$endif}

  inherited Create(AOwner);
  FSection := '';
  FActive := True;
  FStoredProps := TPropertyNamesEh.Create;
  FStoredProps.Root := AOwner;
end;

destructor TPropStorageEh.Destroy;