* Unicode test program using UnicodeString

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@41785 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 262 insertions, 0 deletions

diff --git a/packages/fcl-registry/examples/testunicode2.pp b/packages/fcl-registry/examples/testunicode2.pp
new file mode 100644
index 0000000000..adad479a69
--- /dev/null
+++ b/packages/fcl-registry/examples/testunicode2.pp
@@ -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.
+