/[projects]/dao/DelphiScanner/Components/tpsystools_4.04/source/StRegIni.pas
ViewVC logotype

Annotation of /dao/DelphiScanner/Components/tpsystools_4.04/source/StRegIni.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2671 - (hide annotations) (download)
Tue Aug 25 18:15:15 2015 UTC (8 years, 10 months ago) by torben
File size: 83952 byte(s)
Added tpsystools component
1 torben 2671 // Upgraded to Delphi 2009: Sebastian Zierer
2    
3     (* ***** BEGIN LICENSE BLOCK *****
4     * Version: MPL 1.1
5     *
6     * The contents of this file are subject to the Mozilla Public License Version
7     * 1.1 (the "License"); you may not use this file except in compliance with
8     * the License. You may obtain a copy of the License at
9     * http://www.mozilla.org/MPL/
10     *
11     * Software distributed under the License is distributed on an "AS IS" basis,
12     * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13     * for the specific language governing rights and limitations under the
14     * License.
15     *
16     * The Original Code is TurboPower SysTools
17     *
18     * The Initial Developer of the Original Code is
19     * TurboPower Software
20     *
21     * Portions created by the Initial Developer are Copyright (C) 1996-2002
22     * the Initial Developer. All Rights Reserved.
23     *
24     * Contributor(s):
25     *
26     * ***** END LICENSE BLOCK ***** *)
27    
28     {*********************************************************}
29     {* SysTools: StRegIni.pas 4.04 *}
30     {*********************************************************}
31     {* SysTools: Registry and INI file access *}
32     {*********************************************************}
33    
34     {$I StDefine.inc}
35    
36     unit StRegIni;
37    
38     interface
39    
40     uses
41     Windows,
42     Graphics, Classes, SysUtils,
43     STStrL, StDate, STConst, STBase;
44    
45     type
46     {.Z+}
47     TRegIniType = (riIniType, riRegType);
48     TRegIniMode = (riSet, riGet);
49     TWinVerType = (riWin31,riWin32s,riWin95,riWinNT);
50     {.Z-}
51    
52     TQueryKeyInfo = record
53     QIKey : HKey; {Value of key being queried}
54     QIClassName : string; {Class Name associated with key}
55     QINumSubKeys: DWORD; {Number of Subkeys under queried key}
56     QIMaxSKNLen : DWORD; {Length of longest subkey name}
57     QIMaxCNLen : DWORD; {Length of longest class name found}
58     QINumValues : DWORD; {Number of values found in queried key ONLY, i.e., values in subkeys not included}
59     QIMaxVNLen : DWORD; {Length of longest value name}
60     QIMaxDataLen: DWORD; {Largest size (in bytes) of values in queried key}
61     QISDescLen : DWORD; {Length of Security Descriptor}
62     QIFileTime : TFileTime; {Time/date file/key was last modified}
63     end;
64    
65     const
66     {.Z+}
67     RI_INVALID_VALUE = -1;
68     RIVOLATILE = REG_WHOLE_HIVE_VOLATILE;
69     ShortBufSize = 255;
70     MaxBufSize = 8192;
71     MaxByteArraySize = 127;
72     {.Z-}
73    
74     RIMachine = 'MACHINE';
75     RIUsers = 'USERS';
76     RIRoot = 'ROOT';
77     RICUser = 'C_USERS';
78    
79    
80     type
81     TStRegIni = class(TObject)
82     {.Z+}
83     protected {private}
84     riMode : TRegIniMode;
85    
86     riWinVer : TWinVerType;
87     riType : TRegIniType;
88     riHoldPrimary,
89     riPrimaryKey : HKey;
90     riRemoteKey : HKey;
91    
92     riCurSubKey,
93     riTrueString,
94     riFalseString : PChar;
95    
96     {$IFDEF ThreadSafe}
97     riThreadSafe : TRTLCriticalSection;
98     {$ENDIF}
99    
100     function GetAttributes : TSecurityAttributes;
101     {-get security attributes record or value}
102     procedure SetAttributes(Value : TSecurityAttributes);
103     {-get security attributes record or value}
104    
105     function GetCurSubKey : string;
106     {-get current subkey/section}
107     procedure SetCurSubKey(Value : string);
108     {-set current subkey/section}
109    
110     function GetIsIniFile : Boolean;
111     {-get whether current instance in IniFile or no}
112    
113     procedure ParseIniFile(SList : TStrings);
114     {-adds section names in an INI file to a string list}
115    
116     protected
117     FCurSubKey : string;
118     FriSecAttr : TSecurityAttributes;
119     FIsIniFile : Boolean;
120    
121     riRootName : PChar;
122    
123     BmpText,
124     BmpBinary : TBitMap;
125    
126     {protected procedures to manage open/closing}
127     function OpenRegKey : HKey;
128     {-opens/creates key or ini file}
129     procedure CloseRegKey(const Key : HKey);
130     {-closes open key or ini file}
131    
132     procedure EnterCS;
133     {- call EnterCriticalSection procedure}
134     procedure LeaveCS;
135     {- call LeaveCriticalSection procedure}
136    
137     function WriteIniData(const ValueName : string; Data : string) : Boolean;
138     {-write data to an Ini file}
139    
140     function ReadIniData(const ValueName : string; var Value : string;
141     Default : string) : Integer;
142     {-read data from an Ini file}
143    
144     function WriteRegData(Key : HKey; const ValueName : string; Data : Pointer;
145     DType : DWORD; Size : Integer) : LongInt;
146     {-write data to the registry}
147    
148     function ReadRegData(Key : HKey; const ValueName : string; Data : Pointer;
149     Size : LongInt; DType : DWORD) : LongInt;
150     {-read data from the registry}
151    
152     {.Z-}
153     public
154     constructor Create(RootName : String; IsIniFile : Boolean); virtual;
155     destructor Destroy; override;
156    
157     procedure SetPrimary(Value : string);
158     {-change INI filename or primary key of registry}
159     function GetPrimary : string;
160     {-return current INI filename or primary key of registry}
161    
162     function GetDataInfo(Key : HKey; const ValueName : string;
163     var Size : LongInt; var DType : DWORD) : LongInt;
164     {-get size and type of data for entry in registry}
165    
166     function BytesToString(Value : PByte; Size : Cardinal) : AnsiString;
167     {-converts byte array to string with no spaces}
168     function StringToBytes(const IString : AnsiString; var Value; Size : Cardinal) : Boolean;
169     {-converts string (by groups of 2 char) to byte values}
170    
171    
172     function GetFullKeyPath : string;
173    
174     procedure WriteBoolean(const ValueName : string; Value : Boolean);
175     {-set boolean data in the ini file or registry}
176     function ReadBoolean(const ValueName : string; Default : Boolean) : Boolean;
177     {-get boolean data in the ini file or registry}
178     procedure WriteInteger(const ValueName : string; Value : DWORD);
179     {-set integer data in the ini file or registry}
180     function ReadInteger(const ValueName : string; Default : DWORD) : DWORD;
181     {-get integer data in the ini file or registry}
182     procedure WriteString(const ValueName : string; const Value : string);
183     {-set string data in the ini file or registry}
184     function ReadString(const ValueName : string; const Default : string) : string;
185     {-get string data in the ini file or registry}
186     procedure WriteBinaryData(const ValueName : string; const Value; Size : Integer);
187     {-set byte array in the ini file or registry}
188     procedure ReadBinaryData(const ValueName : string; const Default; var Value; var Size : Integer);
189     {-get byte array from the ini file or registry}
190     procedure WriteFloat(const ValueName : string; const Value : Double);
191     {-set float value in the ini file or registry}
192     function ReadFloat(const ValueName : string; const Default : TStFloat) : TStFloat;
193     {-get float from the ini file or registry}
194     procedure WriteDate(const ValueName : string; const Value : TStDate);
195     {-set date value in the ini file or registry}
196     function ReadDate(const ValueName : string; const Default : TStDate) : TStDate;
197     {-get date value from the ini file or registry}
198     procedure WriteDateTime(const ValueName : string; const Value : TDateTime);
199     {-set datetime value in the ini file or registry}
200     function ReadDateTime(const ValueName : string; const Default : TDateTime) : TDateTime;
201     {-get datetime value from the ini file or registry}
202     procedure WriteTime(const ValueName : string; const Value : TStTime);
203     {-set time value in the ini file or registry}
204     function ReadTime(const ValueName : string; const Default : TStTime) : TStTime;
205     {-get time value from the ini file or registry}
206    
207    
208     procedure CreateKey(const KeyName : string);
209     {-creates Section in INI file or Key in Registry}
210     procedure GetSubKeys(SK : TStrings);
211     {-lists sections in INI file or subkeys of SubKey in Registry}
212     procedure GetValues(SKV : TStrings);
213     {-lists values in INI section or in Registry SubKey}
214     procedure DeleteKey(const KeyName : string; DeleteSubKeys : Boolean);
215     {-Deletes section in INI file or key in Registry file}
216     procedure DeleteValue(const ValueName : string);
217     {-Deletes a value from an INI section or Registry key}
218     procedure QueryKey(var KeyInfo : TQueryKeyInfo);
219     {-lists information about an INI section or Registry SubKey}
220     function KeyExists(KeyName : string) : Boolean;
221     {-checks if exists in INI file/Registry}
222     function IsKeyEmpty(Primary, SubKey : string) : Boolean;
223     {-checks if key has values and/or subkeys}
224    
225     procedure SaveKey(const SubKey : string; FileName : string);
226     {-saves an INI Section with values or Registry Subkey with all values and
227     subkeys to specified file}
228     procedure LoadKey(const SubKey, FileName : string);
229     {-loads an INI file section or Registry key with all subkeys/values}
230     procedure UnLoadKey(const SubKey : string);
231     {-same as DeleteKey for INI file; removes key/subkeys loaded with LoadKey}
232     procedure ReplaceKey(const SubKey, InputFile, SaveFile : string);
233     {-replaces an INI file section or Registry key/subkeys
234     from InputFile, saves old data in SaveFile}
235     procedure RestoreKey(const SubKey, KeyFile : string; Options : DWORD);
236     {-restores an INI section or Registry key/subkeys from KeyFile}
237    
238     procedure RegOpenRemoteKey(CompName : string);
239     {-connects to Registry on another computer on network}
240     procedure RegCloseRemoteKey;
241     {-closes connection made with RegConnectRegistry}
242    
243     property Attributes : TSecurityAttributes
244     read GetAttributes
245     write SetAttributes;
246    
247     property CurSubKey : string
248     read GetCurSubKey
249     write SetCurSubKey;
250    
251     property IsIniFile : Boolean
252     read GetIsIniFile;
253     procedure RegGetKeySecurity(const SubKey : string; var SD : TSecurityDescriptor);
254     {-gets KeySecurity information on WinNT machines}
255     procedure RegSetKeySecurity(const SubKey : string; SD : TSecurityDescriptor);
256     {-sets KeySecurity information on WinNT machines}
257     end;
258    
259    
260     implementation
261    
262     procedure RaiseRegIniError(Code : LongInt);
263     var
264     E : ESTRegIniError;
265     begin
266     E := ESTRegIniError.CreateResTP(Code, 0);
267     E.ErrorCode := Code;
268     raise E;
269     end;
270    
271     {==========================================================================}
272    
273     procedure RaiseRegIniErrorFmt(Code : LongInt; A : array of const);
274     var
275     E : ESTRegIniError;
276     begin
277     E := ESTRegIniError.CreateResFmtTP(Code, A, 0);
278     E.ErrorCode := Code;
279     raise E;
280     end;
281    
282     {==========================================================================}
283    
284     constructor TStRegIni.Create(RootName : String; IsIniFile : Boolean);
285     var
286     S : string;
287     OSI : TOSVERSIONINFO;
288     begin
289     {$IFDEF ThreadSafe}
290     Windows.InitializeCriticalSection(riThreadSafe);
291     {$ENDIF}
292    
293     {check if a primary key or ini file is specified}
294     if (Length(RootName) = 0) then
295     RaiseRegIniError(stscNoFileKey);
296     RootName := ANSIUpperCase(RootName);
297    
298     {get False string from resource}
299     S := SysToolsStr(stscFalseString);
300     riFalseString := StrAlloc(Length(S)); // GetMem(riFalseString,Length(S)+1);
301     StrPCopy(riFalseString,S);
302    
303     {get True string from resource}
304     S := SysToolsStr(stscTrueString);
305     riTrueString := StrAlloc(Length(S)); // GetMem(riTrueString,Length(S)+1);
306     StrPCopy(riTrueString,S);
307    
308     riCurSubKey := StrAlloc(1); // GetMem(riCurSubKey,1);
309     riCurSubKey[0] := #0;
310    
311     BmpText := TBitMap.Create;
312     BmpBinary := TBitMap.Create;
313    
314     BmpText.Handle := LoadBitmap(HInstance, 'STBMPTEXT');
315     BmpBinary.Handle := LoadBitmap(HInstance, 'STBMPBINARY');
316    
317     {setup ini file/primary key via riRootName}
318     if (IsIniFile) then begin
319     riType := riIniType;
320     riRootName := StrAlloc(Length(RootName)); // GetMem(riRootName,Length(RootName)+1);
321     StrPCopy(riRootName,RootName);
322     end else begin
323     riType := riRegType;
324    
325     riPrimaryKey := 0;
326     riHoldPrimary := 0;
327     if (RootName = RIMachine) then
328     riPrimaryKey := HKEY_LOCAL_MACHINE
329     else if (RootName = RIUsers) then
330     riPrimaryKey := HKEY_USERS
331     else if (RootName = RIRoot) then
332     riPrimaryKey := HKEY_CLASSES_ROOT
333     else if (RootName = RICUser) then
334     riPrimaryKey := HKEY_CURRENT_USER
335     else
336     riPrimaryKey := HKEY_CURRENT_USER;
337    
338     OSI.dwOSVersionInfoSize := SizeOf(OSI);
339     if (GetVersionEX(OSI)) then begin
340     case OSI.dwPlatformID of
341     VER_PLATFORM_WIN32S : RaiseRegIniError(stscNoWin32S);
342     VER_PLATFORM_WIN32_WINDOWS : riWinVer := riWin95;
343     VER_PLATFORM_WIN32_NT : riWinVer := riWinNT;
344     end;
345     end;
346    
347     if (FriSecAttr.nLength <> sizeOf(TSecurityAttributes)) then begin
348     FriSecAttr.nLength := sizeof(TSecurityAttributes);
349     FriSecAttr.lpSecurityDescriptor := nil;
350     FriSecAttr.bInheritHandle := TRUE;
351     end;
352    
353     end;
354     end;
355    
356     {==========================================================================}
357    
358     destructor TStRegIni.Destroy;
359     begin
360     {no need to check for local key since none are kept open}
361     {longer than needed for a specific method}
362     if (riRemoteKey <> 0) then
363     RegCloseRemoteKey;
364    
365     if (riRootName <> nil) then
366     FreeMem(riRootName,StrLen(riRootName)+1);
367     if (riFalseString <> nil) then
368     FreeMem(riFalseString,StrLen(riFalseString)+1);
369     if (riTrueString <> nil) then
370     FreeMem(riTrueString,StrLen(riTrueString)+1);
371     if (riCurSubKey <> nil) then
372     FreeMem(riCurSubKey,StrLen(riCurSubKey)+1);
373    
374     BmpText.Free;
375     BmpBinary.Free;
376    
377     {$IFDEF ThreadSafe}
378     Windows.DeleteCriticalSection(riThreadSafe);
379     {$ENDIF}
380     inherited Destroy;
381     end;
382    
383     {==========================================================================}
384    
385    
386     procedure TStRegIni.SetPrimary(Value : string);
387     {-change working Ini file or top level key in registry}
388     begin
389     if riType = riIniType then begin
390     if CompareText(Value,StrPas(riRootName)) = 0 then Exit;
391    
392     if (riRootName <> nil) then
393     StrDispose(riRootName); // FreeMem(riRootName,StrLen(riRootName)+1);
394     riRootName := StrAlloc(Length(Value)); //GetMem(riRootName,Length(Value)+1);
395     StrPCopy(riRootName,Value);
396     end else begin
397     if (riRemoteKey <> 0) then
398     RegCloseRemoteKey;
399    
400     if (Value = RIMachine) then
401     riPrimaryKey := HKEY_LOCAL_MACHINE
402     else if (Value = RIUsers) then
403     riPrimaryKey := HKEY_USERS
404     else if (Value = RIRoot) then
405     riPrimaryKey := HKEY_CLASSES_ROOT
406     else if (Value = RICUser) then
407     riPrimaryKey := HKEY_CURRENT_USER
408     else
409     riPrimaryKey := HKEY_CURRENT_USER;
410     end;
411     end;
412    
413     {==========================================================================}
414    
415     function TStRegIni.GetPrimary : string;
416     {-return working Ini file or top level registry key}
417     begin
418     if (riType = riIniType) then
419     Result := StrPas(riRootName)
420     else begin
421     case riPrimaryKey of
422     HKEY_LOCAL_MACHINE : Result := RIMachine;
423     HKEY_USERS : Result := RIUsers;
424     HKEY_CLASSES_ROOT : Result := RIRoot;
425     HKEY_CURRENT_USER : Result := RICUser;
426     else
427     Result := 'Invalid primary key'
428     end;
429     end;
430     end;
431    
432     {==========================================================================}
433    
434     procedure TStRegIni.EnterCS;
435     begin
436     {$IFDEF ThreadSafe}
437     EnterCriticalSection(riThreadSafe);
438     {$ENDIF}
439     end;
440    
441     {==========================================================================}
442    
443     procedure TStRegIni.LeaveCS;
444     begin
445     {$IFDEF ThreadSafe}
446     LeaveCriticalSection(riThreadSafe);
447     {$ENDIF}
448     end;
449    
450     {==========================================================================}
451    
452     function TStRegIni.GetIsIniFile : Boolean;
453     {-get whether instance is IniFile or no}
454     begin
455     Result := riType = riIniType;
456     end;
457    
458     {==========================================================================}
459    
460     function TStRegIni.GetAttributes : TSecurityAttributes;
461     {-Get current security attributes (NT Only) }
462     begin
463     with Result do begin
464     nLength := sizeof(TSecurityAttributes);
465     lpSecurityDescriptor := FriSecAttr.lpSecurityDescriptor;
466     bInheritHandle := FriSecAttr.bInheritHandle;
467     end;
468     end;
469    
470     {==========================================================================}
471    
472     procedure TStRegIni.SetAttributes(Value : TSecurityAttributes);
473     {-set security attributes (NT only) }
474     begin
475     FriSecAttr.nLength := sizeof(TSecurityAttributes);
476     FriSecAttr.lpSecurityDescriptor := Value.lpSecurityDescriptor;
477     FriSecAttr.bInheritHandle := Value.bInheritHandle;
478     end;
479    
480     {==========================================================================}
481    
482     function TStRegIni.GetCurSubKey : string;
483     {-retrn name of working Ini file section or registry subkey}
484     begin
485     Result := FCurSubKey;
486     end;
487    
488     {==========================================================================}
489    
490     procedure TStRegIni.SetCurSubKey(Value : string);
491     {-set name of working Ini file section or registry subkey}
492     begin
493     if (riCurSubKey <> nil) then
494     StrDispose(riCurSubKey); // FreeMem(riCurSubKey,StrLen(riCurSubKey)+1);
495     FCurSubKey := Value;
496     riCurSubKey := StrAlloc(Length(Value)); // GetMem(riCurSubKey,Length(Value)+1);
497     StrPCopy(riCurSubKey,Value);
498     end;
499    
500     {==========================================================================}
501    
502     function TStRegIni.OpenRegKey : HKey;
503     {-open a registry key}
504     var
505     Disposition : DWORD;
506     ECode : LongInt;
507     begin
508     Disposition := 0;
509     if (riMode = riSet) then begin
510     {Keys are created with all key access privilages and as non-volatile}
511     ECode := RegCreateKeyEx(riPrimaryKey, riCurSubKey,0,nil,
512     REG_OPTION_NON_VOLATILE,KEY_ALL_ACCESS,@FriSecAttr,
513     Result,@Disposition);
514     if (ECode <> ERROR_SUCCESS) then
515     RaiseRegIniErrorFmt(stscCreateKeyFail, [ECode]);
516     end else begin
517     {Read operations limit key access to read only}
518     ECode := RegOpenKeyEx(riPrimaryKey,riCurSubKey, 0, KEY_READ,Result);
519     if (ECode <> ERROR_SUCCESS) then
520     RaiseRegIniErrorFmt(stscOpenKeyFail, [ECode]);
521     end;
522     end;
523    
524     {==========================================================================}
525    
526     procedure TStRegIni.CloseRegKey(const Key : HKey);
527     {-close registry key}
528     begin
529     RegCloseKey(Key);
530     end;
531    
532     {==========================================================================}
533    
534     function TStRegIni.WriteIniData(const ValueName : string;
535     Data : String) : Boolean;
536     {-write data to the Ini file in the working section}
537     var
538     PData,
539     PValueName : PChar;
540     VNLen,
541     DLen : integer;
542     begin
543     if (ValueName = '') then
544     RaiseRegIniError(stscNoValueNameSpecified);
545    
546     PData := nil;
547     PValueName := nil;
548     VNLen := Length(ValueName) + 1;
549     DLen := Length(Data) + 1;
550    
551     try
552     PValueName := StrAlloc(VNLen); // GetMem(PValueName, VNLen);
553     PData := StrAlloc(DLen); // GetMem(PData, DLen);
554    
555     strPCopy(PValueName, ValueName);
556     strPCopy(PData, Data);
557    
558     Result := WritePrivateProfileString(riCurSubKey, PValueName,
559     PData, riRootName)
560     finally
561     if PValueName <> nil then
562     StrDispose(PValueName); // FreeMem(PValueName, VNLen);
563     if PData <> nil then
564     StrDispose(PData); // FreeMem(PData, DLen);
565     end;
566     end;
567    
568     {==========================================================================}
569    
570     function TStRegIni.ReadIniData(const ValueName : string; var Value : String;
571     Default : String) : Integer;
572     {-read a value from the working section of the Ini file}
573     var
574     PValue : array[0..1024] of char;
575     PVName,
576     PDefault : PChar;
577     begin
578     PDefault := nil;
579     PVName := nil;
580    
581     try
582     PVName := StrAlloc(Length(ValueName)); // GetMem(PVName,Length(ValueName)+1);
583     PDefault := StrAlloc(Length(Default)); // GetMem(PDefault,Length(Default)+1);
584    
585     StrPCopy(PVName,ValueName);
586     StrPCopy(PDefault,Default);
587    
588     GetPrivateProfileString(riCurSubKey,PVName,PDefault,
589     PValue,Length(PValue)-1,riRootName);
590    
591     Value := StrPas(PValue);
592     Result := Length(Value);
593     finally
594     if PVName <> nil then
595     StrDispose(PVName); // FreeMem(PVName,strlen(PVName)+1);
596     if PDefault <> nil then
597     StrDispose(PDefault); // FreeMem(PDefault,strlen(PDefault)+1);
598     end;
599     end;
600    
601     {==========================================================================}
602    
603     function TStRegIni.WriteRegData(Key : HKey; const ValueName : string; Data : Pointer;
604     DType : DWORD; Size : Integer) : LongInt;
605     {-write a value into the registry}
606     begin
607     Result := RegSetValueEx(Key, PChar(ValueName), 0, DType, Data, Size);
608     end;
609    
610     {==========================================================================}
611    
612     function TStRegIni.GetDataInfo(Key : HKey; const ValueName : string;
613     var Size : LongInt; var DType : DWORD) : LongInt;
614     {-get the size and type of a specific value in the registry}
615     var
616     PVName : PChar;
617     Opened : Boolean;
618     TS : string;
619     begin
620     Opened := False;
621     riMode := riGet;
622     if (riType = riIniType) then begin
623     TS := ReadString(ValueName,'');
624     Size := Length(TS);
625     DType := REG_SZ;
626     Result := ERROR_SUCCESS;
627     Exit;
628     end;
629    
630     PVName := StrAlloc(Length(ValueName)); //GetMem(PVName,Length(ValueName)+1);
631     try
632     StrPCopy(PVName,ValueName);
633     if Key = 0 then begin
634     Key := OpenRegKey;
635     Opened := True;
636     end;
637     Result := RegQueryValueEx(Key,PVName,nil,@DType,nil,LPDWORD(@Size));
638     finally
639     StrDispose(PVName); // FreeMem(PVName,strlen(PVName)+1);
640     end;
641     if Opened then
642     RegCloseKey(Key);
643     end;
644    
645     {==========================================================================}
646    
647     function TStRegIni.ReadRegData(Key : HKey; const ValueName : string; Data : Pointer;
648     Size : LongInt; DType : DWORD) : LongInt;
649     {-read a value from the registry}
650     var
651     PVName : PChar;
652     begin
653     PVName := StrAlloc(Length(ValueName)); // GetMem(PVName,(Length(ValueName)+1) * SizeOf(Char));
654     try
655     StrPCopy(PVName,ValueName);
656     DType := REG_NONE;
657     Result := RegQueryValueEx(Key, PVName, nil,@DType,PByte(Data),LPDWORD(@Size));
658     finally
659     StrDispose(PVName); // FreeMem(PVName,strlen(PVName)+1);
660     end;
661     end;
662    
663     {==========================================================================}
664    
665     function TStRegIni.GetFullKeyPath : string;
666     begin
667     {$IFDEF ThreadSafe}
668     EnterCS;
669     try
670     {$ENDIF}
671     if (riType = riIniType) then begin
672     Result := StrPas(riRootName) + '\' + StrPas(riCurSubKey);
673     end else begin
674     case riPrimaryKey of
675    
676     HKEY_LOCAL_MACHINE : Result := 'HKEY_LOCAL_MACHINE\';
677     HKEY_USERS : Result := 'HKEY_USERS\';
678     HKEY_CLASSES_ROOT : Result := 'HKEY_CLASSES_ROOT\';
679     HKEY_CURRENT_USER : Result := 'HKEY_CURRENT_USER\';
680     end;
681     Result := Result + StrPas(riCurSubKey);
682     end;
683     {$IFDEF ThreadSafe}
684     finally
685     LeaveCS;
686     end;
687     {$ENDIF}
688     end;
689    
690     {==========================================================================}
691    
692     procedure TStRegIni.WriteBoolean(const ValueName : string; Value : Boolean);
693     {-write Boolean value to the Ini file or registry}
694     var
695     ECode : LongInt;
696     IValue : DWORD;
697     Key : HKey;
698     wResult : Boolean;
699    
700     begin
701     riMode := riSet;
702     {$IFDEF ThreadSafe}
703     EnterCS;
704     try
705     {$ENDIF}
706     if (riType = riIniType) then begin
707     if (Value) then
708     wResult := WriteIniData(ValueName, StrPas(riTrueString))
709     else
710     wResult := WriteIniData(ValueName, StrPas(riFalseString));
711     if (NOT wResult) then
712     RaiseRegIniError(stscIniWriteFail);
713     end else begin
714     Key := OpenRegKey;
715     try
716     IValue := Ord(Value);
717     ECode := WriteRegData(Key,ValueName,@IValue,REG_DWORD,SizeOf(DWORD));
718     if (ECode <> ERROR_SUCCESS) then
719     RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
720     finally
721     if (riRemoteKey = 0) then
722     CloseRegKey(Key);
723     end;
724     end;
725     {$IFDEF ThreadSafe}
726     finally
727     LeaveCS;
728     end;
729     {$ENDIF}
730     end;
731    
732     {==========================================================================}
733    
734     function TStRegIni.ReadBoolean(const ValueName : string; Default : Boolean) : Boolean;
735     {-read a Boolean value from the Ini file or registry}
736     var
737     Value : string;
738     IVal : Double;
739     Key : HKey;
740     ECode,
741    
742     ValSize : LongInt;
743     ValType : DWORD;
744     LResult : Pointer;
745     Code : Integer;
746    
747     begin
748     riMode := riGet;
749     {$IFDEF ThreadSafe}
750     EnterCS;
751     try
752     {$ENDIF}
753     if (riType = riIniType) then begin
754     if Default then
755     ReadIniData(ValueName,Value,StrPas(riTrueString))
756     else
757     ReadIniData(ValueName,Value,StrPas(riFalseString));
758    
759     if (CompareText(Value,StrPas(riFalseString)) = 0) then
760     Result := False
761     else begin
762     if (CompareText(Value,StrPas(riTrueString)) = 0) then
763     Result := True
764     else begin
765     Val(Value,IVal,Code);
766     if (Code = 0) then
767     Result := IVal <> 0
768     else
769     Result := Default;
770     end;
771     end;
772    
773     end else begin
774     try
775     Key := OpenRegKey;
776     except
777     Result := Default;
778     Exit;
779     end;
780     try
781     {get info on requested value}
782     ECode := GetDataInfo(Key,ValueName,ValSize,ValType);
783     if (ECode <> ERROR_SUCCESS) then begin
784     Result := Default;
785     Exit;
786     end;
787    
788     {Size does not include null terminator for strings}
789     if (ValType = REG_SZ) OR (ValType = REG_EXPAND_SZ) then
790     begin
791     Inc(ValSize);
792     {$IFDEF UNICODE}
793     ValSize := ValSize * 2;
794     {$ENDIF}
795     end;
796     GetMem(LResult,ValSize);
797     try
798     ECode := ReadRegData(Key,ValueName,LResult,ValSize,ValType);
799     if (ECode <> ERROR_SUCCESS) then
800     Result := Default
801     else begin
802     {convert data, if possible, to Boolean}
803     case (ValType) of
804     REG_SZ,
805     REG_EXPAND_SZ : Result := StrIComp(PChar(LResult),riFalseString) <> 0;
806     REG_BINARY,
807     REG_DWORD : Result := (LongInt(LResult^) <> 0);
808     else
809     Result := Default;
810     end;
811     end;
812     finally
813     FreeMem(LResult,ValSize);
814     end;
815     finally
816     if (riRemoteKey = 0) then
817     CloseRegKey(Key);
818     end;
819     end;
820     {$IFDEF ThreadSafe}
821     finally
822     LeaveCS;
823     end;
824     {$ENDIF}
825     end;
826    
827     {==========================================================================}
828    
829     procedure TStRegIni.WriteInteger(const ValueName : string; Value : DWORD);
830     {-write an integer to the Ini file or the registry}
831     var
832     ECode : LongInt;
833     Key : HKey;
834    
835     begin
836     riMode := riSet;
837     {$IFDEF ThreadSafe}
838     EnterCS;
839     try
840     {$ENDIF}
841     if (riType = riIniType) then begin
842     if (NOT WriteIniData(ValueName,IntToStr(Value))) then
843     RaiseRegIniError(stscIniWriteFail);
844     end else begin
845     Key := OpenRegKey;
846     try
847     ECode := WriteRegData(Key,ValueName,@Value,REG_DWORD,SizeOf(DWORD));
848     if (ECode <> ERROR_SUCCESS) then
849     RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
850     finally
851     if (riRemoteKey = 0) then
852     CloseRegKey(Key);
853     end;
854     end;
855     {$IFDEF ThreadSafe}
856     finally
857     LeaveCS;
858     end;
859     {$ENDIF}
860     end;
861    
862     {==========================================================================}
863    
864     function TStRegIni.ReadInteger(const ValueName : string; Default : DWORD) : DWORD;
865     {-read an integer from the Ini file or registry}
866     var
867     Value : string;
868    
869     ECode,
870     Key : HKey;
871     Len : LongInt;
872     ValSize : LongInt;
873     ValType : DWORD;
874    
875     LResult : Pointer;
876     Code : Integer;
877     begin
878     riMode := riGet;
879     {$IFDEF ThreadSafe}
880     EnterCS;
881     try
882     {$ENDIF}
883     if (riType = riIniType) then begin
884     Len := ReadIniData(ValueName,Value,IntToStr(Default));
885     if (Len > 0) then begin
886     Val(Value,Result,Code);
887     if (Code <> 0) then
888     Result := Default;
889     end else
890     Result := Default;
891     end else begin
892     try
893     Key := OpenRegKey;
894     except
895     Result := Default;
896     Exit;
897     end;
898     try
899     {get info on requested value}
900     ECode := GetDataInfo(Key,ValueName,ValSize,ValType);
901     if (ECode <> ERROR_SUCCESS) then begin
902     Result := Default;
903     Exit;
904     end;
905    
906     {Size does not include null terminator for strings}
907     if (ValType = REG_SZ) OR (ValType = REG_EXPAND_SZ) then
908     begin
909     Inc(ValSize);
910     {$IFDEF UNICODE}
911     ValSize := ValSize * 2;
912     {$ENDIF}
913     end;
914     GetMem(LResult,ValSize);
915     try
916     ECode := ReadRegData(Key,ValueName,LResult,ValSize,ValType);
917     if (ECode <> ERROR_SUCCESS) then
918     Result := Default
919     else begin
920     {convert data, if possible, to an integer value}
921     case (ValType) of
922     REG_SZ,
923     REG_EXPAND_SZ : begin
924     Value := StrPas(PChar(LResult));
925     Val(Value,Result,Code);
926     if (Code <> 0) then
927     Result := Default;
928     end;
929     REG_BINARY,
930     REG_DWORD : Result := DWORD(LResult^);
931     else
932     Result := Default;
933     end;
934     end;
935     finally
936     FreeMem(LResult,ValSize);
937     end;
938     finally
939     if (riRemoteKey = 0) then
940     CloseRegKey(Key);
941     end;
942     end;
943     {$IFDEF ThreadSafe}
944     finally
945     LeaveCS;
946     end;
947     {$ENDIF}
948     end;
949    
950     {==========================================================================}
951    
952     function TStRegIni.BytesToString(Value : PByte; Size : Cardinal) : AnsiString;
953     {-convert byte array to string, no spaces or hex enunciators, e.g., '$'}
954     var
955     I,
956     Index : Cardinal;
957     S : String[3];
958    
959     begin
960     SetLength(Result,2*Size);
961    
962     for I := 1 to Size do begin
963     Index := I*2;
964     S := HexBL(Byte(PAnsiChar(Value)[I-1]));
965     Result[(Index)-1] := S[1];
966     Result[Index] := S[2];
967     end;
968     end;
969    
970     {==========================================================================}
971    
972     function TStRegIni.StringToBytes(const IString : AnsiString; var Value; Size : Cardinal) : Boolean;
973     {-convert string (by groups of 2 char) to byte values}
974     var
975     Code,
976     Index,
977     I : Integer;
978     Q : array[1..MaxByteArraySize] of byte;
979     S : array[1..3] of AnsiChar;
980     begin
981     if ((Length(IString) div 2) <> LongInt(Size)) then begin
982     Result := False;
983     Exit;
984     end;
985    
986     Result := True;
987     for I := 1 to Size do begin
988     Index := (2*(I-1))+1;
989     S[1] := '$';
990     S[2] := IString[Index];
991     S[3] := IString[Index+1];
992     Val(S,Q[I],Code);
993     if (Code <> 0) then begin
994     Result := False;
995     Exit;
996     end;
997     end;
998     Move(Q, Value, Size);
999     end;
1000    
1001     {==========================================================================}
1002    
1003     procedure TStRegIni.WriteBinaryData(const ValueName : string; const Value; Size : Integer);
1004     {-write binary data of any form to Ini file or registry}
1005     var
1006     SValue : string;
1007     ECode : LongInt;
1008     Key : HKey;
1009     begin
1010     riMode := riSet;
1011     {$IFDEF ThreadSafe}
1012     EnterCS;
1013     try
1014     {$ENDIF}
1015     if (riType = riIniType) then begin
1016     if (Size > MaxByteArraySize) then
1017     RaiseRegIniError(stscByteArrayTooLarge);
1018     SValue := BytesToString(PByte(@Value),Size);
1019     if (NOT WriteIniData(ValueName,SValue)) then
1020     RaiseRegIniError(stscIniWriteFail);
1021     end else begin
1022     Key := OpenRegKey;
1023     try
1024     ECode := WriteRegData(Key,ValueName,@Value,REG_BINARY,Size);
1025     if (ECode <> ERROR_SUCCESS) then
1026     RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
1027     finally
1028     if (riRemoteKey = 0) then
1029     CloseRegKey(Key);
1030     end;
1031     end;
1032     {$IFDEF ThreadSafe}
1033     finally
1034     LeaveCS;
1035     end;
1036     {$ENDIF}
1037     end;
1038    
1039     {==========================================================================}
1040    
1041     procedure TStRegIni.ReadBinaryData(const ValueName : string; const Default;
1042     var Value; var Size : Integer);
1043     {-read binary data of any form from Ini file or regsitry}
1044     var
1045     ECode : LongInt;
1046     Key : HKey;
1047     Len : Cardinal;
1048    
1049     ValSize : LongInt;
1050     ValType : DWORD;
1051    
1052     DefVals,
1053     Values : String;
1054    
1055     begin
1056     riMode := riGet;
1057     {$IFDEF ThreadSafe}
1058     EnterCS;
1059     try
1060     {$ENDIF}
1061     if (riType = riIniType) then begin
1062     DefVals := BytesToString(PByte(@Default), Size);
1063     Len := ReadIniData(ValueName, Values, DefVals);
1064     if (Len mod 2 = 0) then begin
1065     {covert string, if possible, to series of bytes}
1066     if not (StringToBytes(Values, PByte(Value), Size)) then
1067     Move(Default, PByte(Value), Size);
1068     end else
1069     Move(Default, PByte(Value), Size);
1070     end else begin
1071     try
1072     Key := OpenRegKey;
1073     except
1074     Move(Default, Value, Size);
1075     Exit;
1076     end;
1077     try
1078     {get info on requested value}
1079     ECode := GetDataInfo(Key, ValueName, ValSize, ValType);
1080     if (ECode <> ERROR_SUCCESS) then begin
1081     Move(Default, Value, Size);
1082     Exit;
1083     end;
1084    
1085     if (ValSize <> Size) then
1086     RaiseRegIniErrorFmt(stscBufferDataSizesDif, [Size,ValSize])
1087     else
1088     Size := ValSize;
1089    
1090     if (ValType <> REG_BINARY) then
1091     Move(Default, Value, Size)
1092     else begin
1093     ECode := ReadRegData(Key, ValueName, PByte(@Value), ValSize, ValType);
1094     if (ECode <> ERROR_SUCCESS) then
1095     Move(Default, Value, Size)
1096     end;
1097     finally
1098     if (riRemoteKey = 0) then
1099     CloseRegKey(Key);
1100     end;
1101     end;
1102     {$IFDEF ThreadSafe}
1103     finally
1104     LeaveCS;
1105     end;
1106     {$ENDIF}
1107     end;
1108    
1109     {==========================================================================}
1110    
1111     procedure TStRegIni.WriteString(const ValueName : string; const Value : string);
1112     {-write a string to the Ini file or registry}
1113     var
1114     ECode : LongInt;
1115     Key : HKey;
1116     PValue : PChar;
1117     begin
1118     riMode := riSet;
1119     {$IFDEF ThreadSafe}
1120     EnterCS;
1121     try
1122     {$ENDIF}
1123     if (riType = riIniType) then begin
1124     if NOT WriteIniData(ValueName, Value) then
1125     RaiseRegIniError(stscIniWriteFail);
1126     end else begin
1127     PValue := StrAlloc(Length(Value)); // GetMem(PValue, Length(Value)+1);
1128     try
1129     StrPCopy(PValue, Value);
1130     Key := OpenRegKey;
1131     try
1132     {same call for 16/32 since we're using a PChar}
1133     ECode := WriteRegData(Key,ValueName, PValue,REG_SZ, (strlen(PValue)+1) * SizeOf(Char));
1134     if (ECode <> ERROR_SUCCESS) then
1135     RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
1136     finally
1137     if (riRemoteKey = 0) then
1138     CloseRegKey(Key);
1139     end;
1140     finally
1141     StrDispose(PValue); // FreeMem(PValue,strlen(PValue)+1);
1142     end;
1143     end;
1144     {$IFDEF ThreadSafe}
1145     finally
1146     LeaveCS;
1147     end;
1148     {$ENDIF}
1149     end;
1150    
1151     {==========================================================================}
1152    
1153     function TStRegIni.ReadString(const ValueName : string; const Default : string) : string;
1154     {-read a string from an Ini file or the registry}
1155     var
1156     ECode : LongInt;
1157     Len : LongInt;
1158     ValSize : LongInt;
1159     Key : HKey;
1160     ValType : DWORD;
1161     TmpVal : DWORD;
1162     LResult : Pointer;
1163    
1164     begin
1165     riMode := riGet;
1166     {$IFDEF ThreadSafe}
1167     EnterCS;
1168     try
1169     {$ENDIF}
1170     if (riType = riIniType) then begin
1171     Len := ReadIniData(ValueName,Result,Default);
1172     if (Len < 1) then
1173     Result := Default;
1174     end else begin
1175     try
1176     Key := OpenRegKey;
1177     except
1178     Result := Default;
1179     Exit;
1180     end;
1181     try
1182     {get info on requested value}
1183     ECode := GetDataInfo(Key,ValueName,ValSize,ValType);
1184     if (ECode <> ERROR_SUCCESS) then begin
1185     Result := Default;
1186     Exit;
1187     end;
1188    
1189     if (ValType = REG_SZ) OR (ValType = REG_EXPAND_SZ)then
1190     begin
1191     Inc(ValSize);
1192     {$IFDEF UNICODE}
1193     ValSize := ValSize * 2;
1194     {$ENDIF}
1195     end;
1196     GetMem(LResult,ValSize);
1197     try
1198     ECode := ReadRegData(Key,ValueName,LResult,ValSize,ValType);
1199     if (ECode <> ERROR_SUCCESS) AND (ECode <> ERROR_MORE_DATA) then
1200     Result := Default
1201     else begin
1202     {convert data, if possible, to string}
1203     case (ValType) of
1204     REG_SZ,
1205     REG_EXPAND_SZ : Result := StrPas(PChar(LResult));
1206     REG_BINARY : begin
1207     if (ValSize > MaxByteArraySize) then
1208     RaiseRegIniError(stscByteArrayTooLarge);
1209     Result := BytesToString(PByte(@LResult),ValSize);
1210     end;
1211     REG_DWORD : begin
1212     TmpVal := DWORD(LResult^);
1213     Str(TmpVal,Result);
1214     end;
1215     else
1216     Result := Default;
1217     end;
1218     end;
1219     finally
1220     FreeMem(LResult,ValSize);
1221     end;
1222     finally
1223     if (riRemoteKey = 0) then
1224     CloseRegKey(Key);
1225     end;
1226     end;
1227     {$IFDEF ThreadSafe}
1228     finally
1229     LeaveCS;
1230     end;
1231     {$ENDIF}
1232     end;
1233    
1234     {==========================================================================}
1235    
1236     procedure TStRegIni.WriteFloat(const ValueName : string; const Value : Double);
1237     {-write floating point number to Ini file or registry}
1238     var
1239     ECode : LongInt;
1240     Key : HKey;
1241     SValue : string;
1242    
1243     begin
1244     riMode := riSet;
1245     {$IFDEF ThreadSafe}
1246     EnterCS;
1247     try
1248     {$ENDIF}
1249     Str(Value, SValue);
1250     while (SValue[1] = ' ') do
1251     System.Delete(SValue, 1, 1);
1252     if (riType = riIniType) then begin
1253     if (NOT WriteIniData(ValueName, SValue)) then
1254     RaiseRegIniError(stscIniWriteFail);
1255     end else begin
1256     Key := OpenRegKey;
1257     try
1258     ECode := WriteRegData(Key,ValueName,@Value,REG_BINARY,SizeOf(Double));
1259     if (ECode <> ERROR_SUCCESS) then
1260     RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
1261     finally
1262     if (riRemoteKey = 0) then
1263     CloseRegKey(Key);
1264     end;
1265     end;
1266     {$IFDEF ThreadSafe}
1267     finally
1268     LeaveCS;
1269     end;
1270     {$ENDIF}
1271     end;
1272    
1273     {==========================================================================}
1274    
1275     function TStRegIni.ReadFloat(const ValueName : string; const Default : TStFloat) : TStFloat;
1276     {-read floating point value from Ini file or registry}
1277     var
1278     SDefault,
1279     Value : string;
1280    
1281     ECode,
1282     Key : HKey;
1283     Len : LongInt;
1284     ValSize : LongInt;
1285     ValType : DWORD;
1286    
1287     LResult : Pointer;
1288     Code : integer;
1289    
1290     begin
1291     riMode := riGet;
1292     {$IFDEF ThreadSafe}
1293     EnterCS;
1294     try
1295     {$ENDIF}
1296     if (riType = riIniType) then begin
1297     Str(Default,SDefault);
1298     Len := ReadIniData(ValueName,Value,SDefault);
1299     if (Len > 0) then begin
1300     Val(Value,Result,Code);
1301     if (Code <> 0) then
1302     Result := Default;
1303     end else
1304     Result := Default;
1305     end else begin
1306     try
1307     Key := OpenRegKey;
1308     except
1309     Result := Default;
1310     Exit;
1311     end;
1312     try
1313     ECode := GetDataInfo(Key,ValueName,ValSize,ValType);
1314    
1315     if (ECode <> ERROR_SUCCESS) then begin
1316     Result := Default;
1317     Exit;
1318     end;
1319    
1320     {Size does not include null terminator for strings}
1321     if (ValType = REG_SZ) OR (ValType = REG_EXPAND_SZ) then
1322     begin
1323     Inc(ValSize);
1324     {$IFDEF UNICODE}
1325     ValSize := ValSize * 2;
1326     {$ENDIF}
1327     end;
1328    
1329     GetMem(LResult,ValSize);
1330     try
1331     ECode := ReadRegData(Key,ValueName,LResult,ValSize,ValType);
1332     if (ECode <> ERROR_SUCCESS) then
1333     Result := Default
1334     else begin
1335     {convert data, if possible, to floating point number}
1336     case (ValType) of
1337     REG_SZ,
1338     REG_EXPAND_SZ : begin
1339     Value := StrPas(PChar(LResult));
1340     Val(Value,Result,Code);
1341     if (Code <> 0) then
1342     Result := Default;
1343     end;
1344     REG_BINARY,
1345     REG_DWORD : Result := Double(LResult^);
1346     else
1347     Result := Default;
1348     end;
1349     end;
1350     finally
1351     FreeMem(LResult,ValSize);
1352     end;
1353     finally
1354     if (riRemoteKey = 0) then
1355     CloseRegKey(Key);
1356     end;
1357     end;
1358     {$IFDEF ThreadSafe}
1359     finally
1360     LeaveCS;
1361     end;
1362     {$ENDIF}
1363     end;
1364    
1365     {==========================================================================}
1366    
1367     procedure TStRegIni.WriteDateTime(const ValueName : string; const Value : TDateTime);
1368     {-write a Delphi DateTime to Ini file or registry}
1369     var
1370     ECode : LongInt;
1371     Key : HKey;
1372     SValue : string;
1373    
1374     begin
1375     riMode := riSet;
1376     {$IFDEF ThreadSafe}
1377     EnterCS;
1378     try
1379     {$ENDIF}
1380     Str(Value,SValue);
1381     if (riType = riIniType) then begin
1382     if (NOT WriteIniData(ValueName,SValue)) then
1383     RaiseRegIniError(stscIniWriteFail);
1384     end else begin
1385     Key := OpenRegKey;
1386     try
1387     ECode := WriteRegData(Key,ValueName,@Value,REG_BINARY,SizeOf(TDateTime));
1388     if (ECode <> ERROR_SUCCESS) then
1389     RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
1390     finally
1391     if (riRemoteKey = 0) then
1392     CloseRegKey(Key);
1393     end;
1394     end;
1395     {$IFDEF ThreadSafe}
1396     finally
1397     LeaveCS;
1398     end;
1399     {$ENDIF}
1400     end;
1401    
1402     {==========================================================================}
1403    
1404     function TStRegIni.ReadDateTime(const ValueName : string; const Default : TDateTime) : TDateTime;
1405     {-read a Delphi DateTime from the Ini file or registry}
1406     var
1407     SDefault,
1408     Value : string;
1409    
1410     ECode,
1411     Key : HKey;
1412     Len : LongInt;
1413     ValSize : LongInt;
1414     ValType : DWORD;
1415    
1416     LResult : Pointer;
1417     Code : integer;
1418    
1419     begin
1420     riMode := riGet;
1421     {$IFDEF ThreadSafe}
1422     EnterCS;
1423     try
1424     {$ENDIF}
1425     if (riType = riIniType) then begin
1426     Str(Default,SDefault);
1427     Len := ReadIniData(ValueName,Value,SDefault);
1428     if (Len > 0) then begin
1429     Val(Value,Result,Code);
1430     if (Code <> 0) then
1431     Result := Default;
1432     end else
1433     Result := Default;
1434     end else begin
1435     try
1436     Key := OpenRegKey;
1437     except
1438     Result := Default;
1439     Exit;
1440     end;
1441     try
1442     ECode := GetDataInfo(Key,ValueName,ValSize,ValType);
1443    
1444     if (ECode <> ERROR_SUCCESS) then begin
1445     Result := Default;
1446     Exit;
1447     end;
1448    
1449     {Size does not include null terminator for strings}
1450     if (ValType = REG_SZ) OR (ValType = REG_EXPAND_SZ) then
1451     begin
1452     Inc(ValSize);
1453     {$IFDEF UNICODE}
1454     ValSize := ValSize * 2;
1455     {$ENDIF}
1456     end;
1457     GetMem(LResult,ValSize);
1458     try
1459     ECode := ReadRegData(Key,ValueName,LResult,ValSize,ValType);
1460     if (ECode <> ERROR_SUCCESS) then
1461     Result := Default
1462     else begin
1463     {covert data, if possible, to DateTime value}
1464     case (ValType) of
1465     REG_SZ,
1466     REG_EXPAND_SZ : begin
1467     Value := StrPas(PAnsiChar(LResult));
1468     Val(Value,Result,Code);
1469     if (Code <> 0) then
1470     Result := Default;
1471     end;
1472     REG_BINARY,
1473     REG_DWORD : Result := TDateTime(LResult^);
1474     else
1475     Result := Default;
1476     end;
1477     end;
1478     finally
1479     FreeMem(LResult,ValSize);
1480     end;
1481     finally
1482     if (riRemoteKey = 0) then
1483     CloseRegKey(Key);
1484     end;
1485     end;
1486     {$IFDEF ThreadSafe}
1487     finally
1488     LeaveCS;
1489     end;
1490     {$ENDIF}
1491     end;
1492    
1493     {==========================================================================}
1494    
1495     procedure TStRegIni.WriteDate(const ValueName : string; const Value : TStDate);
1496     {-write a SysTools Date to Ini file or registry}
1497     begin
1498     WriteInteger(ValueName,DWORD(Value));
1499     end;
1500    
1501     {==========================================================================}
1502    
1503     function TStRegIni.ReadDate(const ValueName : string; const Default : TStDate) : TStDate;
1504     {-read a SysTools Date from Ini file or registry}
1505     begin
1506     Result := TStDate(ReadInteger(ValueName,DWORD(Default)));
1507     end;
1508    
1509     {==========================================================================}
1510    
1511     procedure TStRegIni.WriteTime(const ValueName : string; const Value : TStTime);
1512     {-write SysTools Time to Ini file or registry}
1513     begin
1514     WriteInteger(ValueName,DWORD(Value));
1515     end;
1516    
1517     {==========================================================================}
1518    
1519     function TStRegIni.ReadTime(const ValueName : string; const Default : TStTime) : TStTime;
1520     {-read SysTools Time from Ini file or registry}
1521     begin
1522     Result := TStTime(ReadInteger(ValueName,DWORD(Default)));
1523     end;
1524    
1525     {==========================================================================}
1526    
1527     procedure TStRegIni.CreateKey(const KeyName : string);
1528     {-create a new section in Ini file or subkey in registry}
1529     const
1530     TempValueName = '$ABC123098FED';
1531     var
1532     Disposition : DWORD;
1533     ECode : LongInt;
1534     newKey : HKey;
1535     PCSKey,
1536     PSKey : PChar;
1537     HoldKey : HKey;
1538     begin
1539     {$IFDEF ThreadSafe}
1540     EnterCS;
1541     try
1542     {$ENDIF}
1543     if (Length(KeyName) = 0) then
1544     RaiseRegIniError(stscNoKeyName);
1545    
1546     if (riType = riIniType) then begin
1547     PSKey := StrAlloc(Length(KeyName)); // GetMem(PSKey,Length(KeyName)+1);
1548     try
1549     StrPCopy(PSKey,KeyName);
1550     {Create Section with temporary value}
1551     if (NOT WritePrivateProfileString(PSKey,TempValueName,' ',riRootName)) then
1552     RaiseRegIniError(stscCreateKeyFail);
1553     {Delete temporary value but leave section intact}
1554     if (NOT WritePrivateProfileString(PSKey,TempValueName,nil,riRootName)) then
1555     RaiseRegIniError(stscIniWriteFail);
1556     finally
1557     StrDispose(PSKey); // FreeMem(PSKey,Length(KeyName)+1);
1558     end;
1559     end else begin
1560     HoldKey := 0;
1561     PCSKey := StrAlloc(Length(KeyName) + StrLen(riCurSubKey) + 2); // GetMem(PCSKey, Length(KeyName)+1 + LongInt(strlen(riCurSubkey))+2);
1562     PSKey := StrAlloc(Length(KeyName)); // GetMem(PSKey, Length(KeyName)+1);
1563     try
1564     PCSKey[0] := #0;
1565     StrPCopy(PSKey,KeyName);
1566     if riCurSubKey[0] <> #0 then
1567     strcat(Strcopy(PCSKey, riCurSubKey), '\');
1568     strcat(PCSKey, PSKey);
1569     if (riRemoteKey <> 0) then begin
1570     HoldKey := riPrimaryKey;
1571     riPrimaryKey := riRemoteKey;
1572     end;
1573     Disposition := 0;
1574     {creates a new key or opens an existing key}
1575     ECode := RegCreateKeyEx(riPrimaryKey,PCSKey,0,nil,
1576     REG_OPTION_NON_VOLATILE,KEY_ALL_ACCESS,@FriSecAttr,
1577     newKey,@Disposition);
1578     if (ECode <> ERROR_SUCCESS) then
1579     RaiseRegIniErrorFmt(stscCreateKeyFail,[ECode]);
1580    
1581     {don't leave a key open longer than it's needed}
1582     RegCloseKey(newKey);
1583     finally
1584     if (HoldKey <> 0) then
1585     riPrimaryKey := HoldKey;
1586     StrDispose(PSKey); // FreeMem(PSKey,Length(KeyName)+1);
1587     StrDispose(PCSKey); // FreeMem(PCSKey, Length(KeyName)+1 + LongInt(strlen(riCurSubkey))+2);
1588     end;
1589     end;
1590     {$IFDEF ThreadSafe}
1591     finally
1592     LeaveCS;
1593     end;
1594     {$ENDIF}
1595     end;
1596    
1597     {==========================================================================}
1598    
1599     procedure TStRegIni.ParseIniFile(SList : TStrings);
1600     {-procedure to read through an INI text file}
1601     var
1602     F : TextFile;
1603     L : string;
1604     begin
1605     AssignFile(F, riRootName);
1606     Reset(F);
1607     try
1608     Readln(F,L);
1609     while NOT EOF(F) do begin
1610     if (L[1] = '[') AND (L[Length(L)] = ']') then begin
1611     Delete(L, Length(L), 1);
1612     Delete(L, 1, 1);
1613     SList.Add(L);
1614     end;
1615     Readln(F,L);
1616     end;
1617     finally
1618     CloseFile(F);
1619     end;
1620     end;
1621    
1622     {==========================================================================}
1623    
1624     procedure TStRegIni.GetSubKeys(SK : TStrings);
1625     {-get list of section names (or values) from Ini file or subkeys in registry}
1626     {For Ini files only: if riCurSubKey = '', list is of section names}
1627     { if riCurSubKey <> '', list is of value names in section}
1628     var
1629     ValueName : PChar;
1630    
1631     Sections,
1632     valuePos,
1633     NumSubKeys,
1634     LongSKName,
1635     LongVName,
1636     NumVals,
1637     MaxSize,
1638     VSize : DWORD;
1639     Buffer : array[0..MaxBufSize] of Char;
1640     S : string;
1641     ECode : LongInt;
1642     Key : HKey;
1643    
1644     begin
1645     riMode := riGet;
1646     {$IFDEF ThreadSafe}
1647     EnterCS;
1648     try
1649     {$ENDIF}
1650     SK.Clear;
1651    
1652     if (riType = riIniType) then begin
1653     Buffer[0] := #0;
1654     if (riCurSubKey[0] = #0) then begin
1655     {Get section names in ini file}
1656     Sections := GetPrivateProfileSectionNames(Buffer,MaxBufSize,riRootName);
1657     end else
1658     {get value names in specified section}
1659     Sections := GetPrivateProfileString(riCurSubKey,nil,#0,
1660     Buffer,MaxBufSize,riRootName);
1661    
1662     {parse Section Names from Buffer string}
1663     if (Sections > 0) then begin
1664     valuePos := 0;
1665     repeat
1666     S := StrPas(Buffer+valuePos);
1667     if (Length(S) > 0) then begin
1668     SK.Add(S);
1669     Inc(valuePos,StrEnd(Buffer+valuePos)-(Buffer+valuePos)+1);
1670     end else
1671     break;
1672     until Length(S) = 0;
1673     end;
1674     end else begin
1675     Key := OpenRegKey;
1676     try
1677     ECode := RegQueryInfoKey(Key,nil,nil,nil,@NumSubKeys,
1678     @LongSKName,nil,@NumVals,@LongVName,@MaxSize,nil,nil);
1679     if (ECode <> ERROR_SUCCESS) then
1680     RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);
1681     Inc(LongSKName);
1682     valuePos := 0;
1683     ValueName := StrAlloc(LongSKName); // GetMem(ValueName,LongSKName);
1684     try
1685     while valuePos < NumSubKeys do begin
1686     ValueName[0] := #0;
1687     VSize := LongSKName;
1688     ECode := RegEnumKeyEx(Key,valuePos,ValueName,VSize,
1689     nil,nil,nil,nil);
1690     if (ECode <> ERROR_SUCCESS) AND
1691     (ECode <> ERROR_MORE_DATA) then
1692     RaiseRegIniErrorFmt(stscEnumKeyFail,[ECode]);
1693     SK.Add(StrPas(ValueName));
1694     Inc(valuePos);
1695     end;
1696     finally
1697     StrDispose(ValueName); // FreeMem(ValueName,LongSKName);
1698     end;
1699     finally
1700     if (riRemoteKey = 0) then
1701     CloseRegKey(Key);
1702     end;
1703     end;
1704     {$IFDEF ThreadSafe}
1705     finally
1706     LeaveCS;
1707     end;
1708     {$ENDIF}
1709     end;
1710    
1711     {==========================================================================}
1712    
1713     procedure TStRegIni.GetValues(SKV : TStrings);
1714     {-return value names and string representation of data in}
1715     {Ini file section or registry subkey}
1716     var
1717     ValueName : PChar;
1718    
1719     valuePos,
1720     NumSubKeys,
1721     LongSKName,
1722     LongVName,
1723     NumVals,
1724     MaxSize,
1725     VSize,
1726     DSize : DWORD;
1727    
1728     S, TS : string;
1729     KeyList : TStringList;
1730     ECode : LongInt;
1731     Key : HKey;
1732    
1733     ValType : DWORD;
1734     LResult : Pointer;
1735    
1736     begin
1737     riMode := riGet;
1738     {$IFDEF ThreadSafe}
1739     EnterCS;
1740     try
1741     {$ENDIF}
1742     SKV.Clear;
1743    
1744     if (riType = riIniType) then begin
1745     KeyList := TStringList.Create;
1746     try
1747     {get list of value names in section}
1748     GetSubKeys(KeyList);
1749     if (KeyList.Count > 0) then begin
1750     for valuePos := 0 to KeyList.Count-1 do begin
1751     S := KeyList[valuePos] + '='
1752     + ReadString(KeyList[valuePos],'');
1753     SKV.AddObject(S,BmpText);
1754     end;
1755     end;
1756     finally
1757     KeyList.Free;
1758     end;
1759     end else begin
1760     Key := OpenRegKey;
1761     try
1762     {get data on specified keys}
1763     ECode := RegQueryInfoKey(Key,nil,nil,nil,
1764     @NumSubKeys,@LongSKName,nil,@NumVals,
1765     @LongVName,@MaxSize,nil,nil);
1766     if (ECode <> ERROR_SUCCESS) then
1767     RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);
1768     Inc(MaxSize);
1769     Inc(LongVName);
1770     GetMem(LResult,MaxSize);
1771     try
1772     valuePos := 0;
1773     ValueName := StrAlloc(LongVName); // GetMem(ValueName,LongVName);
1774     try
1775     {step through values in subkey and get data from each}
1776     while valuePos < NumVals do begin
1777     ValueName[0] := #0;
1778     VSize := LongVName;
1779     DSize := MaxSize;
1780     ECode := RegEnumValue(Key,valuePos,ValueName,
1781     VSize,nil,@ValType,LResult,@DSize);
1782     if (ECode <> ERROR_SUCCESS) AND
1783     (ECode <> ERROR_MORE_DATA) then
1784     RaiseRegIniErrorFmt(stscEnumValueFail,[ECode]);
1785     if (Length(ValueName) > 0) then
1786     S := StrPas(ValueName) + '='
1787     else
1788     S := 'Default=';
1789     case ValType of
1790     {convert data to string representation}
1791     REG_SZ,
1792     REG_EXPAND_SZ : begin
1793     TS := StrPas(PChar(LResult));
1794     S := S + TS;
1795     SKV.AddObject(S,BmpText);
1796     end;
1797    
1798     REG_DWORD,
1799     REG_BINARY : begin
1800     if ValType = REG_DWORD then
1801     Str(LongInt(LResult^),TS)
1802     else
1803     TS := BytesToString(PByte(LResult),DSize);
1804     S := S + TS;
1805     SKV.AddObject(S,BmpBinary);
1806     end;
1807     end;
1808     Inc(valuePos);
1809     end;
1810     finally
1811     StrDispose(ValueName); // FreeMem(ValueName,LongVName);
1812     end;
1813     finally
1814     FreeMem(LResult,MaxSize);
1815     end;
1816     finally
1817     if (riRemoteKey = 0) then
1818     CloseRegKey(Key);
1819     end;
1820     end;
1821     {$IFDEF ThreadSafe}
1822     finally
1823     LeaveCS;
1824     end;
1825     {$ENDIF}
1826     end;
1827    
1828     {==========================================================================}
1829    
1830     procedure TStRegIni.DeleteKey(const KeyName : string; DeleteSubKeys : Boolean);
1831     {-delete a section from Ini file or subkey from registry}
1832     {if DeleteSubKeys = True : specified section (key) and values (subkeys),}
1833     { if any, are deleted }
1834     { = False : specified section (key) can not be deleted }
1835     { if there are any values (subkeys) }
1836     var
1837     PSKey : PChar;
1838     NumSubKeys,
1839     NumValues : DWORD;
1840     Key : HKey;
1841     ECode : LongInt;
1842     TS,
1843     HldKey : String;
1844     ASL : TStringList;
1845    
1846    
1847     procedure ClearKey(StartKey : HKey);
1848     var
1849     SL : TStringList;
1850     NK : HKey;
1851     NSK,
1852     NV : DWORD;
1853     J : LongInt;
1854     TS,
1855     HK : String;
1856     PSK : array[0..255] of char;
1857     begin
1858     ECode := RegQueryInfoKey(StartKey, nil, nil, nil, @NSK,
1859     nil, nil, @NV, nil, nil, nil, nil);
1860     if (NV > 0) then begin
1861     SL := TStringList.Create;
1862     try
1863     GetValues(SL);
1864     for J := 0 to SL.Count-1 do begin
1865     TS := SL.Names[J];
1866     if (AnsiCompareText('Default', TS) <> 0) then
1867     DeleteValue(TS);
1868     end;
1869     finally
1870     SL.Free;
1871     end;
1872     end;
1873    
1874     if NSK > 0 then begin
1875     SL := TStringList.Create;
1876     try
1877     GetSubKeys(SL);
1878     for J := 0 to SL.Count-1 do begin
1879     HK := GetCurSubKey;
1880     SetCurSubKey(HK + '\' + SL[J]);
1881     NK := OpenRegKey;
1882     ClearKey(NK);
1883     RegCloseKey(NK);
1884     SetCurSubKey(HK);
1885     StrPCopy(PSK, SL[J]);
1886     RegDeleteKey(StartKey, PSK);
1887     end;
1888     finally
1889     SL.Free;
1890     end;
1891     end;
1892     end;
1893    
1894     begin
1895     riMode := riSet;
1896     {$IFDEF ThreadSafe}
1897     EnterCS;
1898     try
1899     {$ENDIF}
1900     PSKey := StrAlloc(Length(KeyName)); // GetMem(PSKey,Length(KeyName)+1);
1901     try
1902     StrPCopy(PSKey,KeyName);
1903     if (riType = riIniType) then begin
1904     ASL := TStringList.Create;
1905     try
1906     {check for values in section}
1907     HldKey := GetCurSubkey;
1908     SetCurSubKey(KeyName);
1909     GetSubKeys(ASL);
1910     SetCurSubKey(HldKey);
1911     NumSubKeys := ASL.Count;
1912    
1913     {remove section KeyName from INI file}
1914     if (NumSubKeys > 0) AND (NOT DeleteSubKeys) then
1915     RaiseRegIniErrorFmt(stscKeyHasSubKeys,[NumSubKeys]);
1916     if (NOT WritePrivateProfileString(PSKey,nil,nil,riRootName)) then
1917     RaiseRegIniError(stscIniDeleteFail);
1918     finally
1919     ASL.Free;
1920     end;
1921     end else begin
1922     HldKey := GetCurSubkey;
1923     TS := HldKey + '\' + KeyName;
1924     if TS[1] = '\' then
1925     Delete(TS, 1, 1);
1926     SetCurSubKey(TS);
1927     Key := OpenRegKey;
1928     try
1929     {check for subkeys under key to be deleted}
1930     ECode := RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys,
1931     nil, nil, @NumValues, nil, nil, nil, nil);
1932    
1933     if (ECode <> ERROR_SUCCESS) then
1934     RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);
1935    
1936     if (NumSubKeys > 0) OR (NumValues > 0) then begin
1937     if (NOT DeleteSubKeys) then
1938     RaiseRegIniErrorFmt(stscKeyHasSubKeys,[NumSubKeys])
1939     else
1940     if (riWinVer = riWinNT) then
1941     ClearKey(Key);
1942     end;
1943     finally
1944     RegCloseKey(Key);
1945     SetCurSubKey(HldKey);
1946     end;
1947    
1948     Key := OpenRegKey;
1949     try
1950     ECode := RegDeleteKey(Key, PSKey);
1951     if (ECode <> ERROR_SUCCESS) then
1952     RaiseRegIniErrorFmt(stscDeleteKeyFail,[ECode]);
1953     finally
1954     if (riRemoteKey = 0) then
1955     RegCloseKey(Key);
1956     end;
1957     end;
1958     finally
1959     StrDispose(PSKey); // FreeMem(PSKey,Length(KeyName)+1);
1960     end;
1961     {$IFDEF ThreadSafe}
1962     finally
1963     LeaveCS;
1964     end;
1965     {$ENDIF}
1966     end;
1967    
1968     {==========================================================================}
1969    
1970     procedure TStRegIni.DeleteValue(const ValueName : string);
1971     {-delete value from Ini file section or registry subkey}
1972     var
1973     PVName : PChar;
1974     ECode : LongInt;
1975     Key : HKey;
1976     begin
1977     riMode := riSet;
1978     {$IFDEF ThreadSafe}
1979     EnterCS;
1980     try
1981     {$ENDIF}
1982     PVName := StrAlloc(Length(valueName)); // GetMem(PVName,Length(valueName)+1);
1983     try
1984     StrPCopy(PVName,valueName);
1985     if (riType = riIniType) then begin
1986     if (NOT WritePrivateProfileString(riCurSubKey,PVName,nil,riRootName)) then
1987     RaiseRegIniError(stscIniDelValueFail);
1988     end else begin
1989     Key := OpenRegKey;
1990     try
1991     ECode := RegDeleteValue(Key,PVName);
1992     if (ECode <> ERROR_SUCCESS) then
1993     RaiseRegIniErrorFmt(stscRegDelValueFail,[ECode]);
1994     finally
1995     if (riRemoteKey = 0) then
1996     CloseRegKey(Key);
1997     end;
1998     end;
1999     finally
2000     StrDispose(PVName); // FreeMem(PVName,Length(valueName)+1);
2001     end;
2002     {$IFDEF ThreadSafe}
2003     finally
2004     LeaveCS;
2005     end;
2006     {$ENDIF}
2007     end;
2008    
2009     {==========================================================================}
2010    
2011     procedure TStRegIni.QueryKey(var KeyInfo : TQueryKeyInfo);
2012     {-get informatino about Ini file seciton or registry subkey}
2013     const
2014     BufSize = 2048;
2015     var
2016     PVName,
2017     PCName : PChar;
2018    
2019     P,
2020     step : integer;
2021    
2022     CNSize : DWORD;
2023     Key : HKey;
2024     ECode : LongInt;
2025     SL : TStringList;
2026    
2027     begin
2028     riMode := riGet;
2029     {$IFDEF ThreadSafe}
2030     EnterCS;
2031     try
2032     {$ENDIF}
2033     if (riType = riIniType) then begin
2034     {data for the specified section in the INI file}
2035     SL := TStringList.Create;
2036     try
2037     FillChar(KeyInfo,sizeof(KeyInfo),#0);
2038     {get value names/values}
2039     GetValues(SL);
2040     with KeyInfo do begin
2041     QIMaxVNLen := 0;
2042     QIMaxDataLen := 0;
2043     QINumValues := SL.Count;
2044     if (SL.Count > 0) then begin
2045     for step := 0 to SL.Count-1 do begin
2046     {find maximum length of value names and values}
2047     P := pos('=',SL[step])-1;
2048     if (P > LongInt(QIMaxVNLen)) then
2049     QIMaxVNLen := P;
2050    
2051     P := Length(SL[step]) - P;
2052     if (P > LongInt(QIMaxDataLen)) then
2053     QIMaxDataLen := P;
2054     end;
2055     end;
2056     end;
2057     finally
2058     SL.Free;
2059     end;
2060     end else begin
2061     PVName := nil;
2062     PCName := nil;
2063     try
2064     PVName := StrAlloc(BufSize); // GetMem(PVName,BufSize);
2065     PCName := StrAlloc(BufSize); //GetMem(PCName,BufSize);
2066    
2067     Key := OpenRegKey;
2068     try
2069     PCName[0] := #0;
2070     CNSize := BufSize;
2071     with KeyInfo do begin
2072     ECode := RegQueryInfoKey(Key,PCName,@CNSize,
2073     nil,@QINumSubKeys,@QIMaxSKNLen,
2074     @QIMaxCNLen, @QINumValues,
2075     @QIMaxVNLen, @QIMaxDataLen,
2076     @QISDescLen, @QIFileTime);
2077     if (ECode <> ERROR_SUCCESS) then
2078     RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);
2079     QIKey := Key;
2080     QIClassName := StrPas(PCName);
2081     end;
2082     finally
2083     if (riRemoteKey = 0) then
2084     CloseRegKey(Key);
2085     end;
2086     finally
2087     if (PVName <> nil) then
2088     StrDispose(PVName); // FreeMem(PVName,BufSize);
2089     if (PCName <> nil) then
2090     StrDispose(PCName); // FreeMem(PCName,BufSize);
2091     end;
2092     end;
2093     {$IFDEF ThreadSafe}
2094     finally
2095     LeaveCS;
2096     end;
2097     {$ENDIF}
2098     end;
2099    
2100     {==========================================================================}
2101    
2102     function TStRegIni.KeyExists(KeyName : string) : Boolean;
2103     {-checks if exists in INI file/Registry}
2104     var
2105     KN : PChar;
2106     PV : array[0..9] of char;
2107     HK : HKey;
2108     begin
2109     riMode := riGet;
2110     {$IFDEF ThreadSafe}
2111     EnterCS;
2112     try
2113     {$ENDIF}
2114     KN := StrAlloc(Length(KeyName)); // GetMem(KN, Length(KeyName)+1);
2115     try
2116     StrPCopy(KN, KeyName);
2117     if (riType = riIniType) then begin
2118     GetPrivateProfileString(KN, nil, '$KDNE1234', PV, 10, riRootName);
2119     Result := StrIComp(PV, '$KDNE1234') <> 0;
2120     end else begin
2121     Result := RegOpenKeyEx(riPrimaryKey,KN,0,KEY_READ,HK) = ERROR_SUCCESS;
2122     if Result then
2123     RegCloseKey(HK);
2124     end;
2125     finally
2126     StrDispose(KN); // FreeMem(KN, Length(KeyName)+1);
2127     end;
2128     {$IFDEF ThreadSafe}
2129     finally
2130     LeaveCS;
2131     end;
2132     {$ENDIF}
2133     end;
2134    
2135     {==========================================================================}
2136    
2137     function TStRegIni.IsKeyEmpty(Primary, SubKey : string) : Boolean;
2138     var
2139     FindPos : Integer;
2140     Key : HKey;
2141     NumSubKeys,
2142     NumValues : DWORD;
2143     ECode : LongInt;
2144     HPrime,
2145     HSubKy : String;
2146     ASL : TStringList;
2147    
2148     begin
2149     riMode := riGet;
2150     {$IFDEF ThreadSafe}
2151     EnterCS;
2152     try
2153     {$ENDIF}
2154     HPrime := GetPrimary;
2155     HSubKy := CurSubKey;
2156    
2157     SetPrimary(Primary);
2158     CurSubKey := SubKey;
2159     Result := True;
2160    
2161     if (riType = riIniType) then begin
2162     {check for values in section}
2163     ASL := TStringList.Create;
2164     try
2165     ParseIniFile(ASL);
2166     if not (ASL.Find( '[' + SubKey + ']', FindPos)) then
2167     Result := False;
2168     finally
2169     ASL.Free;
2170     end;
2171     end else begin
2172     try
2173     Key := OpenRegKey;
2174     try
2175     ECode := RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys,
2176     nil, nil, @NumValues, nil, nil, nil, nil);
2177     if (ECode <> ERROR_SUCCESS) or
2178     (NumSubKeys > 0) or (NumValues > 0) then
2179     Result := False;
2180     except
2181     Result := False;
2182     end;
2183     RegCloseKey(Key);
2184     finally
2185     SetPrimary(HPrime);
2186     SetCurSubKey(HSubKy);
2187     end;
2188     end;
2189     {$IFDEF ThreadSafe}
2190     finally
2191     LeaveCS;
2192     end;
2193     {$ENDIF}
2194     end;
2195    
2196     {==========================================================================}
2197    
2198     procedure TStRegIni.SaveKey(const SubKey : string; FileName : string);
2199     {-save contents of registry key to a file}
2200     var
2201     SKey : string;
2202     I,
2203     DotPos : Cardinal;
2204     TSL : TStringList;
2205     F : TextFile;
2206     begin
2207     riMode := riSet;
2208     {$IFDEF ThreadSafe}
2209     EnterCS;
2210     try
2211     {$ENDIF}
2212     if (SubKey <> FCurSubKey) then begin
2213     SKey := FCurSubKey;
2214     SetCurSubKey(SubKey);
2215     end;
2216    
2217     if (riType = riIniType) then begin
2218     if (FileExists(FileName)) then
2219     RaiseRegIniError(stscOutputFileExists);
2220     TSL := TStringList.Create;
2221     try
2222     {get valuenames and values from specified section}
2223     GetValues(TSL);
2224     if (TSL.Count < 1) then
2225     RaiseRegIniError(stscKeyIsEmptyNotExists);
2226     AssignFile(F,FileName);
2227     ReWrite(F);
2228     try
2229     writeln(F,'[' + SubKey + ']');
2230     for I := 0 to TSL.Count-1 do
2231     writeln(F,TSL[I]);
2232     finally
2233     CloseFile(F);
2234     end;
2235     finally
2236     TSL.Free;
2237     end;
2238     end else begin
2239     if (FileExists(FileName)) then
2240     RaiseRegIniError(stscOutputFileExists);
2241     if (HasExtensionL(FileName,DotPos)) then
2242     RaiseRegIniError(stscFileHasExtension);
2243     (* TODO: this was only executed if $H+ why?
2244     GetMem(PFName,Length(FileName)+1);
2245     try
2246     StrPCopy(PFName,FileName);
2247     Key := OpenRegKey;
2248     try
2249     if (riWinVer = riWinNT) then begin
2250     OpenProcessToken(GetCurrentProcess(),
2251     TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY, hToken);
2252     LookupPrivilegeValue(nil,'SeBackupPrivilege',luid);
2253     tp.PrivilegeCount := 1;
2254     tp.Privileges[0].Luid := luid;
2255     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
2256    
2257     AdjustTokenPrivileges(hToken, FALSE, tp,
2258     sizeOf(TTokenPrivileges),ptp,retval);
2259     end;
2260    
2261     ECode := RegSaveKey(Key,PFName,@FriSecAttr);
2262    
2263     if (riWinVer = riWinNT) then
2264     AdjustTokenPrivileges(hToken,TRUE,tp,
2265     sizeOf(TTokenPrivileges),ptp,retval);
2266    
2267     if (ECode <> ERROR_SUCCESS) then
2268     RaiseRegIniErrorFmt(stscSaveKeyFail,[ECode]);
2269     finally
2270     if (riRemoteKey = 0) then
2271     CloseRegKey(Key);
2272     end;
2273     finally
2274     FreeMem(PFName,Length(FileName)+1);
2275     end;
2276     *)
2277     end;
2278    
2279     if (SKey <> '') then
2280     SetCurSubKey(SKey);
2281     {$IFDEF ThreadSafe}
2282     finally
2283     LeaveCS;
2284     end;
2285     {$ENDIF}
2286     end;
2287    
2288     {==========================================================================}
2289    
2290     procedure TStRegIni.LoadKey(const SubKey, FileName : string);
2291     {-load a registry key from a file created with SaveKey}
2292     const
2293     BufSize = 2048;
2294     var
2295     I,
2296     DotPos : Cardinal;
2297    
2298     F : TextFile;
2299     TSL : TStringList;
2300     S,
2301     SKey : string;
2302     ECode : LongInt;
2303     P : LongInt;
2304    
2305     hToken : THandle;
2306     ptp,
2307     tp : TTokenPrivileges;
2308     luid : TLargeInteger;
2309     retval : DWORD;
2310    
2311     begin
2312     {$IFDEF ThreadSafe}
2313     EnterCS;
2314     {$ENDIF}
2315     riMode := riSet;
2316     try
2317     if (riType = riIniType) then begin
2318     if (NOT FileExists(FileName)) then
2319     RaiseRegIniError(stscCantFindInputFile);
2320    
2321     {read contents of file into a string list}
2322     TSL := TStringList.Create;
2323     try
2324     AssignFile(F,FileName);
2325     try
2326     ReSet(F);
2327     while NOT EOF(F) do begin
2328     Readln(F,S);
2329     TSL.Add(S);
2330     end;
2331     finally
2332     CloseFile(F);
2333     end;
2334    
2335     if (TSL.Count < 1) then
2336     RaiseRegIniError(stscKeyIsEmptyNotExists);
2337    
2338     {if section exists - delete it and all values}
2339     DeleteKey(SubKey,True);
2340    
2341     {write contents of string list to ini file}
2342     for I := 1 to TSL.Count-1 do begin
2343     S := TSL[I];
2344     P := pos('=',S);
2345     Delete(S,P,Length(S)-P+1);
2346     WritePrivateProfileString(PChar(SubKey),PChar(S), PChar(TSL.Values[S]),riRootName);
2347     end;
2348     finally
2349     TSL.Free;
2350     end;
2351     end else begin
2352     if (NOT FileExists(FileName)) then
2353     RaiseRegIniError(stscCantFindInputFile);
2354     if (HasExtensionL(FileName,DotPos)) then
2355     RaiseRegIniError(stscFileHasExtension);
2356    
2357     {save current subkey if saving another}
2358     if (SubKey <> FCurSubKey) then begin
2359     SKey := FCurSubKey;
2360     SetCurSubKey(SubKey);
2361     end;
2362    
2363     {get security token for NT}
2364     if (riWinVer = riWinNT) then begin
2365     OpenProcessToken(GetCurrentProcess(),
2366     TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY, hToken);
2367     LookupPrivilegeValue(nil,'SeRestorePrivilege',luid);
2368     tp.PrivilegeCount := 1;
2369     tp.Privileges[0].Luid := luid;
2370     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
2371    
2372     AdjustTokenPrivileges(hToken, FALSE, tp,
2373     sizeOf(TTokenPrivileges),ptp,retval);
2374     end;
2375    
2376     {can load only at top of registry}
2377     if (riPrimaryKey = HKEY_LOCAL_MACHINE) OR
2378     (riPrimaryKey = HKEY_USERS) then begin
2379     ECode := RegLoadKey(riPrimaryKey,PChar(SubKey),PChar(FileName));
2380     if (riWinVer = riWinNT) then
2381     AdjustTokenPrivileges(hToken,TRUE,tp,
2382     sizeOf(TTokenPrivileges),ptp,retval);
2383     if (ECode <> ERROR_SUCCESS) then
2384     RaiseRegIniErrorFmt(stscLoadKeyFail,[ECode]);
2385     end else begin
2386     if (riRemoteKey <> 0) then begin
2387     ECode := RegLoadKey(riRemoteKey,PChar(SubKey),PChar(FileName));
2388     if (riWinVer = riWinNT) then
2389     AdjustTokenPrivileges(hToken,TRUE,tp,
2390     sizeOf(TTokenPrivileges),ptp,retval);
2391     if (ECode <> ERROR_SUCCESS) then
2392     RaiseRegIniErrorFmt(stscLoadKeyFail,[ECode]);
2393     end else
2394     RaiseRegIniError(stscInvalidPKey);
2395     end;
2396    
2397     {restore current subkey if necessary}
2398     if (SKey <> '') then
2399     SetCurSubKey(SKey);
2400     end;
2401     finally
2402     {$IFDEF ThreadSafe}
2403     LeaveCS;
2404     {$ENDIF}
2405     end;
2406     end;
2407    
2408     {==========================================================================}
2409    
2410     procedure TStRegIni.UnLoadKey(const SubKey : string);
2411     {-remove a section from Ini file or subkey from registry}
2412     {Registry only: SubKey must have been loaded with LoadKey}
2413     var
2414     PSKey : PChar;
2415     ECode : LongInt;
2416     HoldKey : HKey;
2417    
2418     hToken : THandle;
2419     ptp,
2420     tp : TTokenPrivileges;
2421     luid : TLargeInteger;
2422     retval : DWORD;
2423    
2424     begin
2425     riMode := riSet;
2426     {$IFDEF ThreadSafe}
2427     EnterCS;
2428     try
2429     {$ENDIF}
2430     if (riType = riIniType) then
2431     DeleteKey(SubKey,TRUE)
2432     else
2433     begin
2434     HoldKey := 0;
2435    
2436     {store primary key if working on remote computer}
2437     if (riRemoteKey <> 0) then begin
2438     HoldKey := riPrimaryKey;
2439     riPrimaryKey := riRemoteKey;
2440     end;
2441     try
2442     if (riWinVer = riWinNT) then begin
2443     OpenProcessToken(GetCurrentProcess(),
2444     TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY, hToken);
2445     LookupPrivilegeValue(nil,'SeRestorePrivilege',luid);
2446     tp.PrivilegeCount := 1;
2447     tp.Privileges[0].Luid := luid;
2448     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
2449    
2450     AdjustTokenPrivileges(hToken, FALSE, tp,
2451     sizeOf(TTokenPrivileges),ptp,retval);
2452     end;
2453    
2454     ECode := RegUnLoadKey(riPrimaryKey,PChar(SubKey));
2455    
2456     if (riWinVer = riWinNT) then
2457     AdjustTokenPrivileges(hToken,TRUE,tp,
2458     sizeOf(TTokenPrivileges),ptp,retval);
2459    
2460     if (ECode <> ERROR_SUCCESS) then
2461     RaiseRegIniErrorFmt(stscUnloadKeyFail,[ECode]);
2462     finally
2463     {restore primary key if function used on remote computer}
2464     if (riRemoteKey <> 0) then
2465     riPrimaryKey := HoldKey;
2466     end;
2467     end;
2468     {$IFDEF ThreadSafe}
2469     finally
2470     LeaveCS;
2471     end;
2472     {$ENDIF}
2473     end;
2474    
2475     {==========================================================================}
2476    
2477     procedure TStRegIni.RestoreKey(const SubKey, KeyFile : string; Options : DWORD);
2478     {-restore a section of Ini file or subkey of registry}
2479     {Registry only: key being loaded must have been stored using SaveKey}
2480     var
2481     ECode : LongInt;
2482     Key : HKey;
2483     hToken : THandle;
2484     ptp,
2485     tp : TTokenPrivileges;
2486     luid : TLargeInteger;
2487     retval : DWORD;
2488    
2489     begin
2490     riMode := riSet;
2491     {$IFDEF ThreadSafe}
2492     EnterCS;
2493     try
2494     {$ENDIF}
2495     if (riType = riIniType) then
2496     LoadKey(SubKey, KeyFile)
2497     else begin
2498     if (riWinVer <> riWinNT) then
2499     RaiseRegIniError(stscNotWinNTPlatform);
2500    
2501     Key := OpenRegKey;
2502     try
2503     if (Options = REG_WHOLE_HIVE_VOLATILE) AND
2504     (Key <> HKEY_USERS) AND
2505     (Key <> HKEY_LOCAL_MACHINE) then
2506     RaiseRegIniError(stscBadOptionsKeyCombo);
2507    
2508     {get process token for WinNT}
2509     if (riWinVer = riWinNT) then begin
2510     OpenProcessToken(GetCurrentProcess(),
2511     TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY, hToken);
2512     LookupPrivilegeValue(nil,'SeRestorePrivilege',luid);
2513     tp.PrivilegeCount := 1;
2514     tp.Privileges[0].Luid := luid;
2515     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
2516    
2517     AdjustTokenPrivileges(hToken, FALSE, tp,
2518     sizeOf(TTokenPrivileges),ptp,retval);
2519     end;
2520    
2521     ECode := RegRestoreKey(Key,PChar(KeyFile),Options);
2522    
2523     if (riWinVer = riWinNT) then
2524     AdjustTokenPrivileges(hToken,TRUE,tp,
2525     sizeOf(TTokenPrivileges),ptp,retval);
2526    
2527     if (ECode <> ERROR_SUCCESS) then
2528     RaiseRegIniErrorFmt(stscRestoreKeyFail,[ECode]);
2529     finally
2530     CloseRegKey(Key);
2531     end;
2532     end;
2533     {$IFDEF ThreadSafe}
2534     finally
2535     LeaveCS;
2536     end;
2537     {$ENDIF}
2538     end;
2539    
2540     {==========================================================================}
2541    
2542     procedure TStRegIni.ReplaceKey(const SubKey, InputFile, SaveFile : string);
2543     {-replace existing section or registry subkey}
2544     {Registry only: key being loaded must have been stored with SaveKey}
2545     { "new" key does not take affect unti re-boot}
2546     var
2547     DotPos : Cardinal;
2548     ECode : LongInt;
2549     hToken : THandle;
2550     ptp,
2551     tp : TTokenPrivileges;
2552     luid : TLargeInteger;
2553     retval : DWORD;
2554    
2555     begin
2556     riMode := riSet;
2557     {$IFDEF ThreadSafe}
2558     EnterCS;
2559     try
2560     {$ENDIF}
2561     if (riType = riIniType) then begin
2562     if (FileExists(SaveFile)) then
2563     RaiseRegIniError(stscOutputFileExists);
2564     SaveKey(SubKey,SaveFile);
2565     LoadKey(SubKey,InputFile);
2566     end else begin
2567     if (FileExists(SaveFile)) then
2568     RaiseRegIniError(stscOutputFileExists);
2569     if (HasExtensionL(SaveFile,DotPos)) OR
2570     (HasExtensionL(InputFile,DotPos)) then
2571     RaiseRegIniError(stscFileHasExtension);
2572    
2573     if (riWinVer = riWinNT) then begin
2574     OpenProcessToken(GetCurrentProcess(),
2575     TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY,
2576     {$IFNDEF VERSION3}
2577     @hToken);
2578     {$ELSE}
2579     hToken);
2580     {$ENDIF}
2581     LookupPrivilegeValue(nil,'SeRestorePrivilege',luid);
2582     tp.PrivilegeCount := 1;
2583     tp.Privileges[0].Luid := luid;
2584     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
2585    
2586     AdjustTokenPrivileges(hToken, FALSE, tp,
2587     sizeOf(TTokenPrivileges),ptp,retval);
2588     end;
2589    
2590     if (riRemoteKey <> 0) then begin
2591     ECode := RegReplaceKey(riRemoteKey,PChar(SubKey),PChar(InputFile),PChar(SaveFile));
2592    
2593     if (riWinVer = riWinNT) then
2594     AdjustTokenPrivileges(hToken,TRUE,tp,
2595     sizeOf(TTokenPrivileges),ptp,retval);
2596     if (ECode <> ERROR_SUCCESS) then
2597     RaiseRegIniErrorFmt(stscReplaceKeyFail,[ECode]);
2598     end else begin
2599     ECode := RegReplaceKey(riPrimaryKey,PChar(SubKey),PChar(InputFile),PChar(SaveFile));
2600     if (riWinVer = riWinNT) then
2601     AdjustTokenPrivileges(hToken,TRUE,tp,
2602     sizeOf(TTokenPrivileges),ptp,retval);
2603     if (ECode <> ERROR_SUCCESS) then
2604     RaiseRegIniErrorFmt(stscReplaceKeyFail,[ECode]);
2605     end;
2606     end;
2607     {$IFDEF ThreadSafe}
2608     finally
2609     LeaveCS;
2610     end;
2611     {$ENDIF}
2612     end;
2613    
2614     {==========================================================================}
2615    
2616     procedure TStRegIni.RegOpenRemoteKey(CompName : string);
2617     {-open a registry subkey on a remote computer}
2618     var
2619     ECode : LongInt;
2620     begin
2621     riMode := riSet;
2622     {$IFDEF ThreadSafe}
2623     EnterCS;
2624     try
2625     {$ENDIF}
2626     if (riType = riIniType) then
2627     RaiseRegIniError(stscNoIniFileSupport)
2628     else begin
2629     if (riRemoteKey <> 0) then
2630     RaiseRegIniError(stscRemoteKeyIsOpen);
2631    
2632     if (riPrimaryKey <> HKEY_LOCAL_MACHINE) AND
2633     (riPrimaryKey <> HKEY_USERS) then
2634     RaiseRegIniError(stscInvalidPKey);
2635    
2636     ECode := Windows.RegConnectRegistry(PChar(CompName),riPrimaryKey,riRemoteKey);
2637     if (ECode <> ERROR_SUCCESS) then
2638     RaiseRegIniErrorFmt(stscConnectRemoteKeyFail,[ECode]);
2639    
2640     {store current primary key while remote key is open}
2641     if (riPrimaryKey <> riRemoteKey) then
2642     riHoldPrimary := riPrimaryKey;
2643     riPrimaryKey := riRemoteKey;
2644     end;
2645     {$IFDEF ThreadSafe}
2646     finally
2647     LeaveCS;
2648     end;
2649     {$ENDIF}
2650     end;
2651    
2652     {==========================================================================}
2653    
2654     procedure TStRegIni.RegCloseRemoteKey;
2655     {-close a registry key on a remote computer}
2656     var
2657     ECode : LongInt;
2658     begin
2659     riMode := riSet;
2660     {$IFDEF ThreadSafe}
2661     EnterCS;
2662     try
2663     {$ENDIF}
2664     if (riType = riIniType) then
2665     RaiseRegIniError(stscNoIniFileSupport)
2666     else begin
2667     if (riRemoteKey <> 0) then begin
2668     ECode := RegCloseKey(riRemoteKey);
2669     if (ECode <> ERROR_SUCCESS) then
2670     RaiseRegIniErrorFmt(stscCloseRemoteKeyFail,[ECode]);
2671     riRemoteKey := 0;
2672    
2673     {reset primary key if opening remote key changed it}
2674     if riHoldPrimary <> 0 then begin
2675     riPrimaryKey := riHoldPrimary;
2676     riHoldPrimary := 0;
2677     end;
2678     end;
2679     end;
2680     {$IFDEF ThreadSafe}
2681     finally
2682     LeaveCS;
2683     end;
2684     {$ENDIF}
2685     end;
2686    
2687     {==========================================================================}
2688    
2689     procedure TStRegIni.RegGetKeySecurity(const SubKey : string; var SD : TSecurityDescriptor);
2690     {-get security attributes for key (WinNT only) }
2691     //SZ: todo Subkey never used
2692     var
2693     Key : HKey;
2694     ECode : LongInt;
2695     SDSize : DWORD;
2696     SI : SECURITY_INFORMATION;
2697     QI : TQueryKeyInfo;
2698    
2699     hToken : THandle;
2700     ptp,
2701     tp : TTokenPrivileges;
2702     luid : TLargeInteger;
2703     retval : DWORD;
2704    
2705     begin
2706     riMode := riSet;
2707     {$IFDEF ThreadSafe}
2708     EnterCS;
2709     try
2710     {$ENDIF}
2711     if (riType = riIniType) then
2712     RaiseRegIniError(stscNoIniFileSupport)
2713     else begin
2714     if (riWinVer <> riWinNT) then
2715     RaiseRegIniError(stscNotWinNTPlatform);
2716    
2717     QueryKey(QI);
2718    
2719     Key := OpenRegKey;
2720     try
2721     SDSize := QI.QISDescLen;
2722     SI := OWNER_SECURITY_INFORMATION or
2723     GROUP_SECURITY_INFORMATION or
2724     DACL_SECURITY_INFORMATION or
2725     SACL_SECURITY_INFORMATION;
2726    
2727     OpenProcessToken(GetCurrentProcess(),
2728     TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY, hToken);
2729     LookupPrivilegeValue(nil,'SeSecurityPrivilege',luid);
2730     tp.PrivilegeCount := 1;
2731     tp.Privileges[0].Luid := luid;
2732     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
2733    
2734     AdjustTokenPrivileges(hToken, FALSE, tp,
2735     sizeOf(TTokenPrivileges),ptp,retval);
2736     ECode := Windows.RegGetKeySecurity(Key,SI,@SD,SDSize);
2737    
2738     AdjustTokenPrivileges(hToken,TRUE,tp,
2739     sizeOf(TTokenPrivileges),ptp,retval);
2740    
2741     if (ECode <> ERROR_SUCCESS) then
2742     RaiseRegIniErrorFmt(stscGetSecurityFail,[ECode]);
2743     finally
2744     CloseRegKey(Key);
2745     end;
2746     end;
2747     {$IFDEF ThreadSafe}
2748     finally
2749     LeaveCS;
2750     end;
2751     {$ENDIF}
2752     end;
2753    
2754     {==========================================================================}
2755    
2756     procedure TStRegIni.RegSetKeySecurity(const SubKey : string; SD : TSecurityDescriptor);
2757     {-set security attributes for a registry key (WinNT only) }
2758     var
2759     Key : HKey;
2760     ECode : LongInt;
2761     SI : SECURITY_INFORMATION;
2762    
2763     hToken : THandle;
2764     ptp,
2765     tp : TTokenPrivileges;
2766     luid : TLargeInteger;
2767     retval : DWORD;
2768    
2769     begin
2770     riMode := riSet;
2771     {$IFDEF ThreadSafe}
2772     EnterCS;
2773     try
2774     {$ENDIF}
2775     if (riType = riIniType) then
2776     RaiseRegIniError(stscNoIniFileSupport)
2777     else begin
2778     if (riWinVer <> riWinNT) then
2779     RaiseRegIniError(stscNotWinNTPlatform);
2780    
2781     Key := OpenRegKey;
2782     try
2783     SI := OWNER_SECURITY_INFORMATION or
2784     GROUP_SECURITY_INFORMATION or
2785     DACL_SECURITY_INFORMATION or
2786     SACL_SECURITY_INFORMATION;
2787    
2788     OpenProcessToken(GetCurrentProcess(),
2789     TOKEN_ADJUST_PRIVILEGES OR TOKEN_QUERY, hToken);
2790     LookupPrivilegeValue(nil,'SeSecurityName',luid);
2791     tp.PrivilegeCount := 1;
2792     tp.Privileges[0].Luid := luid;
2793     tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
2794    
2795     AdjustTokenPrivileges(hToken, FALSE, tp,
2796     sizeOf(TTokenPrivileges),ptp,retval);
2797    
2798     ECode := Windows.RegSetKeySecurity(Key,SI,@SD);
2799    
2800     AdjustTokenPrivileges(hToken,TRUE,tp,
2801     sizeOf(TTokenPrivileges),ptp,retval);
2802    
2803     if (ECode <> ERROR_SUCCESS) then
2804     RaiseRegIniErrorFmt(stscSetSecurityFail,[ECode]);
2805     finally
2806     if (riRemoteKey = 0) then
2807     CloseRegKey(Key);
2808     end;
2809     end;
2810     {$IFDEF ThreadSafe}
2811     finally
2812     LeaveCS;
2813     end;
2814     {$ENDIF}
2815     end;
2816    
2817     end.

  ViewVC Help
Powered by ViewVC 1.1.20