home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 April / Chip_1997-04_cd.bin / prezent / cb / data.z / REGISTRY.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-16  |  26KB  |  962 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1996 Borland International        }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit Registry;
  11.  
  12. {$R-}
  13.  
  14. interface
  15.  
  16. uses Windows, Classes, SysUtils;
  17.  
  18. type
  19.   ERegistryException = class(Exception);
  20.  
  21.   TRegKeyInfo = record
  22.     NumSubKeys: Integer;
  23.     MaxSubKeyLen: Integer;
  24.     NumValues: Integer;
  25.     MaxValueLen: Integer;
  26.     MaxDataLen: Integer;
  27.     FileTime: TFileTime;
  28.   end;
  29.  
  30.   TRegDataType = (rdUnknown, rdString, rdExpandString, rdInteger, rdBinary);
  31.  
  32.   TRegDataInfo = record
  33.     RegData: TRegDataType;
  34.     DataSize: Integer;
  35.   end;
  36.  
  37.   TRegistry = class(TObject)
  38.   private
  39.     FCurrentKey: HKEY;
  40.     FRootKey: HKEY;
  41.     FLazyWrite: Boolean;
  42.     FCurrentPath: string;
  43.     FCloseRootKey: Boolean;
  44.     procedure SetRootKey(Value: HKEY);
  45.   protected
  46.     procedure ChangeKey(Value: HKey; const Path: string);
  47.     function GetBaseKey(Relative: Boolean): HKey;
  48.     function GetData(const Name: string; Buffer: Pointer;
  49.       BufSize: Integer; var RegData: TRegDataType): Integer;
  50.     function GetKey(const Key: string): HKEY;
  51.     procedure PutData(const Name: string; Buffer: Pointer; BufSize: Integer; RegData: TRegDataType);
  52.     procedure SetCurrentKey(Value: HKEY);
  53.   public
  54.     constructor Create;
  55.     destructor Destroy; override;
  56.     procedure CloseKey;
  57.     function CreateKey(const Key: string): Boolean;
  58.     function DeleteKey(const Key: string): Boolean;
  59.     function DeleteValue(const Name: string): Boolean;
  60.     function GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
  61.     function GetDataSize(const ValueName: string): Integer;
  62.     function GetDataType(const ValueName: string): TRegDataType;
  63.     function GetKeyInfo(var Value: TRegKeyInfo): Boolean;
  64.     procedure GetKeyNames(Strings: TStrings);
  65.     procedure GetValueNames(Strings: TStrings);
  66.     function HasSubKeys: Boolean;
  67.     function KeyExists(const Key: string): Boolean;
  68.     function LoadKey(const Key, FileName: string): Boolean;
  69.     procedure MoveKey(const OldName, NewName: string; Delete: Boolean);
  70.     function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
  71.     function ReadCurrency(const Name: string): Currency;
  72.     function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
  73.     function ReadBool(const Name: string): Boolean;
  74.     function ReadDate(const Name: string): TDateTime;
  75.     function ReadDateTime(const Name: string): TDateTime;
  76.     function ReadFloat(const Name: string): Double;
  77.     function ReadInteger(const Name: string): Integer;
  78.     function ReadString(const Name: string): string;
  79.     function ReadTime(const Name: string): TDateTime;
  80.     function RegistryConnect(const UNCName: string): Boolean;
  81.     procedure RenameValue(const OldName, NewName: string);
  82.     function ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
  83.     function RestoreKey(const Key, FileName: string): Boolean;
  84.     function SaveKey(const Key, FileName: string): Boolean;
  85.     function UnLoadKey(const Key: string): Boolean;
  86.     function ValueExists(const Name: string): Boolean;
  87.     procedure WriteCurrency(const Name: string; Value: Currency);
  88.     procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
  89.     procedure WriteBool(const Name: string; Value: Boolean);
  90.     procedure WriteDate(const Name: string; Value: TDateTime);
  91.     procedure WriteDateTime(const Name: string; Value: TDateTime);
  92.     procedure WriteFloat(const Name: string; Value: Double);
  93.     procedure WriteInteger(const Name: string; Value: Integer);
  94.     procedure WriteString(const Name, Value: string);
  95.     procedure WriteTime(const Name: string; Value: TDateTime);
  96.     property CurrentKey: HKEY read FCurrentKey;
  97.     property CurrentPath: string read FCurrentPath;
  98.     property LazyWrite: Boolean read FLazyWrite write FLazyWrite;
  99.     property RootKey: HKEY read FRootKey write SetRootKey;
  100.   end;
  101.  
  102.   TRegIniFile = class(TRegistry)
  103.   private
  104.     FFileName: string;
  105.   public
  106.     constructor Create(const FileName: string);
  107.     function ReadString(const Section, Ident, Default: string): string;
  108.     procedure WriteString(const Section, Ident, Value: String);
  109.     function ReadInteger(const Section, Ident: string;
  110.       Default: Longint): Longint;
  111.     procedure WriteInteger(const Section, Ident: string; Value: Longint);
  112.     function ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
  113.     procedure WriteBool(const Section, Ident: string; Value: Boolean);
  114.     procedure ReadSection(const Section: string; Strings: TStrings);
  115.     procedure ReadSections(Strings: TStrings);
  116.     procedure ReadSectionValues(const Section: string; Strings: TStrings);
  117.     procedure EraseSection(const Section: string);
  118.     procedure DeleteKey(const Section, Ident: String);
  119.     property FileName: string read FFileName;
  120.   end;
  121.  
  122. implementation
  123.  
  124. uses Consts;
  125.  
  126. procedure ReadError(const Name: string);
  127. begin
  128.   raise ERegistryException.CreateResFmt(SInvalidRegType, [Name]);
  129. end;
  130.  
  131. function IsRelative(const Value: string): Boolean;
  132. begin
  133.   Result := not ((Value <> '') and (Value[1] = '\'));
  134. end;
  135.  
  136. function RegDataToDataType(Value: TRegDataType): Integer;
  137. begin
  138.   case Value of
  139.     rdString: Result := REG_SZ;
  140.     rdExpandString: Result := REG_EXPAND_SZ;
  141.     rdInteger: Result := REG_DWORD;
  142.     rdBinary: Result := REG_BINARY;
  143.   else
  144.     Result := REG_NONE;
  145.   end;
  146. end;
  147.  
  148. function DataTypeToRegData(Value: Integer): TRegDataType;
  149. begin
  150.   if Value = REG_SZ then Result := rdString
  151.   else if Value = REG_EXPAND_SZ then Result := rdExpandString
  152.   else if Value = REG_DWORD then Result := rdInteger
  153.   else if Value = REG_BINARY then Result := rdBinary
  154.   else Result := rdUnknown;
  155. end;
  156.  
  157. constructor TRegistry.Create;
  158. begin
  159.   RootKey := HKEY_CURRENT_USER;
  160.   LazyWrite := True;
  161. end;
  162.  
  163. destructor TRegistry.Destroy;
  164. begin
  165.   CloseKey;
  166.   inherited;
  167. end;
  168.  
  169. procedure TRegistry.CloseKey;
  170. begin
  171.   if CurrentKey <> 0 then
  172.   begin
  173.     if LazyWrite then
  174.       RegCloseKey(CurrentKey) else
  175.       RegFlushKey(CurrentKey);
  176.     FCurrentKey := 0;
  177.     FCurrentPath := '';
  178.   end;
  179. end;
  180.  
  181. procedure TRegistry.SetRootKey(Value: HKEY);
  182. begin
  183.   if RootKey <> Value then
  184.   begin
  185.     if FCloseRootKey then
  186.     begin
  187.       RegCloseKey(RootKey);
  188.       FCloseRootKey := False;
  189.     end;
  190.     FRootKey := Value;
  191.     CloseKey;
  192.   end;
  193. end;
  194.  
  195. procedure TRegistry.ChangeKey(Value: HKey; const Path: string);
  196. begin
  197.   CloseKey;
  198.   FCurrentKey := Value;
  199.   FCurrentPath := Path;
  200. end;
  201.  
  202. function TRegistry.GetBaseKey(Relative: Boolean): HKey;
  203. begin
  204.   if (CurrentKey = 0) or not Relative then
  205.     Result := RootKey else
  206.     Result := CurrentKey;
  207. end;
  208.  
  209. procedure TRegistry.SetCurrentKey(Value: HKEY);
  210. begin
  211.   FCurrentKey := Value;
  212. end;
  213.  
  214. function TRegistry.CreateKey(const Key: string): Boolean;
  215. var
  216.   TempKey: HKey;
  217.   S: string;
  218.   Disposition: Integer;
  219.   Relative: Boolean;
  220. begin
  221.   TempKey := 0;
  222.   S := Key;
  223.   Relative := IsRelative(S);
  224.   if not Relative then Delete(S, 1, 1);
  225.   Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil,
  226.     REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS;
  227.   if Disposition = REG_OPENED_EXISTING_KEY then RegCloseKey(TempKey);
  228.   if not Result then
  229.     raise ERegistryException.CreateResFmt(SRegCreateFailed, [Key]);
  230. end;
  231.  
  232. function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
  233. var
  234.   TempKey: HKey;
  235.   S: string;
  236.   Disposition: Integer;
  237.   Relative: Boolean;
  238. begin
  239.   S := Key;
  240.   Relative := IsRelative(S);
  241.   if not Relative then Delete(S, 1, 1);
  242.   TempKey := 0;
  243.   if not CanCreate or (S = '') then
  244.   begin
  245.     Result := RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
  246.       KEY_ALL_ACCESS, TempKey) = ERROR_SUCCESS;
  247.   end else
  248.     Result := RegCreateKeyEx(GetBaseKey(Relative), PChar(S), 0, nil,
  249.       REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS;
  250.   if Result then
  251.   begin
  252.     if (CurrentKey <> 0) and Relative then S := CurrentPath + '\' + S;
  253.     ChangeKey(TempKey, S);
  254.   end;
  255. end;
  256.  
  257. function TRegistry.DeleteKey(const Key: string): Boolean;
  258. var
  259.   I, Len: Integer;
  260.   Relative: Boolean;
  261.   S, KeyName: string;
  262.   OldKey, DeleteKey: HKEY;
  263.   Info: TRegKeyInfo;
  264. begin
  265.   S := Key;
  266.   Relative := IsRelative(S);
  267.   if not Relative then Delete(S, 1, 1);
  268.   OldKey := CurrentKey;
  269.   DeleteKey := GetKey(Key);
  270.   if DeleteKey <> 0 then
  271.   try
  272.     SetCurrentKey(DeleteKey);
  273.     if GetKeyInfo(Info) then
  274.     begin
  275.       SetString(KeyName, nil, Info.MaxSubKeyLen + 1);
  276.       for I := 0 to Info.NumSubKeys - 1 do
  277.       begin
  278.         Len := Info.MaxSubKeyLen + 1;
  279.         if RegEnumKeyEx(DeleteKey, I, PChar(KeyName), Len, nil, nil, nil, nil) = ERROR_SUCCESS then
  280.           Self.DeleteKey(PChar(KeyName));
  281.       end;
  282.     end;
  283.   finally
  284.     SetCurrentKey(OldKey);
  285.   end;
  286.   Result := RegDeleteKey(GetBaseKey(Relative), PChar(S)) = ERROR_SUCCESS;
  287. end;
  288.  
  289. function TRegistry.DeleteValue(const Name: string): Boolean;
  290. begin
  291.   Result := RegDeleteValue(CurrentKey, PChar(Name)) = ERROR_SUCCESS;
  292. end;
  293.  
  294. function TRegistry.GetKeyInfo(var Value: TRegKeyInfo): Boolean;
  295. begin
  296.   FillChar(Value, SizeOf(TRegKeyInfo), 0);
  297.   Result := RegQueryInfoKey(CurrentKey, nil, nil, nil, @Value.NumSubKeys,
  298.     @Value.MaxSubKeyLen, nil, @Value.NumValues, @Value.MaxValueLen,
  299.     @Value.MaxDataLen, nil, @Value.FileTime) = ERROR_SUCCESS;
  300. end;
  301.  
  302. procedure TRegistry.GetKeyNames(Strings: TStrings);
  303. var
  304.   I, Len: Integer;
  305.   Info: TRegKeyInfo;
  306.   S: string;
  307. begin
  308.   Strings.Clear;
  309.   if GetKeyInfo(Info) then
  310.   begin
  311.     SetString(S, nil, Info.MaxSubKeyLen + 1);
  312.     for I := 0 to Info.NumSubKeys - 1 do
  313.     begin
  314.       Len := Info.MaxSubKeyLen + 1;
  315.       RegEnumKeyEx(CurrentKey, I, PChar(S), Len, nil, nil, nil, nil);
  316.       Strings.Add(PChar(S));
  317.     end;
  318.   end;
  319. end;
  320.  
  321. procedure TRegistry.GetValueNames(Strings: TStrings);
  322. var
  323.   I, Len: Integer;
  324.   Info: TRegKeyInfo;
  325.   S: string;
  326. begin
  327.   Strings.Clear;
  328.   if GetKeyInfo(Info) then
  329.   begin
  330.     SetString(S, nil, Info.MaxValueLen + 1);
  331.     for I := 0 to Info.NumValues - 1 do
  332.     begin
  333.       Len := Info.MaxValueLen + 1;
  334.       RegEnumValue(CurrentKey, I, PChar(S), Len, nil, nil, nil, nil);
  335.       Strings.Add(PChar(S));
  336.     end;
  337.   end;
  338. end;
  339.  
  340. function TRegistry.GetDataInfo(const ValueName: string; var Value: TRegDataInfo): Boolean;
  341. var
  342.   DataType: Integer;
  343. begin
  344.   FillChar(Value, SizeOf(TRegDataInfo), 0);
  345.   Result := RegQueryValueEx(CurrentKey, PChar(ValueName), nil, @DataType, nil,
  346.     @Value.DataSize) = ERROR_SUCCESS;
  347.   Value.RegData := DataTypeToRegData(DataType);
  348. end;
  349.  
  350. function TRegistry.GetDataSize(const ValueName: string): Integer;
  351. var
  352.   Info: TRegDataInfo;
  353. begin
  354.   if GetDataInfo(ValueName, Info) then
  355.     Result := Info.DataSize else
  356.     Result := -1;
  357. end;
  358.  
  359. function TRegistry.GetDataType(const ValueName: string): TRegDataType;
  360. var
  361.   Info: TRegDataInfo;
  362. begin
  363.   if GetDataInfo(ValueName, Info) then
  364.     Result := Info.RegData else
  365.     Result := rdUnknown;
  366. end;
  367.  
  368. procedure TRegistry.WriteString(const Name, Value: string);
  369. begin
  370.   PutData(Name, PChar(Value), Length(Value), rdString);
  371. end;
  372.  
  373. function TRegistry.ReadString(const Name: string): string;
  374. var
  375.   Len: Integer;
  376.   RegData: TRegDataType;
  377. begin
  378.   Len := GetDataSize(Name);
  379.   if Len > 0 then
  380.   begin
  381.     SetString(Result, nil, Len);
  382.     GetData(Name, PChar(Result), Len, RegData);
  383.     if (RegData = rdString) or (RegData = rdExpandString) then
  384.       SetLength(Result, StrLen(PChar(Result)))
  385.     else ReadError(Name);
  386.   end
  387.   else Result := '';
  388. end;
  389.  
  390. procedure TRegistry.WriteInteger(const Name: string; Value: Integer);
  391. begin
  392.   PutData(Name, @Value, SizeOf(Integer), rdInteger);
  393. end;
  394.  
  395. function TRegistry.ReadInteger(const Name: string): Integer;
  396. var
  397.   RegData: TRegDataType;
  398. begin
  399.   GetData(Name, @Result, SizeOf(Integer), RegData);
  400.   if RegData <> rdInteger then ReadError(Name);
  401. end;
  402.  
  403. procedure TRegistry.WriteBool(const Name: string; Value: Boolean);
  404. begin
  405.   WriteInteger(Name, Ord(Value));
  406. end;
  407.  
  408. function TRegistry.ReadBool(const Name: string): Boolean;
  409. begin
  410.   Result := ReadInteger(Name) <> 0;
  411. end;
  412.  
  413. procedure TRegistry.WriteFloat(const Name: string; Value: Double);
  414. begin
  415.   PutData(Name, @Value, SizeOf(Double), rdBinary);
  416. end;
  417.  
  418. function TRegistry.ReadFloat(const Name: string): Double;
  419. var
  420.   Len: Integer;
  421.   RegData: TRegDataType;
  422. begin
  423.   Len := GetData(Name, @Result, SizeOf(Double), RegData);
  424.   if (RegData <> rdBinary) or (Len <> SizeOf(Double)) then
  425.     ReadError(Name);
  426. end;
  427.  
  428. procedure TRegistry.WriteCurrency(const Name: string; Value: Currency);
  429. begin
  430.   PutData(Name, @Value, SizeOf(Currency), rdBinary);
  431. end;
  432.  
  433. function TRegistry.ReadCurrency(const Name: string): Currency;
  434. var
  435.   Len: Integer;
  436.   RegData: TRegDataType;
  437. begin
  438.   Len := GetData(Name, @Result, SizeOf(Currency), RegData);
  439.   if (RegData <> rdBinary) or (Len <> SizeOf(Currency)) then
  440.     ReadError(Name);
  441. end;
  442.  
  443. procedure TRegistry.WriteDateTime(const Name: string; Value: TDateTime);
  444. begin
  445.   PutData(Name, @Value, SizeOf(TDateTime), rdBinary);
  446. end;
  447.  
  448. function TRegistry.ReadDateTime(const Name: string): TDateTime;
  449. var
  450.   Len: Integer;
  451.   RegData: TRegDataType;
  452. begin
  453.   Len := GetData(Name, @Result, SizeOf(TDateTime), RegData);
  454.   if (RegData <> rdBinary) or (Len <> SizeOf(TDateTime)) then
  455.     ReadError(Name);
  456. end;
  457.  
  458. procedure TRegistry.WriteDate(const Name: string; Value: TDateTime);
  459. begin
  460.   WriteDateTime(Name, Value);
  461. end;
  462.  
  463. function TRegistry.ReadDate(const Name: string): TDateTime;
  464. begin
  465.   Result := ReadDateTime(Name);
  466. end;
  467.  
  468. procedure TRegistry.WriteTime(const Name: string; Value: TDateTime);
  469. begin
  470.   WriteDateTime(Name, Value);
  471. end;
  472.  
  473. function TRegistry.ReadTime(const Name: string): TDateTime;
  474. begin
  475.   Result := ReadDateTime(Name);
  476. end;
  477.  
  478. procedure TRegistry.WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
  479. begin
  480.   PutData(Name, @Buffer, BufSize, rdBinary);
  481. end;
  482.  
  483. function TRegistry.ReadBinaryData(const Name: string; var Buffer; BufSize: Integer): Integer;
  484. var
  485.   RegData: TRegDataType;
  486.   Info: TRegDataInfo;
  487. begin
  488.   if GetDataInfo(Name, Info) then
  489.   begin
  490.     Result := Info.DataSize;
  491.     RegData := Info.RegData;
  492.     if (RegData = rdBinary) and (Result <= BufSize) then
  493.       GetData(Name, @Buffer, Result, RegData)
  494.     else ReadError(Name);
  495.   end else
  496.     Result := 0;
  497. end;
  498.  
  499. procedure TRegistry.PutData(const Name: string; Buffer: Pointer;
  500.   BufSize: Integer; RegData: TRegDataType);
  501. var
  502.   DataType: Integer;
  503. begin
  504.   DataType := RegDataToDataType(RegData);
  505.   if RegSetValueEx(CurrentKey, PChar(Name), 0, DataType, Buffer,
  506.     BufSize) <> ERROR_SUCCESS then
  507.     raise ERegistryException.CreateResFmt(SRegSetDataFailed, [Name]);
  508. end;
  509.  
  510. function TRegistry.GetData(const Name: string; Buffer: Pointer;
  511.   BufSize: Integer; var RegData: TRegDataType): Integer;
  512. var
  513.   DataType: Integer;
  514. begin
  515.   DataType := REG_NONE;
  516.   if RegQueryValueEx(CurrentKey, PChar(Name), nil, @DataType, PByte(Buffer),
  517.     @BufSize) <> ERROR_SUCCESS then
  518.     raise ERegistryException.CreateResFmt(SRegGetDataFailed, [Name]);
  519.   Result := BufSize;
  520.   RegData := DataTypeToRegData(DataType);
  521. end;
  522.  
  523. function TRegistry.HasSubKeys: Boolean;
  524. var
  525.   Info: TRegKeyInfo;
  526. begin
  527.   Result := GetKeyInfo(Info) and (Info.NumSubKeys > 0);
  528. end;
  529.  
  530. function TRegistry.ValueExists(const Name: string): Boolean;
  531. var
  532.   Info: TRegDataInfo;
  533. begin
  534.   Result := GetDataInfo(Name, Info);
  535. end;
  536.  
  537. function TRegistry.GetKey(const Key: string): HKEY;
  538. var
  539.   S: string;
  540.   Relative: Boolean;
  541. begin
  542.   S := Key;
  543.   Relative := IsRelative(S);
  544.   if not Relative then Delete(S, 1, 1);
  545.   Result := 0;
  546.   RegOpenKeyEx(GetBaseKey(Relative), PChar(S), 0,
  547.     KEY_ALL_ACCESS, Result);
  548. end;
  549.  
  550. function TRegistry.RegistryConnect(const UNCName: string): Boolean;
  551. var
  552.   TempKey: HKEY;
  553. begin
  554.   Result := RegConnectRegistry(PChar(UNCname), RootKey, TempKey) = ERROR_SUCCESS;
  555.   if Result then
  556.   begin
  557.     RootKey := TempKey;
  558.     FCloseRootKey := True;
  559.   end;
  560. end;
  561.  
  562. function TRegistry.LoadKey(const Key, FileName: string): Boolean;
  563. var
  564.   S: string;
  565. begin
  566.   S := Key;
  567.   if not IsRelative(S) then Delete(S, 1, 1);
  568.   Result := RegLoadKey(RootKey, PChar(S), PChar(FileName)) = ERROR_SUCCESS;
  569. end;
  570.  
  571. function TRegistry.UnLoadKey(const Key: string): Boolean;
  572. var
  573.   S: string;
  574. begin
  575.   S := Key;
  576.   if not IsRelative(S) then Delete(S, 1, 1);
  577.   Result := RegUnLoadKey(RootKey, PChar(S)) = ERROR_SUCCESS;
  578. end;
  579.  
  580. function TRegistry.RestoreKey(const Key, FileName: string): Boolean;
  581. var
  582.   RestoreKey: HKEY;
  583. begin
  584.   Result := False;
  585.   RestoreKey := GetKey(Key);
  586.   if RestoreKey <> 0 then
  587.   try
  588.     Result := RegRestoreKey(RestoreKey, PChar(FileName), 0) = ERROR_SUCCESS;
  589.   finally
  590.     RegCloseKey(RestoreKey);
  591.   end;
  592. end;
  593.  
  594. function TRegistry.ReplaceKey(const Key, FileName, BackUpFileName: string): Boolean;
  595. var
  596.   S: string;
  597.   Relative: Boolean;
  598. begin
  599.   S := Key;
  600.   Relative := IsRelative(S);
  601.   if not Relative then Delete(S, 1, 1);
  602.   Result := RegReplaceKey(GetBaseKey(Relative), PChar(S),
  603.     PChar(FileName), PChar(BackUpFileName)) = ERROR_SUCCESS;
  604. end;
  605.  
  606. function TRegistry.SaveKey(const Key, FileName: string): Boolean;
  607. var
  608.   SaveKey: HKEY;
  609. begin
  610.   Result := False;
  611.   SaveKey := GetKey(Key);
  612.   if SaveKey <> 0 then
  613.   try
  614.     Result := RegSaveKey(SaveKey, PChar(FileName), nil) = ERROR_SUCCESS;
  615.   finally
  616.     RegCloseKey(SaveKey);
  617.   end;
  618. end;
  619.  
  620. function TRegistry.KeyExists(const Key: string): Boolean;
  621. var
  622.   TempKey: HKEY;
  623. begin
  624.   TempKey := GetKey(Key);
  625.   if TempKey <> 0 then RegCloseKey(TempKey);
  626.   Result := TempKey <> 0;
  627. end;
  628.  
  629. procedure TRegistry.RenameValue(const OldName, NewName: string);
  630. var
  631.   Len: Integer;
  632.   RegData: TRegDataType;
  633.   Buffer: PChar;
  634. begin
  635.   if ValueExists(OldName) and not ValueExists(NewName) then
  636.   begin
  637.     Len := GetDataSize(OldName);
  638.     if Len > 0 then
  639.     begin
  640.       Buffer := AllocMem(Len);
  641.       try
  642.         Len := GetData(OldName, Buffer, Len, RegData);
  643.         DeleteValue(OldName);
  644.         PutData(NewName, Buffer, Len, RegData);
  645.       finally
  646.         FreeMem(Buffer);
  647.       end;
  648.     end;
  649.   end;
  650. end;
  651.  
  652. procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean);
  653. var
  654.   SrcKey, DestKey: HKEY;
  655.  
  656.   procedure MoveValue(SrcKey, DestKey: HKEY; const Name: string);
  657.   var
  658.     Len: Integer;
  659.     OldKey, PrevKey: HKEY;
  660.     Buffer: PChar;
  661.     RegData: TRegDataType;
  662.   begin
  663.     OldKey := CurrentKey;
  664.     SetCurrentKey(SrcKey);
  665.     try
  666.       Len := GetDataSize(Name);
  667.       if Len > 0 then
  668.       begin
  669.         Buffer := AllocMem(Len);
  670.         try
  671.           Len := GetData(Name, Buffer, Len, RegData);
  672.           PrevKey := CurrentKey;
  673.           SetCurrentKey(DestKey);
  674.           try
  675.             PutData(Name, Buffer, Len, RegData);
  676.           finally
  677.             SetCurrentKey(PrevKey);
  678.           end;
  679.         finally
  680.           FreeMem(Buffer);
  681.         end;
  682.       end;
  683.     finally
  684.       SetCurrentKey(OldKey);
  685.     end;
  686.   end;
  687.  
  688.   procedure CopyValues(SrcKey, DestKey: HKEY);
  689.   var
  690.     I, Len: Integer;
  691.     KeyInfo: TRegKeyInfo;
  692.     S: string;
  693.     OldKey: HKEY;
  694.   begin
  695.     OldKey := CurrentKey;
  696.     SetCurrentKey(SrcKey);
  697.     try
  698.       if GetKeyInfo(KeyInfo) then
  699.       begin
  700.         MoveValue(SrcKey, DestKey, '');
  701.         SetString(S, nil, KeyInfo.MaxValueLen + 1);
  702.         for I := 0 to KeyInfo.NumValues - 1 do
  703.         begin
  704.           Len := KeyInfo.MaxValueLen + 1;
  705.           if RegEnumValue(SrcKey, I, PChar(S), Len, nil, nil, nil, nil) = ERROR_SUCCESS then
  706.             MoveValue(SrcKey, DestKey, PChar(S));
  707.         end;
  708.       end;
  709.     finally
  710.       SetCurrentKey(OldKey);
  711.     end;
  712.   end;
  713.  
  714.   procedure CopyKeys(SrcKey, DestKey: HKEY);
  715.   var
  716.     I, Len: Integer;
  717.     Info: TRegKeyInfo;
  718.     S: string;
  719.     OldKey, PrevKey, NewSrc, NewDest: HKEY;
  720.   begin
  721.     OldKey := CurrentKey;
  722.     SetCurrentKey(SrcKey);
  723.     try
  724.       if GetKeyInfo(Info) then
  725.       begin
  726.         SetString(S, nil, Info.MaxSubKeyLen + 1);
  727.         for I := 0 to Info.NumSubKeys - 1 do
  728.         begin
  729.           Len := Info.MaxSubKeyLen + 1;
  730.           if RegEnumKeyEx(SrcKey, I, PChar(S), Len, nil, nil, nil, nil) = ERROR_SUCCESS then
  731.           begin
  732.             NewSrc := GetKey(PChar(S));
  733.             if NewSrc <> 0 then
  734.             try
  735.               PrevKey := CurrentKey;
  736.               SetCurrentKey(DestKey);
  737.               try
  738.                 CreateKey(PChar(S));
  739.                 NewDest := GetKey(PChar(S));
  740.                 try
  741.                   CopyValues(NewSrc, NewDest);
  742.                   CopyKeys(NewSrc, NewDest);
  743.                 finally
  744.                   RegCloseKey(NewDest);
  745.                 end;
  746.               finally
  747.                 SetCurrentKey(PrevKey);
  748.               end;
  749.             finally
  750.               RegCloseKey(NewSrc);
  751.             end;
  752.           end;
  753.         end;
  754.       end;
  755.     finally
  756.       SetCurrentKey(OldKey);
  757.     end;
  758.   end;
  759.  
  760. begin
  761.   if KeyExists(OldName) and not KeyExists(NewName) then
  762.   begin
  763.     SrcKey := GetKey(OldName);
  764.     if SrcKey <> 0 then
  765.     try
  766.       CreateKey(NewName);
  767.       DestKey := GetKey(NewName);
  768.       if DestKey <> 0 then
  769.       try
  770.         CopyValues(SrcKey, DestKey);
  771.         CopyKeys(SrcKey, DestKey);
  772.         if Delete then DeleteKey(OldName);
  773.       finally
  774.         RegCloseKey(DestKey);
  775.       end;
  776.     finally
  777.       RegCloseKey(SrcKey);
  778.     end;
  779.   end;
  780. end;
  781.  
  782. constructor TRegIniFile.Create(const FileName: string);
  783. begin
  784.   inherited Create;
  785.   FFileName := FileName;
  786.   OpenKey(FileName, True);
  787. end;
  788.  
  789. function TRegIniFile.ReadString(const Section, Ident, Default: string): string;
  790. var
  791.   Key, OldKey: HKEY;
  792. begin
  793.   Key := GetKey(Section);
  794.   if Key <> 0 then
  795.   try
  796.     OldKey := CurrentKey;
  797.     SetCurrentKey(Key);
  798.     try
  799.       if ValueExists(Ident) then
  800.         Result := inherited ReadString(Ident) else
  801.         Result := Default;
  802.     finally
  803.       SetCurrentKey(OldKey);
  804.     end;
  805.   finally
  806.     RegCloseKey(Key);
  807.   end
  808.   else Result := Default;
  809. end;
  810.  
  811. procedure TRegIniFile.WriteString(const Section, Ident, Value: String);
  812. var
  813.   Key, OldKey: HKEY;
  814. begin
  815.   CreateKey(Section);
  816.   Key := GetKey(Section);
  817.   if Key <> 0 then
  818.   try
  819.     OldKey := CurrentKey;
  820.     SetCurrentKey(Key);
  821.     try
  822.       inherited WriteString(Ident, Value);
  823.     finally
  824.       SetCurrentKey(OldKey);
  825.     end;
  826.   finally
  827.     RegCloseKey(Key);
  828.   end;
  829. end;
  830.  
  831. function TRegIniFile.ReadInteger(const Section, Ident: string; Default: LongInt): LongInt;
  832. var
  833.   Key, OldKey: HKEY;
  834.   S: string;
  835. begin
  836.   Key := GetKey(Section);
  837.   if Key <> 0 then
  838.   try
  839.     OldKey := CurrentKey;
  840.     SetCurrentKey(Key);
  841.     try
  842.       if ValueExists(Ident) then
  843.       begin
  844.         S := inherited ReadString(Ident);
  845.         if (Length(S) > 2) and (S[1] = '0') and (UpCase(S[2]) = 'X') then
  846.           S := '$' + Copy(S, 3, Maxint);
  847.         Result := StrToIntDef(S, Default);
  848.       end else
  849.         Result := Default;
  850.     finally
  851.       SetCurrentKey(OldKey);
  852.     end;
  853.   finally
  854.     RegCloseKey(Key);
  855.   end
  856.   else Result := Default;
  857. end;
  858.  
  859. procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt);
  860. var
  861.   Key, OldKey: HKEY;
  862. begin
  863.   CreateKey(Section);
  864.   Key := GetKey(Section);
  865.   if Key <> 0 then
  866.   try
  867.     OldKey := CurrentKey;
  868.     SetCurrentKey(Key);
  869.     try
  870.       inherited WriteString(Ident, IntToStr(Value));
  871.     finally
  872.       SetCurrentKey(OldKey);
  873.     end;
  874.   finally
  875.     RegCloseKey(Key);
  876.   end;
  877. end;
  878.  
  879. function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
  880. begin
  881.   Result := ReadInteger(Section, Ident, Ord(Default)) <> 0;
  882. end;
  883.  
  884. procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean);
  885. const
  886.   Values: array[Boolean] of string = ('0', '1');
  887. var
  888.   Key, OldKey: HKEY;
  889. begin
  890.   CreateKey(Section);
  891.   Key := GetKey(Section);
  892.   if Key <> 0 then
  893.   try
  894.     OldKey := CurrentKey;
  895.     SetCurrentKey(Key);
  896.     try
  897.       inherited WriteString(Ident, Values[Value]);
  898.     finally
  899.       SetCurrentKey(OldKey);
  900.     end;
  901.   finally
  902.     RegCloseKey(Key);
  903.   end;
  904. end;
  905.  
  906. procedure TRegIniFile.ReadSection(const Section: string; Strings: TStrings);
  907. var
  908.   Key, OldKey: HKEY;
  909. begin
  910.   Key := GetKey(Section);
  911.   if Key <> 0 then
  912.   try
  913.     OldKey := CurrentKey;
  914.     SetCurrentKey(Key);
  915.     try
  916.       inherited GetValueNames(Strings);
  917.     finally
  918.       SetCurrentKey(OldKey);
  919.     end;
  920.   finally
  921.     RegCloseKey(Key);
  922.   end;
  923. end;
  924.  
  925. procedure TRegIniFile.ReadSections(Strings: TStrings);
  926. begin
  927.   GetKeyNames(Strings);
  928. end;
  929.  
  930. procedure TRegIniFile.ReadSectionValues(const Section: string; Strings: TStrings);
  931. var
  932.   KeyList: TStringList;
  933.   I: Integer;
  934. begin
  935.   KeyList := TStringList.Create;
  936.   try
  937.     ReadSection(Section, KeyList);
  938.     Strings.BeginUpdate;
  939.     try
  940.       for I := 0 to KeyList.Count - 1 do
  941.         Strings.Values[KeyList[I]] := ReadString(Section, KeyList[I], '');
  942.     finally
  943.       Strings.EndUpdate;
  944.     end;
  945.   finally
  946.     KeyList.Free;
  947.   end;
  948. end;
  949.  
  950. procedure TRegIniFile.EraseSection(const Section: string);
  951. begin
  952.   inherited DeleteKey(Section);
  953. end;
  954.  
  955. procedure TRegIniFile.DeleteKey(const Section, Ident: String);
  956. begin
  957.   inherited DeleteValue(Ident);
  958. end;
  959.  
  960. end.
  961.  
  962.