mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-04 08:02:17 +02:00
* Unicode test program using UnicodeString
git-svn-id: trunk@41785 -
This commit is contained in:
michael
parent
79bf26ac4b
commit
ffea4d3b38
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2733,6 +2733,7 @@ packages/fcl-registry/Makefile.fpc 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/testunicode.pp svneol=native#text/plain
|
||||
packages/fcl-registry/examples/testunicode2.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/regini.inc svneol=native#text/plain
|
||||
|
||||
262
packages/fcl-registry/examples/testunicode2.pp
Normal file
262
packages/fcl-registry/examples/testunicode2.pp
Normal file
@ -0,0 +1,262 @@
|
||||
program testunicode2;
|
||||
|
||||
{ Unicode test program, using unicode strings }
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$codepage utf8}
|
||||
{$IFNDEF UNIX}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
uses
|
||||
{$ifdef unix}
|
||||
cwstring,
|
||||
{$endif}
|
||||
sysutils, classes, registry;
|
||||
|
||||
Var
|
||||
EditKey : Unicodestring = 'ASCII;这是一个测试';
|
||||
labeledEditName : Unicodestring = 'ASCII;പേര് ഇതാണ്ASCII;这是一个测试';
|
||||
labeledEditValue : Unicodestring = 'これは値です;ASCII';
|
||||
labelkeycaption : UnicodeString = 'HKCU\Software\zzz_test\';
|
||||
reg: TRegistry;
|
||||
Results : TStrings;
|
||||
|
||||
|
||||
|
||||
function TestKey (const AKey: UnicodeString): 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: Unicodestring);
|
||||
var
|
||||
wrong,s: unicodestring;
|
||||
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: Unicodestring);
|
||||
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 Utf8Decode(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: Unicodestring);
|
||||
var
|
||||
sl: TStringList;
|
||||
begin
|
||||
sl:=TStringList.Create;
|
||||
sl.Delimiter:=';';
|
||||
try
|
||||
reg.GetValueNames(sl);
|
||||
if Utf8Decode(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: Unicodestring;
|
||||
slKeys,
|
||||
slNames,
|
||||
slValues: TStringList;
|
||||
sValueNames,
|
||||
s: Unicodestring;
|
||||
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:=Utf8Encode(EditKey);
|
||||
|
||||
slNames:=TStringList.Create;
|
||||
slNames.Delimiter:=';';
|
||||
slNames.DelimitedText:=Utf8Encode(LabeledEditName);
|
||||
|
||||
slValues:=TStringList.Create;
|
||||
slValues.Delimiter:=';';
|
||||
slValues.DelimitedText:=Utf8Encode(LabeledEditValue);
|
||||
|
||||
for k:=0 to slKeys.Count-1 do
|
||||
if TestKey(sKey+'\'+Utf8Decode(slKeys[k])) then
|
||||
begin
|
||||
sValueNames:='';
|
||||
for n:=0 to slNames.Count-1 do
|
||||
for v:=0 to slValues.Count-1 do
|
||||
begin
|
||||
s:=UnicodeFormat('%d%d%d_%s',[k,n,v,Utf8Decode(slNames[n])]);
|
||||
if sValueNames='' then
|
||||
sValueNames:=s
|
||||
else
|
||||
sValueNames:=sValueNames+Utf8Decode(slNames.Delimiter)+s;
|
||||
TestValue(s,Utf8Decode(slValues[v]));
|
||||
end;
|
||||
TestGetValueNames(reg.CurrentPath,sValueNames);
|
||||
end;
|
||||
|
||||
TestGetKeyNames(sKey,Utf8Decode(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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user