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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2671 - (show annotations) (download)
Tue Aug 25 18:15:15 2015 UTC (8 years, 9 months ago) by torben
File size: 83952 byte(s)
Added tpsystools component
1 // 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