source: cprs/branches/tmg-cprs/TMG_Extra/tntUniCode/Source/TntRegistry.pas@ 1710

Last change on this file since 1710 was 672, checked in by Kevin Toppenberg, 15 years ago

Adding source to tntControls for compilation

File size: 4.7 KB
RevLine 
[672]1
2{*****************************************************************************}
3{ }
4{ Tnt Delphi Unicode Controls }
5{ http://www.tntware.com/delphicontrols/unicode/ }
6{ Version: 2.3.0 }
7{ }
8{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
9{ }
10{*****************************************************************************}
11
12unit TntRegistry;
13
14{$INCLUDE TntCompilers.inc}
15
16interface
17
18uses
19 Registry, Windows, TntClasses;
20
21{TNT-WARN TRegistry}
22type
23 TTntRegistry = class(TRegistry{TNT-ALLOW TRegistry})
24 private
25 procedure WriteStringEx(dwType: DWORD; const Name, Value: WideString);
26 public
27 procedure GetKeyNames(Strings: TTntStrings);
28 procedure GetValueNames(Strings: TTntStrings);
29 function ReadString(const Name: WideString): WideString;
30 procedure WriteString(const Name, Value: WideString);
31 procedure WriteExpandString(const Name, Value: WideString);
32 end;
33
34implementation
35
36uses
37 RTLConsts, SysUtils, TntSysUtils;
38
39{ TTntRegistry }
40
41procedure TTntRegistry.GetKeyNames(Strings: TTntStrings);
42var
43 Len: DWORD;
44 I: Integer;
45 Info: TRegKeyInfo;
46 S: WideString;
47begin
48 if (not Win32PlatformIsUnicode) then
49 inherited GetKeyNames(Strings.AnsiStrings)
50 else begin
51 Strings.Clear;
52 if GetKeyInfo(Info) then
53 begin
54 SetLength(S, (Info.MaxSubKeyLen + 1) * 2);
55 for I := 0 to Info.NumSubKeys - 1 do
56 begin
57 Len := (Info.MaxSubKeyLen + 1) * 2;
58 if RegEnumKeyExW(CurrentKey, I, PWideChar(S), Len, nil, nil, nil, nil) = ERROR_SUCCESS then
59 Strings.Add(PWideChar(S));
60 end;
61 end;
62 end;
63end;
64
65{$IFNDEF COMPILER_9_UP} // fix declaration for RegEnumValueW (lpValueName is a PWideChar)
66function RegEnumValueW(hKey: HKEY; dwIndex: DWORD; lpValueName: PWideChar;
67 var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD;
68 lpData: PByte; lpcbData: PDWORD): Longint; stdcall; external advapi32 name 'RegEnumValueW';
69{$ENDIF}
70
71procedure TTntRegistry.GetValueNames(Strings: TTntStrings);
72var
73 Len: DWORD;
74 I: Integer;
75 Info: TRegKeyInfo;
76 S: WideString;
77begin
78 if (not Win32PlatformIsUnicode) then
79 inherited GetValueNames(Strings.AnsiStrings)
80 else begin
81 Strings.Clear;
82 if GetKeyInfo(Info) then
83 begin
84 SetLength(S, Info.MaxValueLen + 1);
85 for I := 0 to Info.NumValues - 1 do
86 begin
87 Len := Info.MaxValueLen + 1;
88 RegEnumValueW(CurrentKey, I, PWideChar(S), Len, nil, nil, nil, nil);
89 Strings.Add(PWideChar(S));
90 end;
91 end;
92 end;
93end;
94
95function TTntRegistry.ReadString(const Name: WideString): WideString;
96var
97 DataType: Cardinal;
98 BufSize: Cardinal;
99begin
100 if (not Win32PlatformIsUnicode) then
101 result := inherited ReadString(Name)
102 else begin
103 // get length and type
104 DataType := REG_NONE;
105 if RegQueryValueExW(CurrentKey, PWideChar(Name), nil,
106 @DataType, nil, @BufSize) <> ERROR_SUCCESS then
107 Result := ''
108 else begin
109 // check type
110 if not (DataType in [REG_SZ, REG_EXPAND_SZ]) then
111 raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
112 if BufSize = 1 then
113 BufSize := SizeOf(WideChar); // sometimes this occurs for single character values!
114 SetLength(Result, BufSize div SizeOf(WideChar));
115 if RegQueryValueExW(CurrentKey, PWideChar(Name), nil,
116 @DataType, PByte(PWideChar(Result)), @BufSize) <> ERROR_SUCCESS then
117 raise ERegistryException.CreateFmt(SRegGetDataFailed, [Name]);
118 Result := PWideChar(Result);
119 end
120 end
121end;
122
123procedure TTntRegistry.WriteStringEx(dwType: DWORD; const Name, Value: WideString);
124begin
125 Assert(dwType in [REG_SZ, REG_EXPAND_SZ]);
126 if (not Win32PlatformIsUnicode) then begin
127 if dwType = REG_SZ then
128 inherited WriteString(Name, Value)
129 else
130 inherited WriteExpandString(Name, Value);
131 end else begin
132 if RegSetValueExW(CurrentKey, PWideChar(Name), 0, dwType,
133 PWideChar(Value), (Length(Value) + 1) * SizeOf(WideChar)) <> ERROR_SUCCESS then
134 raise ERegistryException.CreateFmt(SRegSetDataFailed, [Name]);
135 end;
136end;
137
138procedure TTntRegistry.WriteString(const Name, Value: WideString);
139begin
140 WriteStringEx(REG_SZ, Name, Value);
141end;
142
143procedure TTntRegistry.WriteExpandString(const Name, Value: WideString);
144begin
145 WriteStringEx(REG_EXPAND_SZ, Name, Value);
146end;
147
148end.
Note: See TracBrowser for help on using the repository browser.