|
|
@@ -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.
|
joost