mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-15 20:09:20 +02:00
* Corrected patch from Rolf Wetjen to use unicode API on windows (bug ID 32185)
git-svn-id: trunk@36765 -
This commit is contained in:
parent
3b48c6e316
commit
3b5d532ab5
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2701,6 +2701,7 @@ packages/fcl-registry/Makefile svneol=native#text/plain
|
|||||||
packages/fcl-registry/Makefile.fpc svneol=native#text/plain
|
packages/fcl-registry/Makefile.fpc svneol=native#text/plain
|
||||||
packages/fcl-registry/Makefile.fpc.fpcmake svneol=native#text/plain
|
packages/fcl-registry/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||||
packages/fcl-registry/examples/remotereg.pp svneol=native#text/pascal
|
packages/fcl-registry/examples/remotereg.pp svneol=native#text/pascal
|
||||||
|
packages/fcl-registry/examples/testunicode.pp svneol=native#text/plain
|
||||||
packages/fcl-registry/fpmake.pp svneol=native#text/plain
|
packages/fcl-registry/fpmake.pp svneol=native#text/plain
|
||||||
packages/fcl-registry/src/regdef.inc svneol=native#text/plain
|
packages/fcl-registry/src/regdef.inc svneol=native#text/plain
|
||||||
packages/fcl-registry/src/regini.inc svneol=native#text/plain
|
packages/fcl-registry/src/regini.inc svneol=native#text/plain
|
||||||
|
257
packages/fcl-registry/examples/testunicode.pp
Normal file
257
packages/fcl-registry/examples/testunicode.pp
Normal file
@ -0,0 +1,257 @@
|
|||||||
|
program testunicode;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
{$codepage utf8}
|
||||||
|
{$IFNDEF UNIX}
|
||||||
|
{$APPTYPE CONSOLE}
|
||||||
|
{$ENDIF}
|
||||||
|
uses
|
||||||
|
sysutils, classes, registry;
|
||||||
|
|
||||||
|
Var
|
||||||
|
EditKey : UTF8String = 'ASCII;这是一个测试';
|
||||||
|
labeledEditName : UTF8String = 'ASCII;പേര് ഇതാണ്ASCII;这是一个测试';
|
||||||
|
labeledEditValue : UTF8String = 'これは値です;ASCII';
|
||||||
|
labelkeycaption : string = 'HKCU\Software\zzz_test\';
|
||||||
|
reg: TRegistry;
|
||||||
|
Results : TStrings;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function TestKey (const AKey: utf8string): boolean;
|
||||||
|
begin
|
||||||
|
Result:=false;
|
||||||
|
try
|
||||||
|
reg.CloseKey;
|
||||||
|
if reg.KeyExists(AKey) then
|
||||||
|
reg.DeleteKey(AKey);
|
||||||
|
if reg.KeyExists(AKey) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestKey-01 failed: DeleteKey(%s);',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if not reg.OpenKey(AKey,true) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestKey-02 failed: OpenKey(%s,true)',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
reg.CloseKey;
|
||||||
|
if not reg.KeyExists(AKey) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestKey-03 failed: OpenKey(%s,true)',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
reg.DeleteKey(AKey);
|
||||||
|
if not reg.CreateKey(AKey) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestKey-04 failed: CreateKey(%s)',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if not reg.KeyExists(AKey) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestKey-05 failed: CreateKey(%s,true)',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
if not reg.OpenKeyReadOnly(AKey) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestKey-06 failed: OpenKeyReadOnly(%s)',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
reg.CloseKey;
|
||||||
|
if not reg.OpenKey(AKey,false) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestKey-07 failed: OpenKey(%s,false)',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Results.Add('TestKey passed: %s',[AKey]);
|
||||||
|
|
||||||
|
except
|
||||||
|
on e:Exception do
|
||||||
|
Results.Add('TestKey-08 failed: %s; %s;',[AKey,e.Message]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Result:=true;
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestValue (const AName, AValue: utf8string);
|
||||||
|
var
|
||||||
|
wrong,s: string;
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
wrong:=AName+'_wrong';
|
||||||
|
if reg.ValueExists(wrong) then
|
||||||
|
reg.DeleteValue(wrong);
|
||||||
|
if reg.ValueExists(wrong) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestValue-01 failed: DeleteValue(%s)',[wrong]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
reg.WriteString(wrong,AValue);
|
||||||
|
s:=reg.ReadString(wrong);
|
||||||
|
if s<>AValue then
|
||||||
|
begin
|
||||||
|
Results.Add('TestValue-02 failed: WriteString(%s,%s)',[wrong,AValue]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if reg.ValueExists(AName) then
|
||||||
|
reg.DeleteValue(AName);
|
||||||
|
if reg.ValueExists(AName) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestValue-03 failed: DeleteValue(%s)',[AName]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
reg.RenameValue(wrong,AName);
|
||||||
|
s:=reg.ReadString(AName);
|
||||||
|
if s<>AValue then
|
||||||
|
begin
|
||||||
|
Results.Add('TestValue-04 failed: RenameValue(%s,%s)',[wrong,AName]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Results.Add('TestValue passed: %s; %s;',[AName,AValue]);
|
||||||
|
|
||||||
|
except
|
||||||
|
on e:Exception do
|
||||||
|
Results.Add('TestValue-08 failed: %s; %s; %s;',[AName,AValue,e.Message]);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestGetKeyNames (const AKey, AExpected: utf8string);
|
||||||
|
var
|
||||||
|
sl: TStringList;
|
||||||
|
begin
|
||||||
|
sl:=TStringList.Create;
|
||||||
|
sl.Delimiter:=';';
|
||||||
|
reg.CloseKey;
|
||||||
|
try
|
||||||
|
if not reg.OpenKeyReadOnly(AKey) then
|
||||||
|
begin
|
||||||
|
Results.Add('TestGetKeyNames-01 failed: Key "%s";',[AKey]);
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
reg.GetKeyNames(sl);
|
||||||
|
if sl.DelimitedText=AExpected then
|
||||||
|
Results.Add('TestGetKeyNames passed: Key: "%s"; Expected: "%s";',[AKey,AExpected])
|
||||||
|
else
|
||||||
|
Results.Add('TestGetKeyNames-02 failed: Key: "%s"; got: "%s"; expected: "%s";',
|
||||||
|
[AKey,sl.DelimitedText,AExpected]);
|
||||||
|
except
|
||||||
|
on e:Exception do
|
||||||
|
Results.Add('TestGetKeyNames-03 failed exception: Key: "%s"; Got: "%s"; Expected: "%s"; Exception: "%s";',
|
||||||
|
[AKey,sl.DelimitedText,AExpected,e.Message]);
|
||||||
|
end;
|
||||||
|
sl.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TestGetValueNames (const AKey, AExpected: UTF8string);
|
||||||
|
var
|
||||||
|
sl: TStringList;
|
||||||
|
begin
|
||||||
|
sl:=TStringList.Create;
|
||||||
|
sl.Delimiter:=';';
|
||||||
|
try
|
||||||
|
reg.GetValueNames(sl);
|
||||||
|
if sl.DelimitedText=AExpected then
|
||||||
|
Results.Add('TestGetValueNames passed: Key: "%s"; Expected "%s";',[AKey,AExpected])
|
||||||
|
else
|
||||||
|
Results.Add('TestGetValueNames-01 failed: Key "%s"; Got: "%s"; Expected: "%s";',
|
||||||
|
[AKey,sl.DelimitedText,AExpected]);
|
||||||
|
except
|
||||||
|
on e:Exception do
|
||||||
|
Results.Add('TestGetValueNames-02 failed exception: Key: "%s"; Got: "%s"; expected: "%s"; exception: "%s";',
|
||||||
|
[AKey,sl.DelimitedText,AExpected,e.Message]);
|
||||||
|
end;
|
||||||
|
sl.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure Test;
|
||||||
|
var
|
||||||
|
sKey: string;
|
||||||
|
slKeys,
|
||||||
|
slNames,
|
||||||
|
slValues: TStringList;
|
||||||
|
sValueNames,
|
||||||
|
s: string;
|
||||||
|
k,n,v: integer;
|
||||||
|
l: longint;
|
||||||
|
begin
|
||||||
|
sKey:=LabelKeyCaption;
|
||||||
|
l:=pos('\',LabelKeyCaption);
|
||||||
|
if l>0 then
|
||||||
|
delete(sKey,1,l);
|
||||||
|
if sKey[Length(sKey)]='\' then
|
||||||
|
SetLength(sKey,Length(sKey)-1);
|
||||||
|
|
||||||
|
slKeys:=TStringList.Create;
|
||||||
|
slKeys.Delimiter:=';';
|
||||||
|
slKeys.DelimitedText:=EditKey;
|
||||||
|
|
||||||
|
slNames:=TStringList.Create;
|
||||||
|
slNames.Delimiter:=';';
|
||||||
|
slNames.DelimitedText:=LabeledEditName;
|
||||||
|
|
||||||
|
slValues:=TStringList.Create;
|
||||||
|
slValues.Delimiter:=';';
|
||||||
|
slValues.DelimitedText:=LabeledEditValue;
|
||||||
|
|
||||||
|
for k:=0 to slKeys.Count-1 do
|
||||||
|
if TestKey(sKey+'\'+slKeys[k]) then
|
||||||
|
begin
|
||||||
|
sValueNames:='';
|
||||||
|
for n:=0 to slNames.Count-1 do
|
||||||
|
for v:=0 to slValues.Count-1 do
|
||||||
|
begin
|
||||||
|
s:=Format('%d%d%d_%s',[k,n,v,slNames[n]]);
|
||||||
|
if sValueNames='' then
|
||||||
|
sValueNames:=s
|
||||||
|
else
|
||||||
|
sValueNames:=sValueNames+slNames.Delimiter+s;
|
||||||
|
TestValue(s,slValues[v]);
|
||||||
|
end;
|
||||||
|
TestGetValueNames(reg.CurrentPath,sValueNames);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TestGetKeyNames(sKey,slKeys.DelimitedText);
|
||||||
|
|
||||||
|
reg.CloseKey;
|
||||||
|
|
||||||
|
slKeys.Free;
|
||||||
|
slNames.Free;
|
||||||
|
slValues.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Procedure WN;
|
||||||
|
Var
|
||||||
|
F : Text;
|
||||||
|
|
||||||
|
|
||||||
|
begin
|
||||||
|
Assign(F,'names.txt');
|
||||||
|
Rewrite(F);
|
||||||
|
Writeln(F,EditKey);
|
||||||
|
Writeln(F,labeledEditName);
|
||||||
|
Writeln(F,LabeledEditValue);
|
||||||
|
Writeln(F,LabelKeyCaption);
|
||||||
|
Close(F);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
defaultsystemcodepage:=CP_UTF8;
|
||||||
|
if (ParamStr(1)='-s') then
|
||||||
|
WN;
|
||||||
|
reg:=TRegistry.Create;
|
||||||
|
reg.lazywrite:=false;
|
||||||
|
Results:=TStringList.Create;
|
||||||
|
Test;
|
||||||
|
Reg.Free;
|
||||||
|
if (ParamStr(1)='-s') then
|
||||||
|
Results.SaveToFile('result.txt');
|
||||||
|
Writeln(Results.Text);
|
||||||
|
Results.Free;
|
||||||
|
{$IFDEF WINDOWS}Readln;{$ENDIF}
|
||||||
|
end.
|
||||||
|
|
@ -383,30 +383,31 @@ function TRegistry.ReadString(const Name: string): string;
|
|||||||
Var
|
Var
|
||||||
Info : TRegDataInfo;
|
Info : TRegDataInfo;
|
||||||
ReadDataSize: Integer;
|
ReadDataSize: Integer;
|
||||||
|
u: UnicodeString;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
Result:='';
|
||||||
GetDataInfo(Name,Info);
|
GetDataInfo(Name,Info);
|
||||||
if info.datasize>0 then
|
if info.datasize>0 then
|
||||||
|
begin
|
||||||
|
if Not (Info.RegData in [rdString,rdExpandString]) then
|
||||||
|
Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
|
||||||
|
if Odd(Info.DataSize) then
|
||||||
|
SetLength(u,round((Info.DataSize+1)/SizeOf(UnicodeChar)))
|
||||||
|
else
|
||||||
|
SetLength(u,round(Info.DataSize/SizeOf(UnicodeChar)));
|
||||||
|
ReadDataSize := GetData(Name,@u[1],Info.DataSize,Info.RegData);
|
||||||
|
if ReadDataSize > 0 then
|
||||||
begin
|
begin
|
||||||
If Not (Info.RegData in [rdString,rdExpandString]) then
|
// If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type,
|
||||||
Raise ERegistryException.CreateFmt(SInvalidRegType, [Name]);
|
// the size includes any terminating null character or characters
|
||||||
SetLength(Result,Info.DataSize);
|
// unless the data was stored without them! (RegQueryValueEx @ MSDN)
|
||||||
ReadDataSize := GetData(Name,PChar(Result),Info.DataSize,Info.RegData);
|
if StringSizeIncludesNull and
|
||||||
if ReadDataSize > 0 then
|
(u[Length(u)] = WideChar(0)) then
|
||||||
begin
|
SetLength(u,Length(u)-1);
|
||||||
// If the data has the REG_SZ, REG_MULTI_SZ or REG_EXPAND_SZ type,
|
Result:=UTF8Encode(u);
|
||||||
// the size includes any terminating null character or characters
|
end;
|
||||||
// unless the data was stored without them! (RegQueryValueEx @ MSDN)
|
end;
|
||||||
if StringSizeIncludesNull then
|
|
||||||
if Result[ReadDataSize] = #0 then
|
|
||||||
Dec(ReadDataSize);
|
|
||||||
SetLength(Result, ReadDataSize);
|
|
||||||
end
|
|
||||||
else
|
|
||||||
Result := '';
|
|
||||||
end
|
|
||||||
else
|
|
||||||
result:='';
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TRegistry.ReadTime(const Name: string): TDateTime;
|
function TRegistry.ReadTime(const Name: string): TDateTime;
|
||||||
@ -449,9 +450,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRegistry.WriteExpandString(const Name, Value: string);
|
procedure TRegistry.WriteExpandString(const Name, Value: string);
|
||||||
|
var
|
||||||
|
u: UnicodeString;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
PutData(Name, PChar(Value), Length(Value),rdExpandString);
|
u:=UTF8Decode(Value);
|
||||||
|
PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRegistry.WriteFloat(const Name: string; Value: Double);
|
procedure TRegistry.WriteFloat(const Name: string; Value: Double);
|
||||||
@ -465,9 +469,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRegistry.WriteString(const Name, Value: string);
|
procedure TRegistry.WriteString(const Name, Value: string);
|
||||||
|
var
|
||||||
|
u: UnicodeString;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
PutData(Name, PChar(Value), Length(Value), rdString);
|
u:=UTF8Decode(Value);
|
||||||
|
PutData(Name, PWideChar(u), ByteLength(u), rdString);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean);
|
procedure TRegistry.MoveKey(const OldName, NewName: string; Delete: Boolean);
|
||||||
|
@ -40,23 +40,23 @@ end;
|
|||||||
|
|
||||||
function TRegistry.sysCreateKey(const Key: String): Boolean;
|
function TRegistry.sysCreateKey(const Key: String): Boolean;
|
||||||
Var
|
Var
|
||||||
P: PChar;
|
u: UnicodeString;
|
||||||
Disposition: Dword;
|
Disposition: Dword;
|
||||||
Handle: HKEY;
|
Handle: HKEY;
|
||||||
SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
|
SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
SecurityAttributes := Nil;
|
SecurityAttributes := Nil;
|
||||||
P:=PrepKey(Key);
|
u:=UTF8Decode(PrepKey(Key));
|
||||||
FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),
|
FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),
|
||||||
P,
|
PWideChar(u),
|
||||||
0,
|
0,
|
||||||
'',
|
'',
|
||||||
REG_OPTION_NON_VOLATILE,
|
REG_OPTION_NON_VOLATILE,
|
||||||
KEY_ALL_ACCESS,
|
KEY_ALL_ACCESS,
|
||||||
SecurityAttributes,
|
SecurityAttributes,
|
||||||
Handle,
|
Handle,
|
||||||
@Disposition);
|
@Disposition);
|
||||||
Result:=FLastError=ERROR_SUCCESS;
|
Result:=FLastError=ERROR_SUCCESS;
|
||||||
RegCloseKey(Handle);
|
RegCloseKey(Handle);
|
||||||
end;
|
end;
|
||||||
@ -64,28 +64,28 @@ end;
|
|||||||
function TRegistry.DeleteKey(const Key: String): Boolean;
|
function TRegistry.DeleteKey(const Key: String): Boolean;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
P: PChar;
|
u: UnicodeString;
|
||||||
begin
|
begin
|
||||||
P:=PRepKey(Key);
|
u:=UTF8Decode(PRepKey(Key));
|
||||||
FLastError:=RegDeleteKeyA(GetBaseKey(RelativeKey(Key)),P);
|
FLastError:=RegDeleteKeyW(GetBaseKey(RelativeKey(Key)),PWideChar(u));
|
||||||
Result:=FLastError=ERROR_SUCCESS;
|
Result:=FLastError=ERROR_SUCCESS;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TRegistry.DeleteValue(const Name: String): Boolean;
|
function TRegistry.DeleteValue(const Name: String): Boolean;
|
||||||
begin
|
begin
|
||||||
FLastError:= RegDeleteValueA(fCurrentKey, @Name[1]);
|
FLastError:= RegDeleteValueW(fCurrentKey, PWideChar(UTF8Decode(Name)));
|
||||||
Result:=FLastError=ERROR_SUCCESS;
|
Result:=FLastError=ERROR_SUCCESS;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
|
function TRegistry.SysGetData(const Name: String; Buffer: Pointer;
|
||||||
BufSize: Integer; Out RegData: TRegDataType): Integer;
|
BufSize: Integer; Out RegData: TRegDataType): Integer;
|
||||||
Var
|
Var
|
||||||
P: PChar;
|
u: UnicodeString;
|
||||||
RD : DWord;
|
RD : DWord;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
P := PChar(Name);
|
u := UTF8Decode(Name);
|
||||||
FLastError:=RegQueryValueExA(fCurrentKey,P,Nil,
|
FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,
|
||||||
@RD,Buffer,lpdword(@BufSize));
|
@RD,Buffer,lpdword(@BufSize));
|
||||||
if (FLastError<>ERROR_SUCCESS) Then
|
if (FLastError<>ERROR_SUCCESS) Then
|
||||||
Result:=-1
|
Result:=-1
|
||||||
@ -108,13 +108,13 @@ end;
|
|||||||
function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean;
|
function TRegistry.GetDataInfo(const ValueName: String; out Value: TRegDataInfo): Boolean;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
P: PChar;
|
u: UnicodeString;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
P:=PChar(ValueName);
|
u:=UTF8Decode(ValueName);
|
||||||
With Value do
|
With Value do
|
||||||
begin
|
begin
|
||||||
FLastError:=RegQueryValueExA(fCurrentKey,P,Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
|
FLastError:=RegQueryValueExW(fCurrentKey,PWideChar(u),Nil,lpdword(@RegData),Nil,lpdword(@DataSize));
|
||||||
Result:=FLastError=ERROR_SUCCESS;
|
Result:=FLastError=ERROR_SUCCESS;
|
||||||
end;
|
end;
|
||||||
If Not Result Then
|
If Not Result Then
|
||||||
@ -128,6 +128,9 @@ end;
|
|||||||
function TRegistry.GetKey(const Key: String): HKEY;
|
function TRegistry.GetKey(const Key: String): HKEY;
|
||||||
var
|
var
|
||||||
S : string;
|
S : string;
|
||||||
|
{$ifndef WinCE}
|
||||||
|
u : UnicodeString;
|
||||||
|
{$endif}
|
||||||
Rel : Boolean;
|
Rel : Boolean;
|
||||||
begin
|
begin
|
||||||
Result:=0;
|
Result:=0;
|
||||||
@ -138,7 +141,8 @@ begin
|
|||||||
{$ifdef WinCE}
|
{$ifdef WinCE}
|
||||||
FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
|
FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PWideChar(WideString(S)),0,FAccess,Result);
|
||||||
{$else WinCE}
|
{$else WinCE}
|
||||||
FLastError:=RegOpenKeyEx(GetBaseKey(Rel),PChar(S),0,FAccess,Result);
|
u:=UTF8Decode(S);
|
||||||
|
FLastError:=RegOpenKeyExW(GetBaseKey(Rel),PWideChar(u),0,FAccess,Result);
|
||||||
{$endif WinCE}
|
{$endif WinCE}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -195,19 +199,18 @@ end;
|
|||||||
function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
|
function TRegistry.OpenKey(const Key: string; CanCreate: Boolean): Boolean;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
P: PChar;
|
u: UnicodeString;
|
||||||
Handle: HKEY;
|
Handle: HKEY;
|
||||||
Disposition: Integer;
|
Disposition: Integer;
|
||||||
SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
|
SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
|
||||||
S: string;
|
S: string;
|
||||||
begin
|
begin
|
||||||
SecurityAttributes := Nil;
|
SecurityAttributes := Nil;
|
||||||
P:=PrepKey(Key);
|
u:=UTF8Decode(PrepKey(Key));
|
||||||
If CanCreate then
|
If CanCreate then
|
||||||
begin
|
begin
|
||||||
Handle:=0;
|
Handle:=0;
|
||||||
FLastError:=RegCreateKeyExA(GetBaseKey(RelativeKey(Key)),P,0,'',
|
FLastError:=RegCreateKeyExW(GetBaseKey(RelativeKey(Key)),PWideChar(u),0,'',
|
||||||
|
|
||||||
REG_OPTION_NON_VOLATILE,
|
REG_OPTION_NON_VOLATILE,
|
||||||
fAccess,SecurityAttributes,Handle,
|
fAccess,SecurityAttributes,Handle,
|
||||||
pdword(@Disposition));
|
pdword(@Disposition));
|
||||||
@ -215,15 +218,15 @@ begin
|
|||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
FLastError:=RegOpenKeyExA(GetBaseKey(RelativeKey(Key)),
|
FLastError:=RegOpenKeyExW(GetBaseKey(RelativeKey(Key)),
|
||||||
P,0,fAccess,Handle);
|
PWideChar(u),0,fAccess,Handle);
|
||||||
Result:=FLastError=ERROR_SUCCESS;
|
Result:=FLastError=ERROR_SUCCESS;
|
||||||
end;
|
end;
|
||||||
If Result then begin
|
If Result then begin
|
||||||
if RelativeKey(Key) then
|
if RelativeKey(Key) then
|
||||||
S:=CurrentPath + Key
|
S:=CurrentPath + Key
|
||||||
else
|
else
|
||||||
S:=P;
|
S:=UTF8Encode(u);
|
||||||
ChangeKey(Handle, S);
|
ChangeKey(Handle, S);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -251,7 +254,7 @@ begin
|
|||||||
{$ifdef WinCE}
|
{$ifdef WinCE}
|
||||||
Result:=False;
|
Result:=False;
|
||||||
{$else}
|
{$else}
|
||||||
FLastError:=RegConnectRegistryA(PChar(UNCName),RootKey,newroot);
|
FLastError:=RegConnectRegistryW(PWideChar(UTF8Decode(UNCName)),RootKey,newroot);
|
||||||
Result:=FLastError=ERROR_SUCCESS;
|
Result:=FLastError=ERROR_SUCCESS;
|
||||||
if Result then begin
|
if Result then begin
|
||||||
RootKey:=newroot;
|
RootKey:=newroot;
|
||||||
@ -316,64 +319,95 @@ end;
|
|||||||
|
|
||||||
procedure TRegistry.GetKeyNames(Strings: TStrings);
|
procedure TRegistry.GetKeyNames(Strings: TStrings);
|
||||||
|
|
||||||
Var
|
var
|
||||||
L : Cardinal;
|
Info: TRegKeyInfo;
|
||||||
I: Integer;
|
dwLen: DWORD;
|
||||||
Info: TRegKeyInfo;
|
lpName: LPWSTR;
|
||||||
P : PChar;
|
dwIndex: DWORD;
|
||||||
|
lResult: LONGINT;
|
||||||
|
s: string;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Strings.Clear;
|
Strings.Clear;
|
||||||
if GetKeyInfo(Info) then
|
if GetKeyInfo(Info) then
|
||||||
begin
|
begin
|
||||||
L:=Info.MaxSubKeyLen+1;
|
dwLen:=Info.MaxSubKeyLen+1;
|
||||||
GetMem(P,L);
|
GetMem(lpName,dwLen*SizeOf(WideChar));
|
||||||
Try
|
try
|
||||||
for I:=0 to Info.NumSubKeys-1 do
|
for dwIndex:=0 to Info.NumSubKeys-1 do
|
||||||
begin
|
begin
|
||||||
L:=Info.MaxSubKeyLen+1;
|
dwLen:=Info.MaxSubKeyLen+1;
|
||||||
RegEnumKeyExA(CurrentKey,I,P,L,Nil,Nil,Nil,Nil);
|
lResult:=RegEnumKeyExW(CurrentKey,dwIndex,lpName,dwLen,Nil,Nil,Nil,Nil);
|
||||||
Strings.Add(StrPas(P));
|
if lResult<>ERROR_SUCCESS then
|
||||||
end;
|
raise ERegistryException.Create(SysErrorMessage(lResult));
|
||||||
Finally
|
if dwLen=0 then
|
||||||
FreeMem(P);
|
s:=''
|
||||||
end;
|
else
|
||||||
end;
|
begin // dwLen>0
|
||||||
|
SetLength(s,dwLen*3);
|
||||||
|
dwLen:=UnicodeToUTF8(PChar(s),Length(s)+1,lpName,dwLen);
|
||||||
|
if dwLen<=1 then
|
||||||
|
s:=''
|
||||||
|
else // dwLen>1
|
||||||
|
SetLength(s,dwLen-1);
|
||||||
|
end; // if dwLen=0
|
||||||
|
Strings.Add(s);
|
||||||
|
end; // for dwIndex:=0 ...
|
||||||
|
|
||||||
|
finally
|
||||||
|
FreeMem(lpName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRegistry.GetValueNames(Strings: TStrings);
|
procedure TRegistry.GetValueNames(Strings: TStrings);
|
||||||
|
|
||||||
Var
|
var
|
||||||
L : Cardinal;
|
Info: TRegKeyInfo;
|
||||||
I: Integer;
|
dwLen: DWORD;
|
||||||
Info: TRegKeyInfo;
|
lpName: LPWSTR;
|
||||||
P : PChar;
|
dwIndex: DWORD;
|
||||||
|
lResult: LONGINT;
|
||||||
|
s: string;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Strings.Clear;
|
Strings.Clear;
|
||||||
if GetKeyInfo(Info) then
|
if GetKeyInfo(Info) then
|
||||||
begin
|
begin
|
||||||
L:=Info.MaxValueLen+1;
|
dwLen:=Info.MaxValueLen+1;
|
||||||
GetMem(P,L);
|
GetMem(lpName,dwLen*SizeOf(WideChar));
|
||||||
Try
|
try
|
||||||
for I:=0 to Info.NumValues-1 do
|
for dwIndex:=0 to Info.NumValues-1 do
|
||||||
begin
|
begin
|
||||||
L:=Info.MaxValueLen+1;
|
dwLen:=Info.MaxValueLen+1;
|
||||||
RegEnumValueA(CurrentKey,I,P,L,Nil,Nil,Nil,Nil);
|
lResult:=RegEnumValueW(CurrentKey,dwIndex,lpName,dwLen,Nil,Nil,Nil,Nil);
|
||||||
Strings.Add(StrPas(P));
|
if lResult<>ERROR_SUCCESS then
|
||||||
end;
|
raise ERegistryException.Create(SysErrorMessage(lResult));
|
||||||
Finally
|
if dwLen=0 then
|
||||||
FreeMem(P);
|
s:=''
|
||||||
end;
|
else
|
||||||
end;
|
begin // dwLen>0
|
||||||
|
SetLength(s,dwLen*3);
|
||||||
|
dwLen:=UnicodeToUTF8(PChar(s),Length(s)+1,lpName,dwLen);
|
||||||
|
if dwLen<=1 then
|
||||||
|
s:=''
|
||||||
|
else // dwLen>1
|
||||||
|
SetLength(s,dwLen-1);
|
||||||
|
end; // if dwLen=0
|
||||||
|
Strings.Add(s);
|
||||||
|
end; // for dwIndex:=0 ...
|
||||||
|
|
||||||
|
finally
|
||||||
|
FreeMem(lpName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
|
Function TRegistry.SysPutData(const Name: string; Buffer: Pointer;
|
||||||
BufSize: Integer; RegData: TRegDataType) : Boolean;
|
BufSize: Integer; RegData: TRegDataType) : Boolean;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
P: PChar;
|
u: UnicodeString;
|
||||||
RegDataType: DWORD;
|
RegDataType: DWORD;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
@ -384,8 +418,8 @@ begin
|
|||||||
rdInteger : RegDataType:=REG_DWORD;
|
rdInteger : RegDataType:=REG_DWORD;
|
||||||
rdBinary : RegDataType:=REG_BINARY;
|
rdBinary : RegDataType:=REG_BINARY;
|
||||||
end;
|
end;
|
||||||
P:=PChar(Name);
|
u:=UTF8Decode(Name);
|
||||||
FLastError:=RegSetValueExA(fCurrentKey,P,0,RegDataType,Buffer,BufSize);
|
FLastError:=RegSetValueExW(fCurrentKey,PWideChar(u),0,RegDataType,Buffer,BufSize);
|
||||||
Result:=FLastError=ERROR_SUCCESS;
|
Result:=FLastError=ERROR_SUCCESS;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -39,6 +39,8 @@ Type
|
|||||||
FCurrentKey : String;
|
FCurrentKey : String;
|
||||||
Procedure SetFileName(Value : String);
|
Procedure SetFileName(Value : String);
|
||||||
Protected
|
Protected
|
||||||
|
function DoGetValueData(Name: String; out DataType: TDataType; Var Data; Var DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
|
||||||
|
function DoSetValueData(Name: String; DataType: TDataType; const Data; DataSize: Integer; IsUnicode: Boolean): Boolean; virtual;
|
||||||
Procedure LoadFromStream(S : TStream);
|
Procedure LoadFromStream(S : TStream);
|
||||||
Function NormalizeKey(KeyPath : String) : String;
|
Function NormalizeKey(KeyPath : String) : String;
|
||||||
Procedure CreateEmptyDoc;
|
Procedure CreateEmptyDoc;
|
||||||
@ -61,7 +63,7 @@ Type
|
|||||||
Function CreateKey(KeyPath : String) : Boolean;
|
Function CreateKey(KeyPath : String) : Boolean;
|
||||||
Function GetValueSize(Name : String) : Integer;
|
Function GetValueSize(Name : String) : Integer;
|
||||||
Function GetValueType(Name : String) : TDataType;
|
Function GetValueType(Name : String) : TDataType;
|
||||||
Function GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean;
|
Function GetValueInfo(Name : String; Out Info : TDataInfo; AsUnicode : Boolean = False) : Boolean;
|
||||||
Function GetKeyInfo(Out Info : TKeyInfo) : Boolean;
|
Function GetKeyInfo(Out Info : TKeyInfo) : Boolean;
|
||||||
Function EnumSubKeys(List : TStrings) : Integer;
|
Function EnumSubKeys(List : TStrings) : Integer;
|
||||||
Function EnumValues(List : TStrings) : Integer;
|
Function EnumValues(List : TStrings) : Integer;
|
||||||
@ -73,6 +75,9 @@ Type
|
|||||||
Procedure Load;
|
Procedure Load;
|
||||||
Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
|
Function GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
|
||||||
Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
|
Function SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
|
||||||
|
// These interpret the Data buffer as unicode data
|
||||||
|
Function GetValueDataUnicode(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
|
||||||
|
Function SetValueDataUnicode(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
|
||||||
Property FileName : String Read FFileName Write SetFileName;
|
Property FileName : String Read FFileName Write SetFileName;
|
||||||
Property RootKey : String Read FRootKey Write SetRootkey;
|
Property RootKey : String Read FRootKey Write SetRootkey;
|
||||||
Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
|
Property AutoFlush : Boolean Read FAutoFlush Write FAutoFlush;
|
||||||
@ -285,7 +290,7 @@ begin
|
|||||||
MaybeFlush;
|
MaybeFlush;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TXmlRegistry.GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
|
Function TXmlRegistry.DoGetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer; IsUnicode : Boolean) : Boolean;
|
||||||
|
|
||||||
Type
|
Type
|
||||||
PCardinal = ^Cardinal;
|
PCardinal = ^Cardinal;
|
||||||
@ -295,6 +300,7 @@ Var
|
|||||||
DataNode : TDomNode;
|
DataNode : TDomNode;
|
||||||
BL,ND,NS : Integer;
|
BL,ND,NS : Integer;
|
||||||
S : UTF8String;
|
S : UTF8String;
|
||||||
|
U : UnicodeString;
|
||||||
HasData: Boolean;
|
HasData: Boolean;
|
||||||
D : DWord;
|
D : DWord;
|
||||||
|
|
||||||
@ -321,11 +327,22 @@ begin
|
|||||||
dtString : // DataNode is optional
|
dtString : // DataNode is optional
|
||||||
if HasData then
|
if HasData then
|
||||||
begin
|
begin
|
||||||
S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring
|
if not IsUnicode then
|
||||||
NS:=Length(S);
|
begin
|
||||||
Result:=(DataSize>=NS);
|
S:=UTF8Encode(DataNode.NodeValue); // Convert to ansistring
|
||||||
if Result then
|
NS:=Length(S);
|
||||||
Move(S[1],Data,NS);
|
Result:=(DataSize>=NS);
|
||||||
|
if Result then
|
||||||
|
Move(S[1],Data,NS);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
U:=DataNode.NodeValue;
|
||||||
|
NS:=Length(U)*SizeOf(UnicodeChar);
|
||||||
|
Result:=(DataSize>=NS);
|
||||||
|
if Result then
|
||||||
|
Move(U[1],Data,NS);
|
||||||
|
end
|
||||||
end;
|
end;
|
||||||
|
|
||||||
dtBinary : // DataNode is optional
|
dtBinary : // DataNode is optional
|
||||||
@ -345,7 +362,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TXmlRegistry.SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
|
Function TXmlRegistry.DoSetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer; IsUnicode : Boolean) : Boolean;
|
||||||
|
|
||||||
Type
|
Type
|
||||||
PCardinal = ^Cardinal;
|
PCardinal = ^Cardinal;
|
||||||
@ -353,7 +370,8 @@ Type
|
|||||||
Var
|
Var
|
||||||
Node : TDomElement;
|
Node : TDomElement;
|
||||||
DataNode : TDomNode;
|
DataNode : TDomNode;
|
||||||
SW : Widestring;
|
SW : UnicodeString;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Node:=FindValueKey(Name);
|
Node:=FindValueKey(Name);
|
||||||
If Node=Nil then
|
If Node=Nil then
|
||||||
@ -367,7 +385,10 @@ begin
|
|||||||
Case DataType of
|
Case DataType of
|
||||||
dtDWORD : SW:=IntToStr(PCardinal(@Data)^);
|
dtDWORD : SW:=IntToStr(PCardinal(@Data)^);
|
||||||
dtString : begin
|
dtString : begin
|
||||||
SW:=WideString(PAnsiChar(@Data));
|
if IsUnicode then
|
||||||
|
SW:=UnicodeString(PUnicodeChar(@Data))
|
||||||
|
else
|
||||||
|
SW:=UnicodeString(PAnsiChar(@Data));
|
||||||
//S:=UTF8Encode(SW);
|
//S:=UTF8Encode(SW);
|
||||||
end;
|
end;
|
||||||
dtBinary : SW:=BufToHex(Data,DataSize);
|
dtBinary : SW:=BufToHex(Data,DataSize);
|
||||||
@ -393,6 +414,28 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Function TXmlRegistry.SetValueData(Name : String; DataType : TDataType; Const Data; DataSize : Integer) : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=DoSetValueData(Name,DataType,Data,DataSize,False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Function TXmlRegistry.GetValueData(Name : String; Out DataType : TDataType; Var Data; Var DataSize : Integer) : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result:=DoGetValueData(Name,DataType,Data,DataSize,False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXmlRegistry.GetValueDataUnicode(Name: String; out DataType: TDataType; Var Data; Var DataSize: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
Result:=DoGetValueData(Name,DataType,Data,DataSize,True);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXmlRegistry.SetValueDataUnicode(Name: String; DataType: TDataType; const Data; DataSize: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
Result:=DoSetValueData(Name,DataType,Data,DataSize,True)
|
||||||
|
end;
|
||||||
|
|
||||||
Function TXmlRegistry.FindSubKey (S : String; N : TDomElement) : TDomElement;
|
Function TXmlRegistry.FindSubKey (S : String; N : TDomElement) : TDomElement;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
@ -607,7 +650,7 @@ begin
|
|||||||
Result:=dtUnknown;
|
Result:=dtUnknown;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Function TXMLRegistry.GetValueInfo(Name : String; Out Info : TDataInfo) : Boolean;
|
function TXmlRegistry.GetValueInfo(Name: String; out Info: TDataInfo; AsUnicode: Boolean): Boolean;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
N : TDomElement;
|
N : TDomElement;
|
||||||
@ -620,10 +663,17 @@ begin
|
|||||||
If Result then
|
If Result then
|
||||||
begin
|
begin
|
||||||
DN:=N.FirstChild;
|
DN:=N.FirstChild;
|
||||||
if Assigned(DN) and (DN.NodeType=TEXT_NODE) then begin
|
if Assigned(DN) and (DN.NodeType=TEXT_NODE) then
|
||||||
S := UTF8Encode(DN.NodeValue);
|
begin
|
||||||
L:=Length(S);
|
if AsUnicode then
|
||||||
end else
|
L:=Length(DN.NodeValue)*SizeOf(UnicodeChar)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
S := UTF8Encode(DN.NodeValue);
|
||||||
|
L:=Length(S);
|
||||||
|
end
|
||||||
|
end
|
||||||
|
else
|
||||||
L:=0;
|
L:=0;
|
||||||
With Info do
|
With Info do
|
||||||
begin
|
begin
|
||||||
|
@ -124,7 +124,7 @@ Var
|
|||||||
DataType : TDataType;
|
DataType : TDataType;
|
||||||
begin
|
begin
|
||||||
Result:=BufSize;
|
Result:=BufSize;
|
||||||
If TXmlregistry(FSysData).GetValueData(Name,DataType,Buffer^,Result) then
|
If TXmlregistry(FSysData).GetValueDataUnicode(Name,DataType,Buffer^,Result) then
|
||||||
begin
|
begin
|
||||||
Case DataType of
|
Case DataType of
|
||||||
dtUnknown : RegData:=rdUnknown;
|
dtUnknown : RegData:=rdUnknown;
|
||||||
@ -144,7 +144,7 @@ Var
|
|||||||
Info : TDataInfo;
|
Info : TDataInfo;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info);
|
Result := TXmlRegistry(FSysData).GetValueInfo(ValueName,Info,True);
|
||||||
If Not Result then
|
If Not Result then
|
||||||
With Value do
|
With Value do
|
||||||
begin
|
begin
|
||||||
@ -270,7 +270,7 @@ begin
|
|||||||
rdInteger : DataType := dtDword;
|
rdInteger : DataType := dtDword;
|
||||||
rdBinary : DataType := dtBinary;
|
rdBinary : DataType := dtBinary;
|
||||||
end;
|
end;
|
||||||
Result:=TXMLRegistry(FSysData).SetValueData(Name,DataType,Buffer^,BufSize);
|
Result:=TXMLRegistry(FSysData).SetValueDataUnicode(Name,DataType,Buffer^,BufSize);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TRegistry.RenameValue(const OldName, NewName: string);
|
procedure TRegistry.RenameValue(const OldName, NewName: string);
|
||||||
|
Loading…
Reference in New Issue
Block a user