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