Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kolekce/d456/DCSLIB25.ZIP/DCIniStream.pas

Pascal/Delphi Source File | 2001-01-20 | 35KB | 1,312 lines

unit DCIniStream;

interface

uses
  Windows, Classes, SysUtils, DCRecordStream;

resourcestring
  RES_IKEY_ERR_INVALIDKEY = '═σΩε≡≡σΩ≥φ√Θ ≥Φ∩ Σδ  ''%s''';
  RES_IKEY_ERR_DUPNAME    = '╨ατΣσδ ''%s'' ≤µσ ±≤∙σ±≥Γ≤σ≥. ┬√ßσ≡Φ≥σ Σ≡≤πεσ Φ∞ ';

const
  HashTableSize     = 64;

  INIKEY_ROOT_NAME  = 'HIKSV';

  // Roots HashCodes
  INIKEY_LOCAL_MACHINE = $1;
  INIKEY_USERS         = $2;

  INIKEY_FLAG_READONLY = $01;
  INIKEY_FLAG_NOTVALUE = $02;
  INIKEY_FLAG_NOTSKEYS = $04;

  INIDAT_HEADER_SIZE   = $08;   // 8 Byte

  INIDAT_FLAG_READONLY = $01;
  INIDAT_FLAG_NOTEDIT  = $02;
  INIDAT_FLAG_DEFAULT  = $04;
  INIDAT_FLAG_EMPTY    = $08;

  SystemIniKeyNames: array[$1..$2] of string = (
    'INIKEY_LOCAL_MACHINE',
    'INIKEY_USERS');

type
  HIniRootKey     = 0..HashTableSize-1;
  HIniKey         = Longint;

  TKeyName        = string[40];
  THashTableType  = array[0..HashTableSize-1] of HIniKey;
  TIniDataType    = (idUnknown, idString, idInteger, idBinary);

  PIniKeyType_tag = ^TIniKeyType;
  TIniKeyType = packed record
    Flags     : WORD;           // 02
    Name      : TKeyName;       // 40
    ParentKey : Longint;        // 04
    HashCode  : WORD;           // 02
    HashNext  : Longint;        // 04
    HashPrev  : Longint;        // 04
    HashTable : THashTableType; // 04*64(HashTableSize)
    Data      : Longint;        // 04
    NumSubKeys: WORD;           // 02
    NumValues : WORD;           // 02
  end;

  PIniKeyData_tag = ^TIniKeyDataType;
  TIniKeyDataType = packed record
    Flags     : WORD;           // 02
    DataType  : SmallInt;       // 02
    NameLen   : WORD;           // 02
    DataLen   : WORD;           // 02
    NameValue : PChar;          // 01
    DataValue : Pointer;        // 01
  end;

  EIniKeyException = class(Exception);

  TValueList = class(TStringList)
  private
    FBuffer: Pointer;
    FFlags: WORD;
    function GetKeyValue(Index: Integer): PIniKeyData_tag;
    procedure SetKeyValue(Index: Integer; const Value: PIniKeyData_tag);
    function GetDataSize: Integer;
    procedure DestroyValue(pValue: PIniKeyData_tag);
  protected
    procedure PutData(const Name: string; Buffer: Pointer; ASize: Integer;
      AType: TIniDataType);
    function GetData(const Name: string; var Buffer: Pointer; var AType: TIniDataType): Integer;
  public
    constructor Create;
    procedure Delete(Index: Integer); override;
    procedure LoadValues(ABuffer: Pointer; ADataSize: Integer);
    function GetBuffer(var ABuffer: Pointer): Integer;
    procedure Clear; override;
    function DeleteValue(const Name: string): boolean;
    function RenameValue(const OldName, NewName: string): DWORD;
    function ReadCurrency(const Name: string): Currency;
    function ReadBinaryData(const Name: string; var Buffer; ASize: Integer): Integer;
    function ReadBool(const Name: string): Boolean;
    function ReadDateTime(const Name: string): TDateTime;
    function ReadFloat(const Name: string): Double;
    function ReadInteger(const Name: string): Longint;
    function ReadString(const Name: string): string;
    function ReadTime(const Name: string): TDateTime;
    procedure WriteCurrency(const Name: string; Value: Currency);
    procedure WriteBinaryData(const Name: string; var Buffer; ASize: Integer);
    procedure WriteBool(const Name: string; Value: Boolean);
    procedure WriteDate(const Name: string; Value: TDateTime);
    procedure WriteDateTime(const Name: string; Value: TDateTime);
    procedure WriteFloat(const Name: string; Value: Double);
    procedure WriteInteger(const Name: string; Value: Longint);
    procedure WriteString(const Name, Value: string);
    procedure WriteTime(const Name: string; Value: TDateTime);
    property KeyValue[Index: Integer]: PIniKeyData_tag read GetKeyValue write SetKeyValue;
    property Buffer: Pointer read FBuffer write FBuffer;
    property DataSize: Integer read GetDataSize;
    property Flags: WORD read FFlags write FFlags;
  end;

  TIniKeyStream = class(TRecordStream)
  private
    FRootKey: HIniRootKey;
    FValues: TValueList;
    FCurrentKey: HIniKey;
    FCurrentPath: string;
    procedure SetRootKey(const Value: HIniRootKey);
    function ClearKey(var AKey: TIniKeyType; AName: TKeyName = ''): PIniKeyType_tag;
    function GetBaseKey(Relative: Boolean): HIniKey;
    procedure CreateSystemKeys(var RootKey: TIniKeyType);
    function CreateDefaultValue: HIniKey;
  protected
    procedure GetRootData(AData: Pointer); override;
    function CreateKeyEx(hKey: HIniKey; AKey: string; var hResult: HIniKey): DWORD;
    function DeleteKeyEx(hKey: HIniKey; AKey: string = ''): DWORD;
    function OpenKeyEx(hKey: HIniKey; AKey: string; var hResult: HIniKey): DWORD;
    function GetKeyValuesEx(hKey: HIniKey; ValueList: TValueList): Integer;
    procedure CloseKeyEx(hKey: HIniKey; ValueList: TValueList);
    function Append(AData: Pointer): Integer;
    procedure WriteData(AData: TIniKeyType);
    procedure ReadData(var AData: PIniKeyType_tag);
    procedure ChangeKey(Value: HIniKey; const Path: string);
    function GetFlagsBit(AKeyInfo: TIniKeyType; AOffset: Byte): boolean;
    procedure SetFlagsBit(var AKeyInfo: TIniKeyType; AOffset: Byte;
      Value: Boolean);
    procedure LoadValuesEx;
  public
    constructor Create(AName: string);
    destructor Destroy; override;
    procedure CloseKey;
    function CreateKey(const Key: String): Boolean;
    function DeleteKey(const Key: string): Boolean;
    function OpenKey(const Key: String; CanCreate: Boolean): Boolean;
    function GetKeyInfo(var AKeyInfo: PIniKeyType_tag): boolean;
    procedure RenameValue(const OldName, NewName: string);
    function ReadCurrency(const Name: string): Currency;
    function ReadBinaryData(const Name: string; var Buffer; ASize: Integer): Integer;
    function ReadBool(const Name: string): Boolean;
    function ReadDateTime(const Name: string): TDateTime;
    function ReadFloat(const Name: string): Double;
    function ReadInteger(const Name: string): Longint;
    function ReadString(const Name: string): string;
    function ReadTime(const Name: string): TDateTime;
    procedure WriteCurrency(const Name: string; Value: Currency);
    procedure WriteBinaryData(const Name: string; var Buffer; ASize: Integer);
    procedure WriteBool(const Name: string; Value: Boolean);
    procedure WriteDate(const Name: string; Value: TDateTime);
    procedure WriteDateTime(const Name: string; Value: TDateTime);
    procedure WriteFloat(const Name: string; Value: Double);
    procedure WriteInteger(const Name: string; Value: Longint);
    procedure WriteString(const Name, Value: string);
    procedure WriteTime(const Name: string; Value: TDateTime);
    function GetDataInfo(const ValueName: string; var Value: TIniDataType): boolean;
    function GetDataSize(const ValueName: string): integer;
    procedure GetKeyNames(Strings: TStrings; AKey: boolean = False);
    procedure GetValueNames(Strings: TStrings);
    function RestoreKey(const Key, FileName: string): boolean;
    function SaveKey(const Key, FileName: string): boolean;
    property CurrentKey: HIniKey read FCurrentKey;
    property CurrentPath: string read FCurrentPath;
    property RootKey: HIniRootKey read FRootKey write SetRootKey;
  end;

  TRegKeyFile = class(TIniKeyStream)
  end;

function GetHashCode(Value: PChar; HashTableSize: Byte): Byte;

implementation

procedure ReadError(const Name: string);
begin
  raise EIniKeyException.CreateFmt(RES_IKEY_ERR_INVALIDKEY, [Name]);
end;

function IsRelative(const Value: string; var AValue: string): Boolean;
begin
  AValue := Value;
  Result := not ((Value <> '') and (Value[1] = '\'));
  if not Result then System.Delete(AValue, 1, 1);
end;

function GetSubKey(var Value: string): string;
 var
  nPos: Integer;
begin
  nPos   := Pos('\', Value);
  if nPos <> 0 then
  begin
    Result := Copy(Value, 1, nPos-1);
    Value  := Copy(Value, nPos+1, Length(Value)-nPos);
  end
  else begin
    Result := Value;
    Value  := '';
  end;
end;

function GetHashCode(Value: PChar; HashTableSize: Byte): Byte;
 var
  CharSum: longint;
begin
  CharSum := 0;
  while Value^ <> #0 do
  begin
    CharSum := CharSum + Byte(Value^);
    Inc(Value);
  end;
  Result := CharSum mod HashTableSize;
end;

{ TRecordStream }

function TIniKeyStream.Append(AData: Pointer): Integer;
begin
  Result := inherited Append(AData, SizeOf(TIniKeyType));
end;

procedure TIniKeyStream.ChangeKey(Value: HIniKey; const Path: string);
begin
  CloseKey;
  FCurrentKey := Value;
  FCurrentPath := Path;
end;

function TIniKeyStream.ClearKey(var AKey: TIniKeyType; AName: TKeyName): PIniKeyType_tag;
begin
  FillChar(AKey, SizeOf(TIniKeyType), 0);
  if AName <> '' then AKey.Name := AName;
  Result := @AKey;
end;

procedure TIniKeyStream.CloseKey;
begin
  if CurrentKey <> 0 then
  begin
    CloseKeyEx(FCurrentKey, FValues);
    FCurrentKey  := 0;
    FCurrentPath := '';
  end;
end;

procedure TIniKeyStream.CloseKeyEx(hKey: HIniKey; ValueList: TValueList);
 var
  pKeyInfo: PIniKeyType_tag;
  Buffer: Pointer;
  DataSize: Integer;
begin
  {±ε⌡≡αφσφΦσ Σαφφ√⌡ Ωδ■≈α}
  GetMem(pKeyInfo, SizeOf(TIniKeyType));
  try
   LockRecord(0);
   RecNo := hKey;
   GetKeyInfo(pKeyInfo);
   with pKeyInfo^ do
   begin
     NumValues := ValueList.Count;
     WriteData(pKeyInfo^);
     DataSize  := ValueList.GetBuffer(Buffer);
     RecNo     := Data;
     inherited WriteData(Buffer, DataSize);
   end;
   if DataSize > 0 then FreeMem(Buffer, DataSize);
   ValueList.Clear;
  finally
    FreeMem(pKeyInfo);
    UnlockRecord(0);
  end;
end;

constructor TIniKeyStream.Create(AName: string);
begin
  inherited Create(Format('%s.key',[AName]), SizeOf(TIniKeyType));
  FRootKey := INIKEY_LOCAL_MACHINE;
  FValues  := TValueList.Create;
end;

function TIniKeyStream.CreateDefaultValue: HIniKey;
 var
  Buffer: Pointer;
  DataSize: Integer;
  ValueList: TValueList;
begin
  ValueList := TValueList.Create;
  try
    ValueList.Flags := INIDAT_FLAG_READONLY or INIDAT_FLAG_DEFAULT or INIDAT_FLAG_EMPTY;
    ValueList.WriteString('', '');
    DataSize := ValueList.GetBuffer(Buffer);
  finally
    ValueList.Free;
  end;
  if DataSize > 0 then
    Result := inherited Append(Buffer, DataSize)
  else
    Result := 0;

  if DataSize > 0 then FreeMem(Buffer, DataSize);
end;

function TIniKeyStream.CreateKey(const Key: String): Boolean;
 var
  TempKey: HIniKey;
  S: string;
  Relative: boolean;
begin
  Relative := IsRelative(Key, S);
  Result   := CreateKeyEx(GetBaseKey(Relative), Key, TempKey) = ERROR_SUCCESS;
end;

function TIniKeyStream.CreateKeyEx(hKey: HIniKey; AKey: string;
  var hResult: HIniKey): DWORD;
 var
  SubKey: string;
  PKeyInfo, SKeyInfo: PIniKeyType_tag;
  hCode: Byte;
  HParentKey: HIniKey;
begin
  GetMem(PKeyInfo, SizeOf(TIniKeyType));
  GetMem(SKeyInfo, SizeOf(TIniKeyType));

  LockRecord(0);
  SeekRecord(hKey, 0);

  Result := ERROR_BAD_LENGTH;
  try
    while AKey <> '' do
    begin
      SubKey  := GetSubKey(AKey);
      hCode   := GetHashCode(PChar(AnsiUpperCase(SubKey)), HashTableSize);
      GetKeyInfo(PKeyInfo);
      if PKeyInfo^.HashTable[hCode] = 0 then
      begin
        {═αΣε ±ετΣα≥ⁿ}
        ClearKey(SKeyInfo^);
        with SKeyInfo^ do
        begin
          Name      := SubKey;
          HashCode  := hCode;
          HashPrev  := 0;
          ParentKey := RecNo;
          NumValues := 1;
          Data      := CreateDefaultValue;
        end;
        with PKeyInfo^ do
        begin
          Inc(NumSubKeys);
          HashTable[hCode] := Append(SKeyInfo);
          hResult := HashTable[hCode];
        end;
        RecNo := SKeyInfo^.ParentKey;
        WriteData(PKeyInfo^);
        Result := ERROR_SUCCESS;
      end
      else begin

        HParentKey := RecNo;
        RecNo      := PKeyInfo^.HashTable[hCode];
        GetKeyInfo(PKeyInfo);

        while (AnsiCompareText(PKeyInfo^.Name, SubKey) <> 0) and
              (PKeyInfo^.HashNext <> 0)
        do begin
          RecNo := PKeyInfo^.HashNext;
          GetKeyInfo(PKeyInfo);
        end;

        if AnsiCompareStr(PKeyInfo^.Name, SubKey) <> 0 then
        begin
          ClearKey(SKeyInfo^);
          with SKeyInfo^ do
          begin
            Name      := SubKey;
            HashCode  := hCode;
            HashPrev  := RecNo;
            ParentKey := HParentKey;
            NumValues := 1;
            Data      := CreateDefaultValue;
          end;
          with PKeyInfo^ do
          begin
            Inc(NumSubKeys);
            HashTable[hCode] := Append(SKeyInfo);
            hResult := HashTable[hCode];
          end;
          RecNo := SKeyInfo^.ParentKey;
          WriteData(PKeyInfo^);
          Append(SKeyInfo);
          Result := ERROR_SUCCESS;
        end
        else begin
          {╥αΩεΘ ≤µσ σ±≥ⁿ, ∩σ≡σΩδ■≈ασ∞±  φα ±δσΣ. SubKey}
          Result := ERROR_DUP_NAME;
          hResult:= RecNo;
        end;
      end;
    end;
  finally
    FreeMem(PKeyInfo);
    FreeMem(SKeyInfo);
    UnlockRecord(0);
  end;
end;

procedure TIniKeyStream.CreateSystemKeys(var RootKey: TIniKeyType);
 var
  i: Integer;
  PKeyValue: PIniKeyType_tag;
  DataKey: HIniKey;
begin
  GetMem(PKeyValue, SizeOf(TIniKeyType));
  LockRecord(0);
  try
    for i := Low(SystemIniKeyNames) to High(SystemIniKeyNames) do
    begin
      ClearKey(PKeyValue^, SystemIniKeyNames[i]);
      SetFlagsBit(PKeyValue^, INIKEY_FLAG_READONLY, True);
      RootKey.HashTable[i] := Append(PKeyValue);
    end;
    for i := Low(SystemIniKeyNames) to High(SystemIniKeyNames) do
    begin
      DataKey := CreateDefaultValue;
      RecNo   := RootKey.HashTable[i];
      GetKeyInfo(PKeyValue);
      PKeyValue^.Data      := DataKey;
      PKeyValue^.NumValues := 1;
      WriteData(PKeyValue^);
    end;
  finally
    UnlockRecord(0);
  end;
end;

function TIniKeyStream.DeleteKey(const Key: string): Boolean;
 var
  Relative: Boolean;
  KeyPath, S: string;
begin
  Relative := IsRelative(Key, S);
  KeyPath  := CurrentPath;
  if CurrentKey <> 0 then
  begin
    CloseKey;
    Result := DeleteKeyEx(GetBaseKey(Relative), S) = ERROR_SUCCESS;
    Result := Result and OpenKey(KeyPath, True);
  end
  else
    Result := DeleteKeyEx(GetBaseKey(Relative), S) = ERROR_SUCCESS;
end;

function TIniKeyStream.DeleteKeyEx(hKey: HIniKey; AKey: string): DWORD;
 var
  hTempKey: HIniKey;
  pKeyInfo: PIniKeyType_tag;

  function DeleteSubKeyEx(hSubKey: HIniKey; MainKey: boolean): DWORD; forward;

  function DeleteHashKeys(hSubKey: HIniKey): DWORD;
  begin
    Result := ERROR_SUCCESS;
    RecNo  := hSubKey;
    GetKeyInfo(PKeyInfo);
    if PKeyInfo^.HashNext <>0 then Result := DeleteHashKeys(PKeyInfo^.HashNext);
    if Result = ERROR_SUCCESS then Result := DeleteSubKeyEx(hSubKey, False);
  end;

  function DeleteSubKeyEx(hSubKey: HIniKey; MainKey: boolean): DWORD;
   var
    i: Integer;
    AParentKey, AHashPrev, AHashNext: HIniKey;
    AHashCode: WORD;
  begin
    GetKeyInfo(PKeyInfo);
    with PKeyInfo^ do
    begin
      AParentKey := ParentKey;
      AHashPrev  := HashPrev;
      AHashNext  := HashNext;
      AHashCode  := HashCode;
      {╙Σαδ σ∞ Σαφφ√σ πδαΓφεπε Ωδ■≈α}
      if Data <> 0 then Delete(Data);
      {
        ╙Σαδ σ∞ ∩εΣΩδ■≈Φ:
         ╬ß⌡εΣΦ∞ ≥αßδΦ÷≤ HashTable, Σδ  ΩαµΣεΘ φσφ≤δσΓεΘ τα∩Φ±Φ,
         Γ√Σσδ σ∞ ÷σ∩ε≈Ω≤ Ωδ■≈σΘ(HashNext) Φ ≤Σαδ σ∞ Φ⌡ Γ εß≡α≥φε∞ ∩ε≡ ΣΩσ
       }
      if NumSubKeys > 0 then
      begin
        for i := Low(HashTable) to High(HashTable) do
          if HashTable[i] <> 0 then DeleteHashKeys(HashTable[i]);
      end;
    end;
    {╙Σαδ σ∞ πδαΓφ√Θ Ωδ■≈}
    if MainKey then
    begin
      if AHashPrev <> 0 then
      begin
        RecNo := AHashPrev;
        GetKeyInfo(PKeyInfo);
        PKeyInfo^.HashNext := AHashNext;
        WriteData(PKeyInfo^);

        RecNo := AParentKey;
        GetKeyInfo(PKeyInfo);
        Dec(PKeyInfo^.NumSubKeys);
        WriteData(PKeyInfo^);
      end
      else begin
        RecNo := AParentKey;
        GetKeyInfo(PKeyInfo);
        PKeyInfo^.HashTable[AHashCode] := AHashNext;
        Dec(PKeyInfo^.NumSubKeys);
        WriteData(PKeyInfo^);
      end;
    end;
    Delete(hSubKey);
    Result := ERROR_SUCCESS
  end;

begin
  if AKey <> '' then
    Result := OpenKeyEx(hKey, AKey, hTempKey)
  else begin
    Result   := ERROR_SUCCESS;
    hTempKey := hKey
  end;
  if Result = ERROR_SUCCESS then
  begin
    LockRecord(0);
    SeekRecord(hTempKey, 0);
    GetMem(PKeyInfo, SizeOf(TIniKeyType));
    try
      Result := DeleteSubKeyEx(hTempKey, True);
    finally
      FreeMem(PKeyInfo);
      UnlockRecord(0);
    end;
  end;
end;

destructor TIniKeyStream.Destroy;
begin
  FValues.Free;
  inherited;
end;

function TIniKeyStream.GetBaseKey(Relative: Boolean): HIniKey;
begin
  if (CurrentKey = 0) or not Relative then
    Result := PIniKeyType_tag(RootData)^.HashTable[FRootKey]
  else
    Result := CurrentKey;
end;

function TIniKeyStream.GetDataInfo(const ValueName: string;
  var Value: TIniDataType): boolean;
 var
  Buffer: Pointer;
begin
  Result := FValues.GetData(ValueName, Buffer, Value) <> 0;
end;

function TIniKeyStream.GetDataSize(const ValueName: string): integer;
 var
  Buffer: Pointer;
  ADataType: TIniDataType;
begin
  if FValues.GetData(ValueName, Buffer, ADataType) <> 0 then
    Result := PIniKeyData_tag(Buffer)^.DataLen
  else
    Result := -1;
end;

function TIniKeyStream.GetFlagsBit(AKeyInfo: TIniKeyType;
  AOffset: Byte): boolean;
begin
  if AKeyInfo.Flags and AOffset = 0 then
    Result := False
  else
    Result := True
end;

function TIniKeyStream.GetKeyInfo(var AKeyInfo: PIniKeyType_tag): boolean;
begin
  Result := True;
  ClearKey(AKeyInfo^);
  ReadData(AKeyInfo);
end;

procedure TIniKeyStream.GetKeyNames(Strings: TStrings; AKey: boolean = False);
 var
  hKey: HIniKey;
  PKeyInfo, PSubKeyInfo: PIniKeyType_tag;
  i: integer;

  procedure AddKeyName(hSubKey: HIniKey);
   var
    pKey: ^integer;
  begin
    SeekRecord(hSubKey, 0);
    GetKeyInfo(PSubKeyInfo);
    if AKey then
    begin
      GetMem(pKey, Sizeof(Integer));
      pKey^ := hSubKey;
      Strings.AddObject(PSubKeyInfo^.Name, TObject(pKey));
    end
    else
      Strings.Add(PSubKeyInfo^.Name);
    if PSubKeyInfo^.HashNext <> 0 then AddKeyName(PSubKeyInfo^.HashNext);
  end;

begin
  Strings.Clear;
  hKey := CurrentKey;
  SeekRecord(hKey, 0);
  GetMem(PKeyInfo, SizeOf(TIniKeyType));
  GetMem(PSubKeyInfo, SizeOf(TIniKeyType));
  try
    GetKeyInfo(PKeyInfo);
    with PKeyInfo^ do
    begin
      if NumSubKeys > 0 then
      begin
        for i := Low(HashTable) to High(HashTable) do
          if HashTable[i] <> 0 then AddKeyName(HashTable[i]);
      end;
    end;
  finally
    FreeMem(PKeyInfo);
    FreeMem(PSubKeyInfo);
    SeekRecord(hKey, 0);
  end;
end;

function TIniKeyStream.GetKeyValuesEx(hKey: HIniKey;
  ValueList: TValueList): Integer;
 var
  pKeyInfo: PIniKeyType_tag;
  ABuffer: Pointer;
  DataSize: Integer;
begin
  RecNo := hKey;
  GetMem(pKeyInfo, SizeOf(TIniKeyType));
  try
    GetKeyInfo(PKeyInfo);
    if PKeyInfo^.Data > 0 then
    begin
      RecNo   := PKeyInfo^.Data;
      ABuffer := AllocMem(1);
      inherited ReadData(ABuffer, DataSize);
      ValueList.LoadValues(ABuffer, DataSize);
      FreeMem(ABuffer, DataSize);
    end
    else
      ValueList.Clear;
    Result := ValueList.Count;
  finally
    FreeMem(pKeyInfo);
  end;
end;

procedure TIniKeyStream.GetRootData(AData: Pointer);
begin
  with PIniKeyType_tag(AData)^ do
  begin
    Name := Format('%s %s',[INIKEY_ROOT_NAME,
                   FormatDateTime('dd.mm.yyyy hh:nn:ss', Now)]);
    HashCode   := 0;
    HashNext   := 0;
    Data       := 0;
    NumSubKeys := 2;
    NumValues  := 0;

    SetFlagsBit(PIniKeyType_tag(AData)^, INIKEY_FLAG_READONLY, True);
    SetFlagsBit(PIniKeyType_tag(AData)^, INIKEY_FLAG_NOTVALUE, True);
    SetFlagsBit(PIniKeyType_tag(AData)^, INIKEY_FLAG_NOTSKEYS, True);


  end;
  {
    ╬∩≡σΣσδ σ∞
      INIKEY_LOCAL_MACHINE
      INIKEY_USERS
  }
  CreateSystemKeys(PIniKeyType_tag(AData)^);

end;

procedure TIniKeyStream.GetValueNames(Strings: TStrings);
 var
  i: integer;
  Value: PIniKeyData_tag;
begin
  Strings.Clear;
  for i := 0 to FValues.Count-1 do
  begin
    Value := FValues.KeyValue[i];
    if Trim(Value^.NameValue) <> '' then Strings.Add(Value^.NameValue);
  end;
end;

procedure TIniKeyStream.LoadValuesEx;
begin
  GetKeyValuesEx(CurrentKey, FValues);
end;

function TIniKeyStream.OpenKey(const Key: String;
  CanCreate: Boolean): Boolean;
var
  TempKey: HIniKey;
  S: string;
  Relative: Boolean;
  Value: integer;
begin
  Relative := IsRelative(Key, S);
  TempKey  := 0;
  if not CanCreate or (S = '') then
    Result := OpenKeyEx(GetBaseKey(Relative), S, TempKey) = ERROR_SUCCESS
  else begin
    Value  := CreateKeyEx(GetBaseKey(Relative), S, TempKey);
    Result := (Value = ERROR_SUCCESS) or (Value = ERROR_DUP_NAME);
  end;
  if Result then
  begin
    if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
    ChangeKey(TempKey, S);
    GetKeyValuesEx(CurrentKey, FValues);
  end;
end;

function TIniKeyStream.OpenKeyEx(hKey: HIniKey; AKey: string;
  var hResult: HIniKey): DWORD;
 var
  SubKey: string;
  PKeyInfo: PIniKeyType_tag;
  hCode: Byte;
begin
  GetMem(PKeyInfo, SizeOf(TIniKeyType));

  LockRecord(0);
  SeekRecord(hKey, 0);

  Result  := ERROR_SUCCESS;
  hResult := 0;

  try
    while (AKey <> '') and (Result = ERROR_SUCCESS) do
    begin
      SubKey  := GetSubKey(AKey);
      hCode   := GetHashCode(PChar(AnsiUpperCase(SubKey)), HashTableSize);
      GetKeyInfo(PKeyInfo);

      if AnsiCompareText(PKeyInfo^.Name, SubKey) = 0 then Break;

      if PKeyInfo^.HashTable[hCode] = 0 then
      begin
        Result := ERROR_BADKEY
      end
      else begin

        RecNo := PKeyInfo^.HashTable[hCode];
        GetKeyInfo(PKeyInfo);

        while (AnsiCompareText(PKeyInfo^.Name, SubKey) <> 0) and
              (PKeyInfo^.HashNext <> 0)
        do begin
          RecNo := PKeyInfo^.HashNext;
          GetKeyInfo(PKeyInfo);
        end;

        if AnsiCompareStr(PKeyInfo^.Name, SubKey) <> 0 then
        begin
          Result := ERROR_BADKEY
        end
        else
          {╥αΩεΘ ≤µσ σ±≥ⁿ, ∩σ≡σΩδ■≈ασ∞±  φα ±δσΣ. SubKey}
          ;
      end;
    end;
  finally
    UnlockRecord(0);
    FreeMem(PKeyInfo);
    if Result = ERROR_SUCCESS then hResult := RecNo;
  end;
end;

function TIniKeyStream.ReadBinaryData(const Name: string; var Buffer;
  ASize: Integer): Integer;
begin
  Result := FValues.ReadBinaryData(Name, Buffer, ASize);
end;

function TIniKeyStream.ReadBool(const Name: string): Boolean;
begin
  Result := FValues.ReadBool(Name);
end;

function TIniKeyStream.ReadCurrency(const Name: string): Currency;
begin
  Result := FValues.ReadCurrency(Name);
end;

procedure TIniKeyStream.ReadData(var AData: PIniKeyType_tag);
 var
  ADataSize: Integer;
begin
  inherited ReadData(Pointer(AData), ADataSize);
end;

function TIniKeyStream.ReadDateTime(const Name: string): TDateTime;
begin
  Result := FValues.ReadDateTime(Name);
end;

function TIniKeyStream.ReadFloat(const Name: string): Double;
begin
  Result := FValues.ReadFloat(Name);
end;

function TIniKeyStream.ReadInteger(const Name: string): LongInt;
begin
  Result := FValues.ReadInteger(Name);
end;

function TIniKeyStream.ReadString(const Name: string): string;
begin
  Result := FValues.ReadString(Name);
end;

function TIniKeyStream.ReadTime(const Name: string): TDateTime;
begin
  Result := ReadDateTime(Name);
end;

procedure TIniKeyStream.RenameValue(const OldName, NewName: string);
begin
  FValues.RenameValue(OldName, NewName)
end;

function TIniKeyStream.RestoreKey(const Key, FileName: string): boolean;
begin
  Result := True;
end;

function TIniKeyStream.SaveKey(const Key, FileName: string): boolean;
begin
  Result := True;
end;

procedure TIniKeyStream.SetFlagsBit(var AKeyInfo: TIniKeyType;
  AOffset: Byte; Value: Boolean);
begin
  if Value then
    AKeyInfo.Flags := AKeyInfo.Flags or AOffset
  else
    AKeyInfo.Flags := AKeyInfo.Flags and (AOffset xor $FF)
end;

procedure TIniKeyStream.SetRootKey(const Value: HIniRootKey);
begin
  if RootKey <> Value then
  begin
    FRootKey := Value;
    CloseKey;
  end;
end;

procedure TIniKeyStream.WriteBinaryData(const Name: string; var Buffer;
  ASize: Integer);
begin
  FValues.WriteBinaryData(Name, Buffer, ASize);
end;

procedure TIniKeyStream.WriteBool(const Name: string; Value: Boolean);
begin
  FValues.WriteBool(Name, Value);
end;

procedure TIniKeyStream.WriteCurrency(const Name: string; Value: Currency);
begin
  FValues.WriteCurrency(Name, Value);
end;

procedure TIniKeyStream.WriteData(AData: TIniKeyType);
begin
  inherited WriteData(@AData, SizeOf(TIniKeyType))
end;

procedure TIniKeyStream.WriteDate(const Name: string; Value: TDateTime);
begin
  WriteDateTime(Name, Value);
end;

procedure TIniKeyStream.WriteDateTime(const Name: string;
  Value: TDateTime);
begin
  FValues.WriteDateTime(Name, Value);
end;

procedure TIniKeyStream.WriteFloat(const Name: string; Value: Double);
begin
  FValues.WriteFloat(Name, Value);
end;

procedure TIniKeyStream.WriteInteger(const Name: string; Value: Longint);
begin
  FValues.WriteInteger(Name, Value);
end;

procedure TIniKeyStream.WriteString(const Name, Value: string);
begin
  FValues.WriteString(Name, Value);
end;

procedure TIniKeyStream.WriteTime(const Name: string; Value: TDateTime);
begin
  WriteDateTime(Name, Value);
end;

{ TValueList }

procedure TValueList.Clear;
 var
  i: Integer;
begin
  FFlags := 0;
  for i := 0 to Count-1 do DestroyValue(KeyValue[i]);
  inherited;
end;

constructor TValueList.Create;
begin
  inherited;
  FFlags := 0;
end;

function TValueList.GetDataSize: Integer;
 var
  i: Integer;
  pKeyData: PIniKeyData_tag;
begin
  Result := 0;
  for i := 0 to Count-1 do
  begin
    pKeyData := KeyValue[i];
    with pKeyData^ do  Inc(Result, INIDAT_HEADER_SIZE + NameLen + DataLen);
  end;
end;

function TValueList.GetBuffer(var ABuffer: Pointer): Integer;
 var
  Offset: DWORD;
  i: Integer;
  pKeyData: PIniKeyData_tag;
begin
  Offset := 0;
  Result := DataSize;
  GetMem(ABuffer, DataSize);
  for i := 0 to Count-1 do
  begin
    pKeyData := KeyValue[i];
    System.Move(pKeyData^, (PChar(ABuffer)+Offset)^, INIDAT_HEADER_SIZE);
    Inc(Offset, INIDAT_HEADER_SIZE);
    with pKeyData^ do
    begin
      System.Move(NameValue^, (PChar(ABuffer)+Offset)^, NameLen);
      Inc(Offset, NameLen);
      System.Move(DataValue^, (PChar(ABuffer)+Offset)^, DataLen);
      Inc(Offset, DataLen);
    end;
  end;
end;

function TValueList.GetData(const Name: string; var Buffer: Pointer;
  var AType: TIniDataType): Integer;
 var
  i: Integer;
  pKeyData: PIniKeyData_tag;
begin
  i := IndexOf(Name);
  if i > -1 then
  begin
    pKeyData   := KeyValue[i];
    with pKeyData^ do
    begin
      Buffer := DataValue;
      AType  := TIniDataType(DataType);
      Result := DataLen;
    end;
  end
  else
    Result := 0;
end;

function TValueList.GetKeyValue(Index: Integer): PIniKeyData_tag;
begin
  Result := PIniKeyData_tag(GetObject(Index));
end;

procedure TValueList.LoadValues(ABuffer: Pointer; ADataSize: Integer);
 var
  Offset: Integer;
  pKeyData: PIniKeyData_tag;
begin
  Buffer := ABuffer;
  Clear;
  Offset := 0;
  while Offset < ADataSize do
  begin
    GetMem(pKeyData, SizeOf(TIniKeyDataType));

    System.Move((PChar(Buffer)+Offset)^, pKeyData^, INIDAT_HEADER_SIZE);
    Inc(Offset, INIDAT_HEADER_SIZE);

    with pKeyData^ do
    begin
      GetMem(NameValue, NameLen);
      System.Move((PChar(Buffer)+Offset)^, NameValue^, NameLen);
      Inc(Offset, NameLen);

      if DataLen > 0 then
      begin
        GetMem(DataValue, DataLen);
        System.Move((PChar(Buffer)+Offset)^, DataValue^, DataLen);
      end;
      Inc(Offset, DataLen);

      AddObject(NameValue, TObject(pKeyData))
    end;
  end;
  Sort;
end;

procedure TValueList.PutData(const Name: string; Buffer: Pointer;
 ASize: Integer; AType: TIniDataType);
 var
  i: Integer;
  pKeyData: PIniKeyData_tag;
begin
  i := IndexOf(Name);

  if i > -1 then
  begin
    pKeyData   := KeyValue[i];
    with pKeyData^ do
    begin
      ReallocMem(DataValue, ASize);
    end;
  end else
  begin
    GetMem(pKeyData, SizeOf(TIniKeyDataType));
    with pKeyData^ do
    begin
      Flags     := FFlags;
      NameLen   := Length(Name)+1;

      GetMem(NameValue, NameLen);
      StrLCopy(NameValue, PChar(Name), NameLen);

      GetMem(DataValue, ASize);
    end;
    AddObject(Name, TObject(pKeyData));
  end;

  with pKeyData^ do
  begin
    DataType := Ord(AType);
    DataLen  := ASize;
    System.Move(Buffer^, DataValue^, DataLen);
  end;
end;

function TValueList.ReadCurrency(const Name: string): Currency;
 var
  DataLen  : Integer;
  DataType : TIniDataType;
  DataValue: Pointer;
begin
  DataLen := GetData(Name, DataValue, DataType);
  Result  := 0;
  if DataLen > 0 then
  begin
    if (DataType = idBinary) and (DataLen = SizeOf(Currency)) then
      System.Move(DataValue^, Result, DataLen)
    else
      ReadError(Name);
  end;
end;

function TValueList.ReadBinaryData(const Name: string; var Buffer;
  ASize: Integer): Integer;
 var
  DataLen  : Integer;
  DataType : TIniDataType;
  DataValue: Pointer;
begin
  DataLen := GetData(Name, DataValue, DataType);
  Result  := 0;
  if DataLen > 0 then
  begin
    if (DataType = idBinary) and (ASize >= DataLen) then
    begin
      System.Move(DataValue^, Buffer, DataLen);
      Result := DataLen;
    end
    else
      ReadError(Name);
  end
end;

function TValueList.ReadBool(const Name: string): Boolean;
begin
  Result := ReadInteger(Name) <> 0;
end;

function TValueList.ReadDateTime(const Name: string): TDateTime;
 var
  DataLen  : Integer;
  DataType : TIniDataType;
  DataValue: Pointer;
begin
  DataLen := GetData(Name, DataValue, DataType);
  Result  := 0;
  if DataLen > 0 then
  begin
    if (DataType = idBinary) and (DataLen = SizeOf(TDateTime)) then
      System.Move(DataValue^, Result, DataLen)
    else
      ReadError(Name);
  end;
end;

function TValueList.ReadInteger(const Name: string): LongInt;
 var
  DataLen  : Integer;
  DataType : TIniDataType;
  DataValue: Pointer;
begin
  DataLen := GetData(Name, DataValue, DataType);
  Result  := 0;
  if DataLen > 0 then
  begin
    if DataType = idInteger then
      System.Move(DataValue^, Result, DataLen)
    else
      ReadError(Name);
  end;
end;

function TValueList.ReadFloat(const Name: string): Double;
 var
  DataLen  : Integer;
  DataType : TIniDataType;
  DataValue: Pointer;
begin
  DataLen := GetData(Name, DataValue, DataType);
  Result  := 0;
  if DataLen > 0 then
  begin
    if (DataType = idBinary) and (DataLen = SizeOf(Double)) then
      System.Move(DataValue^, Result, DataLen)
    else
      ReadError(Name);
  end;
end;

function TValueList.ReadString(const Name: string): string;
 var
  DataLen  : Integer;
  DataType : TIniDataType;
  DataValue: Pointer;
begin
  DataLen := GetData(Name, DataValue, DataType);
  if DataLen > 0 then
  begin
    if DataType = idString then
      SetString(Result, PChar(DataValue), DataLen-1)
    else
      ReadError(Name);
  end
  else
    Result := '';
end;

function TValueList.ReadTime(const Name: string): TDateTime;
begin
  Result := ReadDateTime(Name);
end;

function TValueList.RenameValue(const OldName, NewName: string): DWORD;
 var
  i, j: Integer;
  pKeyData: PIniKeyData_tag;
begin
  i := IndexOf(OldName);
  j := IndexOf(NewName);

  if (j > -1) and (i <> j) then
  begin
    Result := ERROR_DUP_NAME;
    Exit;
  end;

  if (i > -1) and (i <> j) then
  begin
    Strings[i] := NewName;
    pKeyData   := KeyValue[i];
    with pKeyData^ do
    begin
      NameLen := Length(NewName);
      ReallocMem(NameValue, NameLen+1);
      StrPCopy(NameValue, NewName);
    end;
  end;

  Result := ERROR_SUCCESS;
end;

procedure TValueList.SetKeyValue(Index: Integer;
  const Value: PIniKeyData_tag);
begin
  PutObject(Index, TObject(Value));
end;

procedure TValueList.WriteBinaryData(const Name: string; var Buffer;
  ASize: Integer);
begin
  PutData(Name, @Buffer, ASize, idBinary);
end;

procedure TValueList.WriteBool(const Name: string; Value: Boolean);
begin
  WriteInteger(Name, Ord(Value));
end;

procedure TValueList.WriteCurrency(const Name: string; Value: Currency);
begin
  PutData(Name, @Value, SizeOf(Currency), idBinary);
end;

procedure TValueList.WriteDate(const Name: string; Value: TDateTime);
begin
  WriteDateTime(Name, Value);
end;

procedure TValueList.WriteDateTime(const Name: string; Value: TDateTime);
begin
  PutData(Name, @Value, SizeOf(TDateTime), idBinary);
end;

procedure TValueList.WriteInteger(const Name: string; Value: LongInt);
begin
  PutData(Name, @Value, SizeOf(LongInt), idInteger);
end;

procedure TValueList.WriteFloat(const Name: string; Value: Double);
begin
  PutData(Name, @Value, SizeOf(Double), idBinary);
end;

procedure TValueList.WriteString(const Name, Value: string);
begin
  PutData(Name, PChar(Value), Length(Value)+1, idString);
end;

procedure TValueList.WriteTime(const Name: string; Value: TDateTime);
begin
  WriteDateTime(Name, Value);
end;

procedure TValueList.Delete(Index: Integer);
begin
  DestroyValue(KeyValue[Index]);
  inherited;
end;

procedure TValueList.DestroyValue(pValue: PIniKeyData_tag);
begin
  with pValue^ do
  begin
    FreeMem(NameValue, NameLen);
    if DataLen <> 0 then  FreeMem(DataValue, DataLen);
  end;
  FreeMem(pValue);
end;

function TValueList.DeleteValue(const Name: string): boolean;
 var
  Index: integer;
begin
  Result := True;
  Index  := IndexOf(Name);
  if Index > -1 then
    Delete(Index)
  else
    Result := False;
end;

end.