Changeset 34 for trunk/Components/Common

Timestamp:

Nov 25, 2017, 12:27:33 AM (7 years ago)

Author:

chronos

Message:

• Modified: Improved New game window.
• Modified: Used newer version of Common and CoolTranslator packages.

Location:

trunk

Files:

• . (modified) (1 prop)
• Components/Common/Common.lpk (modified) (3 diffs)
• Components/Common/Common.pas (modified) (2 diffs)
• Components/Common/Languages/UFindFile.cs.po (added)
• Components/Common/Languages/UFindFile.po (added)
• Components/Common/Languages/UJobProgressView.cs.po (added)
• Components/Common/Languages/UJobProgressView.po (modified) (1 diff)
• Components/Common/Languages/UScaleDPI.cs.po (added)
• Components/Common/Languages/UScaleDPI.po (added)
• Components/Common/UApplicationInfo.pas (modified) (3 diffs)
• Components/Common/UCommon.pas (modified) (9 diffs)
• Components/Common/UDebugLog.pas (modified) (4 diffs)
• Components/Common/UFindFile.pas (modified) (4 diffs)
• Components/Common/UJobProgressView.lfm (modified) (4 diffs)
• Components/Common/UJobProgressView.lrt (modified) (1 diff)
• Components/Common/UJobProgressView.pas (modified) (13 diffs)
• Components/Common/ULastOpenedList.pas (modified) (7 diffs)
• Components/Common/UListViewSort.pas (added)
• Components/Common/UPersistentForm.pas (added)
• Components/Common/URegistry.pas (modified) (5 diffs)
• Components/Common/UResetableThread.pas (modified) (2 diffs)
• Components/Common/UScaleDPI.pas (added)
• Components/Common/USyncCounter.pas (added)
• Components/Common/UURI.pas (modified) (1 diff)
• Components/Common/UXMLUtils.pas (modified) (4 diffs)

trunk

@@ -3 +3 @@
 backup
 tunneler.exe
+tunneler.dbg
+tunneler.lps
 heaptrclog.trc
-tunneler.lps
+Components/Common/Languages/*.mo
+Components/CoolTranslator/Demo/lib

@@ -3 +3 @@
 backup
 tunneler.exe
+tunneler.dbg
+tunneler.lps
 heaptrclog.trc
-tunneler.lps
+Components/Common/Languages/*.mo
+Components/CoolTranslator/Demo/lib

trunk/Components/Common/Common.lpk

@@ -1 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <Package Version="4">
     <PathDelim Value="\"/>
     <Name Value="Common"/>
+    <Type Value="RunAndDesignTime"/>
     <AddToProjectUsesSection Value="True"/>
     <Author Value="Chronos (robie@centrum.cz)"/>
@@ -12 +13 @@
         <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
-      <Other>
-        <CompilerMessages>
-          <UseMsgFile Value="True"/>
-        </CompilerMessages>
-        <CompilerPath Value="$(CompPath)"/>
-      </Other>
     </CompilerOptions>
     <Description Value="Various libraries"/>
     <License Value="GNU/GPL"/>
     <Version Minor="7"/>
-    <Files Count="15">
+    <Files Count="20">
       <Item1>
         <Filename Value="StopWatch.pas"/>
@@ -87 +82 @@
         <UnitName Value="UApplicationInfo"/>
       </Item15>
+      <Item16>
+        <Filename Value="USyncCounter.pas"/>
+        <UnitName Value="USyncCounter"/>
+      </Item16>
+      <Item17>
+        <Filename Value="UListViewSort.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UListViewSort"/>
+      </Item17>
+      <Item18>
+        <Filename Value="UPersistentForm.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UPersistentForm"/>
+      </Item18>
+      <Item19>
+        <Filename Value="UFindFile.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UFindFile"/>
+      </Item19>
+      <Item20>
+        <Filename Value="UScaleDPI.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="UScaleDPI"/>
+      </Item20>
     </Files>
     <i18n>
       <EnableI18N Value="True"/>
       <OutDir Value="Languages"/>
+      <EnableI18NForLFM Value="True"/>
     </i18n>
-    <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="2">
+    <RequiredPkgs Count="3">
       <Item1>
-        <PackageName Value="TemplateGenerics"/>
+        <PackageName Value="LCL"/>
       </Item1>
       <Item2>
+        <PackageName Value="TemplateGenerics"/>
+      </Item2>
+      <Item3>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item2>
+      </Item3>
     </RequiredPkgs>
     <UsageOptions>

trunk/Components/Common/Common.pas

@@ -10 +10 @@
   StopWatch, UCommon, UDebugLog, UDelay, UPrefixMultiplier, UURI, UThreading, 
   UMemory, UResetableThread, UPool, ULastOpenedList, URegistry, 
-  UJobProgressView, UXMLUtils, UApplicationInfo, LazarusPackageIntf;
+  UJobProgressView, UXMLUtils, UApplicationInfo, USyncCounter, UListViewSort, 
+  UPersistentForm, UFindFile, UScaleDPI, LazarusPackageIntf;
 
 implementation
@@ -20 +21 @@
   RegisterUnit('UJobProgressView', @UJobProgressView.Register);
   RegisterUnit('UApplicationInfo', @UApplicationInfo.Register);
+  RegisterUnit('UListViewSort', @UListViewSort.Register);
+  RegisterUnit('UPersistentForm', @UPersistentForm.Register);
+  RegisterUnit('UFindFile', @UFindFile.Register);
+  RegisterUnit('UScaleDPI', @UScaleDPI.Register);
 end;
 

trunk/Components/Common/Languages/UJobProgressView.po

@@ -14 +14 @@
 msgstr ""
 
+#: ujobprogressview.soperations
+msgid "Operations"
+msgstr ""
+
 #: ujobprogressview.spleasewait
 msgid "Please wait..."

trunk/Components/Common/UApplicationInfo.pas

@@ -15 +15 @@
   private
     FIdentification: Byte;
+    FLicense: string;
     FVersionMajor: Byte;
     FVersionMinor: Byte;
@@ -47 +48 @@
     property RegistryKey: string read FRegistryKey write FRegistryKey;
     property RegistryRoot: TRegistryRoot read FRegistryRoot write FRegistryRoot;
+    property License: string read FLicense write FLicense;
   end;
 
@@ -55 +57 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TApplicationInfo]);
+  RegisterComponents('Common', [TApplicationInfo]);
 end;
 

trunk/Components/Common/UCommon.pas

@@ -6 +6 @@
 
 uses
-  {$IFDEF Windows}Windows,{$ENDIF}
+  {$ifdef Windows}Windows,{$endif}
+  {$ifdef Linux}baseunix,{$endif}
   Classes, SysUtils, StrUtils, Dialogs, Process, LCLIntf,
   FileUtil; //, ShFolder, ShellAPI;
@@ -48 +49 @@
 function LoggedOnUserNameEx(Format: TUserNameFormat): string;
 function SplitString(var Text: string; Count: Word): string;
+function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
 function GetBit(Variable: QWord; Index: Byte): Boolean;
+procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean); overload;
 procedure SetBit(var Variable: QWord; Index: Byte; State: Boolean); overload;
 procedure SetBit(var Variable: Cardinal; Index: Byte; State: Boolean); overload;
@@ -62 +65 @@
 procedure ExecuteProgram(CommandLine: string);
 procedure FreeThenNil(var Obj);
+function RemoveQuotes(Text: string): string;
+function ComputerName: string;
+function OccurenceOfChar(What: Char; Where: string): Integer;
+function GetDirCount(Dir: string): Integer;
+function MergeArray(A, B: array of string): TArrayOfString;
+function LoadFileToStr(const FileName: TFileName): AnsiString;
 
 
@@ -105 +114 @@
   Find := FindFirst(UTF8Decode(Path + AFileSpec), faAnyFile xor faDirectory, SearchRec);
   while Find = 0 do begin
-    DeleteFileUTF8(Path + UTF8Encode(SearchRec.Name));
+    DeleteFile(Path + UTF8Encode(SearchRec.Name));
 
     Find := SysUtils.FindNext(SearchRec);
@@ -284 +293 @@
   L: LongWord;
 begin
-
   L := MAX_USERNAME_LENGTH + 2;
   SetLength(Result, L);
@@ -299 +307 @@
   end;
 end;
-
+{$endif}
+
+function ComputerName: string;
+{$ifdef mswindows}
+const
+ INFO_BUFFER_SIZE = 32767;
+var
+  Buffer : array[0..INFO_BUFFER_SIZE] of WideChar;
+  Ret : DWORD;
+begin
+  Ret := INFO_BUFFER_SIZE;
+  If (GetComputerNameW(@Buffer[0],Ret)) then begin
+    Result := UTF8Encode(WideString(Buffer));
+  end
+  else begin
+    Result := 'ERROR_NO_COMPUTERNAME_RETURNED';
+  end;
+end;
+{$endif}
+{$ifdef unix}
+var
+  Name: UtsName;
+begin
+  fpuname(Name);
+  Result := Name.Nodename;
+end;
+{$endif}
+
+{$ifdef windows}
 function LoggedOnUserNameEx(Format: TUserNameFormat): string;
 const
@@ -336 +372 @@
 end;
 
+function GetBitCount(Variable: QWord; MaxIndex: Integer): Integer;
+var
+  I: Integer;
+begin
+  Result := 0;
+  for I := 0 to MaxIndex - 1 do
+    if ((Variable shr I) and 1) = 1 then Inc(Result);
+end;
+
 function GetBit(Variable:QWord;Index:Byte):Boolean;
 begin
@@ -341 +386 @@
 end;
 
+procedure SetBit(var Variable: Int64; Index: Byte; State: Boolean);
+begin
+  Variable := (Variable and ((1 shl Index) xor High(QWord))) or (Int64(State) shl Index);
+end;
+
 procedure SetBit(var Variable:QWord;Index:Byte;State:Boolean); overload;
 begin
-  Variable := (Variable and ((1 shl Index) xor QWord($ffffffffffffffff))) or (QWord(State) shl Index);
+  Variable := (Variable and ((1 shl Index) xor High(QWord))) or (QWord(State) shl Index);
 end;
 
 procedure SetBit(var Variable:Cardinal;Index:Byte;State:Boolean); overload;
 begin
-  Variable := (Variable and ((1 shl Index) xor Cardinal($ffffffff))) or (Cardinal(State) shl Index);
+  Variable := (Variable and ((1 shl Index) xor High(Cardinal))) or (Cardinal(State) shl Index);
 end;
 
 procedure SetBit(var Variable:Word;Index:Byte;State:Boolean); overload;
 begin
-  Variable := (Variable and ((1 shl Index) xor Word($ffff))) or (Word(State) shl Index);
+  Variable := (Variable and ((1 shl Index) xor High(Word))) or (Word(State) shl Index);
 end;
 
@@ -400 +450 @@
 
 procedure OpenWebPage(URL: string);
-var
-  Process: TProcess;
-  Browser, Params: string;
 begin
   OpenURL(URL);
-  {try
-    Process := TProcess.Create(nil);
-    Browser := '';
-    //FindDefaultBrowser(Browser, Params);
-    //Process.Executable := Browser;
-    //Process.Parameters.Add(Format(Params, [ApplicationInfo.HomePage]);
-    Process.CommandLine := 'cmd.exe /c start ' + URL;
-    Process.Options := [poNoConsole];
-    Process.Execute;
+end;
+
+procedure OpenFileInShell(FileName: string);
+begin
+  ExecuteProgram('cmd.exe /c start "' + FileName + '"');
+end;
+
+function RemoveQuotes(Text: string): string;
+begin
+  Result := Text;
+  if (Pos('"', Text) = 1) and (Text[Length(Text)] = '"') then
+    Result := Copy(Text, 2, Length(Text) - 2);
+end;
+
+function OccurenceOfChar(What: Char; Where: string): Integer;
+var
+  I: Integer;
+begin
+  Result := 0;
+  for I := 1 to Length(Where) do
+    if Where[I] = What then Inc(Result);
+end;
+
+function GetDirCount(Dir: string): Integer;
+begin
+  Result := OccurenceOfChar(DirectorySeparator, Dir);
+  if Copy(Dir, Length(Dir), 1) = DirectorySeparator then
+    Dec(Result);
+end;
+
+function MergeArray(A, B: array of string): TArrayOfString;
+var
+  I: Integer;
+begin
+  SetLength(Result, Length(A) + Length(B));
+  for I := 0 to Length(A) - 1 do
+    Result[I] := A[I];
+  for I := 0 to Length(B) - 1 do
+    Result[Length(A) + I] := B[I];
+end;
+
+function LoadFileToStr(const FileName: TFileName): AnsiString;
+var
+  FileStream: TFileStream;
+  Read: Integer;
+begin
+  Result := '';
+  FileStream := TFileStream.Create(FileName, fmOpenRead);
+  try
+    if FileStream.Size > 0 then begin
+      SetLength(Result, FileStream.Size);
+      Read := FileStream.Read(Pointer(Result)^, FileStream.Size);
+      SetLength(Result, Read);
+    end;
   finally
-    Process.Free;
-  end;}
-end;
-
-procedure OpenFileInShell(FileName: string);
-begin
-  ExecuteProgram('cmd.exe /c start "' + FileName + '"');
-end;
+    FileStream.Free;
+  end;
+end;
+
+
 
 initialization

trunk/Components/Common/UDebugLog.pas

@@ -31 +31 @@
     Items: TListObject;
     Lock: TCriticalSection;
-    procedure Add(Group: string; Text: string);
+    procedure Add(Text: string; Group: string = '');
     procedure WriteToFile(Text: string);
     constructor Create(AOwner: TComponent); override;
@@ -52 +52 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TDebugLog]);
+  RegisterComponents('Common', [TDebugLog]);
 end;
 
@@ -69 +69 @@
 end;
 
-procedure TDebugLog.Add(Group: string; Text: string);
+procedure TDebugLog.Add(Text: string; Group: string = '');
 var
   NewItem: TDebugLogItem;
@@ -103 +103 @@
   try
     if ExtractFileDir(FileName) <> '' then
-      ForceDirectoriesUTF8(ExtractFileDir(FileName));
-    if FileExistsUTF8(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
+      ForceDirectories(ExtractFileDir(FileName));
+    if FileExists(FileName) then LogFile := TFileStream.Create(UTF8Decode(FileName), fmOpenWrite)
       else LogFile := TFileStream.Create(UTF8Decode(FileName), fmCreate);
     LogFile.Seek(0, soFromEnd);

trunk/Components/Common/UFindFile.pas

@@ -55 +55 @@
   end;
 
+const
+{$IFDEF WINDOWS}
+  FilterAll = '*.*';
+{$ENDIF}
+{$IFDEF LINUX}
+  FilterAll = '*';
+{$ENDIF}
+
 procedure Register;
 
@@ -64 +72 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TFindFile]);
+  RegisterComponents('Common', [TFindFile]);
 end;
 
@@ -71 +79 @@
   inherited Create(AOwner);
   Path := IncludeTrailingBackslash(UTF8Encode(GetCurrentDir));
-  FileMask := '*.*';
+  FileMask := FilterAll;
   FileAttr := [ffaAnyFile];
   s := TStringList.Create;
@@ -127 +135 @@
   If not InSubFolders then Exit;
 
-  if SysUtils.FindFirst(UTF8Decode(inPath + '*.*'), faDirectory, Rec) = 0 then
+  if SysUtils.FindFirst(UTF8Decode(inPath + FilterAll), faDirectory, Rec) = 0 then
   try
     repeat

trunk/Components/Common/UJobProgressView.lfm

@@ -14 +14 @@
   OnDestroy = FormDestroy
   Position = poScreenCenter
-  LCLVersion = '1.1'
+  LCLVersion = '1.6.0.4'
   object PanelOperationsTitle: TPanel
     Left = 0
@@ -28 +28 @@
     object LabelOperation: TLabel
       Left = 8
-      Height = 14
+      Height = 13
       Top = 8
-      Width = 67
+      Width = 66
       Caption = 'Operations:'
       Font.Height = -11
@@ -80 +80 @@
     object LabelEstimatedTimePart: TLabel
       Left = 8
-      Height = 14
+      Height = 13
       Top = -2
-      Width = 72
+      Width = 71
       Caption = 'Estimated time:'
       ParentColor = False
@@ -132 +132 @@
     object LabelEstimatedTimeTotal: TLabel
       Left = 8
-      Height = 14
+      Height = 13
       Top = 0
-      Width = 98
+      Width = 97
       Caption = 'Total estimated time:'
       ParentColor = False

trunk/Components/Common/UJobProgressView.lrt

@@ -1 @@
-TJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
-TJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
-TJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:
+TFORMJOBPROGRESSVIEW.LABELOPERATION.CAPTION=Operations:
+TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMEPART.CAPTION=Estimated time:
+TFORMJOBPROGRESSVIEW.LABELESTIMATEDTIMETOTAL.CAPTION=Total estimated time:

trunk/Components/Common/UJobProgressView.pas

@@ -111 +111 @@
     Finished: Boolean;
     FOnJobFinish: TJobProgressViewMethod;
+    FOnOwnerDraw: TNotifyEvent;
+    FOwnerDraw: Boolean;
     FShowDelay: Integer;
     FTerminate: Boolean;
@@ -116 +118 @@
     TotalStartTime: TDateTime;
     Log: TStringList;
-    Form: TFormJobProgressView;
     procedure SetTerminate(const AValue: Boolean);
     procedure UpdateProgress;
@@ -122 +123 @@
     procedure StartJobs;
     procedure UpdateHeight;
+    procedure JobProgressChange(Sender: TObject);
   public
+    Form: TFormJobProgressView;
     Jobs: TObjectList; // TListObject<TJob>
     CurrentJob: TJob;
@@ -136 +139 @@
     property Terminate: Boolean read FTerminate write SetTerminate;
   published
+    property OwnerDraw: Boolean read FOwnerDraw write FOwnerDraw;
     property ShowDelay: Integer read FShowDelay write FShowDelay;
     property AutoClose: Boolean read FAutoClose write FAutoClose;
     property OnJobFinish: TJobProgressViewMethod read FOnJobFinish
       write FOnJobFinish;
+    property OnOwnerDraw: TNotifyEvent read FOnOwnerDraw
+      write FOnOwnerDraw;
   end;
 
@@ -160 +166 @@
   STotalEstimatedTime = 'Total estimated time: %s';
   SFinished = 'Finished';
+  SOperations = 'Operations';
 
 procedure Register;
 begin
-  RegisterComponents('Samples', [TJobProgressView]);
+  RegisterComponents('Common', [TJobProgressView]);
 end;
 
@@ -196 +203 @@
   NewJob.Progress.Max := 100;
   NewJob.Progress.Reset;
+  NewJob.Progress.OnChange := JobProgressChange;
   Jobs.Add(NewJob);
   //ReloadJobList;
@@ -212 +220 @@
   Terminate := False;
 
-  Form.BringToFront;
+  if not OwnerDraw then Form.BringToFront;
 
   Finished := False;
@@ -244 +252 @@
       CurrentJobIndex := I;
       CurrentJob := TJob(Jobs[I]);
+      JobProgressChange(Self);
       StartTime := Now;
       Form.LabelEstimatedTimePart.Caption := Format(SEstimatedTime, ['']);
@@ -339 +348 @@
 end;
 
+procedure TJobProgressView.JobProgressChange(Sender: TObject);
+begin
+  if Assigned(FOnOwnerDraw) then
+    FOnOwnerDraw(Self);
+end;
+
 procedure TFormJobProgressView.TimerUpdateTimer(Sender: TObject);
 var
@@ -357 +372 @@
   if not Visible then begin
     TimerUpdate.Interval := UpdateInterval;
-    Show;
+    if not JobProgressView.OwnerDraw then Show;
   end;
 end;
@@ -509 +524 @@
 destructor TJobProgressView.Destroy;
 begin
-  Log.Free;
-  Jobs.Free;
-  inherited Destroy;
+  FreeAndNil(Log);
+  FreeAndNil(Jobs);
+  inherited;
 end;
 
@@ -519 +534 @@
     FLock.Acquire;
     FMax := AValue;
+    if FMax < 1 then FMax := 1;
     if FValue >= FMax then FValue := FMax;
   finally
@@ -610 +626 @@
 begin
   Progress.Free;
-  inherited Destroy;
+  inherited;
 end;
 

trunk/Components/Common/ULastOpenedList.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Registry, URegistry, Menus;
+  Classes, SysUtils, Registry, URegistry, Menus, XMLConf;
 
 type
@@ -18 +18 @@
     procedure SetMaxCount(AValue: Integer);
     procedure LimitMaxCount;
+    procedure ItemsChange(Sender: TObject);
+    procedure DoChange;
   public
     Items: TStringList;
@@ -25 +27 @@
     procedure LoadFromRegistry(Context: TRegistryContext);
     procedure SaveToRegistry(Context: TRegistryContext);
+    procedure LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string);
+    procedure SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
     procedure AddItem(FileName: string);
   published
@@ -38 +42 @@
 procedure Register;
 begin
-  RegisterComponents('Samples', [TLastOpenedList]);
+  RegisterComponents('Common', [TLastOpenedList]);
 end;
 
@@ -58 +62 @@
 end;
 
+procedure TLastOpenedList.ItemsChange(Sender: TObject);
+begin
+  DoChange;
+end;
+
+procedure TLastOpenedList.DoChange;
+begin
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
 constructor TLastOpenedList.Create(AOwner: TComponent);
 begin
   inherited;
   Items := TStringList.Create;
+  Items.OnChange := ItemsChange;
   MaxCount := 10;
 end;
@@ -129 +145 @@
 end;
 
+procedure TLastOpenedList.LoadFromXMLConfig(XMLConfig: TXMLConfig; Path: string
+  );
+var
+  I: Integer;
+  Value: string;
+  Count: Integer;
+begin
+  with XMLConfig do begin
+    Count := GetValue(Path + '/Count', 0);
+    if Count > MaxCount then Count := MaxCount;
+    Items.Clear;
+    for I := 0 to Count - 1 do begin
+      Value := GetValue(Path + '/File' + IntToStr(I), '');
+      if Trim(Value) <> '' then Items.Add(Value);
+    end;
+    if Assigned(FOnChange) then
+      FOnChange(Self);
+  end;
+end;
+
+procedure TLastOpenedList.SaveToXMLConfig(XMLConfig: TXMLConfig; Path: string);
+var
+  I: Integer;
+begin
+  with XMLConfig do begin
+    SetValue(Path + '/Count', Items.Count);
+    for I := 0 to Items.Count - 1 do
+      SetValue(Path + '/File' + IntToStr(I), Items[I]);
+    Flush;
+  end;
+end;
+
 procedure TLastOpenedList.AddItem(FileName:string);
 begin
@@ -134 +182 @@
   Items.Insert(0, FileName);
   LimitMaxCount;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
+  DoChange;
 end;
 

trunk/Components/Common/URegistry.pas

@@ -17 +17 @@
     rrKeyDynData = HKEY($80000006));
 
+  { TRegistryContext }
+
   TRegistryContext = record
     RootKey: HKEY;
     Key: string;
+    class operator Equal(A, B: TRegistryContext): Boolean;
   end;
 
@@ -26 +29 @@
   TRegistryEx = class(TRegistry)
   private
+    function GetCurrentContext: TRegistryContext;
+    procedure SetCurrentContext(AValue: TRegistryContext);
   public
     function ReadBoolWithDefault(const Name: string;
@@ -35 +40 @@
     function DeleteKeyRecursive(const Key: string): Boolean;
     function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
+    property CurrentContext: TRegistryContext read GetCurrentContext write SetCurrentContext;
   end;
 
@@ -46 +52 @@
   Result.RootKey := RootKey;
   Result.Key := Key;
+end;
+
+{ TRegistryContext }
+
+class operator TRegistryContext.Equal(A, B: TRegistryContext): Boolean;
+begin
+  Result := (A.Key = B.Key) and (A.RootKey = B.RootKey);
 end;
 
@@ -106 +119 @@
 end;
 
+function TRegistryEx.GetCurrentContext: TRegistryContext;
+begin
+  Result.Key := CurrentPath;
+  Result.RootKey := RootKey;
+end;
+
+procedure TRegistryEx.SetCurrentContext(AValue: TRegistryContext);
+begin
+  RootKey := AValue.RootKey;
+  OpenKey(AValue.Key, True);
+end;
+
 function TRegistryEx.ReadBoolWithDefault(const Name: string;
   DefaultValue: Boolean): Boolean;

trunk/Components/Common/UResetableThread.pas

@@ -104 +104 @@
 
 procedure TResetableThread.WaitForStart;
-var
-  WaitResult: TWaitResult;
+//var
+//  WaitResult: TWaitResult;
 begin
   //try
@@ -127 +127 @@
 
 procedure TResetableThread.WaitForStop;
-var
-  WaitState: TWaitResult;
+//var
+//  WaitState: TWaitResult;
 begin
   try

trunk/Components/Common/UURI.pas

@@ -326 +326 @@
     Drive := Drive + DriveSeparator;
   end else Drive := '';
-  Directory.AsString := AValue;
+  if (Drive <> '') and (AValue = '') then
+    Directory.AsString := Directory.DirSeparator
+    else Directory.AsString := AValue;
 end;
 

trunk/Components/Common/UXMLUtils.pas

@@ -7 +7 @@
 uses
   {$IFDEF WINDOWS}Windows,{$ENDIF}
-  Classes, SysUtils, DateUtils;
+  Classes, SysUtils, DateUtils, XMLRead, XMLWrite, DOM;
 
 function XMLTimeToDateTime(XMLDateTime: string): TDateTime;
 function DateTimeToXMLTime(Value: TDateTime; ApplyLocalBias: Boolean = True): WideString;
+procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
+procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
+procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
+procedure WriteString(Node: TDOMNode; Name: string; Value: string);
+procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
+function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
+function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
+function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
+function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
+function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime): TDateTime;
 
 
@@ -66 +76 @@
   Minute: Integer;
   Second: Integer;
+  SecondFraction: Double;
   Millisecond: Integer;
 begin
@@ -88 +99 @@
       if Pos('Z', XMLDateTime) > 0 then
         LeftCutString(XMLDateTime, Part, 'Z');
-      Millisecond := StrToInt(Part);
+      SecondFraction := StrToFloat('0' + DecimalSeparator + Part);
+      Millisecond := Trunc(SecondFraction * 1000);
     end else begin
       if Pos('+', XMLDateTime) > 0 then
@@ -123 +135 @@
 end;
 
+procedure WriteInteger(Node: TDOMNode; Name: string; Value: Integer);
+var
+  NewNode: TDOMNode;
+begin
+  NewNode := Node.OwnerDocument.CreateElement(Name);
+  NewNode.TextContent := IntToStr(Value);
+  Node.AppendChild(NewNode);
+end;
+
+procedure WriteInt64(Node: TDOMNode; Name: string; Value: Int64);
+var
+  NewNode: TDOMNode;
+begin
+  NewNode := Node.OwnerDocument.CreateElement(Name);
+  NewNode.TextContent := IntToStr(Value);
+  Node.AppendChild(NewNode);
+end;
+
+procedure WriteBoolean(Node: TDOMNode; Name: string; Value: Boolean);
+var
+  NewNode: TDOMNode;
+begin
+  NewNode := Node.OwnerDocument.CreateElement(Name);
+  NewNode.TextContent := BoolToStr(Value);
+  Node.AppendChild(NewNode);
+end;
+
+procedure WriteString(Node: TDOMNode; Name: string; Value: string);
+var
+  NewNode: TDOMNode;
+begin
+  NewNode := Node.OwnerDocument.CreateElement(Name);
+  NewNode.TextContent := Value;
+  Node.AppendChild(NewNode);
+end;
+
+procedure WriteDateTime(Node: TDOMNode; Name: string; Value: TDateTime);
+var
+  NewNode: TDOMNode;
+begin
+  NewNode := Node.OwnerDocument.CreateElement(Name);
+  NewNode.TextContent := DateTimeToXMLTime(Value);
+  Node.AppendChild(NewNode);
+end;
+
+function ReadInteger(Node: TDOMNode; Name: string; DefaultValue: Integer): Integer;
+var
+  NewNode: TDOMNode;
+begin
+  Result := DefaultValue;
+  NewNode := Node.FindNode(Name);
+  if Assigned(NewNode) then
+    Result := StrToInt(NewNode.TextContent);
+end;
+
+function ReadInt64(Node: TDOMNode; Name: string; DefaultValue: Int64): Int64;
+var
+  NewNode: TDOMNode;
+begin
+  Result := DefaultValue;
+  NewNode := Node.FindNode(Name);
+  if Assigned(NewNode) then
+    Result := StrToInt64(NewNode.TextContent);
+end;
+
+function ReadBoolean(Node: TDOMNode; Name: string; DefaultValue: Boolean): Boolean;
+var
+  NewNode: TDOMNode;
+begin
+  Result := DefaultValue;
+  NewNode := Node.FindNode(Name);
+  if Assigned(NewNode) then
+    Result := StrToBool(NewNode.TextContent);
+end;
+
+function ReadString(Node: TDOMNode; Name: string; DefaultValue: string): string;
+var
+  NewNode: TDOMNode;
+begin
+  Result := DefaultValue;
+  NewNode := Node.FindNode(Name);
+  if Assigned(NewNode) then
+    Result := NewNode.TextContent;
+end;
+
+function ReadDateTime(Node: TDOMNode; Name: string; DefaultValue: TDateTime
+  ): TDateTime;
+var
+  NewNode: TDOMNode;
+begin
+  Result := DefaultValue;
+  NewNode := Node.FindNode(Name);
+  if Assigned(NewNode) then
+    Result := XMLTimeToDateTime(NewNode.TextContent);
+end;
+
 end.
 

@@ -3 +3 @@
 backup
 tunneler.exe
+tunneler.dbg
+tunneler.lps
 heaptrclog.trc
-tunneler.lps
+Components/Common/Languages/*.mo
+Components/CoolTranslator/Demo/lib