paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 03:49:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Bart Broersma to fix writing unicode strings in the Windows

Browse Source 
registry + test (modified, bug #35060)

git-svn-id: trunk@41415 -
This commit is contained in:
joost 2019-02-22 22:26:21 +00:00
parent 382d5060a0
commit 42204977f8
5 changed files with 157 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12728,6 +12728,7 @@ tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
tests/test/packages/fcl-registry/tw35060a.pp svneol=native#text/plain
tests/test/packages/fcl-registry/tw35060b.pp svneol=native#text/plain
tests/test/packages/fcl-registry/tw35060c.pp svneol=native#text/plain
tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain

4
packages/fcl-registry/src/registry.pp
View File

@ -504,7 +504,7 @@ var
u: UnicodeString;
begin
u:=UTF8Decode(Value);
u:=Value;
PutData(Name, PWideChar(u), ByteLength(u), rdExpandString);
end;
@ -538,7 +538,7 @@ var
u: UnicodeString;
begin
u:=UTF8Decode(Value);
u:=Value;
PutData(Name, PWideChar(u), ByteLength(u), rdString);
end;

15
tests/test/packages/fcl-registry/tw35060a.pp
View File

@ -48,15 +48,6 @@ begin
Result := Trim(Result);
end;
//Creating and removing Keys using plain Windows W-API
function PrepKeyW(Const S : UnicodeString) : pWideChar;
begin
Result:=PWideChar(S);
If Result^='\' then
Inc(Result);
end;
procedure CreateKeyInHKCU(const Key: UnicodeString);
Var
u: UnicodeString;
@ -66,7 +57,7 @@ Var
FLastError: LongInt;
begin
SecurityAttributes := Nil;
u:=PrepKeyW(Key);
u:=Key;
Handle := 0;
FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
PWideChar(u),
@ -103,12 +94,12 @@ var
Key: UnicodeString;
FLastError: LongInt;
begin
Key:=PRepKeyW(TestKeyFull);
Key:=TestKeyFull;
FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
[String(Key),Trim(SysErrorMessage(FLastError))]));
Key:=PRepKeyW(TestKeyBugID);
Key:=TestKeyBugID;
FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
[String(Key),Trim(SysErrorMessage(FLastError))]));

14
tests/test/packages/fcl-registry/tw35060b.pp
View File

@ -49,14 +49,6 @@ begin
end;
//Creating and removing Keys using plain Windows W-API
function PrepKeyW(Const S : UnicodeString) : pWideChar;
begin
Result:=PWideChar(S);
If Result^='\' then
Inc(Result);
end;
procedure CreateKeyInHKCU(const Key: UnicodeString);
Var
u: UnicodeString;
@ -66,7 +58,7 @@ Var
FLastError: LongInt;
begin
SecurityAttributes := Nil;
u:=PrepKeyW(Key);
u:=Key;
Handle := 0;
FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
PWideChar(u),
@ -103,12 +95,12 @@ var
Key: UnicodeString;
FLastError: LongInt;
begin
Key:=PRepKeyW(TestKeyFull);
Key:=TestKeyFull;
FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
[String(Key),Trim(SysErrorMessage(FLastError))]));
Key:=PRepKeyW(TestKeyBugID);
Key:=TestKeyBugID;
FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
[String(Key),Trim(SysErrorMessage(FLastError))]));

148
tests/test/packages/fcl-registry/tw35060c.pp Normal file
View File

@ -0,0 +1,148 @@
{ %TARGET=win32,win64,wince }
program tw35060c;
{$apptype console}
{$assertions on}
{$ifdef fpc}
{$codepage cp1252}
{$mode objfpc}
{$h+}
{$endif fpc}
uses
SysUtils, Classes, Windows, Registry;
{$ifndef fpc}
type
UnicodeString = WideString;
function GetLastOSError: Integer;
begin
Result := GetLastError;
end;
{$endif}
const
ExpectedAnsiHex = 'E4 EB EF';
ExpectedUnicodeHex = '00E4 00EB 00EF';
BugID = 'FPCBug0035060';
function UnicodeToHex(const S: UnicodeString): String;
var
i: Integer;
begin
Result := '';
for i := 1 to length(S) do
Result := Result + IntToHex(Word(S[i]),4) + #32;
Result := Trim(Result);
end;
function AnsiToHex(const S: String): String;
var
i: Integer;
begin
Result := '';
for i := 1 to length(S) do
Result := Result + IntToHex(Byte(S[i]),2) + #32;
Result := Trim(Result);
end;
procedure CreateKeyInHKCU(const Key: UnicodeString);
Var
u: UnicodeString;
// name,value: UnicodeString;
Disposition: Dword;
Handle: HKEY;
SecurityAttributes: Pointer; //LPSECURITY_ATTRIBUTES;
FLastError: LongInt;
begin
SecurityAttributes := Nil;
u:=Key;
Handle := 0;
FLastError:=RegCreateKeyExW(HKEY_CURRENT_USER,
PWideChar(u),
0,
'',
REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS,
SecurityAttributes,
Handle,
@Disposition);
Assert(FLastError=ERROR_SUCCESS,format('Creating key "%s" using plain Windows API failed: "%s"',
[String(Key),Trim(SysErrorMessage(FLastError))]));
//name := UnicodeString('äëï');
//value := UnicodeString('äëï');
//FLastError:=RegSetValueExW(Handle,PWideChar(name),0,REG_SZ,PWideChar(Value),ByteLength(Value));
//writeln('FLastError=',flasterror);
//RegCloseKey(Handle);
end;
procedure CreateTestKey;
const
TestKey: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
var
Len: Integer;
begin
Len := Length(TestKey);
Assert((Len=26) and (Word(TestKey[Len])=$EF) and (Word(TestKey[Len-1])=$EB) and (Word(TestKey[Len-2])=$E4),'Wrong encoding of TestKey');
CreateKeyInHKCU(TestKey);
end;
procedure RemoveTestKey;
const
TestKeyFull: UnicodeString = 'Software\'+ UniCodeString(BugID)+ '\äëï';
TestKeyBugID: UnicodeString = 'Software\'+ UniCodeString(BugID);
var
Key: UnicodeString;
FLastError: LONG;
begin
Key:=TestKeyFull;
FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
[String(Key),Trim(SysErrorMessage(FLastError))]));
Key:=TestKeyBugID;
FLastError:=RegDeleteKeyW(HKEY_CURRENT_USER,PWideChar(Key));
Assert(FLastError=ERROR_SUCCESS,format('Removing key "%s" using plain Windows API failed: "%s"',
[String(Key),Trim(SysErrorMessage(FLastError))]));
writeln('Test keys successfully removed.');
end;
var
R: TRegistry;
Name, Value, S, Key: String;
U: UnicodeString;
B: Boolean;
Err: Integer;
begin
CreateTestKey;
Name := 'äëï';
U := UnicodeString(Name);
S := AnsiToHex(Name);
Assert(S=ExpectedAnsiHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedAnsiHex,S]));
S := UnicodeToHex(U);
Assert(S=ExpectedUnicodeHex,format('Name is wrongly encoded: expected: %s, found: %s',[ExpectedUnicodeHex,S]));
R := TRegistry.Create(KEY_ALL_ACCESS);
try
R.RootKey := HKEY_CURRENT_USER;
Key := 'Software\'+BugId+'\'+Name;
B := R.OpenKey(Key,False);
Err := GetLastOSError;
writeln('B=',B);
Assert(B,format('OpenKey(''%s'') failed: "%s" [%d]',[Key,Trim(SysErrorMessage(Err)),Err]));
R.WriteString(Name,Name);
Value := R.ReadString(Name);
SetCodePage(RawByteString(Value), 1252, True);
S := AnsiToHex(Value);
Assert(S=ExpectedAnsiHex ,format('Found Value="%s" Bytes: %s, expected bytes: %s',[Value,S,ExpectedAnsiHex]));
writeln('ReadString value equals WriteString value.');
finally
R.Free;
RemoveTestKey;
end;
end.