source upload

contrib/CoreCipher/Source/CoreAtomic.inc

@@ -0,0 +1,440 @@
+// used Critical Simulate Atomic with TMonitor.Enter(obj) and TMonitor.Exit(obj)
+// CriticalSimulateAtomic defined so performance to be reduced
+
+// used soft Simulate Critical(ring)
+// SoftCritical defined so performance to be reduced
+
+{ * object lock create by qq600585                                             * }
+{ ****************************************************************************** }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+
+constructor TSoftCritical.Create;
+begin
+  inherited Create;
+  L := False;
+end;
+
+procedure TSoftCritical.Acquire;
+{$IFDEF ANTI_DEAD_ATOMIC_LOCK}
+var
+  d: TTimeTick;
+{$ENDIF ANTI_DEAD_ATOMIC_LOCK}
+begin
+{$IFDEF ANTI_DEAD_ATOMIC_LOCK}
+  d := GetTimeTick;
+  while L do
+    if GetTimeTick - d >= 5000 then
+        RaiseInfo('dead lock');
+{$ELSE ANTI_DEAD_ATOMIC_LOCK}
+  while L do
+      NOP;
+{$ENDIF ANTI_DEAD_ATOMIC_LOCK}
+  L := True;
+end;
+
+procedure TSoftCritical.Release;
+begin
+  L := False;
+end;
+
+procedure TSoftCritical.Enter;
+begin
+  Acquire;
+end;
+
+procedure TSoftCritical.Leave;
+begin
+  Release;
+end;
+
+constructor TCritical.Create;
+begin
+  inherited Create;
+  LNum := TAtomInt.Create(0);
+end;
+
+destructor TCritical.Destroy;
+begin
+  LNum.Free;
+  inherited Destroy;
+end;
+
+procedure TCritical.Acquire;
+begin
+  Inc(LNum.LockP^);
+  LNum.UnLock;
+  inherited Acquire;
+end;
+
+procedure TCritical.Release;
+begin
+  Dec(LNum.LockP^);
+  LNum.UnLock;
+  inherited Release;
+end;
+
+procedure TCritical.Enter;
+begin
+  Acquire();
+end;
+
+procedure TCritical.Leave;
+begin
+  Release();
+end;
+
+function TCritical.IsBusy: Boolean;
+begin
+  Result := LNum.V > 0;
+end;
+
+type
+  PCritical_Struct = ^TCritical_Struct;
+
+  TCritical_Struct = record
+    Obj: TObject;
+    LEnter: Integer;
+    LockTick: TTimeTick;
+    Critical: TCritical;
+  end;
+
+  TGetCriticalLockState = (lsSame, lsNew, lsIdle);
+
+var
+  CoreLockCritical: TCriticalSection;
+  CoreComputeCritical: TCriticalSection;
+  CoreTimeTickCritical: TCriticalSection;
+  CriticalList: TCoreClassList;
+
+procedure InitCriticalLock;
+begin
+  CoreLockCritical := TCriticalSection.Create;
+  CoreComputeCritical := TCriticalSection.Create;
+  CoreTimeTickCritical := TCriticalSection.Create;
+  CriticalList := TCoreClassList.Create;
+end;
+
+procedure FreeCriticalLock;
+var
+  i: Integer;
+  p: PCritical_Struct;
+begin
+  for i := 0 to CriticalList.Count - 1 do
+    begin
+      p := PCritical_Struct(CriticalList[i]);
+      p^.Critical.Free;
+      Dispose(p);
+    end;
+  CriticalList.Free;
+  CriticalList := nil;
+
+  CoreLockCritical.Free;
+  CoreLockCritical := nil;
+
+  CoreComputeCritical.Free;
+  CoreComputeCritical := nil;
+
+  CoreTimeTickCritical.Free;
+  CoreTimeTickCritical := nil;
+end;
+
+procedure GetCriticalLock(const Obj: TObject; var output: PCritical_Struct; var state: TGetCriticalLockState);
+var
+  i, pIndex: Integer;
+  p1, p2: PCritical_Struct;
+begin
+  output := nil;
+  pIndex := -1;
+  p1 := nil;
+  i := 0;
+  while i < CriticalList.Count do
+    begin
+      p2 := PCritical_Struct(CriticalList[i]);
+      if p2^.Obj = Obj then
+        begin
+          output := p2;
+          state := TGetCriticalLockState.lsSame;
+          exit;
+        end
+      else if (p2^.Obj = nil) and (p2^.LEnter = 0) then
+        begin
+          p1 := p2;
+          pIndex := i;
+        end;
+      Inc(i);
+    end;
+
+  if p1 <> nil then
+    begin
+      p1^.Obj := Obj;
+      output := p1;
+      if pIndex > 0 then
+          CriticalList.Move(pIndex, 0);
+      state := TGetCriticalLockState.lsIdle;
+    end
+  else
+    begin
+      new(p1);
+      p1^.Obj := Obj;
+      p1^.LEnter := 0;
+      p1^.LockTick := GetTimeTick();
+      p1^.Critical := TCritical.Create;
+      CriticalList.Insert(0, p1);
+      output := p1;
+      state := TGetCriticalLockState.lsNew;
+    end;
+end;
+
+procedure _LockCriticalObj(Obj: TObject);
+var
+  p: PCritical_Struct;
+  ls: TGetCriticalLockState;
+begin
+  CoreLockCritical.Acquire;
+  GetCriticalLock(Obj, p, ls);
+  CoreLockCritical.Release;
+  p^.Critical.Acquire;
+  p^.LockTick := GetTimeTick();
+  AtomInc(p^.LEnter);
+end;
+
+procedure _UnLockCriticalObj(Obj: TObject);
+var
+  p: PCritical_Struct;
+  ls: TGetCriticalLockState;
+begin
+  CoreLockCritical.Acquire;
+  GetCriticalLock(Obj, p, ls);
+  CoreLockCritical.Release;
+
+  AtomDec(p^.LEnter);
+  if p^.LEnter < 0 then
+      RaiseInfo('error: unlock failed: illegal unlock');
+  p^.LockTick := GetTimeTick();
+  p^.Critical.Release;
+end;
+
+procedure _RecycleLocker(const Obj: TObject);
+var
+  p: PCritical_Struct;
+  i: Integer;
+begin
+  if (CoreLockCritical = nil) or (CriticalList = nil) or (CriticalList.Count = 0) then
+      exit;
+
+  CoreLockCritical.Acquire;
+  i := 0;
+  while i < CriticalList.Count do
+    begin
+      p := PCritical_Struct(CriticalList[i]);
+      if p^.Obj = Obj then
+        begin
+          CriticalList.Delete(i);
+          p^.Critical.Free;
+          Dispose(p);
+          break;
+        end
+      else
+          Inc(i);
+    end;
+  CoreLockCritical.Release;
+end;
+
+function DeltaStep(const value_, Delta_: NativeInt): NativeInt;
+begin
+  if Delta_ > 0 then
+      Result := (value_ + (Delta_ - 1)) and (not(Delta_ - 1))
+  else
+      Result := value_;
+end;
+
+procedure AtomInc(var x: Int64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomInc(var x: Int64; const V: Int64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x, V);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: Int64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: Int64; const V: Int64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x, V);
+{$ENDIF FPC}
+end;
+
+procedure AtomInc(var x: UInt64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomInc(var x: UInt64; const V: UInt64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x, V);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: UInt64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: UInt64; const V: UInt64);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x, V);
+{$ENDIF FPC}
+end;
+
+procedure AtomInc(var x: Integer);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomInc(var x: Integer; const V: Integer);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x, V);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: Integer);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: Integer; const V: Integer);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x, V);
+{$ENDIF FPC}
+end;
+
+procedure AtomInc(var x: Cardinal);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomInc(var x: Cardinal; const V: Cardinal);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Inc(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicIncrement(x, V);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: Cardinal);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x);
+{$ENDIF FPC}
+end;
+
+procedure AtomDec(var x: Cardinal; const V: Cardinal);
+begin
+{$IFDEF FPC}
+  CoreComputeCritical.Acquire;
+  Dec(x, V);
+  CoreComputeCritical.Release;
+{$ELSE FPC}
+  System.AtomicDecrement(x, V);
+{$ENDIF FPC}
+end;

contrib/CoreCipher/Source/CoreComputeThread.inc

@@ -0,0 +1,505 @@
+{ ****************************************************************************** }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+type
+  TComputeDispatch = record
+    OnRunCall: TRunWithThreadCall;
+    OnRunMethod: TRunWithThreadMethod;
+    OnRunProc: TRunWithThreadProc;
+    OnRunCall_NP: TRunWithThreadCall_NP;
+    OnRunMethod_NP: TRunWithThreadMethod_NP;
+    OnRunProc_NP: TRunWithThreadProc_NP;
+    OnDoneCall: TRunWithThreadCall;
+    OnDoneMethod: TRunWithThreadMethod;
+    OnDoneProc: TRunWithThreadProc;
+    UserData: Pointer;
+    UserObject: TCoreClassObject;
+    procedure Init;
+    procedure AssignTo(th: TComputeThread);
+  end;
+
+  PComputeDispatchData = ^TComputeDispatch;
+
+  TCoreComputeThreadPool = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<TComputeThread>;
+  TComputeDispatchPool = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<PComputeDispatchData>;
+
+  TParallelOverflow = record
+    ActivtedParallel: Integer;
+    procedure Acquire;
+    procedure Release;
+    function Busy(): Boolean; inline;
+  end;
+
+var
+  CoreThreadPool: TCoreComputeThreadPool;
+  ComputeDispatchCritical: TCritical;
+  ComputeThreadTaskRunning: TAtomInteger;
+  ParallelGranularity: Integer;
+  MaxActivtedParallel: Integer;
+  ParallelOverflow: TParallelOverflow;
+  ComputeDispatchPool: TComputeDispatchPool;
+  IdleComputeThreadSum: TAtomInt;
+
+procedure TComputeDispatch.Init;
+begin
+  OnRunCall := nil;
+  OnRunMethod := nil;
+  OnRunProc := nil;
+  OnRunCall_NP := nil;
+  OnRunMethod_NP := nil;
+  OnRunProc_NP := nil;
+  OnDoneCall := nil;
+  OnDoneMethod := nil;
+  OnDoneProc := nil;
+  UserData := nil;
+  UserObject := nil;
+end;
+
+procedure TComputeDispatch.AssignTo(th: TComputeThread);
+begin
+  th.OnRunCall := OnRunCall;
+  th.OnRunMethod := OnRunMethod;
+  th.OnRunProc := OnRunProc;
+  th.OnRunCall_NP := OnRunCall_NP;
+  th.OnRunMethod_NP := OnRunMethod_NP;
+  th.OnRunProc_NP := OnRunProc_NP;
+  th.OnDoneCall := OnDoneCall;
+  th.OnDoneMethod := OnDoneMethod;
+  th.OnDoneProc := OnDoneProc;
+  th.UserData := UserData;
+  th.UserObject := UserObject;
+end;
+
+procedure TParallelOverflow.Acquire;
+begin
+  while Busy() do
+      TCoreClassThread.Sleep(1);
+  AtomInc(ActivtedParallel);
+end;
+
+procedure TParallelOverflow.Release;
+begin
+  AtomDec(ActivtedParallel);
+end;
+
+function TParallelOverflow.Busy(): Boolean;
+begin
+  Result := ActivtedParallel >= MaxActivtedParallel;
+end;
+
+function PickOrCreateThread(): TComputeThread;
+begin
+  Result := TComputeThread.Create;
+  CoreThreadPool.Add(Result);
+end;
+
+procedure PostComputeDispatchData(var data: TComputeDispatch);
+var
+  tk: TTimeTick;
+  done: Boolean;
+  th: TComputeThread;
+begin
+  // check for idle thread, and again run.
+  if IdleComputeThreadSum.V > 0 then
+    begin
+      ComputeDispatchCritical.Acquire;
+      ComputeDispatchPool.Add(@data);
+      ComputeDispatchCritical.Release;
+      tk := GetTimeTick();
+      while (IdleComputeThreadSum.V > 0) and (GetTimeTick() - tk < 20) do
+        begin
+          ComputeDispatchCritical.Acquire;
+          done := ComputeDispatchPool.IndexOf(@data) < 0;
+          ComputeDispatchCritical.Release;
+          if done then
+              exit;
+        end;
+      ComputeDispatchCritical.Acquire;
+      done := ComputeDispatchPool.IndexOf(@data) < 0;
+      if not done then
+          ComputeDispatchPool.Remove(@data);
+      ComputeDispatchCritical.Release;
+      if done then
+          exit;
+    end;
+
+  // create thread
+  ComputeDispatchCritical.Acquire;
+  inc(ComputeThreadTaskRunning.LockP()^);
+  ComputeThreadTaskRunning.Unlock;
+  th := PickOrCreateThread();
+  data.AssignTo(th);
+  th.Start();
+  ComputeDispatchCritical.Release;
+end;
+
+procedure InitCoreThreadPool(Thread_Num: Integer);
+var
+  th: TComputeThread;
+begin
+  CoreThreadPool := TCoreComputeThreadPool.Create;
+  ComputeThreadTaskRunning := TAtomInteger.Create(0);
+  ParallelGranularity := Thread_Num;
+  ComputeDispatchCritical := TCritical.Create;
+  MaxActivtedParallel := Thread_Num;
+  ParallelOverflow.ActivtedParallel := 0;
+  ComputeDispatchPool := TComputeDispatchPool.Create;
+  IdleComputeThreadSum := TAtomInt.Create(0);
+end;
+
+procedure FreeCoreThreadPool;
+begin
+  while TComputeThread.ActivtedTask() > 0 do
+      CheckThreadSynchronize(1);
+
+  CoreThreadPool.Free;
+  CoreThreadPool := nil;
+
+  ComputeThreadTaskRunning.Free;
+  ComputeThreadTaskRunning := nil;
+
+  ComputeDispatchCritical.Free;
+  ComputeDispatchCritical := nil;
+
+  ComputeDispatchPool.Free;
+  ComputeDispatchPool := nil;
+
+  IdleComputeThreadSum.Free;
+  IdleComputeThreadSum := nil;
+end;
+
+procedure TComputeThread.Execute;
+var
+  tk: TTimeTick;
+  NoTask: Boolean;
+  i: Integer;
+begin
+  while True do
+    begin
+      try
+{$IFDEF MT19937SeedOnTComputeThreadIs0} SetMT19937Seed(0); {$ELSE MT19937SeedOnTComputeThreadIs0} MT19937Randomize(); {$ENDIF MT19937SeedOnTComputeThreadIs0}
+        if Assigned(OnRunCall) then
+            OnRunCall(Self);
+        if Assigned(OnRunMethod) then
+            OnRunMethod(Self);
+        if Assigned(OnRunProc) then
+            OnRunProc(Self);
+        if Assigned(OnRunCall_NP) then
+            OnRunCall_NP();
+        if Assigned(OnRunMethod_NP) then
+            OnRunMethod_NP();
+        if Assigned(OnRunProc_NP) then
+            OnRunProc_NP();
+      except
+      end;
+
+      if Assigned(OnDoneCall) or Assigned(OnDoneMethod) or Assigned(OnDoneProc) then
+          Synchronize({$IFDEF FPC}@{$ENDIF FPC}Done_Sync);
+
+      // check for idle thread, and again run.
+      tk := GetTimeTick;
+      NoTask := True;
+      inc(IdleComputeThreadSum.LockP^);
+      IdleComputeThreadSum.Unlock;
+      for i := 1 to 100 do
+        begin
+          while NoTask and (GetTimeTick - tk < 10) do
+            begin
+              ComputeDispatchCritical.Acquire;
+              if ComputeDispatchPool.Count > 0 then
+                begin
+                  ComputeDispatchPool[0]^.AssignTo(Self);
+                  ComputeDispatchPool.Delete(0);
+                  NoTask := False;
+                end;
+              ComputeDispatchCritical.Release;
+            end;
+          if not NoTask then
+              break;
+          // little delay
+          Sleep(1);
+        end;
+      dec(IdleComputeThreadSum.LockP^);
+      IdleComputeThreadSum.Unlock;
+      if NoTask then
+          break;
+    end;
+
+  dec(ComputeThreadTaskRunning.LockP()^);
+  ComputeThreadTaskRunning.Unlock();
+
+  ComputeDispatchCritical.Acquire;
+  CoreThreadPool.Remove(Self);
+  ComputeDispatchCritical.Release;
+
+  RemoveMT19937Thread(Self);
+end;
+
+procedure TComputeThread.Done_Sync;
+begin
+  try
+    if Assigned(OnDoneCall) then
+        OnDoneCall(Self);
+    if Assigned(OnDoneMethod) then
+        OnDoneMethod(Self);
+    if Assigned(OnDoneProc) then
+        OnDoneProc(Self);
+  except
+  end;
+end;
+
+constructor TComputeThread.Create;
+begin
+  inherited Create(True);
+  FreeOnTerminate := True;
+  OnRunCall := nil;
+  OnRunMethod := nil;
+  OnRunProc := nil;
+  OnRunCall_NP := nil;
+  OnRunMethod_NP := nil;
+  OnRunProc_NP := nil;
+  OnDoneCall := nil;
+  OnDoneMethod := nil;
+  OnDoneProc := nil;
+  UserData := nil;
+  UserObject := nil;
+end;
+
+destructor TComputeThread.Destroy;
+begin
+  inherited Destroy;
+end;
+
+class function TComputeThread.ActivtedTask(): Integer;
+begin
+  ComputeDispatchCritical.Acquire;
+  Result := CoreThreadPool.Count;
+  ComputeDispatchCritical.Release;
+end;
+
+class function TComputeThread.WaitTask(): Integer;
+begin
+  Result := IdleComputeThreadSum.V;
+end;
+
+class function TComputeThread.TotalTask(): Integer;
+begin
+  Result := ComputeThreadTaskRunning.V;
+end;
+
+class function TComputeThread.State(): string;
+begin
+  Result := Format('total: %d Activted: %d Waiting: %d Granularity: %d MaxParallel: %d/%d',
+    [TotalTask(), ActivtedTask(), WaitTask(), ParallelGranularity, ParallelOverflow.ActivtedParallel, MaxActivtedParallel]);
+end;
+
+class function TComputeThread.GetParallelGranularity: Integer;
+begin
+  Result := ParallelGranularity;
+end;
+
+class function TComputeThread.GetMaxActivtedParallel: Integer;
+begin
+  Result := MaxActivtedParallel;
+end;
+
+type
+  TSyncTmp = class
+  private
+    OnRun: TRunWithThreadProc_NP;
+    procedure DoSync;
+  end;
+
+procedure TSyncTmp.DoSync;
+begin
+  try
+    OnRun();
+    Free;
+  except
+  end;
+end;
+
+class procedure TComputeThread.Sync(const OnRun_: TRunWithThreadProc_NP);
+{$IFDEF FPC}
+var
+  tmp: TSyncTmp;
+{$ENDIF FPC}
+begin
+{$IFDEF FPC}
+  tmp := TSyncTmp.Create;
+  tmp.OnRun := OnRun_;
+  TCompute.Synchronize(TCompute.CurrentThread, @tmp.DoSync);
+{$ELSE FPC}
+  TCompute.Synchronize(TCompute.CurrentThread, procedure
+    begin
+      OnRun_();
+    end);
+{$ENDIF FPC}
+end;
+
+class procedure TComputeThread.Sync(const Thread_: TThread; OnRun_: TRunWithThreadProc_NP);
+{$IFDEF FPC}
+var
+  tmp: TSyncTmp;
+{$ENDIF FPC}
+begin
+{$IFDEF FPC}
+  tmp := TSyncTmp.Create;
+  tmp.OnRun := OnRun_;
+  TCompute.Synchronize(Thread_, @tmp.DoSync);
+{$ELSE FPC}
+  TCompute.Synchronize(Thread_, procedure
+    begin
+      OnRun_();
+    end);
+{$ENDIF FPC}
+end;
+
+class procedure TComputeThread.RunC(const data: Pointer; const Obj: TCoreClassObject; const OnRun, OnDone: TRunWithThreadCall);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunCall := OnRun;
+  Dispatch_.OnDoneCall := OnDone;
+  Dispatch_.UserData := data;
+  Dispatch_.UserObject := Obj;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunC(const data: Pointer; const Obj: TCoreClassObject; const OnRun: TRunWithThreadCall);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunCall := OnRun;
+  Dispatch_.UserData := data;
+  Dispatch_.UserObject := Obj;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunC(const OnRun: TRunWithThreadCall);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunCall := OnRun;
+  Dispatch_.UserData := nil;
+  Dispatch_.UserObject := nil;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunC_NP(const OnRun: TRunWithThreadCall_NP);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunCall_NP := OnRun;
+  Dispatch_.UserData := nil;
+  Dispatch_.UserObject := nil;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunM(const data: Pointer; const Obj: TCoreClassObject; const OnRun, OnDone: TRunWithThreadMethod);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunMethod := OnRun;
+  Dispatch_.OnDoneMethod := OnDone;
+  Dispatch_.UserData := data;
+  Dispatch_.UserObject := Obj;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunM(const data: Pointer; const Obj: TCoreClassObject; const OnRun: TRunWithThreadMethod);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunMethod := OnRun;
+  Dispatch_.UserData := data;
+  Dispatch_.UserObject := Obj;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunM(const OnRun: TRunWithThreadMethod);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunMethod := OnRun;
+  Dispatch_.UserData := nil;
+  Dispatch_.UserObject := nil;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunM_NP(const OnRun: TRunWithThreadMethod_NP);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunMethod_NP := OnRun;
+  Dispatch_.UserData := nil;
+  Dispatch_.UserObject := nil;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunP(const data: Pointer; const Obj: TCoreClassObject; const OnRun, OnDone: TRunWithThreadProc);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunProc := OnRun;
+  Dispatch_.OnDoneProc := OnDone;
+  Dispatch_.UserData := data;
+  Dispatch_.UserObject := Obj;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunP(const data: Pointer; const Obj: TCoreClassObject; const OnRun: TRunWithThreadProc);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunProc := OnRun;
+  Dispatch_.UserData := data;
+  Dispatch_.UserObject := Obj;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunP(const OnRun: TRunWithThreadProc);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunProc := OnRun;
+  Dispatch_.UserData := nil;
+  Dispatch_.UserObject := nil;
+  PostComputeDispatchData(Dispatch_);
+end;
+
+class procedure TComputeThread.RunP_NP(const OnRun: TRunWithThreadProc_NP);
+var
+  Dispatch_: TComputeDispatch;
+begin
+  Dispatch_.Init;
+  Dispatch_.OnRunProc_NP := OnRun;
+  Dispatch_.UserData := nil;
+  Dispatch_.UserObject := nil;
+  PostComputeDispatchData(Dispatch_);
+end;

contrib/CoreCipher/Source/CoreEndian.inc

@@ -0,0 +1,597 @@
+{ ****************************************************************************** }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+{$IFDEF OverflowCheck}{$Q-}{$ENDIF}
+{$IFDEF RangeCheck}{$R-}{$ENDIF}
+
+
+function ROL8(const Value: Byte; Shift: Byte): Byte;
+begin
+  Shift := Shift and $07;
+  Result := Byte((Value shl Shift) or (Value shr (8 - Shift)));
+end;
+
+function ROL16(const Value: Word; Shift: Byte): Word;
+begin
+  Shift := Shift and $0F;
+  Result := Word((Value shl Shift) or (Value shr (16 - Shift)));
+end;
+
+function ROL32(const Value: Cardinal; Shift: Byte): Cardinal;
+begin
+  Shift := Shift and $1F;
+  Result := Cardinal((Value shl Shift) or (Value shr (32 - Shift)));
+end;
+
+function ROL64(const Value: UInt64; Shift: Byte): UInt64;
+begin
+  Shift := Shift and $3F;
+  Result := UInt64((Value shl Shift) or (Value shr (64 - Shift)));
+end;
+
+function ROR8(const Value: Byte; Shift: Byte): Byte;
+begin
+  Shift := Shift and $07;
+  Result := UInt8((Value shr Shift) or (Value shl (8 - Shift)));
+end;
+
+function ROR16(const Value: Word; Shift: Byte): Word;
+begin
+  Shift := Shift and $0F;
+  Result := Word((Value shr Shift) or (Value shl (16 - Shift)));
+end;
+
+function ROR32(const Value: Cardinal; Shift: Byte): Cardinal;
+begin
+  Shift := Shift and $1F;
+  Result := Cardinal((Value shr Shift) or (Value shl (32 - Shift)));
+end;
+
+function ROR64(const Value: UInt64; Shift: Byte): UInt64;
+begin
+  Shift := Shift and $3F;
+  Result := UInt64((Value shr Shift) or (Value shl (64 - Shift)));
+end;
+
+function Endian(const AValue: SmallInt): SmallInt;
+begin
+  { the extra Word type cast is necessary because the "AValue shr 8" }
+  { is turned into "Integer(AValue) shr 8", so if AValue < 0 then }
+  { the sign bits from the upper 16 bits are shifted in rather than }
+  { zeroes. }
+  Result := SmallInt((Word(AValue) shr 8) or (Word(AValue) shl 8));
+end;
+
+function Endian(const AValue: Word): Word;
+begin
+  Result := Word((AValue shr 8) or (AValue shl 8));
+end;
+
+function Endian(const AValue: Integer): Integer;
+begin
+  Result := ((Cardinal(AValue) shl 8) and $FF00FF00) or ((Cardinal(AValue) shr 8) and $00FF00FF);
+  Result := (Cardinal(Result) shl 16) or (Cardinal(Result) shr 16);
+end;
+
+function Endian(const AValue: Cardinal): Cardinal;
+begin
+  Result := ((AValue shl 8) and $FF00FF00) or ((AValue shr 8) and $00FF00FF);
+  Result := (Result shl 16) or (Result shr 16);
+end;
+
+function Endian(const AValue: Int64): Int64;
+begin
+  Result := ((UInt64(AValue) shl 8) and $FF00FF00FF00FF00) or ((UInt64(AValue) shr 8) and $00FF00FF00FF00FF);
+  Result := ((UInt64(Result) shl 16) and $FFFF0000FFFF0000) or ((UInt64(Result) shr 16) and $0000FFFF0000FFFF);
+  Result := (UInt64(Result) shl 32) or ((UInt64(Result) shr 32));
+end;
+
+function Endian(const AValue: UInt64): UInt64;
+begin
+  Result := ((AValue shl 8) and $FF00FF00FF00FF00) or ((AValue shr 8) and $00FF00FF00FF00FF);
+  Result := ((Result shl 16) and $FFFF0000FFFF0000) or ((Result shr 16) and $0000FFFF0000FFFF);
+  Result := (Result shl 32) or ((Result shr 32));
+end;
+
+function BE2N(const AValue: SmallInt): SmallInt;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function BE2N(const AValue: Word): Word;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function BE2N(const AValue: Integer): Integer;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function BE2N(const AValue: Cardinal): Cardinal;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function BE2N(const AValue: Int64): Int64;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function BE2N(const AValue: UInt64): UInt64;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function LE2N(const AValue: SmallInt): SmallInt;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function LE2N(const AValue: Word): Word;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function LE2N(const AValue: Integer): Integer;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function LE2N(const AValue: Cardinal): Cardinal;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function LE2N(const AValue: Int64): Int64;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function LE2N(const AValue: UInt64): UInt64;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2BE(const AValue: SmallInt): SmallInt;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2BE(const AValue: Word): Word;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2BE(const AValue: Integer): Integer;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2BE(const AValue: Cardinal): Cardinal;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2BE(const AValue: Int64): Int64;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2BE(const AValue: UInt64): UInt64;
+begin
+{$IFDEF BIG_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2LE(const AValue: SmallInt): SmallInt;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2LE(const AValue: Word): Word;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2LE(const AValue: Integer): Integer;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2LE(const AValue: Cardinal): Cardinal;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2LE(const AValue: Int64): Int64;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+function N2LE(const AValue: UInt64): UInt64;
+begin
+{$IFDEF LITTLE_ENDIAN}
+  Result := AValue;
+{$ELSE}
+  Result := Endian(AValue);
+{$ENDIF}
+end;
+
+procedure Swap(var v1, v2: Byte);
+var
+  v: Byte;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: Word);
+var
+  v: Word;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: Integer);
+var
+  v: Integer;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: Cardinal);
+var
+  v: Cardinal;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: Int64);
+var
+  v: Int64;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: UInt64);
+var
+  v: UInt64;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+{$IFDEF OVERLOAD_NATIVEINT}
+
+procedure Swap(var v1, v2: NativeInt);
+var
+  v: NativeInt;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: NativeUInt);
+var
+  v: NativeUInt;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+{$ENDIF OVERLOAD_NATIVEINT}
+
+
+procedure Swap(var v1, v2: string);
+var
+  v: string;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: Single);
+var
+  v: Single;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: Double);
+var
+  v: Double;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure Swap(var v1, v2: Pointer);
+var
+  v: Pointer;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+procedure SwapVariant(var v1, v2: Variant);
+var
+  v: Variant;
+begin
+  v := v1;
+  v1 := v2;
+  v2 := v;
+end;
+
+function Swap(const v: Word): Word;
+begin
+  Result := Endian(v);
+end;
+
+function Swap(const v: Cardinal): Cardinal;
+begin
+  Result := Endian(v);
+end;
+
+function Swap(const v: UInt64): UInt64;
+begin
+  Result := Endian(v);
+end;
+
+function SAR16(const AValue: SmallInt; const Shift: Byte): SmallInt;
+begin
+  Result := SmallInt(
+    Word(Word(Word(AValue) shr (Shift and 15)) or
+    (Word(SmallInt(Word(0 - Word(Word(AValue) shr 15)) and Word(SmallInt(0 - (Ord((Shift and 15) <> 0) { and 1 } ))))) shl (16 - (Shift and 15)))));
+end;
+
+function SAR32(const AValue: Integer; Shift: Byte): Integer;
+begin
+  Result := Integer(
+    Cardinal(Cardinal(Cardinal(AValue) shr (Shift and 31)) or
+    (Cardinal(Integer(Cardinal(0 - Cardinal(Cardinal(AValue) shr 31)) and Cardinal(Integer(0 - (Ord((Shift and 31) <> 0) { and 1 } ))))) shl (32 - (Shift and 31)))));
+end;
+
+function SAR64(const AValue: Int64; Shift: Byte): Int64;
+begin
+  Result := Int64(
+    UInt64(UInt64(UInt64(AValue) shr (Shift and 63)) or
+    (UInt64(Int64(UInt64(0 - UInt64(UInt64(AValue) shr 63)) and UInt64(Int64(0 - (Ord((Shift and 63) <> 0) { and 1 } ))))) shl (64 - (Shift and 63)))));
+end;
+
+function MemoryAlign(addr: Pointer; alignment_: NativeUInt): Pointer;
+var
+  tmp: NativeUInt;
+begin
+  tmp := NativeUInt(addr) + (alignment_ - 1);
+  Result := Pointer(tmp - (tmp mod alignment_));
+end;
+
+{$IFDEF OverflowCheck}{$Q+}{$ENDIF}
+{$IFDEF RangeCheck}{$R+}{$ENDIF}
+
+
+function if_(const bool_: Boolean; const True_, False_: Boolean): Boolean;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: ShortInt): ShortInt;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: SmallInt): SmallInt;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: Integer): Integer;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: Int64): Int64;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: Byte): Byte;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: Word): Word;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: Cardinal): Cardinal;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: UInt64): UInt64;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: Single): Single;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: Double): Double;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function if_(const bool_: Boolean; const True_, False_: string): string;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;
+
+function ifv_(const bool_: Boolean; const True_, False_: Variant): Variant;
+begin
+  if bool_ then
+      Result := True_
+  else
+      Result := False_;
+end;

contrib/CoreCipher/Source/Core_AtomVar.inc

@@ -0,0 +1,60 @@
+function TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.GetValue: T_;
+begin
+  Critical.Acquire;
+  Result := FValue__;
+  Critical.Release;
+end;
+
+procedure TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.SetValue(const Value_: T_);
+begin
+  Critical.Acquire;
+  FValue__ := Value_;
+  Critical.Release;
+end;
+
+function TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.GetValueP: PT_;
+begin
+  Result := @FValue__;
+end;
+
+constructor TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.Create(Value_: T_);
+begin
+  inherited Create;
+  FValue__ := Value_;
+  Critical := TCritical_.Create;
+end;
+
+destructor TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.Destroy;
+begin
+  Critical.Free;
+  inherited Destroy;
+end;
+
+function TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.Lock: T_;
+begin
+  Critical.Acquire;
+  Result := FValue__;
+end;
+
+function TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.LockP: PT_;
+begin
+  Critical.Acquire;
+  Result := @FValue__;
+end;
+
+procedure TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.UnLock(const Value_: T_);
+begin
+  FValue__ := Value_;
+  Critical.Release;
+end;
+
+procedure TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.UnLock(const Value_: PT_);
+begin
+  FValue__ := Value_^;
+  Critical.Release;
+end;
+
+procedure TAtomVar{$IFNDEF FPC}<T_>{$ENDIF FPC}.UnLock();
+begin
+  Critical.Release;
+end;

contrib/CoreCipher/Source/Core_DelphiParallelFor.inc

@@ -0,0 +1,319 @@
+{$IFDEF SystemParallel}
+
+
+procedure DelphiParallelFor(parallel: Boolean; b, e: Integer; OnFor: TDelphiParallelForProcedure32);
+var
+  i_: Integer;
+begin
+  if b > e then
+      exit;
+  if (not parallel) or (not WorkInParallelCore.V) or ParallelOverflow.Busy() then
+    begin
+      i_ := b;
+      while i_ <= e do
+        begin
+          OnFor(i_);
+          inc(i_);
+        end;
+      exit;
+    end;
+  ParallelOverflow.Acquire;
+  try
+      TParallel.&For(b, e, OnFor);
+  finally
+      ParallelOverflow.Release;
+  end;
+end;
+
+procedure DelphiParallelFor(parallel: Boolean; b, e: Int64; OnFor: TDelphiParallelForProcedure64);
+var
+  i_: Int64;
+begin
+  if b > e then
+      exit;
+  if (not parallel) or (not WorkInParallelCore.V) or ParallelOverflow.Busy() then
+    begin
+      i_ := b;
+      while i_ <= e do
+        begin
+          OnFor(i_);
+          inc(i_);
+        end;
+      exit;
+    end;
+  ParallelOverflow.Acquire;
+  try
+      TParallel.&For(b, e, OnFor);
+  finally
+      ParallelOverflow.Release;
+  end;
+end;
+{$ELSE SystemParallel}
+
+
+type
+  TDelphiParallelThData32 = record
+    b, e: Integer;
+    Completed: ^Integer;
+    OnFor: TDelphiParallelForProcedure32;
+    Critical: TCritical;
+  end;
+
+  PDelphiParallelThData32 = ^TDelphiParallelThData32;
+
+procedure DelphiParallelTh32(ThSender: TComputeThread);
+var
+  p: PDelphiParallelThData32;
+  Pass: Integer;
+begin
+  p := ThSender.UserData;
+  Pass := p^.b;
+  while Pass <= p^.e do
+    begin
+      p^.OnFor(Pass);
+      inc(Pass);
+    end;
+
+  p^.Critical.Acquire;
+  AtomInc(p^.Completed^, p^.e - p^.b + 1);
+  p^.Critical.Release;
+  dispose(p);
+end;
+
+procedure DelphiParallelFor(parallel: Boolean; b, e: Integer; OnFor: TDelphiParallelForProcedure32);
+var
+  Total, Depth, Completed, StepTotal, stepW, Pass, w: Integer;
+  p: PDelphiParallelThData32;
+  i_: Integer;
+  Critical: TCritical;
+begin
+  if b > e then
+      exit;
+  if (not parallel) or (not WorkInParallelCore.V) or ParallelOverflow.Busy() then
+    begin
+      i_ := b;
+      while i_ <= e do
+        begin
+          try
+              OnFor(i_);
+          except
+          end;
+          inc(i_);
+        end;
+      exit;
+    end;
+  ParallelOverflow.Acquire;
+  try
+    Depth := ParallelGranularity;
+    Total := e - b + 1;
+    Critical := TCritical.Create;
+
+    Completed := 0;
+
+    if (Total < Depth) then
+      begin
+        Pass := b;
+        while Pass <= e do
+          begin
+            new(p);
+            p^.b := Pass;
+            p^.e := Pass;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, DelphiParallelTh32);
+            inc(Pass);
+          end;
+      end
+    else
+      begin
+        stepW := Total div Depth;
+        StepTotal := Total div stepW;
+        if Total mod stepW > 0 then
+            inc(StepTotal);
+
+        Pass := 0;
+        while Pass < StepTotal do
+          begin
+            w := stepW * Pass;
+            new(p);
+            if w + stepW <= Total then
+              begin
+                p^.b := w + b;
+                p^.e := w + stepW + b - 1;
+              end
+            else
+              begin
+                p^.b := w + b;
+                p^.e := Total + b - 1;
+              end;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, DelphiParallelTh32);
+            inc(Pass);
+          end;
+      end;
+
+    repeat
+      TThread.Sleep(1);
+      Critical.Acquire;
+      w := Completed;
+      Critical.Release;
+    until w >= Total;
+
+    Critical.Free;
+  finally
+      ParallelOverflow.Release;
+  end;
+end;
+
+type
+  TDelphiParallelThData64 = record
+    b, e: Int64;
+    Completed: ^Int64;
+    OnFor: TDelphiParallelForProcedure64;
+    Critical: TCritical;
+  end;
+
+  PDelphiParallelThData64 = ^TDelphiParallelThData64;
+
+procedure DelphiParallelTh64(ThSender: TComputeThread);
+var
+  p: PDelphiParallelThData64;
+  Pass: Int64;
+begin
+  p := ThSender.UserData;
+  Pass := p^.b;
+  while Pass <= p^.e do
+    begin
+      p^.OnFor(Pass);
+      inc(Pass);
+    end;
+
+  p^.Critical.Acquire;
+  AtomInc(p^.Completed^, p^.e - p^.b + 1);
+  p^.Critical.Release;
+  dispose(p);
+end;
+
+procedure DelphiParallelFor(parallel: Boolean; b, e: Int64; OnFor: TDelphiParallelForProcedure64);
+var
+  Total, Depth, Completed, StepTotal, stepW, Pass, w: Int64;
+  p: PDelphiParallelThData64;
+  i_: Int64;
+  Critical: TCritical;
+begin
+  if b > e then
+      exit;
+  if (not parallel) or (not WorkInParallelCore.V) or ParallelOverflow.Busy() then
+    begin
+      i_ := b;
+      while i_ <= e do
+        begin
+          try
+              OnFor(i_);
+          except
+          end;
+          inc(i_);
+        end;
+      exit;
+    end;
+  ParallelOverflow.Acquire;
+  try
+    Depth := ParallelGranularity;
+    Total := e - b + 1;
+    Critical := TCritical.Create;
+
+    Completed := 0;
+
+    if (Total < Depth) then
+      begin
+        Pass := b;
+        while Pass <= e do
+          begin
+            new(p);
+            p^.b := Pass;
+            p^.e := Pass;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, DelphiParallelTh64);
+            inc(Pass);
+          end;
+      end
+    else
+      begin
+        stepW := Total div Depth;
+        StepTotal := Total div stepW;
+        if Total mod stepW > 0 then
+            inc(StepTotal);
+
+        Pass := 0;
+        while Pass < StepTotal do
+          begin
+            w := stepW * Pass;
+            new(p);
+            if w + stepW <= Total then
+              begin
+                p^.b := w + b;
+                p^.e := w + stepW + b - 1;
+              end
+            else
+              begin
+                p^.b := w + b;
+                p^.e := Total + b - 1;
+              end;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, DelphiParallelTh64);
+            inc(Pass);
+          end;
+      end;
+
+    repeat
+      TThread.Sleep(1);
+      Critical.Acquire;
+      w := Completed;
+      Critical.Release;
+    until w >= Total;
+
+    Critical.Free;
+  finally
+      ParallelOverflow.Release;
+  end;
+end;
+
+{$ENDIF SystemParallel}
+
+
+procedure DelphiParallelFor(b, e: Integer; OnFor: TDelphiParallelForProcedure32);
+begin
+  DelphiParallelFor(True, b, e, OnFor);
+end;
+
+procedure DelphiParallelFor(b, e: Int64; OnFor: TDelphiParallelForProcedure64);
+begin
+  DelphiParallelFor(True, b, e, OnFor);
+end;
+
+procedure DelphiParallelFor(OnFor: TDelphiParallelForProcedure32; b, e: Integer);
+begin
+  DelphiParallelFor(b, e, OnFor);
+end;
+
+procedure DelphiParallelFor(OnFor: TDelphiParallelForProcedure64; b, e: Int64);
+begin
+  DelphiParallelFor(b, e, OnFor);
+end;
+
+procedure DelphiParallelFor(parallel: Boolean; OnFor: TDelphiParallelForProcedure32; b, e: Integer);
+begin
+  DelphiParallelFor(parallel, b, e, OnFor);
+end;
+
+procedure DelphiParallelFor(parallel: Boolean; OnFor: TDelphiParallelForProcedure64; b, e: Int64);
+begin
+  DelphiParallelFor(parallel, b, e, OnFor);
+end;

contrib/CoreCipher/Source/Core_FPCParallelFor.inc

@@ -0,0 +1,263 @@
+type
+  TFPCParallelThData32 = record
+    b, e: Integer;
+    Completed: ^Integer;
+    OnFor: TFPCParallelForProcedure32;
+    Critical: TCritical;
+  end;
+
+  PFPCParallelThData32 = ^TFPCParallelThData32;
+
+procedure FPCParallelTh32(ThSender: TComputeThread);
+var
+  p: PFPCParallelThData32;
+  Pass: Integer;
+begin
+  p := ThSender.UserData;
+  Pass := p^.b;
+  while Pass <= p^.e do
+    begin
+      p^.OnFor(Pass);
+      inc(Pass);
+    end;
+
+  p^.Critical.Acquire;
+  AtomInc(p^.Completed^, p^.e - p^.b + 1);
+  p^.Critical.Release;
+  dispose(p);
+end;
+
+procedure FPCParallelFor(parallel: Boolean; OnFor: TFPCParallelForProcedure32; b, e: Integer);
+var
+  Total, Depth, Completed, StepTotal, stepW, Pass, w: Integer;
+  p: PFPCParallelThData32;
+  i_: Integer;
+  Critical: TCritical;
+begin
+  if b > e then
+      exit;
+  if (not parallel) or (not WorkInParallelCore.V) or ParallelOverflow.Busy() then
+    begin
+      i_ := b;
+      while i_ <= e do
+        begin
+          try
+              OnFor(i_);
+          except
+          end;
+          inc(i_);
+        end;
+      exit;
+    end;
+  ParallelOverflow.Acquire;
+  try
+    Depth := ParallelGranularity;
+    Total := e - b + 1;
+    Critical := TCritical.Create;
+
+    Completed := 0;
+
+    if (Total < Depth) then
+      begin
+        Pass := b;
+        while Pass <= e do
+          begin
+            new(p);
+            p^.b := Pass;
+            p^.e := Pass;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, @FPCParallelTh32);
+            inc(Pass);
+          end;
+      end
+    else
+      begin
+        stepW := Total div Depth;
+        StepTotal := Total div stepW;
+        if Total mod stepW > 0 then
+            inc(StepTotal);
+
+        Pass := 0;
+        while Pass < StepTotal do
+          begin
+            w := stepW * Pass;
+            new(p);
+            if w + stepW <= Total then
+              begin
+                p^.b := w + b;
+                p^.e := w + stepW + b - 1;
+              end
+            else
+              begin
+                p^.b := w + b;
+                p^.e := Total + b - 1;
+              end;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, @FPCParallelTh32);
+            inc(Pass);
+          end;
+      end;
+
+    repeat
+      TThread.Sleep(1);
+      Critical.Acquire;
+      w := Completed;
+      Critical.Release;
+    until w >= Total;
+
+    Critical.Free;
+  finally
+      ParallelOverflow.Release;
+  end;
+end;
+
+type
+  TFPCParallelThData64 = record
+    b, e: Int64;
+    Completed: ^Int64;
+    OnFor: TFPCParallelForProcedure64;
+    Critical: TCritical;
+  end;
+
+  PFPCParallelThData64 = ^TFPCParallelThData64;
+
+procedure FPCParallelTh64(ThSender: TComputeThread);
+var
+  p: PFPCParallelThData64;
+  Pass: Int64;
+begin
+  p := ThSender.UserData;
+  Pass := p^.b;
+  while Pass <= p^.e do
+    begin
+      p^.OnFor(Pass);
+      inc(Pass);
+    end;
+
+  p^.Critical.Acquire;
+  AtomInc(p^.Completed^, p^.e - p^.b + 1);
+  p^.Critical.Release;
+  dispose(p);
+end;
+
+procedure FPCParallelFor(parallel: Boolean; OnFor: TFPCParallelForProcedure64; b, e: Int64);
+var
+  Total, Depth, Completed, StepTotal, stepW, Pass, w: Int64;
+  p: PFPCParallelThData64;
+  i_: Int64;
+  Critical: TCritical;
+begin
+  if b > e then
+      exit;
+  if (not parallel) or (not WorkInParallelCore.V) or ParallelOverflow.Busy() then
+    begin
+      i_ := b;
+      while i_ <= e do
+        begin
+          try
+              OnFor(i_);
+          except
+          end;
+          inc(i_);
+        end;
+      exit;
+    end;
+  ParallelOverflow.Acquire;
+  try
+    Depth := ParallelGranularity;
+    Total := e - b + 1;
+    Critical := TCritical.Create;
+
+    Completed := 0;
+
+    if (Total < Depth) then
+      begin
+        Pass := b;
+        while Pass <= e do
+          begin
+            new(p);
+            p^.b := Pass;
+            p^.e := Pass;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, @FPCParallelTh64);
+            inc(Pass);
+          end;
+      end
+    else
+      begin
+        stepW := Total div Depth;
+        StepTotal := Total div stepW;
+        if Total mod stepW > 0 then
+            inc(StepTotal);
+
+        Pass := 0;
+        while Pass < StepTotal do
+          begin
+            w := stepW * Pass;
+            new(p);
+            if w + stepW <= Total then
+              begin
+                p^.b := w + b;
+                p^.e := w + stepW + b - 1;
+              end
+            else
+              begin
+                p^.b := w + b;
+                p^.e := Total + b - 1;
+              end;
+            p^.Completed := @Completed;
+            p^.OnFor := OnFor;
+            p^.Critical := Critical;
+            TComputeThread.RunC(p, nil, @FPCParallelTh64);
+            inc(Pass);
+          end;
+      end;
+
+    repeat
+      TThread.Sleep(1);
+      Critical.Acquire;
+      w := Completed;
+      Critical.Release;
+    until w >= Total;
+
+    Critical.Free;
+  finally
+      ParallelOverflow.Release;
+  end;
+end;
+
+procedure FPCParallelFor(OnFor: TFPCParallelForProcedure32; b, e: Integer);
+begin
+  FPCParallelFor(True, OnFor, b, e);
+end;
+
+procedure FPCParallelFor(OnFor: TFPCParallelForProcedure64; b, e: Int64);
+begin
+  FPCParallelFor(True, OnFor, b, e);
+end;
+
+procedure FPCParallelFor(b, e: Integer; OnFor: TFPCParallelForProcedure32);
+begin
+  FPCParallelFor(OnFor, b, e);
+end;
+
+procedure FPCParallelFor(b, e: Int64; OnFor: TFPCParallelForProcedure64);
+begin
+  FPCParallelFor(OnFor, b, e);
+end;
+
+procedure FPCParallelFor(parallel: Boolean; b, e: Integer; OnFor: TFPCParallelForProcedure32);
+begin
+  FPCParallelFor(parallel, OnFor, b, e);
+end;
+
+procedure FPCParallelFor(parallel: Boolean; b, e: Int64; OnFor: TFPCParallelForProcedure64);
+begin
+  FPCParallelFor(parallel, OnFor, b, e);
+end;

contrib/CoreCipher/Source/Core_LineProcessor.inc

@@ -0,0 +1,191 @@
+{$IFDEF RangeCheck}{$R-}{$ENDIF}
+{$IFDEF OverflowCheck}{$Q-}{$ENDIF}
+
+
+procedure TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.CreateDone;
+begin
+end;
+
+constructor TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.Create(const data_: Pointer; const width_, height_: NativeInt; const Value_: T_; const LineTail_: Boolean);
+begin
+  inherited Create;
+  FData := PTArry_(data_);
+  FWidth := width_;
+  FHeight := height_;
+  FValue := Value_;
+  FLineTail := LineTail_;
+  CreateDone();
+end;
+
+destructor TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.VertLine(X, y1, y2: NativeInt);
+var
+  i: NativeInt;
+  p: PT_;
+begin
+  if (X < 0) or (X >= FWidth) then
+      Exit;
+
+  if y1 < 0 then
+      y1 := 0;
+  if y1 >= FHeight then
+      y1 := FHeight - 1;
+
+  if y2 < 0 then
+      y2 := 0;
+  if y2 >= FHeight then
+      y2 := FHeight - 1;
+
+  if y2 < y1 then
+      Swap(y1, y2);
+
+  p := @FData^[X + y1 * FWidth];
+  for i := y1 to y2 do
+    begin
+      Process(p, FValue);
+      inc(p, FWidth);
+    end;
+end;
+
+procedure TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.HorzLine(x1, Y, x2: NativeInt);
+var
+  i: NativeInt;
+  p: PT_;
+begin
+  if (Y < 0) or (Y >= FHeight) then
+      Exit;
+
+  if x1 < 0 then
+      x1 := 0;
+  if x1 >= FWidth then
+      x1 := FWidth - 1;
+
+  if x2 < 0 then
+      x2 := 0;
+  if x2 >= FWidth then
+      x2 := FWidth - 1;
+
+  if x1 > x2 then
+      Swap(x1, x2);
+
+  p := @FData^[x1 + Y * FWidth];
+
+  for i := x1 to x2 do
+    begin
+      Process(p, FValue);
+      inc(p);
+    end;
+end;
+
+procedure TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.Line(x1, y1, x2, y2: NativeInt);
+var
+  dy, dx, SY, SX, i, Delta: NativeInt;
+  pi, pl: NativeInt;
+begin
+  if (x1 = x2) and (y1 = y2) then
+    begin
+      Process(@FData^[x1 + y1 * FWidth], FValue);
+      Exit;
+    end;
+
+  dx := x2 - x1;
+  dy := y2 - y1;
+
+  if dx > 0 then
+      SX := 1
+  else if dx < 0 then
+    begin
+      dx := -dx;
+      SX := -1;
+    end
+  else // Dx = 0
+    begin
+      if dy > 0 then
+          VertLine(x1, y1, y2 - 1)
+      else if dy < 0 then
+          VertLine(x1, y2 + 1, y1);
+      if FLineTail then
+          Process(@FData^[x2 + y2 * FWidth], FValue);
+      Exit;
+    end;
+
+  if dy > 0 then
+      SY := 1
+  else if dy < 0 then
+    begin
+      dy := -dy;
+      SY := -1;
+    end
+  else // Dy = 0
+    begin
+      if x2 > x1 then
+          HorzLine(x1, y1, x2 - 1)
+      else
+          HorzLine(x2 + 1, y1, x1);
+      if FLineTail then
+          Process(@FData^[x2 + y2 * FWidth], FValue);
+      Exit;
+    end;
+
+  pi := x1 + y1 * FWidth;
+  SY := SY * FWidth;
+  pl := FWidth * FHeight;
+
+  if dx > dy then
+    begin
+      Delta := dx shr 1;
+      for i := 0 to dx - 1 do
+        begin
+          if (pi >= 0) and (pi < pl) then
+              Process(@FData^[pi], FValue);
+
+          inc(pi, SX);
+          inc(Delta, dy);
+          if Delta >= dx then
+            begin
+              inc(pi, SY);
+              dec(Delta, dx);
+            end;
+        end;
+    end
+  else // Dx < Dy
+    begin
+      Delta := dy shr 1;
+      for i := 0 to dy - 1 do
+        begin
+          if (pi >= 0) and (pi < pl) then
+              Process(@FData^[pi], FValue);
+
+          inc(pi, SY);
+          inc(Delta, dx);
+          if Delta >= dy then
+            begin
+              inc(pi, SX);
+              dec(Delta, dy);
+            end;
+        end;
+    end;
+  if (FLineTail) and (pi >= 0) and (pi < pl) then
+      Process(@FData^[pi], FValue);
+end;
+
+procedure TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.FillBox(x1, y1, x2, y2: NativeInt);
+var
+  i: Integer;
+begin
+  if y1 > y2 then
+      Swap(y1, y2);
+  for i := y1 to y2 do
+      HorzLine(x1, i, x2);
+end;
+
+procedure TLineProcessor{$IFNDEF FPC}<T_>{$ENDIF FPC}.Process(const vp: PT_; const v: T_);
+begin
+  vp^ := v;
+end;
+{$IFDEF RangeCheck}{$R+}{$ENDIF}
+{$IFDEF OverflowCheck}{$Q+}{$ENDIF}

contrib/CoreCipher/Source/Core_MT19937.inc

@@ -0,0 +1,636 @@
+(*
+  paper: Mersenne Twister: A 623-dimensionallyequidistributed uniformpseudorandom number generator
+  post by 2002
+
+  reference material
+  https://baike.baidu.com/item/%E6%A2%85%E6%A3%AE%E7%B4%A0%E6%95%B0
+  https://baike.baidu.com/item/%E6%A2%85%E6%A3%AE%E6%97%8B%E8%BD%AC%E7%AE%97%E6%B3%95
+  https://www.cnblogs.com/lfri/p/11461695.html
+  https://en.wikipedia.org/wiki/Mersenne_twister
+*)
+
+{ ****************************************************************************** }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+const
+  MT19937N = 624;
+  MT19937M = 397;
+  Mag01: array [0 .. 1] of Integer = (0, Integer($9908B0DF));
+  MT19937UPPER_MASK = Integer($80000000); // most significant r/w bits
+  MT19937LOWER_MASK = Integer($7FFFFFFF); // least significant r bits
+  TEMPERING_MASK_B = Integer($9D2C5680);
+  TEMPERING_MASK_C = Integer($EFC60000);
+
+type
+  TMTVector = array [0 .. MT19937N - 1] of Integer;
+
+type
+  TMT19937Core = record
+    MT: TMTVector; // the array for the state vector
+    MTI: Integer;
+    InternalRndSeed, InternalOldRndSeed: Cardinal;
+    Thread: TCoreClassThread;
+    LastActivtedTime: TTimeTick;
+    Busy: Boolean;
+    Instance: Integer;
+    procedure BuildMT(Seed_: Integer);
+    function GenRand_MT19937(): Integer;
+    procedure Init(Thread_: TCoreClassThread; LastActivtedTime_: TTimeTick);
+    procedure Serialize(stream: TCoreClassStream);
+    procedure Unserialize(stream: TCoreClassStream);
+  end;
+
+  PMD19937Core = ^TMT19937Core;
+
+  TMT19937List_Decl = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<PMD19937Core>;
+
+  TMT19937List = class(TMT19937List_Decl)
+  end;
+
+  { Initializing the array with a seed }
+procedure TMT19937Core.BuildMT(Seed_: Integer);
+var
+  i: Integer;
+begin
+  MT[0] := Integer(Seed_);
+  for i := 1 to MT19937N - 1 do
+    begin
+      MT[i] := 1812433253 * (MT[i - 1] xor (MT[i - 1] shr 30)) + i;
+      { See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. }
+      { In the previous versions, MSBs of the seed affect }
+      { only MSBs of the array mt[]. }
+      { 2002/01/09 modified by Makoto Matsumoto }
+    end;
+  MTI := MT19937N;
+end;
+
+function TMT19937Core.GenRand_MT19937(): Integer;
+var
+  th: TCoreClassThread;
+  Y, K: Integer;
+begin
+  if InternalRndSeed <> InternalOldRndSeed then
+      MTI := MT19937N + 1;
+
+  { generate MT19937N longints at one time }
+  if (MTI >= MT19937N) then
+    begin
+      { if BuildMT() has not been called }
+      if MTI = (MT19937N + 1) then
+        begin
+          { default initial seed is used }
+          BuildMT(Integer(InternalRndSeed));
+
+          { hack: InternalRndSeed is not used more than once in this algorithm. Most }
+          { user changes are re-initialising reandseed with the value it had }
+          { at the start -> with the "not", we will detect this change. }
+          { Detecting other changes is not useful, since the generated }
+          { numbers will be different anyway. }
+          InternalRndSeed := not(InternalRndSeed);
+          InternalOldRndSeed := InternalRndSeed;
+        end;
+
+      for K := 0 to MT19937N - MT19937M - 1 do
+        begin
+          Y := (MT[K] and MT19937UPPER_MASK) or (MT[K + 1] and MT19937LOWER_MASK);
+          MT[K] := MT[K + MT19937M] xor (Y shr 1) xor Mag01[Y and $00000001];
+        end;
+
+      for K := MT19937N - MT19937M to MT19937N - 2 do
+        begin
+          Y := (MT[K] and MT19937UPPER_MASK) or (MT[K + 1] and MT19937LOWER_MASK);
+          MT[K] := MT[K + (MT19937M - MT19937N)] xor (Y shr 1) xor Mag01[Y and $00000001];
+        end;
+
+      Y := (MT[MT19937N - 1] and MT19937UPPER_MASK) or (MT[0] and MT19937LOWER_MASK);
+      MT[MT19937N - 1] := MT[MT19937M - 1] xor (Y shr 1) xor Mag01[Y and $00000001];
+      MTI := 0;
+    end;
+
+  Y := MT[MTI];
+  inc(MTI);
+  Y := Y xor (Y shr 11);
+  Y := Y xor (Y shl 7) and TEMPERING_MASK_B;
+  Y := Y xor (Y shl 15) and TEMPERING_MASK_C;
+  Y := Y xor (Y shr 18);
+  Result := Y;
+end;
+
+procedure TMT19937Core.Init(Thread_: TCoreClassThread; LastActivtedTime_: TTimeTick);
+begin
+  InternalRndSeed := 0;
+  InternalOldRndSeed := 0;
+  BuildMT(0);
+  Thread := Thread_;
+  LastActivtedTime := LastActivtedTime_;
+  Busy := False;
+  Instance := 0;
+end;
+
+procedure TMT19937Core.Serialize(stream: TCoreClassStream);
+begin
+  stream.WriteBuffer(MT[0], SizeOf(TMTVector));
+  stream.WriteBuffer(MTI, 4);
+  stream.WriteBuffer(InternalRndSeed, 4);
+  stream.WriteBuffer(InternalOldRndSeed, 4);
+end;
+
+procedure TMT19937Core.Unserialize(stream: TCoreClassStream);
+begin
+  stream.ReadBuffer(MT[0], SizeOf(TMTVector));
+  stream.ReadBuffer(MTI, 4);
+  stream.ReadBuffer(InternalRndSeed, 4);
+  stream.ReadBuffer(InternalOldRndSeed, 4);
+end;
+
+var
+  MT19937InternalCritical: TCritical;
+  MT19937POOL: TMT19937List;
+  MT19937CoreToDelphi_: Boolean;
+
+function InternalMT19937__(): PMD19937Core;
+var
+  th: TCoreClassThread;
+  i: Integer;
+  p: PMD19937Core;
+begin
+  th := TCoreClassThread.CurrentThread;
+  Result := nil;
+
+  MT19937InternalCritical.Acquire;
+
+  i := 0;
+  while i < MT19937POOL.Count do
+    begin
+      p := MT19937POOL[i];
+      if p^.Thread = th then
+        begin
+          if i > 0 then
+              MT19937POOL.Exchange(0, i);
+          p^.LastActivtedTime := GetTimeTick;
+          Result := p;
+          inc(i);
+        end
+      else if (not p^.Busy) and (p^.Instance <= 0) and (GetTimeTick - p^.LastActivtedTime > MT19937LifeTime) then
+        begin
+          dispose(p);
+          MT19937POOL.Delete(i);
+        end
+      else
+          inc(i);
+    end;
+
+  if Result = nil then
+    begin
+      New(p);
+      p^.Init(th, GetTimeTick);
+      MT19937POOL.Add(p);
+      Result := p;
+    end;
+
+  MT19937InternalCritical.Release;
+end;
+
+procedure RemoveMT19937Thread(th: TCoreClassThread);
+var
+  i: Integer;
+  p: PMD19937Core;
+begin
+  MT19937InternalCritical.Acquire;
+  i := 0;
+  while i < MT19937POOL.Count do
+    begin
+      p := MT19937POOL[i];
+      if (p^.Thread = th) or
+        ((not p^.Busy) and (p^.Instance <= 0) and (GetTimeTick - p^.LastActivtedTime > MT19937LifeTime)) then
+        begin
+          dispose(p);
+          MT19937POOL.Delete(i);
+        end
+      else
+          inc(i);
+    end;
+  MT19937InternalCritical.Release;
+end;
+
+{$IFDEF DELPHI}
+
+{$IFDEF InstallMT19937CoreToDelphi}
+
+
+function DelphiRandom32Proc: UInt32;
+begin
+  Result := UInt32(InternalMT19937__()^.GenRand_MT19937());
+end;
+
+procedure DelphiRandomizeProc(NewSeed: UInt64);
+begin
+  InternalMT19937__()^.InternalRndSeed := Cardinal(NewSeed);
+end;
+
+procedure MT19937Install();
+begin
+  Random32Proc := DelphiRandom32Proc;
+  RandomizeProc := DelphiRandomizeProc;
+  MT19937CoreToDelphi_ := True;
+end;
+{$ENDIF InstallMT19937CoreToDelphi}
+
+{$ENDIF DELPHI}
+
+
+procedure InitMT19937Rand;
+begin
+  MT19937InternalCritical := TCritical.Create;
+  MT19937POOL := TMT19937List.Create;
+  MT19937CoreToDelphi_ := False;
+
+{$IFDEF DELPHI}
+{$IFDEF InstallMT19937CoreToDelphi}
+  MT19937Install();
+{$ENDIF InstallMT19937CoreToDelphi}
+{$ENDIF DELPHI}
+  MT19937LifeTime := 10 * 1000;
+end;
+
+procedure FreeMT19937Rand;
+var
+  i: Integer;
+begin
+  for i := 0 to MT19937POOL.Count - 1 do
+      dispose(MT19937POOL[i]);
+  DisposeObject(MT19937POOL);
+  MT19937POOL := nil;
+  MT19937InternalCritical.Free;
+  MT19937InternalCritical := nil;
+end;
+
+function MT19937CoreToDelphi: Boolean;
+begin
+  Result := MT19937CoreToDelphi_;
+end;
+
+function MT19937InstanceNum(): Integer;
+begin
+  MT19937InternalCritical.Acquire;
+  Result := MT19937POOL.Count;
+  MT19937InternalCritical.Release;
+end;
+
+procedure SetMT19937Seed(seed: Integer);
+begin
+  with InternalMT19937__()^ do
+    begin
+      MT19937InternalCritical.Acquire;
+      InternalRndSeed := seed;
+      InternalOldRndSeed := seed;
+      BuildMT(seed);
+      Thread := TCoreClassThread.CurrentThread;
+      LastActivtedTime := GetTimeTick();
+      MT19937InternalCritical.Release;
+    end;
+end;
+
+function GetMT19937Seed(): Integer;
+begin
+  Result := InternalMT19937__()^.InternalRndSeed;
+end;
+
+procedure MT19937Randomize();
+begin
+  SetMT19937Seed(Integer(GetTimeTick()));
+end;
+
+function MT19937Rand32(L: Integer): Integer;
+begin
+  { otherwise we can return values = L (JM) }
+  if (L < 0) then
+      inc(L);
+  Result := Integer((Int64(Cardinal(InternalMT19937__()^.GenRand_MT19937())) * L) shr 32);
+end;
+
+procedure MT19937Rand32(L: Integer; dest: PInteger; num: NativeInt);
+begin
+  { otherwise we can return values = L (JM) }
+  if (L < 0) then
+      inc(L);
+
+  with InternalMT19937__()^ do
+    begin
+      Busy := True;
+      try
+        while num > 0 do
+          begin
+            dest^ := Integer((Int64(Cardinal(GenRand_MT19937())) * L) shr 32);
+            dec(num);
+            inc(dest);
+          end;
+      finally
+        LastActivtedTime := GetTimeTick;
+        Busy := False;
+      end;
+    end;
+end;
+
+function MT19937Rand64(L: Int64): Int64;
+begin
+  { always call random, so the random generator cycles (TP-compatible) (JM) }
+  with InternalMT19937__()^ do
+      Result := Int64((UInt64(Cardinal(GenRand_MT19937())) or ((UInt64(Cardinal(GenRand_MT19937())) shl 32))) and $7FFFFFFFFFFFFFFF);
+  if (L <> 0) then
+      Result := Result mod L
+  else
+      Result := 0;
+end;
+
+procedure MT19937Rand64(L: Int64; dest: PInt64; num: NativeInt);
+begin
+  with InternalMT19937__()^ do
+    begin
+      Busy := True;
+      try
+        while num > 0 do
+          begin
+            dest^ := Int64((UInt64(Cardinal(GenRand_MT19937())) or ((UInt64(Cardinal(GenRand_MT19937())) shl 32))) and $7FFFFFFFFFFFFFFF);
+            if (dest^ <> 0) then
+                dest^ := dest^ mod L
+            else
+                dest^ := 0;
+            dec(num);
+            inc(dest);
+          end;
+      finally
+        LastActivtedTime := GetTimeTick;
+        Busy := False;
+      end;
+    end;
+end;
+
+function MT19937RandE: Extended;
+const
+  f = Extended(1.0) / (Int64(1) shl 32);
+begin
+  Result := f * Cardinal(InternalMT19937__()^.GenRand_MT19937());
+end;
+
+procedure MT19937RandE(dest: PExtended; num: NativeInt);
+const
+  f = Extended(1.0) / (Int64(1) shl 32);
+begin
+  with InternalMT19937__()^ do
+    begin
+      Busy := True;
+      try
+        while num > 0 do
+          begin
+            dest^ := f * Cardinal(GenRand_MT19937());
+            dec(num);
+            inc(dest);
+          end;
+      finally
+        LastActivtedTime := GetTimeTick;
+        Busy := False;
+      end;
+    end;
+end;
+
+function MT19937RandF: Single;
+const
+  f = Single(1.0) / (Int64(1) shl 32);
+begin
+  Result := f * Cardinal(InternalMT19937__()^.GenRand_MT19937());
+end;
+
+procedure MT19937RandF(dest: PSingle; num: NativeInt);
+const
+  f = Single(1.0) / (Int64(1) shl 32);
+begin
+  with InternalMT19937__()^ do
+    begin
+      Busy := True;
+      try
+        while num > 0 do
+          begin
+            dest^ := f * Cardinal(GenRand_MT19937());
+            dec(num);
+            inc(dest);
+          end;
+      finally
+        LastActivtedTime := GetTimeTick;
+        Busy := False;
+      end;
+    end;
+end;
+
+function MT19937RandD: Double;
+const
+  f = Double(1.0) / (Int64(1) shl 32);
+begin
+  Result := f * Cardinal(InternalMT19937__()^.GenRand_MT19937());
+end;
+
+procedure MT19937RandD(dest: PDouble; num: NativeInt);
+const
+  f = Double(1.0) / (Int64(1) shl 32);
+begin
+  with InternalMT19937__()^ do
+    begin
+      Busy := True;
+      try
+        while num > 0 do
+          begin
+            dest^ := f * Cardinal(GenRand_MT19937());
+            dec(num);
+            inc(dest);
+          end;
+      finally
+        LastActivtedTime := GetTimeTick;
+        Busy := False;
+      end;
+    end;
+end;
+
+procedure MT19937SaveToStream(stream: TCoreClassStream);
+begin
+  InternalMT19937__()^.Serialize(stream);
+end;
+
+procedure MT19937LoadFromStream(stream: TCoreClassStream);
+begin
+  InternalMT19937__()^.Unserialize(stream);
+end;
+
+{ ****************************************************************************** }
+{ * TMT19937 classes                                                           * }
+{ ****************************************************************************** }
+function TMT19937Random.GetSeed: Integer;
+begin
+  with PMD19937Core(FRndInstance)^ do
+      Result := InternalRndSeed;
+end;
+
+procedure TMT19937Random.SetSeed(const Value: Integer);
+begin
+  with PMD19937Core(FRndInstance)^ do
+    begin
+      InternalRndSeed := Value;
+      InternalOldRndSeed := Value;
+      BuildMT(Value);
+    end;
+end;
+
+constructor TMT19937Random.Create;
+begin
+  inherited Create;
+  FRndInstance := InternalMT19937__();
+  AtomInc(PMD19937Core(FRndInstance)^.Instance);
+end;
+
+destructor TMT19937Random.Destroy;
+begin
+  AtomDec(PMD19937Core(FRndInstance)^.Instance);
+  inherited Destroy;
+end;
+
+procedure TMT19937Random.Rndmize;
+begin
+  with PMD19937Core(FRndInstance)^ do
+      InternalRndSeed := GetTimeTick;
+end;
+
+function TMT19937Random.Rand32(L: Integer): Integer;
+begin
+  { otherwise we can return values = L (JM) }
+  if (L < 0) then
+      inc(L);
+  with PMD19937Core(FRndInstance)^ do
+      Result := Integer((Int64(Cardinal(GenRand_MT19937())) * L) shr 32);
+end;
+
+procedure TMT19937Random.Rand32(L: Integer; dest: PInteger; num: NativeInt);
+begin
+  { otherwise we can return values = L (JM) }
+  if (L < 0) then
+      inc(L);
+
+  with PMD19937Core(FRndInstance)^ do
+    begin
+      while num > 0 do
+        begin
+          dest^ := Integer((Int64(Cardinal(GenRand_MT19937())) * L) shr 32);
+          dec(num);
+          inc(dest);
+        end;
+    end;
+end;
+
+function TMT19937Random.Rand64(L: Int64): Int64;
+begin
+  { always call random, so the random generator cycles (TP-compatible) (JM) }
+  with PMD19937Core(FRndInstance)^ do
+      Result := Int64((UInt64(Cardinal(GenRand_MT19937())) or ((UInt64(Cardinal(GenRand_MT19937())) shl 32))) and $7FFFFFFFFFFFFFFF);
+  if (L <> 0) then
+      Result := Result mod L
+  else
+      Result := 0;
+end;
+
+procedure TMT19937Random.Rand64(L: Int64; dest: PInt64; num: NativeInt);
+begin
+  with PMD19937Core(FRndInstance)^ do
+    begin
+      while num > 0 do
+        begin
+          dest^ := Int64((UInt64(Cardinal(GenRand_MT19937())) or ((UInt64(Cardinal(GenRand_MT19937())) shl 32))) and $7FFFFFFFFFFFFFFF);
+          if (dest^ <> 0) then
+              dest^ := dest^ mod L
+          else
+              dest^ := 0;
+          dec(num);
+          inc(dest);
+        end;
+    end;
+end;
+
+function TMT19937Random.RandE: Extended;
+const
+  f = Extended(1.0) / (Int64(1) shl 32);
+begin
+  with PMD19937Core(FRndInstance)^ do
+      Result := f * Cardinal(GenRand_MT19937());
+end;
+
+procedure TMT19937Random.RandE(dest: PExtended; num: NativeInt);
+const
+  f = Extended(1.0) / (Int64(1) shl 32);
+begin
+  with PMD19937Core(FRndInstance)^ do
+    begin
+      while num > 0 do
+        begin
+          dest^ := f * Cardinal(GenRand_MT19937());
+          dec(num);
+          inc(dest);
+        end;
+    end;
+end;
+
+function TMT19937Random.RandF: Single;
+const
+  f = Single(1.0) / (Int64(1) shl 32);
+begin
+  with PMD19937Core(FRndInstance)^ do
+      Result := f * Cardinal(GenRand_MT19937());
+end;
+
+procedure TMT19937Random.RandF(dest: PSingle; num: NativeInt);
+const
+  f = Single(1.0) / (Int64(1) shl 32);
+begin
+  with PMD19937Core(FRndInstance)^ do
+    begin
+      while num > 0 do
+        begin
+          dest^ := f * Cardinal(GenRand_MT19937());
+          dec(num);
+          inc(dest);
+        end;
+    end;
+end;
+
+function TMT19937Random.RandD: Double;
+const
+  f = Double(1.0) / (Int64(1) shl 32);
+begin
+  with PMD19937Core(FRndInstance)^ do
+      Result := f * Cardinal(GenRand_MT19937());
+end;
+
+procedure TMT19937Random.RandD(dest: PDouble; num: NativeInt);
+const
+  f = Double(1.0) / (Int64(1) shl 32);
+begin
+  with PMD19937Core(FRndInstance)^ do
+    begin
+      while num > 0 do
+        begin
+          dest^ := f * Cardinal(GenRand_MT19937());
+          dec(num);
+          inc(dest);
+        end;
+    end;
+end;

contrib/CoreCipher/Source/DoStatusIO.pas

@@ -0,0 +1,608 @@
+{ ****************************************************************************** }
+{ * Status IO          writen by QQ 600585@qq.com                              * }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+
+unit DoStatusIO;
+
+{$INCLUDE zDefine.inc}
+
+interface
+
+uses
+{$IFNDEF FPC}
+{$IF Defined(WIN32) or Defined(WIN64)}
+  Windows,
+{$ELSEIF not Defined(Linux)}
+  FMX.Types,
+{$IFEND}
+{$IFEND FPC}
+  SysUtils, Classes, SyncObjs,
+{$IFDEF FPC}
+  FPCGenericStructlist, fgl,
+{$ELSE FPC}
+  System.Generics.Collections,
+{$ENDIF FPC}
+  PascalStrings, UPascalStrings, UnicodeMixedLib, CoreClasses;
+
+type
+{$IFDEF FPC}
+  TDoStatusProc = procedure(Text_: SystemString; const ID: Integer) is nested;
+{$ELSE FPC}
+  TDoStatusProc = reference to procedure(Text_: SystemString; const ID: Integer);
+{$ENDIF FPC}
+  TDoStatusMethod = procedure(Text_: SystemString; const ID: Integer) of object;
+  TDoStatusCall = procedure(Text_: SystemString; const ID: Integer);
+
+procedure AddDoStatusHook(TokenObj: TCoreClassObject; CallProc: TDoStatusMethod);
+procedure AddDoStatusHookM(TokenObj: TCoreClassObject; CallProc: TDoStatusMethod);
+procedure AddDoStatusHookC(TokenObj: TCoreClassObject; CallProc: TDoStatusCall);
+procedure AddDoStatusHookP(TokenObj: TCoreClassObject; CallProc: TDoStatusProc);
+procedure DeleteDoStatusHook(TokenObj: TCoreClassObject);
+procedure DisableStatus;
+procedure EnabledStatus;
+
+procedure DoStatus(Text_: SystemString; const ID: Integer); overload;
+procedure DoStatus(const v: Pointer; siz, width: NativeInt); overload;
+procedure DoStatus(prefix: SystemString; v: Pointer; siz, width: NativeInt); overload;
+procedure DoStatus(const v: TCoreClassStrings); overload;
+procedure DoStatus(const v: Int64); overload;
+procedure DoStatus(const v: Integer); overload;
+procedure DoStatus(const v: Single); overload;
+procedure DoStatus(const v: Double); overload;
+procedure DoStatus(const v: Pointer); overload;
+procedure DoStatus(const v: SystemString; const Args: array of const); overload;
+procedure DoError(v: SystemString; const Args: array of const); overload;
+procedure DoStatus(const v: SystemString); overload;
+procedure DoStatus(const v: TPascalString); overload;
+procedure DoStatus(const v: TUPascalString); overload;
+procedure DoStatus(const v: TMD5); overload;
+procedure DoStatus; overload;
+
+procedure DoStatusNoLn(const v: TPascalString); overload;
+procedure DoStatusNoLn(const v: SystemString; const Args: array of const); overload;
+procedure DoStatusNoLn; overload;
+
+function StrInfo(s: TPascalString): string; overload;
+function StrInfo(s: TUPascalString): string; overload;
+function BytesInfo(s: TBytes): string; overload;
+
+var
+  LastDoStatus: SystemString;
+  IDEOutput: Boolean;
+  ConsoleOutput: Boolean;
+  OnDoStatusHook: TDoStatusCall;
+
+implementation
+
+procedure bufHashToString(hash: Pointer; Size: NativeInt; var output: TPascalString);
+const
+  HexArr: array [0 .. 15] of SystemChar = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
+var
+  i: Integer;
+begin
+  output.Len := Size * 2;
+  for i := 0 to Size - 1 do
+    begin
+      output.buff[i * 2] := HexArr[(PByte(nativeUInt(hash) + i)^ shr 4) and $0F];
+      output.buff[i * 2 + 1] := HexArr[PByte(nativeUInt(hash) + i)^ and $0F];
+    end;
+end;
+
+procedure DoStatus(Text_: SystemString; const ID: Integer);
+begin
+  try
+      OnDoStatusHook(Text_, ID);
+  except
+  end;
+end;
+
+procedure DoStatus(const v: Pointer; siz, width: NativeInt);
+var
+  s: TPascalString;
+  i: Integer;
+  n: SystemString;
+begin
+  bufHashToString(v, siz, s);
+  n := '';
+  for i := 1 to s.Len div 2 do
+    begin
+      if n <> '' then
+          n := n + #32 + s[i * 2 - 1] + s[i * 2]
+      else
+          n := s[i * 2 - 1] + s[i * 2];
+
+      if i mod (width div 2) = 0 then
+        begin
+          DoStatus(n);
+          n := '';
+        end;
+    end;
+  if n <> '' then
+      DoStatus(n);
+end;
+
+procedure DoStatus(prefix: SystemString; v: Pointer; siz, width: NativeInt);
+var
+  s: TPascalString;
+  i: Integer;
+  n: SystemString;
+begin
+  bufHashToString(v, siz, s);
+  n := '';
+  for i := 1 to s.Len div 2 do
+    begin
+      if n <> '' then
+          n := n + #32 + s[i * 2 - 1] + s[i * 2]
+      else
+          n := s[i * 2 - 1] + s[i * 2];
+
+      if i mod (width div 2) = 0 then
+        begin
+          DoStatus(prefix + n);
+          n := '';
+        end;
+    end;
+  if n <> '' then
+      DoStatus(prefix + n);
+end;
+
+procedure DoStatus(const v: TCoreClassStrings);
+var
+  i: Integer;
+  o: TCoreClassObject;
+begin
+  for i := 0 to v.Count - 1 do
+    begin
+      o := v.Objects[i];
+      if o <> nil then
+          DoStatus('%s<%s>', [v[i], o.ClassName])
+      else
+          DoStatus(v[i]);
+    end;
+end;
+
+procedure DoStatus(const v: Int64);
+begin
+  DoStatus(IntToStr(v));
+end;
+
+procedure DoStatus(const v: Integer);
+begin
+  DoStatus(IntToStr(v));
+end;
+
+procedure DoStatus(const v: Single);
+begin
+  DoStatus(FloatToStr(v));
+end;
+
+procedure DoStatus(const v: Double);
+begin
+  DoStatus(FloatToStr(v));
+end;
+
+procedure DoStatus(const v: Pointer);
+begin
+  DoStatus(Format('0x%p', [v]));
+end;
+
+procedure DoStatus(const v: SystemString; const Args: array of const);
+begin
+  DoStatus(Format(v, Args));
+end;
+
+procedure DoError(v: SystemString; const Args: array of const);
+begin
+  DoStatus(Format(v, Args), 2);
+end;
+
+procedure DoStatus(const v: SystemString);
+begin
+  DoStatus(v, 0);
+end;
+
+procedure DoStatus(const v: TPascalString);
+begin
+  DoStatus(v.Text, 0);
+end;
+
+procedure DoStatus(const v: TUPascalString);
+begin
+  DoStatus(v.Text, 0);
+end;
+
+procedure DoStatus(const v: TMD5);
+begin
+  DoStatus(umlMD5ToString(v).Text);
+end;
+
+type
+  TStatusProcStruct = record
+    TokenObj: TCoreClassObject;
+    OnStatusM: TDoStatusMethod;
+    OnStatusC: TDoStatusCall;
+    OnStatusP: TDoStatusProc;
+  end;
+
+  PStatusProcStruct = ^TStatusProcStruct;
+
+  TStatusStruct = record
+    s: SystemString;
+    th: TCoreClassThread;
+    TriggerTime: TTimeTick;
+  end;
+
+  PStatusStruct = ^TStatusStruct;
+
+  TStatusNoLnStruct = record
+    s: TPascalString;
+    th: TCoreClassThread;
+    TriggerTime: TTimeTick;
+  end;
+
+  PStatusNoLnStruct = ^TStatusNoLnStruct;
+
+  TStatusProcList = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<PStatusProcStruct>;
+  TStatusStructList = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<PStatusStruct>;
+  TStatusNoLnStructList = {$IFDEF FPC}specialize {$ENDIF FPC} TGenericsList<PStatusNoLnStruct>;
+
+var
+  StatusActive: Boolean;
+  HookStatusProcs: TStatusProcList;
+  StatusStructList: TStatusStructList;
+  StatusCritical: TCriticalSection;
+  StatusNoLnStructList: TStatusNoLnStructList;
+  Hooked_OnCheckThreadSynchronize: TCheckThreadSynchronize;
+
+function GetOrCreateStatusNoLnData_(th_: TCoreClassThread): PStatusNoLnStruct;
+var
+  tk: TTimeTick;
+  i: Integer;
+begin
+  tk := GetTimeTick();
+  Result := nil;
+  i := 0;
+  while i < StatusNoLnStructList.Count do
+    begin
+      if StatusNoLnStructList[i]^.th = th_ then
+        begin
+          Result := StatusNoLnStructList[i];
+          Result^.TriggerTime := tk;
+
+          if i > 0 then
+              StatusNoLnStructList.Exchange(i, 0);
+          inc(i);
+        end
+      else if tk - StatusNoLnStructList[i]^.TriggerTime > C_Tick_Minute then
+        begin
+          Dispose(StatusNoLnStructList[i]);
+          StatusNoLnStructList.Delete(i);
+        end
+      else
+          inc(i);
+    end;
+
+  if Result = nil then
+    begin
+      new(Result);
+      Result^.s := '';
+      Result^.th := th_;
+      Result^.TriggerTime := tk;
+      StatusNoLnStructList.Add(Result);
+    end;
+end;
+
+function GetOrCreateStatusNoLnData(): PStatusNoLnStruct;
+begin
+  Result := GetOrCreateStatusNoLnData_(TCoreClassThread.CurrentThread);
+end;
+
+procedure DoStatusNoLn(const v: TPascalString);
+var
+  L, i: Integer;
+  StatusNoLnData: PStatusNoLnStruct;
+  pSS: PStatusStruct;
+begin
+  StatusCritical.Acquire;
+  StatusNoLnData := GetOrCreateStatusNoLnData();
+  try
+    L := v.Len;
+    i := 1;
+    while i <= L do
+      begin
+        if CharIn(v[i], [#13, #10]) then
+          begin
+            if StatusNoLnData^.s.Len > 0 then
+              begin
+                new(pSS);
+                pSS^.s := StatusNoLnData^.s.Text;
+                pSS^.th := TCoreClassThread.CurrentThread;
+                pSS^.TriggerTime := GetTimeTick;
+                StatusStructList.Add(pSS);
+                StatusNoLnData^.s := '';
+              end;
+            repeat
+                inc(i);
+            until (i > L) or (not CharIn(v[i], [#13, #10]));
+          end
+        else
+          begin
+            StatusNoLnData^.s.Append(v[i]);
+            inc(i);
+          end;
+      end;
+  finally
+      StatusCritical.Release;
+  end;
+end;
+
+procedure DoStatusNoLn(const v: SystemString; const Args: array of const);
+begin
+  DoStatusNoLn(Format(v, Args));
+end;
+
+procedure DoStatusNoLn;
+var
+  StatusNoLnData: PStatusNoLnStruct;
+  a: SystemString;
+begin
+  StatusCritical.Acquire;
+  StatusNoLnData := GetOrCreateStatusNoLnData();
+  a := StatusNoLnData^.s;
+  StatusNoLnData^.s := '';
+  StatusCritical.Release;
+  if Length(a) > 0 then
+      DoStatus(a);
+end;
+
+function StrInfo(s: TPascalString): string;
+begin
+  Result := BytesInfo(s.Bytes);
+end;
+
+function StrInfo(s: TUPascalString): string;
+begin
+  Result := BytesInfo(s.Bytes);
+end;
+
+function BytesInfo(s: TBytes): string;
+begin
+  Result := umlStringOf(s);
+end;
+
+procedure _InternalOutput(const Text_: SystemString; const ID: Integer);
+var
+  i: Integer;
+  p: PStatusProcStruct;
+begin
+  if (StatusActive) and (HookStatusProcs.Count > 0) then
+    begin
+      LastDoStatus := Text_;
+      for i := HookStatusProcs.Count - 1 downto 0 do
+        begin
+          p := HookStatusProcs[i];
+          try
+            if Assigned(p^.OnStatusM) then
+                p^.OnStatusM(Text_, ID);
+            if Assigned(p^.OnStatusC) then
+                p^.OnStatusC(Text_, ID);
+            if Assigned(p^.OnStatusP) then
+                p^.OnStatusP(Text_, ID);
+          except
+          end;
+        end;
+    end;
+
+{$IFNDEF FPC}
+  if ((IDEOutput) or (ID = 2)) and (DebugHook <> 0) then
+    begin
+{$IF Defined(WIN32) or Defined(WIN64)}
+      OutputDebugString(PWideChar('"' + Text_ + '"'));
+{$ELSEIF not Defined(Linux)}
+      FMX.Types.Log.d('"' + Text_ + '"');
+{$IFEND}
+    end;
+{$IFEND FPC}
+  if ((ConsoleOutput) or (ID = 2)) and (IsConsole) then
+      Writeln(Text_);
+end;
+
+procedure CheckDoStatus(th: TCoreClassThread);
+var
+  i: Integer;
+  pSS: PStatusStruct;
+begin
+  if StatusCritical = nil then
+      exit;
+  if (th = nil) or (th.ThreadID <> MainThreadID) then
+      exit;
+  StatusCritical.Acquire;
+  try
+    if StatusStructList.Count > 0 then
+      begin
+        for i := 0 to StatusStructList.Count - 1 do
+          begin
+            pSS := StatusStructList[i];
+            _InternalOutput(pSS^.s, 0);
+            pSS^.s := '';
+            Dispose(pSS);
+          end;
+        StatusStructList.Clear;
+      end;
+  finally
+      StatusCritical.Release;
+  end;
+end;
+
+procedure DoStatus;
+begin
+  CheckDoStatus(TCoreClassThread.CurrentThread);
+end;
+
+procedure InternalDoStatus(Text_: SystemString; const ID: Integer);
+var
+  th: TCoreClassThread;
+  pSS: PStatusStruct;
+begin
+  th := TCoreClassThread.CurrentThread;
+  if (th = nil) or (th.ThreadID <> MainThreadID) then
+    begin
+      new(pSS);
+      pSS^.s := '[' + IntToStr(th.ThreadID) + '] ' + Text_;;
+      pSS^.th := th;
+      pSS^.TriggerTime := GetTimeTick();
+      StatusCritical.Acquire;
+      StatusStructList.Add(pSS);
+      StatusCritical.Release;
+      exit;
+    end;
+
+  CheckDoStatus(th);
+  _InternalOutput(Text_, ID);
+end;
+
+procedure AddDoStatusHook(TokenObj: TCoreClassObject; CallProc: TDoStatusMethod);
+begin
+  AddDoStatusHookM(TokenObj, CallProc);
+end;
+
+procedure AddDoStatusHookM(TokenObj: TCoreClassObject; CallProc: TDoStatusMethod);
+var
+  p: PStatusProcStruct;
+begin
+  new(p);
+  p^.TokenObj := TokenObj;
+  p^.OnStatusM := CallProc;
+  p^.OnStatusC := nil;
+  p^.OnStatusP := nil;
+  HookStatusProcs.Add(p);
+end;
+
+procedure AddDoStatusHookC(TokenObj: TCoreClassObject; CallProc: TDoStatusCall);
+var
+  p: PStatusProcStruct;
+begin
+  new(p);
+  p^.TokenObj := TokenObj;
+  p^.OnStatusM := nil;
+  p^.OnStatusC := CallProc;
+  p^.OnStatusP := nil;
+  HookStatusProcs.Add(p);
+end;
+
+procedure AddDoStatusHookP(TokenObj: TCoreClassObject; CallProc: TDoStatusProc);
+var
+  p: PStatusProcStruct;
+begin
+  new(p);
+  p^.TokenObj := TokenObj;
+  p^.OnStatusM := nil;
+  p^.OnStatusC := nil;
+  p^.OnStatusP := CallProc;
+  HookStatusProcs.Add(p);
+end;
+
+procedure DeleteDoStatusHook(TokenObj: TCoreClassObject);
+var
+  i: Integer;
+  p: PStatusProcStruct;
+begin
+  i := 0;
+  while i < HookStatusProcs.Count do
+    begin
+      p := HookStatusProcs[i];
+      if p^.TokenObj = TokenObj then
+        begin
+          Dispose(p);
+          HookStatusProcs.Delete(i);
+        end
+      else
+          inc(i);
+    end;
+end;
+
+procedure DisableStatus;
+begin
+  StatusActive := False;
+end;
+
+procedure EnabledStatus;
+begin
+  StatusActive := True;
+end;
+
+procedure DoCheckThreadSynchronize;
+begin
+  DoStatus();
+  if Assigned(Hooked_OnCheckThreadSynchronize) then
+      Hooked_OnCheckThreadSynchronize();
+end;
+
+procedure _DoInit;
+begin
+  HookStatusProcs := TStatusProcList.Create;
+  StatusStructList := TStatusStructList.Create;
+  StatusCritical := TCriticalSection.Create;
+  StatusNoLnStructList := TStatusNoLnStructList.Create;
+
+  StatusActive := True;
+  LastDoStatus := '';
+  IDEOutput := False;
+  ConsoleOutput := True;
+  OnDoStatusHook := {$IFDEF FPC}@{$ENDIF FPC}InternalDoStatus;
+
+  Hooked_OnCheckThreadSynchronize := CoreClasses.OnCheckThreadSynchronize;
+  CoreClasses.OnCheckThreadSynchronize := {$IFDEF FPC}@{$ENDIF FPC}DoCheckThreadSynchronize;
+end;
+
+procedure _DoFree;
+var
+  i: Integer;
+  pSS: PStatusStruct;
+begin
+  for i := 0 to HookStatusProcs.Count - 1 do
+      Dispose(PStatusProcStruct(HookStatusProcs[i]));
+  DisposeObject(HookStatusProcs);
+
+  for i := 0 to StatusStructList.Count - 1 do
+    begin
+      pSS := StatusStructList[i];
+      pSS^.s := '';
+      Dispose(pSS);
+    end;
+  DisposeObject(StatusStructList);
+
+  for i := 0 to StatusNoLnStructList.Count - 1 do
+      Dispose(StatusNoLnStructList[i]);
+  DisposeObject(StatusNoLnStructList);
+
+  DisposeObject(StatusCritical);
+
+  StatusActive := True;
+  StatusCritical := nil;
+end;
+
+initialization
+
+_DoInit;
+
+finalization
+
+_DoFree;
+
+end.

contrib/CoreCipher/Source/FPCGenericStructlist.pas

@@ -0,0 +1,214 @@
+{ ****************************************************************************** }
+{ * Generic list of any type (TGenericStructList).                             * }
+{ ****************************************************************************** }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+{
+  Based on FPC FGL unit, copyright by FPC team.
+  License of FPC RTL is the same as our engine (modified LGPL,
+  see COPYING.txt for details).
+  Fixed to compile also under FPC 2.4.0 and 2.2.4.
+  Some small comfortable methods added.
+}
+
+unit FPCGenericStructlist;
+
+{$IFDEF FPC}
+{$mode objfpc}{$H+}
+
+{$IF defined(VER2_2)} {$DEFINE OldSyntax} {$IFEND}
+{$IF defined(VER2_4)} {$DEFINE OldSyntax} {$IFEND}
+
+{$define HAS_ENUMERATOR}
+{$ifdef VER2_2} {$undef HAS_ENUMERATOR} {$endif}
+{$ifdef VER2_4_0} {$undef HAS_ENUMERATOR} {$endif}
+{ Just undef enumerator always, in FPC 2.7.1 it's either broken
+  or I shouldn't overuse TFPGListEnumeratorSpec. }
+{$undef HAS_ENUMERATOR}
+
+{ FPC < 2.6.0 had buggy version of the Extract function,
+  also with different interface, see http://bugs.freepascal.org/view.php?id=19960. }
+{$define HAS_EXTRACT}
+{$ifdef VER2_2} {$undef HAS_EXTRACT} {$endif}
+{$ifdef VER2_4} {$undef HAS_EXTRACT} {$endif}
+{$ENDIF FPC}
+
+interface
+
+{$IFDEF FPC}
+
+uses fgl;
+
+type
+  { Generic list of types that are compared by CompareByte.
+
+    This is equivalent to TFPGList, except it doesn't override IndexOf,
+    so your type doesn't need to have a "=" operator built-in inside FPC.
+    When calling IndexOf or Remove, it will simply compare values using
+    CompareByte, this is what TFPSList.IndexOf uses.
+    This way it works to create lists of records, vectors (constant size arrays),
+    old-style TP objects, and also is suitable to create a list of methods
+    (since for methods, the "=" is broken, for Delphi compatibility,
+    see http://bugs.freepascal.org/view.php?id=9228).
+
+    We also add some trivial helper methods like @link(Add) and @link(L). }
+  generic TGenericsList<t> = class(TFPSList)
+  private
+    type
+      TCompareFunc = function(const Item1, Item2: t): Integer;
+      TTypeList = array[0..MaxGListSize] of t;
+      PTypeList = ^TTypeList;
+  {$ifdef HAS_ENUMERATOR} TFPGListEnumeratorSpec = specialize TFPGListEnumerator<t>; {$endif}
+
+  {$ifndef OldSyntax}protected var{$else}
+      {$ifdef PASDOC}protected var{$else} { PasDoc can't handle "var protected", and I don't know how/if they should be handled? }
+                     var protected{$endif}{$endif} FOnCompare: TCompareFunc;
+
+    procedure CopyItem(Src, dest: Pointer); override;
+    procedure Deref(Item: Pointer); override;
+    function  Get(index: Integer): t; {$ifdef CLASSESINLINE} inline; {$endif}
+    function  GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif}
+    function  ItemPtrCompare(Item1, Item2: Pointer): Integer;
+    procedure Put(index: Integer; const Item: t); {$ifdef CLASSESINLINE} inline; {$endif}
+  public
+    constructor Create;
+    function Add(const Item: t): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    {$ifdef HAS_EXTRACT} function Extract(const Item: t): t; {$ifdef CLASSESINLINE} inline; {$endif} {$endif}
+    function First: t; {$ifdef CLASSESINLINE} inline; {$endif}
+    {$ifdef HAS_ENUMERATOR} function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif} {$endif}
+    function IndexOf(const Item: t): Integer;
+    procedure Insert(index: Integer; const Item: t); {$ifdef CLASSESINLINE} inline; {$endif}
+    function Last: t; {$ifdef CLASSESINLINE} inline; {$endif}
+{$ifndef OldSyntax}
+    procedure Assign(Source: TGenericsList);
+{$endif OldSyntax}
+    function Remove(const Item: t): Integer; {$ifdef CLASSESINLINE} inline; {$endif}
+    procedure Sort(Compare: TCompareFunc);
+    property Items[index: Integer]: t read Get write Put; default;
+    property List: PTypeList read GetList;
+    property ListData: PTypeList read GetList;
+  end;
+
+{$ENDIF FPC}
+
+implementation
+
+{$IFDEF FPC}
+constructor TGenericsList.Create;
+begin
+  inherited Create(SizeOf(t));
+end;
+
+procedure TGenericsList.CopyItem(Src, dest: Pointer);
+begin
+  t(dest^) := t(Src^);
+end;
+
+procedure TGenericsList.Deref(Item: Pointer);
+begin
+  Finalize(t(Item^));
+end;
+
+function TGenericsList.Get(index: Integer): t;
+begin
+  Result := t(inherited Get(index)^);
+end;
+
+function TGenericsList.GetList: PTypeList;
+begin
+  Result := PTypeList(FList);
+end;
+
+function TGenericsList.ItemPtrCompare(Item1, Item2: Pointer): Integer;
+begin
+  Result := FOnCompare(t(Item1^), t(Item2^));
+end;
+
+procedure TGenericsList.Put(index: Integer; const Item: t);
+begin
+  inherited Put(index, @Item);
+end;
+
+function TGenericsList.Add(const Item: t): Integer;
+begin
+  Result := inherited Add(@Item);
+end;
+
+{$ifdef HAS_EXTRACT}
+function TGenericsList.Extract(const Item: t): t;
+begin
+  inherited Extract(@Item, @Result);
+end;
+{$endif}
+
+function TGenericsList.First: t;
+begin
+  Result := t(inherited First^);
+end;
+
+{$ifdef HAS_ENUMERATOR}
+function TGenericsList.GetEnumerator: TFPGListEnumeratorSpec;
+begin
+  Result := TFPGListEnumeratorSpec.Create(Self);
+end;
+{$endif}
+
+function TGenericsList.IndexOf(const Item: t): Integer;
+begin
+  Result := inherited IndexOf(@Item);
+end;
+
+procedure TGenericsList.Insert(index: Integer; const Item: t);
+begin
+  t(inherited Insert(index)^) := Item;
+end;
+
+function TGenericsList.Last: t;
+begin
+  Result := t(inherited Last^);
+end;
+
+{$ifndef OldSyntax}
+procedure TGenericsList.Assign(Source: TGenericsList);
+var
+  i: Integer;
+begin
+  Clear;
+  for i := 0 to Source.Count - 1 do
+    Add(Source[i]);
+end;
+{$endif OldSyntax}
+
+function TGenericsList.Remove(const Item: t): Integer;
+begin
+  Result := IndexOf(Item);
+  if Result >= 0 then
+    Delete(Result);
+end;
+
+procedure TGenericsList.Sort(Compare: TCompareFunc);
+begin
+  FOnCompare := Compare;
+  inherited Sort(@ItemPtrCompare);
+end;
+
+{$ENDIF FPC}
+
+end.
+
+
+

contrib/CoreCipher/Source/Fast_MD5.pas

@@ -0,0 +1,268 @@
+{ ****************************************************************************** }
+{ * Fast md5                                                                   * }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+unit Fast_MD5;
+
+{$INCLUDE zDefine.inc}
+
+interface
+
+
+uses CoreClasses, UnicodeMixedLib;
+
+function FastMD5(const buffPtr: PByte; bufSiz: nativeUInt): TMD5; overload;
+function FastMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5; overload;
+
+implementation
+
+{$IF Defined(MSWINDOWS) and Defined(Delphi)}
+
+
+uses MemoryStream64;
+
+(*
+  fastMD5 algorithm by Maxim Masiutin
+  https://github.com/maximmasiutin/MD5_Transform-x64
+
+  delphi imp by 600585@qq.com
+  https://github.com/PassByYou888/FastMD5
+*)
+
+{$IF Defined(WIN32)}
+(*
+  ; ==============================================================
+  ;
+  ; MD5_386.Asm   -  386 optimized helper routine for calculating
+  ;                  MD Message-Digest values
+  ; written 2/2/94 by
+  ;
+  ; Peter Sawatzki
+  ; Buchenhof 3
+  ; D58091 Hagen, Germany Fed Rep
+  ;
+  ; EMail: Peter@Sawatzki.de
+  ; EMail: 100031.3002@compuserve.com
+  ; WWW:   http://www.sawatzki.de
+  ;
+  ;
+  ; original C Source was found in Dr. Dobbs Journal Sep 91
+  ; MD5 algorithm from RSA Data Security, Inc.
+*)
+{$L MD5_32.obj}
+{$ELSEIF Defined(WIN64)}
+(*
+  ; MD5_Transform-x64
+  ; MD5 transform routine oprimized for x64 processors
+  ; Copyright 2018 Ritlabs, SRL
+  ; The 64-bit version is written by Maxim Masiutin <max@ritlabs.com>
+
+  ; The main advantage of this 64-bit version is that
+  ; it loads 64 bytes of hashed message into 8 64-bit registers
+  ; (RBP, R8, R9, R10, R11, R12, R13, R14) at the beginning,
+  ; to avoid excessive memory load operations
+  ; througout the routine.
+
+  ; To operate with 32-bit values store in higher bits
+  ; of a 64-bit register (bits 32-63) uses "Ror" by 32;
+  ; 8 macro variables (M1-M8) are used to keep record
+  ; or corrent state of whether the register has been
+  ; Ror'ed or not.
+
+  ; It also has an ability to use Lea instruction instead
+  ; of two sequental Adds (uncomment UseLea=1), but it is
+  ; slower on Skylake processors. Also, Intel in the
+  ; Optimization Reference Maual discourages us of
+  ; Lea as a replacement of two adds, since it is slower
+  ; on the Atom processors.
+
+  ; MD5_Transform-x64 is released under a dual license,
+  ; and you may choose to use it under either the
+  ; Mozilla Public License 2.0 (MPL 2.1, available from
+  ; https://www.mozilla.org/en-US/MPL/2.0/) or the
+  ; GNU Lesser General Public License Version 3,
+  ; dated 29 June 2007 (LGPL 3, available from
+  ; https://www.gnu.org/licenses/lgpl.html).
+
+  ; MD5_Transform-x64 is based
+  ; on the following code by Peter Sawatzki.
+
+  ; The original notice by Peter Sawatzki follows.
+*)
+{$L MD5_64.obj}
+{$ENDIF}
+
+procedure MD5_Transform(var Accu; const Buf); register; external;
+
+function FastMD5(const buffPtr: PByte; bufSiz: nativeUInt): TMD5;
+var
+  Digest: TMD5;
+  Lo, Hi: Cardinal;
+  p: PByte;
+  ChunkIndex: Byte;
+  ChunkBuff: array [0 .. 63] of Byte;
+begin
+  Lo := 0;
+  Hi := 0;
+  PCardinal(@Digest[0])^ := $67452301;
+  PCardinal(@Digest[4])^ := $EFCDAB89;
+  PCardinal(@Digest[8])^ := $98BADCFE;
+  PCardinal(@Digest[12])^ := $10325476;
+
+  inc(Lo, bufSiz shl 3);
+  inc(Hi, bufSiz shr 29);
+
+  p := buffPtr;
+
+  while bufSiz >= $40 do
+    begin
+      MD5_Transform(Digest, p^);
+      inc(p, $40);
+      dec(bufSiz, $40);
+    end;
+  if bufSiz > 0 then
+      CopyPtr(p, @ChunkBuff[0], bufSiz);
+
+  Result := PMD5(@Digest[0])^;
+  ChunkBuff[bufSiz] := $80;
+  ChunkIndex := bufSiz + 1;
+  if ChunkIndex > $38 then
+    begin
+      if ChunkIndex < $40 then
+          FillPtrByte(@ChunkBuff[ChunkIndex], $40 - ChunkIndex, 0);
+      MD5_Transform(Result, ChunkBuff);
+      ChunkIndex := 0
+    end;
+  FillPtrByte(@ChunkBuff[ChunkIndex], $38 - ChunkIndex, 0);
+  PCardinal(@ChunkBuff[$38])^ := Lo;
+  PCardinal(@ChunkBuff[$3C])^ := Hi;
+  MD5_Transform(Result, ChunkBuff);
+end;
+
+function FastMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5;
+const
+  deltaSize: Cardinal = $40 * $FFFF;
+
+var
+  Digest: TMD5;
+  Lo, Hi: Cardinal;
+  DeltaBuf: Pointer;
+  bufSiz: Int64;
+  Rest: Cardinal;
+  p: PByte;
+  ChunkIndex: Byte;
+  ChunkBuff: array [0 .. 63] of Byte;
+begin
+  if StartPos > EndPos then
+      Swap(StartPos, EndPos);
+  StartPos := umlClamp(StartPos, 0, stream.Size);
+  EndPos := umlClamp(EndPos, 0, stream.Size);
+  if EndPos - StartPos <= 0 then
+    begin
+      Result := FastMD5(nil, 0);
+      exit;
+    end;
+{$IFDEF OptimizationMemoryStreamMD5}
+  if stream is TCoreClassMemoryStream then
+    begin
+      Result := FastMD5(Pointer(nativeUInt(TCoreClassMemoryStream(stream).Memory) + StartPos), EndPos - StartPos);
+      exit;
+    end;
+  if stream is TMemoryStream64 then
+    begin
+      Result := FastMD5(TMemoryStream64(stream).PositionAsPtr(StartPos), EndPos - StartPos);
+      exit;
+    end;
+{$ENDIF}
+  //
+  Lo := 0;
+  Hi := 0;
+  PCardinal(@Digest[0])^ := $67452301;
+  PCardinal(@Digest[4])^ := $EFCDAB89;
+  PCardinal(@Digest[8])^ := $98BADCFE;
+  PCardinal(@Digest[12])^ := $10325476;
+
+  bufSiz := EndPos - StartPos;
+  Rest := 0;
+
+  inc(Lo, bufSiz shl 3);
+  inc(Hi, bufSiz shr 29);
+
+  DeltaBuf := GetMemory(deltaSize);
+  stream.Position := StartPos;
+
+  if bufSiz < $40 then
+    begin
+      stream.read(DeltaBuf^, bufSiz);
+      p := DeltaBuf;
+    end
+  else
+    while bufSiz >= $40 do
+      begin
+        if Rest = 0 then
+          begin
+            if bufSiz >= deltaSize then
+                Rest := deltaSize
+            else
+                Rest := bufSiz;
+            stream.ReadBuffer(DeltaBuf^, Rest);
+
+            p := DeltaBuf;
+          end;
+        MD5_Transform(Digest, p^);
+        inc(p, $40);
+        dec(bufSiz, $40);
+        dec(Rest, $40);
+      end;
+
+  if bufSiz > 0 then
+      CopyPtr(p, @ChunkBuff[0], bufSiz);
+
+  FreeMemory(DeltaBuf);
+
+  Result := PMD5(@Digest[0])^;
+  ChunkBuff[bufSiz] := $80;
+  ChunkIndex := bufSiz + 1;
+  if ChunkIndex > $38 then
+    begin
+      if ChunkIndex < $40 then
+          FillPtrByte(@ChunkBuff[ChunkIndex], $40 - ChunkIndex, 0);
+      MD5_Transform(Result, ChunkBuff);
+      ChunkIndex := 0
+    end;
+  FillPtrByte(@ChunkBuff[ChunkIndex], $38 - ChunkIndex, 0);
+  PCardinal(@ChunkBuff[$38])^ := Lo;
+  PCardinal(@ChunkBuff[$3C])^ := Hi;
+  MD5_Transform(Result, ChunkBuff);
+end;
+
+{$ELSE}
+
+
+function FastMD5(const buffPtr: PByte; bufSiz: nativeUInt): TMD5;
+begin
+  Result := umlMD5(buffPtr, bufSiz);
+end;
+
+function FastMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5;
+begin
+  Result := umlStreamMD5(stream, StartPos, EndPos);
+end;
+
+{$ENDIF Defined(MSWINDOWS) and Defined(Delphi)}
+
+end.

contrib/CoreCipher/Source/GeometrySplitHeader.inc

@@ -0,0 +1,789 @@
+type
+  TItemCompareEvent = function(Item1, Item2: TCoreClassObject; Info: pointer): integer of object;
+  TItemCompareMethod = function(Item1, Item2: TCoreClassObject; Info: pointer): integer;
+
+  TCustomObjectList = class(TCoreClassObjectList)
+  public
+    procedure Append(AItem: TCoreClassObject);
+  end;
+
+  // TCustomSortedList is a TObjectList descendant providing easy sorting
+  // capabilities, while keeping simplicity. Override the DoCompare method
+  // to compare two items.
+  TCustomSortedList = class(TCustomObjectList)
+  private
+    FSorted: boolean;
+    procedure SetSorted(AValue: boolean);
+  protected
+    // Override this method to implement the object comparison between two
+    // items. The default just compares the item pointers
+    function DoCompare(Item1, Item2: TCoreClassObject): integer; virtual; abstract;
+  public
+    constructor Create(AutoFreeObj_: boolean);
+    function Add(AItem: TCoreClassObject): integer;
+    // AddUnique behaves just like Add but checks if the item to add is unique
+    // by checking the result of the Find function. If the item is found it is
+    // replaced by the new item (old item removed), unless RaiseError = True, in
+    // that case an exception is raised.
+    function AddUnique(Item: TCoreClassObject; RaiseError: boolean = false): integer; virtual;
+    function Find(Item: TCoreClassObject; out Index: integer): boolean; virtual;
+    // Find (multiple) items equal to Item, and return Index of first equal
+    // item and the number of multiples in Count
+    procedure FindMultiple(Item: TCoreClassObject; out AIndex, ACount: integer); virtual;
+    procedure Sort; virtual;
+    property Sorted: boolean read FSorted write SetSorted default true;
+  end;
+
+  // TSortedList is an object list that provides an events or method template
+  // to compare items. Assign either OnCompare (for an event) or CompareMethod
+  // (for a method template) to do the comparison of items. Additional information
+  // required for the compare method can be passed with the CompareInfo pointer.
+  TSortedList = class(TCustomSortedList)
+  private
+    FCompareInfo: pointer;
+    FOnCompare_: TItemCompareEvent;
+    FCompareMethod: TItemCompareMethod;
+  protected
+    function DoCompare(Item1, Item2: TCoreClassObject): integer; override;
+  public
+    property CompareInfo: pointer read FCompareInfo write FCompareInfo;
+    // Use CompareMethod if you want to specify a compare method as stand-alone method
+    property CompareMethod: TItemCompareMethod read FCompareMethod write FCompareMethod;
+    // Use OnCompare if you want to specify a compare method as a method of a class
+    property OnCompare: TItemCompareEvent read FOnCompare_ write FOnCompare_;
+  end;
+
+  TPoing2D_ = record
+    case byte of
+      0: (X, Y: double);
+      1: (Elem: array [0 .. 1] of double);
+  end;
+
+  PPoing2D_ = ^TPoing2D_;
+
+  TTriangle2D_ = class;
+  TTriMesh2D_ = class;
+
+  // Basic 2D vertex class, containing an FPoint (TPoing2D_) field with X and Y coordinate.
+  TVertex2D_ = class(TCoreClassPersistent)
+  private
+    FPoint: TPoing2D_;
+    function GetX: double;
+    function GetY: double;
+    procedure SetX(const Value: double);
+    procedure SetY(const Value: double);
+    function GetPoint: PPoing2D_;
+  protected
+    function GetTriangle: TTriangle2D_; virtual; abstract;
+    procedure SetTriangle(const Value: TTriangle2D_); virtual; abstract;
+  public
+    constructor Create; virtual;
+    constructor CreateWithCoords(const AX, AY: double);
+    procedure Assign(Source: TCoreClassPersistent); override;
+    property X: double read GetX write SetX;
+    property Y: double read GetY write SetY;
+    property Point: PPoing2D_ read GetPoint;
+    // Reference back to the triangle this vertex belongs to. In fact, there can
+    // be many triangles this vertex belongs to, but this is one of them (not
+    // specified which one). If Triangle = nil, there is no reference yet.
+    property Triangle: TTriangle2D_ read GetTriangle write SetTriangle;
+  end;
+
+  TVertex2DClass_ = class of TVertex2D_;
+
+  TVertex2DList_ = class(TCoreClassObjectList)
+  private
+    function GetItems(Index: integer): TVertex2D_;
+    procedure SetItems(Index: integer; const Value: TVertex2D_);
+  public
+    property Items[Index: integer]: TVertex2D_ read GetItems write SetItems; default;
+  end;
+
+  // 2D vertex class with additional Triangle pointer
+  TTriVertex2D_ = class(TVertex2D_)
+  private
+    FTriangle: TTriangle2D_;
+  protected
+    function GetTriangle: TTriangle2D_; override;
+    procedure SetTriangle(const Value: TTriangle2D_); override;
+  public
+    procedure Assign(Source: TCoreClassPersistent); override;
+  end;
+
+  // A segment is a boundary that connects two vertices. When a segment is present
+  // the triangles bordering it cannot be swapped, thus constraining the triangulation
+  TSegment2D_ = class(TCoreClassPersistent)
+  private
+    FValidMetrics: boolean;
+    FVertex1: TVertex2D_;
+    FVertex2: TVertex2D_;
+    FCenter: TPoing2D_;
+    FNormal: TPoing2D_;
+    FSquaredEncroachRadius: double;
+    procedure SetVertex1(const Value: TVertex2D_);
+    procedure SetVertex2(const Value: TVertex2D_);
+    function GetCenter: TPoing2D_;
+    function GetSquaredEncroachRadius: double;
+    function GetNormal: TPoing2D_;
+  protected
+    procedure CalculateMetrics; virtual;
+  public
+    constructor CreateWithVertices(AVertex1, AVertex2: TVertex2D_);
+    procedure Assign(Source: TCoreClassPersistent); override;
+    procedure Invalidate;
+    // Replaces references in the segment to OldVertex by a reference to NewVertex.
+    procedure ReplaceVertex(OldVertex, NewVertex: TVertex2D_);
+    // Find the intersection point of us with ASegment, and create and return a vertex
+    // if it does, or nil if no intersection.
+    function IntersectWith(ASegment: TSegment2D_): TVertex2D_;
+    // Is AVertex lying on this segment? Use the passed precision as tolerance
+    // (pass the square of required precision)
+    function IsVertexOnSegment(AVertex: TVertex2D_; APrecisionSqr: double): boolean;
+    // Does point P encroach on this segment?
+    function PointEncroaches(const P: TPoing2D_): boolean;
+    // Reference to start vertex of this segment
+    property Vertex1: TVertex2D_ read FVertex1 write SetVertex1;
+    // Reference to end vertex of this segment
+    property Vertex2: TVertex2D_ read FVertex2 write SetVertex2;
+    // Center (midpoint) between the two vertices
+    property Center: TPoing2D_ read GetCenter;
+    // The normal of this segment. It points outwards from the graph, perpendicular
+    // to the segment, and is unit length
+    property Normal: TPoing2D_ read GetNormal;
+    // The encroach radius is slightly bigger (10%) than the actual radius of
+    // the segment's circle. This way, points encroach on it slightly quicker
+    // esp near segment endpoints.
+    property SquaredEncroachRadius: double read GetSquaredEncroachRadius;
+  end;
+
+  TSegment2DClass_ = class of TSegment2D_;
+
+  TSegment2DList_ = class(TCoreClassObjectList)
+  private
+    function GetItems(Index: integer): TSegment2D_;
+  public
+    property Items[Index: integer]: TSegment2D_ read GetItems; default;
+  end;
+
+  // hit-test result for hit-testing triangles
+  THitTestTriangle_ = (
+    httNone,   // Not on the triangle
+    httBody,   // On the body of the triangle
+    httVtx0,   // On or close to triangle's vertex 0
+    httVtx1,   // On or close to triangle's vertex 1
+    httVtx2,   // On or close to triangle's vertex 2
+    httEdge0,  // On the body, and on edge 0
+    httEdge1,  // On the body, and on edge 1
+    httEdge2,  // On the body, and on edge 2
+    httClose0, // Not on the body but close to edge 0
+    httClose1, // Not on the body but close to edge 1
+    httClose2  // Not on the body but close to edge 2
+    );
+
+  // Basic class for triangles that are present in a triangular 2D mesh
+  TTriangle2D_ = class(TCoreClassPersistent)
+  private
+    FVertices: array [0 .. 2] of TVertex2D_;
+    FNormals: array [0 .. 2] of TPoing2D_;
+    FNeighbours: array [0 .. 2] of TTriangle2D_;
+    FCenter: TPoing2D_;
+    FRegionIndex: integer;
+    function GetVertices(Index: integer): TVertex2D_;
+    procedure SetVertices(Index: integer; const Value: TVertex2D_);
+    function GetNeighbours(Index: integer): TTriangle2D_;
+    procedure SetNeighbours(Index: integer; const Value: TTriangle2D_);
+    function GetCenter: TPoing2D_;
+  protected
+    FValidMetrics: boolean;
+    FMesh: TTriMesh2D_; // pointer back to mesh
+    function GetSegments(Index: integer): TSegment2D_; virtual;
+    procedure SetSegments(Index: integer; const Value: TSegment2D_); virtual;
+    // Calcuate metrics for this triangle, may be overridden in descendants to
+    // calculate more metrics
+    procedure CalculateMetrics; virtual;
+    procedure InvalidateSegments;
+  public
+    constructor Create; virtual;
+    procedure Invalidate;
+    // Set the vertices a, b, c all at the same time
+    procedure HookupVertices(VertexA, VertexB, VertexC: TVertex2D_);
+    // Set the neighbours a, b, c all at the same time
+    procedure HookupNeighbours(TriangleA, TriangleB, TriangleC: TTriangle2D_);
+    // Replace the neighbour OldNeighbour (if we have it) by NewNeighbour
+    procedure ReplaceNeighbour(OldNeighbour, NewNeighbour: TTriangle2D_);
+    // Returns index 0, 1, or 2 if ATriangle is one of it's neighbours, or -1
+    // if ATriangle isn't
+    function NeighbourIndex(ATriangle: TTriangle2D_): integer;
+    // Returns index 0, 1, or 2 if AVertex is one of the vertices of ATriangle,
+    // or -1 if not
+    function VertexIndex(AVertex: TVertex2D_): integer;
+    // Returns index 0, 1, or 2 if ASegment is one of the segments of ATriangle,
+    // or -1 if not
+    function SegmentIndex(ASegment: TSegment2D_): integer;
+    // Hit-test the triangle with APoint, and return one of the hittest
+    // values.
+    function HitTest(const APoint: TPoing2D_): THitTestTriangle_;
+    // Returns the edge index of the edge that crosses the line when going from
+    // the center of this triangle to point APoint (and beyond).
+    function EdgeFromCenterTowardsPoint(const APoint: TPoing2D_): integer;
+    // Returns the signed area of this triangle (result is positive when triangle
+    // is defined counter-clockwise, and negative if clockwise).
+    function Area: double;
+    // Returns the cosine of the angle at vertex Index
+    function AngleCosine(Index: integer): double;
+    // Returns the cosine of the smallest angle in the triangle
+    function SmallestAngleCosine: double;
+    // Returns the square of the length of the longest edge
+    function SquaredLongestEdgeLength: double;
+    // References to the vertices of which this triangle consists. The vertices
+    // are numbered 0, 1, 2 (also referred to as a, b, c).
+    // The triangle must always be described in counterclockwise direction.
+    property Vertices[Index: integer]: TVertex2D_ read GetVertices write SetVertices;
+    // References to the neighbouring triangles, or nil if there is none at this location
+    // Neighbour 0 corresponds to the neighbour along edge ab, neighbour 1 to edge bc
+    // and neighbour 2 to edge ca.
+    property Neighbours[Index: integer]: TTriangle2D_ read GetNeighbours write SetNeighbours;
+    // Returns reference to the segment at edge Index. Segments are only actually
+    // added in a descendant class, so in the base class TTriangle2D_ nil is returned
+    property Segments[Index: integer]: TSegment2D_ read GetSegments write SetSegments;
+    // Returns center of triangle (3 points averaged)
+    property Center: TPoing2D_ read GetCenter;
+    // Index of the region this triangle belongs to, or -1 if none
+    property RegionIndex: integer read FRegionIndex write FRegionIndex;
+  end;
+
+  TTriangle2DClass_ = class of TTriangle2D_;
+
+  // List of triangles.
+  TTriangle2DList_ = class(TCoreClassObjectList)
+  private
+    function GetItems(Index: integer): TTriangle2D_;
+  public
+    property Items[Index: integer]: TTriangle2D_ read GetItems; default;
+  end;
+
+  // The object represents general triangle-edge group.
+  // Capacity will be increased when needed, but will never be reduced, to avoid memory fragmentation.
+  TTriangleGroup2D_ = class(TCoreClassPersistent)
+  private
+    FTriangles: array of TTriangle2D_;
+    FEdges: array of integer;
+    FCount: integer;
+    FCapacity: integer;
+    function GetTriangles(Index: integer): TTriangle2D_;
+  protected
+    function GetEdges(Index: integer): integer;
+    procedure SetEdges(Index: integer; const Value: integer);
+  public
+    procedure Clear; virtual;
+    // Add a triangle reference and edge index to the end of the list
+    procedure AddTriangleAndEdge(ATriangle: TTriangle2D_; AEdge: integer);
+    // Insert a triangle reference and edge index in the list at AIndex
+    procedure InsertTriangleAndEdge(AIndex: integer; ATriangle: TTriangle2D_; AEdge: integer);
+    // Delete triangle and edge at AIndex
+    procedure Delete(AIndex: integer);
+    // Exchange triangle/edge pairs at Index1 and Index2
+    procedure Exchange(Index1, Index2: integer);
+    // List of triangles in this triangle group
+    property Triangles[Index: integer]: TTriangle2D_ read GetTriangles;
+    // Number of triangles in the triangle group
+    property Count: integer read FCount;
+  end;
+
+  // Represents a fan of triangles around the Vertex. This class is used in linear searches.
+  TTriangleFan2D_ = class(TTriangleGroup2D_)
+  private
+    FCenter: TVertex2D_;
+    procedure SetCenter(const Value: TVertex2D_);
+    function GetVertices(Index: integer): TVertex2D_;
+  protected
+    procedure BuildTriangleFan(ABase: TTriangle2D_); virtual;
+  public
+    procedure Clear; override;
+    // Move the triangle fan to another center vertex that lies on the other end
+    // of the outgoing edge of triangle at AIndex
+    procedure MoveToVertexAt(AIndex: integer);
+    // Return the index of the triangle that might cover the point APoint
+    function TriangleIdxInDirection(const APoint: TPoing2D_): integer;
+    // Return the triangle that might cover the vertex AVertex
+    function TriangleInDirection(const APoint: TPoing2D_): TTriangle2D_;
+    // Runs through the Vertices array, and if a vertex matches, it's index is
+    // returned. If none matches, -1 is returned.
+    function VertexIndex(AVertex: TVertex2D_): integer;
+    // The center vertex of the triangle fan. Set Center to a vertex in the mesh
+    // and the triangle fan around it will be rebuilt. Center must have a pointer
+    // back to a triangle (it cannot be nil)
+    property Center: TVertex2D_ read FCenter write SetCenter;
+    // List of outward pointing edge indices in this triangle fan
+    property OutwardEdges[Index: integer]: integer read GetEdges;
+    // Vertices at the other end of the outward pointing edge at Index in the
+    // triangle fan
+    property Vertices[Index: integer]: TVertex2D_ read GetVertices;
+  end;
+
+  // A triangle chain between vertex1 and vertex2
+  TTriangleChain2D_ = class(TTriangleGroup2D_)
+  private
+    FVertex1, FVertex2: TVertex2D_;
+  public
+    // Build a triangle chain from Vertex1 to Vertex2. For searching, use ASearchFan
+    // if assigned, or use temporary search fan if nil. If a chain was found,
+    // the function result is true
+    function BuildChain(AVertex1, AVertex2: TVertex2D_; var ASearchFan: TTriangleFan2D_): boolean;
+    // List of edge indices in this triangle chain.. the edge index points to the
+    // edge crossing the line from Vertex1 to Vertex2, except for the last one,
+    // where it indicates the index of Vertex2.
+    property Edges[Index: integer]: integer read GetEdges write SetEdges;
+  end;
+
+  // A mesh consisting of triangles and vertices, where each triangle contains reference to 3 vertices.
+  TTriMesh2D_ = class(TCoreClassPersistent)
+  private
+    FPrecision: double;
+    FVertices: TVertex2DList_;
+    FTriangles: TTriangle2DList_;
+    FSegments: TSegment2DList_;
+    FSearchSteps: integer;
+    // comparison function to sort triagles by Center.X, smallest values first
+    function TriangleCompareLeft(Item1, Item2: TCoreClassObject; Info: pointer): integer;
+  protected
+    FPrecisionSqr: double;
+    procedure SetPrecision(const Value: double); virtual;
+    // Create a new vertex of correct class
+    function NewVertex: TVertex2D_;
+    class function GetVertexClass: TVertex2DClass_; virtual;
+    // Create a new triangle of correct class
+    function NewTriangle: TTriangle2D_;
+    class function GetTriangleClass: TTriangle2DClass_; virtual;
+    // Create a new segment of correct class
+    function NewSegment: TSegment2D_;
+    class function GetSegmentClass: TSegment2DClass_; virtual;
+    // Initialize info properties
+    procedure InitializeInfo; virtual;
+  public
+    constructor Create; virtual;
+    destructor Destroy; override;
+    // Clear the mesh
+    procedure Clear; virtual;
+    // Create a convex hull around all the vertices in the mesh
+    procedure ConvexHull;
+    // Optimize the mesh for usage in a finite element method. The triangle list
+    // is sorted such that the triangles form a long chain going up and down from
+    // left to right, and all vertices used are placed in the AVertices list, which
+    // is also sorted by usage in the triangles. Thus, vertices connected to each
+    // other usually are also have an index relatively close in the Vertices list,
+    // which accomplishes that the finite element matrix is more banded than with
+    // a random distribution (and gauss elimination works faster). The AVertices
+    // array must be initialized, it will be cleared and then filled with all
+    // vertices used by the triangles.
+    procedure OptimizeForFEM(AVertices: TVertex2DList_);
+    // Remove all segments that are non-functional (e.g. vertex pointers are nil,
+    // or vertex1 and vertex2 point to the same vertex)
+    procedure RemoveNonSegments;
+    // Get the min and max location of the mesh. Returns false if there are no
+    // vertices
+    function BoundingBox(var AMin, AMax: TPoing2D_): boolean;
+    // Returns the sum of all triangle's absolute area
+    function AbsoluteArea: double;
+    // Returns the sum of all triangle's signed area
+    function SignedArea: double;
+    // Locate the vertex that is closest to APoint. The function returns the closest
+    // vertex from the vertex list to APoint. If there are no vertices in the list,
+    // nil is returned. The basic algorithm is a linear search but this can
+    // be overridden in descendants (to implement e.g. a quadtree approach).
+    // A TTriangleFan2D_ object can be passed in Fan to speed up searching.
+    function LocateClosestVertex(const APoint: TPoing2D_;
+      AFan: TTriangleFan2D_ = nil): TVertex2D_; virtual;
+    // List of vertices used in this mesh
+    property Vertices: TVertex2DList_ read FVertices;
+    // List of triangles used in this mesh
+    property Triangles: TTriangle2DList_ read FTriangles;
+    // List of segments used in this mesh
+    property Segments: TSegment2DList_ read FSegments;
+    // Precision used when generating mesh. If a point lies within precision
+    // from a triangle edge, it is considered to be on it, the edge will be
+    // split instead of the body.
+    // When a vertex lays within Precision of another vertex, no new triangle
+    // will be created, thus the vertex is skipped (not triangulated).
+    property Precision: double read FPrecision write SetPrecision;
+    // Number of search steps performed in linear search.
+    property SearchSteps: integer read FSearchSteps;
+  end;
+
+  TTriMesh2DClass_ = class of TTriMesh2D_;
+
+  TConvexHull_ = class(TCoreClassPersistent)
+  private
+    FMesh: TTriMesh2D_;
+    // Add a new segment in the hull, using vertices with Idx1, Idx2
+    procedure AddSegment(Idx1, Idx2: integer);
+    // Is the vertex AVertex left of line V1-V2? (looking from point V1)
+    function IsLeftOfLine(const V1, V2, AVertex: TVertex2D_): boolean;
+    // Does AVertex violate ASegment (outside of it?)
+    function SegmentViolated(ASegment: TSegment2D_; AVertex: TVertex2D_): boolean;
+    // Add a new vertex to the hull. This updates the hull segments if the
+    // vertex falls outside of them
+    procedure AddVertexToHull(AVertex: TVertex2D_);
+  public
+    procedure MakeConvexHull(AMesh: TTriMesh2D_);
+  end;
+
+  // Class encapsulating 2D Planar Straightline Graphs (PSLG)
+  TGraph2D_ = class(TCoreClassPersistent)
+  private
+    FVertices: TVertex2DList_;
+    FSegments: TSegment2DList_;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear; virtual;
+    // Replaces references in the segment list to OldVertex by a reference to
+    // NewVertex.
+    procedure ReplaceVertex(OldVertex, NewVertex: TVertex2D_);
+    // List of vertices in this PSLG
+    property Vertices: TVertex2DList_ read FVertices;
+    // List of segments in this PSLG
+    property Segments: TSegment2DList_ read FSegments;
+  end;
+
+  // A Segment Triangle contains references for each edge to a segment, or nil
+  // if there is no graph segment for this edge.
+  TSegmentTriangle2D_ = class(TTriangle2D_)
+  private
+    FSegments: array [0 .. 2] of TSegment2D_;
+  protected
+    function GetSegments(Index: integer): TSegment2D_; override;
+    procedure SetSegments(Index: integer; const Value: TSegment2D_); override;
+  end;
+
+  TMeshRegion_ = class(TCoreClassObject)
+  private
+    FWindingNumber: integer;
+    FIsOuterRegion: boolean;
+  public
+    // Winding number of this region
+    property WindingNumber: integer read FWindingNumber write FWindingNumber;
+    // This region is the outer region (only one)
+    property IsOuterRegion: boolean read FIsOuterRegion write FIsOuterRegion;
+  end;
+
+  TMeshRegionList_ = class(TCoreClassObjectList)
+  private
+    function GetItems(Index: integer): TMeshRegion_;
+  public
+    property Items[Index: integer]: TMeshRegion_ read GetItems; default;
+  end;
+
+  TTriangulationEvent = procedure(Sender: TCoreClassObject; const AMessage: SystemString) of object;
+
+  // Which triangles should be removed after triangulation?
+  TRemovalStyle_ = (
+    rsNone,    // Remove no triagles
+    rsOutside, // Remove all triangles that are connected to construction vertices
+    rsEvenOdd, // Even-Odd fillrule removal
+    rsNonZero, // Non-Zero fillrule removal
+    rsNegative // Remove all triangles with windingnumber < 0
+    );
+
+  // Triangulates a polygon or other Planar Straightline Graphs (PSLG) into a triangular mesh.
+  TTriangulationMesh2D_ = class(TTriMesh2D_)
+  private
+    FCornerPoints: TVertex2DList_;
+    FRemovals: TTriangle2DList_;
+    FRegions: TMeshRegionList_;
+    FSegmentChain: TTriangleChain2D_;
+    FSearchFan: TTriangleFan2D_;
+    FTick: TTimeTick;
+    FVertexSkipCount: integer;
+    FSplitEdgeCount: integer;
+    FSplitBodyCount: integer;
+    FHitTests: integer;
+    FAreaInitial: double;
+    FCalculationTime: double;
+    FOnExecutionStep: TTriangulationEvent;
+    FOnPhaseComplete: TTriangulationEvent;
+    FOnStatus: TTriangulationEvent;
+  protected
+    FBBMin, FBBMax: TPoing2D_;
+    FMeshMin, FMeshMax: TPoing2D_;
+    class function GetTriangleClass: TTriangle2DClass_; override;
+    // perform the execution step event
+    procedure DoExecutionStep(const AMessage: SystemString);
+    // perform phase complete event
+    procedure DoPhaseComplete(const AMessage: SystemString);
+    // perform status event
+    procedure DoStatus(const AMessage: SystemString);
+    // Replace OldVertex by NewVertex in all segments
+    procedure ReplaceVertexInSegments(Old_, New_: TVertex2D_);
+    // Prepare the mesh so it can triangulate vertices by adding 4 corner points
+    // and 2 initial triangles
+    procedure PrepareMeshConstruction; virtual;
+    // Remove the mesh construction elements that were created initially
+    procedure RemoveMeshConstruction(ARemovalStyle: TRemovalStyle_); virtual;
+    // Detect all the regions in the mesh, give each triangle a region index
+    procedure DetectRegions; virtual;
+    // Add another segment to the triangulation
+    function AddSegmentToTriangulation(ASegment: TSegment2D_): boolean;
+    // Add another vertex to the triangulation, subsequently dividing the mesh.
+    // When False is returned, the vertex was not added (it fell on top of another vertex)
+    function AddVertexToTriangulation(AVertex: TVertex2D_; Updates: TTriangle2DList_): boolean; virtual;
+    // Split the triangle into 3 sub-triangles, at point AVertex on the body. The
+    // point is guaranteed to lie on the triangle prior before calling this
+    // method.
+    procedure SplitTriangleBody(ATriangle: TTriangle2D_; AVertex: TVertex2D_; Updates: TTriangle2DList_);
+    // Split the triangle into 2 on the edge (with AEdge index) at AVertex, and do the same with the triangle opposing the edge.
+    // In some rare cases, this might lead to degenerate triangles at the opposing edge,
+    // in this case the triangle's body is split. AVertex is guaranteed to lie in the triangle, or just on the edge.
+    procedure SplitTriangleEdge(ATriangle: TTriangle2D_; AEdge: integer; AVertex: TVertex2D_; Updates: TTriangle2DList_);
+    // Hittest the triangle list to find the triangle under the position where
+    // AVertex is located. If a triangle was hit, it is returned in the ATriangle.
+    // Result indicates where the triangle was hit. If ATriangle contains a
+    // reference upon calling, it will be used as an initial guess. Set UseQuick
+    // to true if the ATriangle input is expected to be far away from the hit,
+    // or set to False if ATriangle is probably the one hit. If called with
+    // UseQuick = false, ATriangle *must* be assigned!
+    function HitTestTriangles(const APoint: TPoing2D_; var ATriangle: TTriangle2D_; UseQuick: boolean): THitTestTriangle_;
+    // This routine can be called when separate triangle groups in the mesh may be no longer
+    // connected (after removal). Since the normal method relies on connectedness,
+    // it can fail. This method is *much* slower, simply verifies each triangle,
+    // but guarantees a result is returned in these odd cases.
+    function BruteForceHitTestTriangles(const APoint: TPoing2D_; var ATriangle: TTriangle2D_): THitTestTriangle_;
+    // Do post-processing on the mesh.
+    procedure PostProcessMesh; virtual;
+    // Check triangle after it was inserted, the AEdge indicates the edge number
+    // for which neighbours need to be checked.
+    procedure CheckTriangleWithEdge(ATriangle: TTriangle2D_; AEdge: integer; Updates: TTriangle2DList_); virtual;
+    // Generate a list of triangles that occur around AVertex. The list AList will
+    // be cleared before this is done. AVertex should have a valid pointer to
+    // one of the triangles it belongs to. If the result is false, AVertex didn't
+    // have a pointer, or it was an invalid pointer.
+    function BuildTriangleFan(AList: TTriangle2DList_; AVertex: TVertex2D_): boolean;
+    // Remove ATriangle from the mesh. This also resets the neighbours so they
+    // do not point to the triangle. ATriangle will be disposed of.
+    procedure RemoveTriangleFromMesh(ATriangle: TTriangle2D_);
+    // Reduce the chain by swapping triangles. Since this is a delaunay action,
+    // we do not implement it here but in descendant.
+    procedure ReduceSegmentChain(AChain: TTriangleChain2D_; ARemovals: TTriangle2DList_); virtual;
+    // Initialize info properties
+    procedure InitializeInfo; override;
+    // Finalize info properties
+    procedure FinalizeInfo; virtual;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    // Clear all vertices, triangles and segments in the mesh, and initialize
+    // all statistics.
+    procedure Clear; override;
+    // Add the vertices and segments of AGraph to our mesh. This doesn't triangulate
+    // them yet, call Triangulate to triangulate all the graphs that have been added.
+    procedure AddGraph(AGraph: TGraph2D_); virtual;
+    // Triangulate the graphs that were added with AddGraph, by adding all the
+    // vertices and segments in turn to the mesh. Before this is done, the mesh
+    // is cleared and 4 corner points are added well outside the polygon's
+    // bounding box. Between these 4 points, 2 initial triangles are added.
+    // After the triangulation finishes, but before post-processing, the bounding
+    // corners + triangles not part of the final mesh will be removed, unless
+    // ARemovalStyle = rsNone.
+    procedure Triangulate(ARemovalStyle: TRemovalStyle_ = rsOutside);
+    // List of mesh regions. Regions have a winding number which indicates
+    // visibility according to fill rule
+    property Regions: TMeshRegionList_ read FRegions;
+    // Number of vertices skipped in triangulation. Skipping happens because sometimes
+    // vertices may lay almost on top of other vertices (within Precision), and
+    // these vertices will be skipped.
+    property VertexSkipCount: integer read FVertexSkipCount;
+    // Number of triangle body splits that occurred in triangulation
+    property SplitBodyCount: integer read FSplitBodyCount;
+    // Number of triangle edge splits that occurred in triangulation
+    property SplitEdgeCount: integer read FSplitEdgeCount;
+    // The number of triangle hit tests performed.
+    property HitTests: integer read FHitTests;
+    // Initial area after creating the bounding box
+    property AreaInitial: double read FAreaInitial;
+    // Total time in seconds for triangulation (including postprocessing)
+    property CalculationTime: double read FCalculationTime;
+    // Connect an event to this handler to get information on each step in the execution
+    property OnExecutionStep: TTriangulationEvent read FOnExecutionStep write FOnExecutionStep;
+    // Connect an event to this handler to get information on completed phases
+    property OnPhaseComplete: TTriangulationEvent read FOnPhaseComplete write FOnPhaseComplete;
+    // Information for the status line (fast update rate)
+    property OnStatus: TTriangulationEvent read FOnStatus write FOnStatus;
+  end;
+
+  TDelaunayTriangle2D_ = class(TSegmentTriangle2D_)
+  private
+    FSquaredRadius: double;
+    FCircleCenter: TPoing2D_;
+    function GetCircleCenter: TPoing2D_;
+    function GetSquaredRadius: double;
+  protected
+    procedure CalculateMetrics; override;
+  public
+    // Test whether AVertex lies within the Delaunay circle of this triangle
+    function VertexInCircle(AVertex: TVertex2D_): boolean;
+    // Check if this triangle is in fact abiding the delaunay criterium (no neighbouring
+    // triangle's opposite points inside the circle going through its 3 vertices)
+    function IsDelaunay: boolean;
+    // Returns the Delaunay circle center of this triangle
+    property CircleCenter: TPoing2D_ read GetCircleCenter;
+    // Returns the squared radius of the Delaunay circle of this triangle
+    property SquaredRadius: double read GetSquaredRadius;
+  end;
+
+  TQualityTriangle2D_ = class(TDelaunayTriangle2D_)
+  private
+    FQuality: double;
+    function GetOffCenter: TPoing2D_;
+  protected
+    function GetQuality: double; virtual;
+    procedure CalculateMetrics; override;
+  public
+    // Does this triangle have an encroached segment?
+    function HasEncroachedSegment: boolean;
+    // Return the segment that is encroached due to APoint, or nil if none
+    function EncroachedSegmentFromPoint(const APoint: TPoing2D_): TSegment2D_;
+    // Calculate and return the OffCenter point for this triangle
+    property OffCenter: TPoing2D_ read GetOffCenter;
+    // Quality is defined as the smallest angle cosine. Larger values mean worse quality
+    property Quality: double read GetQuality;
+  end;
+
+  TSortedTriangle2DList_ = class(TCustomSortedList)
+  private
+    function GetItems(Index: integer): TQualityTriangle2D_;
+  protected
+    function DoCompare(Item1, Item2: TCoreClassObject): integer; override;
+  public
+    property Items[Index: integer]: TQualityTriangle2D_ read GetItems; default;
+  end;
+
+  TEncroachItem_ = class(TCoreClassObject)
+  private
+    FSegment: TSegment2D_;
+    FEncroacher: TTriangle2D_;
+    FTriangle: TTriangle2D_;
+  public
+    // The triangle that encroaches upon the segment
+    property Encroacher: TTriangle2D_ read FEncroacher write FEncroacher;
+    // The segment that was encroached
+    property Segment: TSegment2D_ read FSegment write FSegment;
+    // The triangle that connects to the encroached segment
+    property Triangle: TTriangle2D_ read FTriangle write FTriangle;
+  end;
+
+  TEncroachItemList_ = class(TCustomSortedList)
+  private
+    function GetItems(Index: integer): TEncroachItem_;
+  protected
+    function DoCompare(Item1, Item2: TCoreClassObject): integer; override;
+  public
+    // Add a new item if not yet present. AEncroacher is the triangle causing
+    // the encroach, ATriangle is the triangle having a segment ASegment that is
+    // encroached
+    procedure AddItem(AEncroacher, ATriangle: TTriangle2D_; ASegment: TSegment2D_);
+    // Return the index of an item that has ATriangle as triangle, or -1 if none
+    function IndexByTriangle(ATriangle: TTriangle2D_): integer;
+    // Remove all items that have ATriangle as Encroacher or Triangle
+    procedure RemoveAllItemsWithTriangle(ATriangle: TTriangle2D_);
+    procedure RemoveAllItemsWithSegment(ASegment: TSegment2D_);
+    property Items[Index: integer]: TEncroachItem_ read GetItems; default;
+  end;
+
+  // TDelaunayMesh2D_ implements a delaunay triangulation of a polygon or point cloud.
+  TDelaunayMesh2D_ = class(TTriangulationMesh2D_)
+  private
+    FSwapCount: integer;
+    FCircleCalcCount: integer;
+    FDelaunayPrecision: double;
+  protected
+    procedure SetPrecision(const Value: double); override;
+    class function GetTriangleClass: TTriangle2DClass_; override;
+    // Check triangle after it was inserted, the AEdge indicates the edge number
+    // for which neighbours need to be checked. See if we need to swap this
+    // triangle.
+    procedure CheckTriangleWithEdge(ATriangle: TTriangle2D_; AEdge: integer;
+      Updates: TTriangle2DList_); override;
+    // The T1 and T2 triangles should swap their common edge. However, this may not
+    // be done under some circumstances. This check should evaluate these. For the
+    // standard Delaunay this check ensures the triangles form a convex hull, and
+    // that they are not constrained by a segment.
+    function AllowSwapTriangles(T1, T2: TTriangle2D_; E1, E2: integer): boolean; virtual;
+    // Reduce the chain by swapping triangle pairs
+    procedure ReduceSegmentChain(AChain: TTriangleChain2D_; ARemovals: TTriangle2DList_); override;
+    // Do the actual swap of triangle T1 and T2 along edges E1 and E2. This function
+    // does *not* check if the swap may be made, see AllowSwapTriangles for the
+    // check.
+    procedure SwapTriangles(T1, T2: TTriangle2D_; E1, E2: integer; Updates: TTriangle2DList_);
+    procedure InitializeInfo; override;
+  public
+    // Count the number of triangles that do not abide Delaunay
+    function NonDelaunayTriangleCount: integer;
+    // Check whether all triangles abide Delaunay
+    function IsDelaunay: boolean;
+    // Iterate through the triangles and try to force the non-delaunay ones
+    // to adapt. This method can be called after completion of Triangulate. It
+    // makes no sense to call this method more than once, unless changes are made
+    // to the mesh (the procedure already contains a loop). The return is the new
+    // number of non-delaunay triangles.
+    function ForceDelaunay: integer;
+    // Number of triangle swaps that occurred during triangulation
+    property SwapCount: integer read FSwapCount;
+    // Number of circle calculations that occurred during triangulation. A
+    // circle calculation is used to determine the circle through the 3 points
+    // of a triangle.
+    property CircleCalcCount: integer read FCircleCalcCount;
+  end;
+
+  TQualityMesh2D_ = class(TDelaunayMesh2D_)
+  private
+    FBadTriangles: TSortedTriangle2DList_; // List of bad triangles
+    FEncroached: TEncroachItemList_;       // List of encroached segments + info
+    FUpdates: TTriangle2DList_;
+    FSteinerPoints: TVertex2DList_;
+    FSquaredBeta: double;
+    FBeta: double;
+    FMinimumAngleDeg: double;
+    FMinimumAngleCos: double;
+    FMinimumSegmentLength: double;
+    FMinSegLengthSqr: double;
+    FMaximumElementSize: double;
+    procedure SetBeta(const Value: double);
+    procedure SetMinimumAngle(const Value: double);
+    procedure SetMinimumSegmentLength(const Value: double);
+  protected
+    class function GetTriangleClass: TTriangle2DClass_; override;
+    // Post process the mesh: in this process we subdivide the triangles and
+    // add Steiner points.
+    procedure PostProcessMesh; override;
+    procedure BuildBadTriangleList; virtual;
+    procedure ProcessBadTriangleList; virtual;
+    procedure UpdateLists; virtual;
+    procedure SplitEncroachedSegment(AItem: TEncroachItem_); virtual;
+    procedure SplitBadTriangle(ATriangle: TQualityTriangle2D_; TestOnly: boolean); virtual;
+    function IsDegenerate(ASegment: TSegment2D_): boolean;
+    // Is this a bad triangle? (its smallest angle is smaller than the minimum set)
+    function IsBadTriangle(ATriangle: TQualityTriangle2D_): boolean;
+  public
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure Clear; override;
+    // Refines the mesh locally around X, Y until the element under X,Y is not
+    // larger than AMaximumElementSize
+    procedure LocalRefine(const X, Y, AMaximumElementSize: double);
+    // Returns the minimum angle found in the mesh, in degrees.
+    function MinimumAngleInMesh: double;
+    // Number of degenerate triangles present in the mesh (due to segment angles
+    // being too small)
+    function DegenerateTriangleCount: integer;
+    // Specify the minimum angle in degrees that may appear within each triangle in the
+    // quality triangulation. The practical upper limit for this value is around 33 degrees.
+    property MinimumAngle: double read FMinimumAngleDeg write SetMinimumAngle;
+    // If segments are to be split, this will not be done if the resulting segments'
+    // length is smaller than this value.
+    property MinimumSegmentLength: double read FMinimumSegmentLength write SetMinimumSegmentLength;
+    // Maximum element size allowed (triangles with larger area will be split).
+    // If no maximum size is required, then leave this value on 0 (default)
+    property MaximumElementSize: double read FMaximumElementSize write FMaximumElementSize;
+    // List of steiner points that were generated
+    property SteinerPoints: TVertex2DList_ read FSteinerPoints;
+  end;

contrib/CoreCipher/Source/TextDataEngine.pas

@@ -0,0 +1,810 @@
+{ ****************************************************************************** }
+{ * ini text library,writen by QQ 600585@qq.com                                * }
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+(*
+  update history
+  2017-12-6
+  performance optimization
+*)
+
+unit TextDataEngine;
+
+{$INCLUDE zDefine.inc}
+
+interface
+
+uses SysUtils, Variants,
+  CoreClasses,
+  UnicodeMixedLib,
+  PascalStrings,
+  ListEngine,
+  MemoryStream64;
+
+type
+  THashTextEngine = class(TCoreClassObject)
+  private
+    FComment: TCoreClassStrings;
+    FSectionList, FSectionHashVariantList, FSectionHashStringList: THashObjectList;
+    FAutoUpdateDefaultValue: Boolean;
+    FSectionPoolSize, FListPoolSize: Integer;
+
+    function GetNames(n: SystemString): TCoreClassStrings;
+    procedure SetNames(n: SystemString; const Value: TCoreClassStrings);
+    function GetHitVariant(SName, VName: SystemString): Variant;
+    procedure SetHitVariant(SName, VName: SystemString; const Value: Variant);
+    function GetHitString(SName, VName: SystemString): SystemString;
+    procedure SetHitString(SName, VName: SystemString; const Value: SystemString);
+
+    // return override state
+    function GetHVariantList(n: SystemString): THashVariantList;
+    function GetHStringList(n: SystemString): THashStringList;
+    procedure AddDataSection(aSection: SystemString; TextList: TCoreClassStrings);
+  public
+    constructor Create; overload;
+    constructor Create(SectionPoolSize_: Integer); overload;
+    constructor Create(SectionPoolSize_, ListPoolSize_: Integer); overload;
+    destructor Destroy; override;
+
+    procedure Rebuild;
+    procedure Clear;
+    procedure Delete(n: SystemString);
+
+    function Exists(n: SystemString): Boolean;
+
+    function GetDefaultValue(const SectionName, KeyName: SystemString; const DefaultValue: Variant): Variant;
+    procedure SetDefaultValue(const SectionName, KeyName: SystemString; const Value: Variant);
+
+    function GetDefaultText(const SectionName, KeyName: SystemString; const DefaultValue: SystemString): SystemString;
+    procedure SetDefaultText(const SectionName, KeyName: SystemString; const Value: SystemString);
+
+    // import section
+    function DataImport(TextList: TCoreClassStrings): Boolean; overload;
+    function DataImport(TextList: TListPascalString): Boolean; overload;
+
+    // export section
+    procedure DataExport(TextList: TCoreClassStrings); overload;
+    procedure DataExport(TextList: TListPascalString); overload;
+
+    procedure Merge(sour: THashTextEngine);
+    procedure Assign(sour: THashTextEngine);
+    function Same(sour: THashTextEngine): Boolean;
+
+    procedure LoadFromStream(stream: TCoreClassStream);
+    procedure SaveToStream(stream: TCoreClassStream);
+
+    procedure LoadFromFile(FileName: SystemString);
+    procedure SaveToFile(FileName: SystemString);
+
+    function TotalCount: NativeInt;
+    function MaxSectionNameLen: Integer;
+    function MinSectionNameLen: Integer;
+
+    function GetAsText: SystemString;
+    procedure SetAsText(const Value: SystemString);
+    property AsText: SystemString read GetAsText write SetAsText;
+
+    procedure GetSectionList(dest: TCoreClassStrings); overload;
+    procedure GetSectionList(dest: TListString); overload;
+    procedure GetSectionList(dest: TListPascalString); overload;
+    function GetSectionObjectName(_Obj: THashVariantList): SystemString; overload;
+    function GetSectionObjectName(_Obj: THashStringList): SystemString; overload;
+
+    property AutoUpdateDefaultValue: Boolean read FAutoUpdateDefaultValue write FAutoUpdateDefaultValue;
+
+    property Comment: TCoreClassStrings read FComment write FComment;
+
+    property Hit[SName, VName: SystemString]: Variant read GetHitVariant write SetHitVariant; default;
+    property HitVariant[SName, VName: SystemString]: Variant read GetHitVariant write SetHitVariant;
+    property HitString[SName, VName: SystemString]: SystemString read GetHitString write SetHitString;
+
+    property Names[n: SystemString]: TCoreClassStrings read GetNames write SetNames;
+    property Strings[n: SystemString]: TCoreClassStrings read GetNames write SetNames;
+
+    property VariantList[n: SystemString]: THashVariantList read GetHVariantList;
+    property HVariantList[n: SystemString]: THashVariantList read GetHVariantList;
+    property StringList[n: SystemString]: THashStringList read GetHStringList;
+    property HStringList[n: SystemString]: THashStringList read GetHStringList;
+  end;
+
+  TTextDataEngine = THashTextEngine;
+  TSectionTextData = THashTextEngine;
+
+implementation
+
+function THashTextEngine.GetNames(n: SystemString): TCoreClassStrings;
+var
+  h: THashVariantTextStream;
+begin
+  if not FSectionList.Exists(n) then
+      FSectionList[n] := TCoreClassStringList.Create;
+
+  if FSectionHashVariantList.Exists(n) then
+    begin
+      Result := TCoreClassStringList.Create;
+      h := THashVariantTextStream.Create(THashVariantList(FSectionHashVariantList[n]));
+      h.DataExport(Result);
+      DisposeObject(h);
+
+      FSectionList[n] := Result;
+    end;
+
+  Result := TCoreClassStrings(FSectionList[n]);
+end;
+
+procedure THashTextEngine.SetNames(n: SystemString; const Value: TCoreClassStrings);
+var
+  ns: TCoreClassStrings;
+begin
+  ns := TCoreClassStringList.Create;
+  ns.Assign(Value);
+  FSectionList[n] := ns;
+  FSectionHashVariantList.Delete(n);
+end;
+
+function THashTextEngine.GetHitVariant(SName, VName: SystemString): Variant;
+var
+  nsl: TCoreClassStrings;
+  vl: THashVariantList;
+  vt: THashVariantTextStream;
+begin
+  Result := Null;
+  vl := THashVariantList(FSectionHashVariantList[SName]);
+  if vl = nil then
+    begin
+      nsl := Names[SName];
+      if nsl = nil then
+          Exit;
+      if nsl.Count = 0 then
+          Exit;
+      vl := THashVariantList.CustomCreate(FListPoolSize);
+      vl.AutoUpdateDefaultValue := AutoUpdateDefaultValue;
+
+      vt := THashVariantTextStream.Create(vl);
+      vt.DataImport(nsl);
+      DisposeObject(vt);
+
+      FSectionHashVariantList[SName] := vl;
+    end;
+  Result := vl[VName];
+end;
+
+procedure THashTextEngine.SetHitVariant(SName, VName: SystemString; const Value: Variant);
+var
+  nsl: TCoreClassStrings;
+  vl: THashVariantList;
+  vt: THashVariantTextStream;
+begin
+  vl := THashVariantList(FSectionHashVariantList[SName]);
+  if vl = nil then
+    begin
+      vl := THashVariantList.CustomCreate(FListPoolSize);
+      vl.AutoUpdateDefaultValue := AutoUpdateDefaultValue;
+
+      nsl := Names[SName];
+      if nsl <> nil then
+        begin
+          vt := THashVariantTextStream.Create(vl);
+          vt.DataImport(nsl);
+          DisposeObject(vt);
+        end;
+      FSectionHashVariantList[SName] := vl;
+    end;
+  vl[VName] := Value;
+end;
+
+function THashTextEngine.GetHitString(SName, VName: SystemString): SystemString;
+var
+  nsl: TCoreClassStrings;
+  sl: THashStringList;
+  st: THashStringTextStream;
+begin
+  Result := '';
+  sl := THashStringList(FSectionHashStringList[SName]);
+  if sl = nil then
+    begin
+      nsl := Names[SName];
+      if nsl = nil then
+          Exit;
+      if nsl.Count = 0 then
+          Exit;
+      sl := THashStringList.CustomCreate(FListPoolSize);
+      sl.AutoUpdateDefaultValue := AutoUpdateDefaultValue;
+
+      st := THashStringTextStream.Create(sl);
+      st.DataImport(nsl);
+      DisposeObject(st);
+
+      FSectionHashStringList[SName] := sl;
+    end;
+  Result := sl[VName];
+end;
+
+procedure THashTextEngine.SetHitString(SName, VName: SystemString; const Value: SystemString);
+var
+  nsl: TCoreClassStrings;
+  sl: THashStringList;
+  st: THashStringTextStream;
+begin
+  sl := THashStringList(FSectionHashStringList[SName]);
+  if sl = nil then
+    begin
+      sl := THashStringList.CustomCreate(FListPoolSize);
+      sl.AutoUpdateDefaultValue := AutoUpdateDefaultValue;
+
+      nsl := Names[SName];
+      if nsl <> nil then
+        begin
+          st := THashStringTextStream.Create(sl);
+          st.DataImport(nsl);
+          DisposeObject(st);
+        end;
+      FSectionHashStringList[SName] := sl;
+    end;
+  sl[VName] := Value;
+end;
+
+function THashTextEngine.GetHVariantList(n: SystemString): THashVariantList;
+var
+  nsl: TCoreClassStrings;
+  vt: THashVariantTextStream;
+begin
+  Result := THashVariantList(FSectionHashVariantList[n]);
+  if Result = nil then
+    begin
+      Result := THashVariantList.CustomCreate(FListPoolSize);
+      Result.AutoUpdateDefaultValue := FAutoUpdateDefaultValue;
+      nsl := Names[n];
+      if nsl <> nil then
+        begin
+          vt := THashVariantTextStream.Create(Result);
+          vt.DataImport(nsl);
+          DisposeObject(vt);
+        end;
+
+      FSectionHashVariantList[n] := Result;
+    end;
+end;
+
+function THashTextEngine.GetHStringList(n: SystemString): THashStringList;
+var
+  nsl: TCoreClassStrings;
+  st: THashStringTextStream;
+begin
+  Result := THashStringList(FSectionHashStringList[n]);
+  if Result = nil then
+    begin
+      Result := THashStringList.CustomCreate(FListPoolSize);
+      Result.AutoUpdateDefaultValue := FAutoUpdateDefaultValue;
+      nsl := Names[n];
+      if nsl <> nil then
+        begin
+          st := THashStringTextStream.Create(Result);
+          st.DataImport(nsl);
+          DisposeObject(st);
+        end;
+
+      FSectionHashStringList[n] := Result;
+    end;
+end;
+
+procedure THashTextEngine.AddDataSection(aSection: SystemString; TextList: TCoreClassStrings);
+begin
+  while (TextList.Count > 0) and (TextList[0] = '') do
+      TextList.Delete(0);
+  while (TextList.Count > 0) and (TextList[TextList.Count - 1] = '') do
+      TextList.Delete(TextList.Count - 1);
+
+  FSectionList.Add(aSection, TextList);
+end;
+
+constructor THashTextEngine.Create;
+begin
+  Create(10, 10);
+end;
+
+constructor THashTextEngine.Create(SectionPoolSize_: Integer);
+begin
+  Create(SectionPoolSize_, 16);
+end;
+
+constructor THashTextEngine.Create(SectionPoolSize_, ListPoolSize_: Integer);
+begin
+  inherited Create;
+  FSectionPoolSize := SectionPoolSize_;
+  FListPoolSize := ListPoolSize_;
+
+  FComment := TCoreClassStringList.Create;
+  FSectionList := THashObjectList.CustomCreate(True, FSectionPoolSize);
+  FSectionHashVariantList := THashObjectList.CustomCreate(True, FSectionPoolSize);
+  FSectionHashStringList := THashObjectList.CustomCreate(True, FSectionPoolSize);
+  FAutoUpdateDefaultValue := False;
+end;
+
+destructor THashTextEngine.Destroy;
+begin
+  Clear;
+  DisposeObject(FSectionList);
+  DisposeObject(FSectionHashVariantList);
+  DisposeObject(FSectionHashStringList);
+  DisposeObject(FComment);
+  inherited Destroy;
+end;
+
+procedure THashTextEngine.Rebuild;
+var
+  i: Integer;
+  tmpSecLst: TListPascalString;
+  nsl: TCoreClassStrings;
+  hv: THashVariantTextStream;
+  hs: THashStringTextStream;
+begin
+  tmpSecLst := TListPascalString.Create;
+
+  if FSectionHashVariantList.Count > 0 then
+    begin
+      FSectionHashVariantList.GetListData(tmpSecLst);
+      for i := 0 to tmpSecLst.Count - 1 do
+        begin
+          nsl := TCoreClassStringList.Create;
+          hv := THashVariantTextStream.Create(THashVariantList(tmpSecLst.Objects[i]));
+          hv.DataExport(nsl);
+          DisposeObject(hv);
+          FSectionList[tmpSecLst[i]] := nsl;
+        end;
+      FSectionHashVariantList.Clear;
+    end;
+
+  if FSectionHashStringList.Count > 0 then
+    begin
+      FSectionHashStringList.GetListData(tmpSecLst);
+      for i := 0 to tmpSecLst.Count - 1 do
+        begin
+          nsl := TCoreClassStringList.Create;
+          hs := THashStringTextStream.Create(THashStringList(tmpSecLst.Objects[i]));
+          hs.DataExport(nsl);
+          DisposeObject(hs);
+          FSectionList[tmpSecLst[i]] := nsl;
+        end;
+      FSectionHashStringList.Clear;
+    end;
+
+  DisposeObject(tmpSecLst);
+end;
+
+procedure THashTextEngine.Clear;
+begin
+  FSectionList.Clear;
+  FSectionHashVariantList.Clear;
+  FSectionHashStringList.Clear;
+  FComment.Clear;
+end;
+
+procedure THashTextEngine.Delete(n: SystemString);
+begin
+  FSectionList.Delete(n);
+  FSectionHashVariantList.Delete(n);
+  FSectionHashStringList.Delete(n);
+end;
+
+function THashTextEngine.Exists(n: SystemString): Boolean;
+begin
+  Result := FSectionList.Exists(n) or FSectionHashVariantList.Exists(n) or FSectionHashStringList.Exists(n);
+end;
+
+function THashTextEngine.GetDefaultValue(const SectionName, KeyName: SystemString; const DefaultValue: Variant): Variant;
+begin
+  Result := VariantList[SectionName].GetDefaultValue(KeyName, DefaultValue);
+end;
+
+procedure THashTextEngine.SetDefaultValue(const SectionName, KeyName: SystemString; const Value: Variant);
+begin
+  Hit[SectionName, KeyName] := Value;
+end;
+
+function THashTextEngine.GetDefaultText(const SectionName, KeyName: SystemString; const DefaultValue: SystemString): SystemString;
+begin
+  Result := HStringList[SectionName].GetDefaultValue(KeyName, DefaultValue);
+end;
+
+procedure THashTextEngine.SetDefaultText(const SectionName, KeyName: SystemString; const Value: SystemString);
+begin
+  HitString[SectionName, KeyName] := Value;
+end;
+
+function THashTextEngine.DataImport(TextList: TCoreClassStrings): Boolean;
+var
+  i: Integer;
+  ln: U_String;
+  nsect: SystemString;
+  ntLst: TCoreClassStrings;
+begin
+  // merge section
+  Rebuild;
+
+  // import new section
+  ntLst := nil;
+  nsect := '';
+  Result := False;
+  if Assigned(TextList) then
+    begin
+      if TextList.Count > 0 then
+        begin
+          i := 0;
+          while i < TextList.Count do
+            begin
+              ln := umlTrimChar(TextList[i], ' ');
+              if (ln.Len > 0) and (ln.First = '[') and (ln.Last = ']') then
+                begin
+                  if Result then
+                      AddDataSection(nsect, ntLst);
+                  ntLst := TCoreClassStringList.Create;
+                  nsect := umlGetFirstStr(ln, '[]').Text;
+                  Result := True;
+                end
+              else if Result then
+                begin
+                  ntLst.Append(ln);
+                end
+              else
+                begin
+                  if (ln.Len > 0) and (not CharIn(ln.First, [';'])) then
+                      FComment.Append(ln);
+                end;
+              inc(i);
+            end;
+          if Result then
+              AddDataSection(nsect, ntLst);
+        end;
+
+      while (FComment.Count > 0) and (FComment[0] = '') do
+          FComment.Delete(0);
+      while (FComment.Count > 0) and (FComment[FComment.Count - 1] = '') do
+          FComment.Delete(FComment.Count - 1);
+    end;
+end;
+
+function THashTextEngine.DataImport(TextList: TListPascalString): Boolean;
+var
+  i: Integer;
+  ln: U_String;
+  nsect: SystemString;
+  ntLst: TCoreClassStrings;
+begin
+  // merge section
+  Rebuild;
+
+  // import new section
+  ntLst := nil;
+  nsect := '';
+  Result := False;
+  if Assigned(TextList) then
+    begin
+      if TextList.Count > 0 then
+        begin
+          i := 0;
+          while i < TextList.Count do
+            begin
+              ln := TextList[i].TrimChar(' ');
+              if (ln.Len > 0) and (ln.First = '[') and (ln.Last = ']') then
+                begin
+                  if Result then
+                      AddDataSection(nsect, ntLst);
+                  ntLst := TCoreClassStringList.Create;
+                  nsect := umlGetFirstStr(ln, '[]').Text;
+                  Result := True;
+                end
+              else if Result then
+                begin
+                  ntLst.Append(ln);
+                end
+              else
+                begin
+                  if (ln.Len > 0) and (not CharIn(ln.First, [';'])) then
+                      FComment.Append(ln);
+                end;
+              inc(i);
+            end;
+          if Result then
+              AddDataSection(nsect, ntLst);
+        end;
+
+      while (FComment.Count > 0) and (FComment[0] = '') do
+          FComment.Delete(0);
+      while (FComment.Count > 0) and (FComment[FComment.Count - 1] = '') do
+          FComment.Delete(FComment.Count - 1);
+    end;
+end;
+
+procedure THashTextEngine.DataExport(TextList: TCoreClassStrings);
+var
+  i: Integer;
+  tmpSecLst: TListPascalString;
+  nsl: TCoreClassStrings;
+begin
+  Rebuild;
+
+  TextList.AddStrings(FComment);
+  if FComment.Count > 0 then
+      TextList.Append('');
+
+  tmpSecLst := TListPascalString.Create;
+
+  FSectionList.GetListData(tmpSecLst);
+  if tmpSecLst.Count > 0 then
+    for i := 0 to tmpSecLst.Count - 1 do
+      if (tmpSecLst.Objects[i] is TCoreClassStrings) then
+        begin
+          nsl := TCoreClassStrings(tmpSecLst.Objects[i]);
+          if nsl <> nil then
+            begin
+              TextList.Append('[' + tmpSecLst[i] + ']');
+              TextList.AddStrings(nsl);
+              TextList.Append('');
+            end;
+        end;
+
+  DisposeObject(tmpSecLst);
+end;
+
+procedure THashTextEngine.DataExport(TextList: TListPascalString);
+var
+  i: Integer;
+  tmpSecLst: TListPascalString;
+  nsl: TCoreClassStrings;
+begin
+  Rebuild;
+
+  TextList.AddStrings(FComment);
+  if FComment.Count > 0 then
+      TextList.Append('');
+
+  tmpSecLst := TListPascalString.Create;
+
+  FSectionList.GetListData(tmpSecLst);
+  if tmpSecLst.Count > 0 then
+    for i := 0 to tmpSecLst.Count - 1 do
+      if (tmpSecLst.Objects[i] is TCoreClassStrings) then
+        begin
+          nsl := TCoreClassStrings(tmpSecLst.Objects[i]);
+          if nsl <> nil then
+            begin
+              TextList.Append('[' + tmpSecLst[i].Text + ']');
+              TextList.AddStrings(nsl);
+              TextList.Append('');
+            end;
+        end;
+
+  DisposeObject(tmpSecLst);
+end;
+
+procedure THashTextEngine.Merge(sour: THashTextEngine);
+var
+  ns: TCoreClassStringList;
+begin
+  try
+    Rebuild;
+    ns := TCoreClassStringList.Create;
+    sour.Rebuild;
+    sour.DataExport(ns);
+    DataImport(ns);
+    DisposeObject(ns);
+    Rebuild;
+  except
+  end;
+end;
+
+procedure THashTextEngine.Assign(sour: THashTextEngine);
+var
+  ns: TCoreClassStringList;
+begin
+  try
+    ns := TCoreClassStringList.Create;
+    sour.Rebuild;
+    sour.DataExport(ns);
+    Clear;
+    DataImport(ns);
+    DisposeObject(ns);
+  except
+  end;
+end;
+
+function THashTextEngine.Same(sour: THashTextEngine): Boolean;
+var
+  i: Integer;
+  ns: TCoreClassStringList;
+  n: SystemString;
+begin
+  Result := False;
+  Rebuild;
+  sour.Rebuild;
+
+  // if Comment.Text <> sour.Comment.Text then
+  // Exit;
+
+  if FSectionList.Count <> sour.FSectionList.Count then
+      Exit;
+
+  ns := TCoreClassStringList.Create;
+
+  for i := 0 to ns.Count - 1 do
+    begin
+      n := ns[i];
+      if not sour.Exists(n) then
+        begin
+          DisposeObject(ns);
+          Exit;
+        end;
+    end;
+
+  for i := 0 to ns.Count - 1 do
+    begin
+      n := ns[i];
+      if not SameText(Strings[n].Text, sour.Strings[n].Text) then
+        begin
+          DisposeObject(ns);
+          Exit;
+        end;
+    end;
+
+  DisposeObject(ns);
+  Result := True;
+end;
+
+procedure THashTextEngine.LoadFromStream(stream: TCoreClassStream);
+var
+  n: TListPascalString;
+begin
+  Clear;
+  n := TListPascalString.Create;
+  n.LoadFromStream(stream);
+  DataImport(n);
+  DisposeObject(n);
+end;
+
+procedure THashTextEngine.SaveToStream(stream: TCoreClassStream);
+var
+  n: TListPascalString;
+begin
+  n := TListPascalString.Create;
+  DataExport(n);
+  n.SaveToStream(stream);
+  DisposeObject(n);
+end;
+
+procedure THashTextEngine.LoadFromFile(FileName: SystemString);
+var
+  m64: TMemoryStream64;
+begin
+  m64 := TMemoryStream64.Create;
+  try
+      m64.LoadFromFile(FileName);
+  except
+    DisposeObject(m64);
+    Exit;
+  end;
+
+  try
+      LoadFromStream(m64);
+  finally
+      DisposeObject(m64);
+  end;
+end;
+
+procedure THashTextEngine.SaveToFile(FileName: SystemString);
+var
+  m64: TMemoryStream64;
+begin
+  m64 := TMemoryStream64.Create;
+  try
+    SaveToStream(m64);
+    m64.SaveToFile(FileName);
+  finally
+      DisposeObject(m64);
+  end;
+end;
+
+function THashTextEngine.TotalCount: NativeInt;
+var
+  i: Integer;
+  tmpSecLst: TListPascalString;
+begin
+  Result := 0;
+  tmpSecLst := TListPascalString.Create;
+
+  FSectionList.GetListData(tmpSecLst);
+  if tmpSecLst.Count > 0 then
+    for i := 0 to tmpSecLst.Count - 1 do
+      if (not FSectionHashVariantList.Exists(tmpSecLst[i])) and (not FSectionHashStringList.Exists(tmpSecLst[i])) then
+          inc(Result, TCoreClassStrings(tmpSecLst.Objects[i]).Count);
+
+  FSectionHashVariantList.GetListData(tmpSecLst);
+  if tmpSecLst.Count > 0 then
+    for i := 0 to tmpSecLst.Count - 1 do
+        inc(Result, THashVariantList(tmpSecLst.Objects[i]).Count);
+
+  FSectionHashStringList.GetListData(tmpSecLst);
+  if tmpSecLst.Count > 0 then
+    for i := 0 to tmpSecLst.Count - 1 do
+        inc(Result, THashStringList(tmpSecLst.Objects[i]).Count);
+
+  DisposeObject(tmpSecLst);
+end;
+
+function THashTextEngine.MaxSectionNameLen: Integer;
+begin
+  Result := umlMax(FSectionList.HashList.MaxNameLen,
+    umlMax(FSectionHashVariantList.HashList.MaxNameLen, FSectionHashStringList.HashList.MaxNameLen));
+end;
+
+function THashTextEngine.MinSectionNameLen: Integer;
+begin
+  Result := umlMin(FSectionList.HashList.MinNameLen,
+    umlMin(FSectionHashVariantList.HashList.MinNameLen, FSectionHashStringList.HashList.MinNameLen));
+end;
+
+function THashTextEngine.GetAsText: SystemString;
+var
+  ns: TCoreClassStringList;
+begin
+  ns := TCoreClassStringList.Create;
+  DataExport(ns);
+  Result := ns.Text;
+  DisposeObject(ns);
+end;
+
+procedure THashTextEngine.SetAsText(const Value: SystemString);
+var
+  ns: TListPascalString;
+begin
+  Clear;
+
+  ns := TListPascalString.Create;
+  ns.Text := Value;
+  DataImport(ns);
+  DisposeObject(ns);
+end;
+
+procedure THashTextEngine.GetSectionList(dest: TCoreClassStrings);
+begin
+  Rebuild;
+  FSectionList.GetListData(dest);
+end;
+
+procedure THashTextEngine.GetSectionList(dest: TListString);
+begin
+  Rebuild;
+  FSectionList.GetListData(dest);
+end;
+
+procedure THashTextEngine.GetSectionList(dest: TListPascalString);
+begin
+  Rebuild;
+  FSectionList.GetListData(dest);
+end;
+
+function THashTextEngine.GetSectionObjectName(_Obj: THashVariantList): SystemString;
+begin
+  Result := FSectionHashVariantList.GetObjAsName(_Obj);
+end;
+
+function THashTextEngine.GetSectionObjectName(_Obj: THashStringList): SystemString;
+begin
+  Result := FSectionHashStringList.GetObjAsName(_Obj);
+end;
+
+end.

contrib/CoreCipher/Source/clear_with_dcu.bat

@@ -0,0 +1,26 @@
+del/s *.dcu
+del/s *.o
+del/s *.ppu
+del/s *.rsm
+del/s *.replay
+del/s *.loginpackage
+del/s *.dres
+del/s *.local
+del/s *.identcache
+del/s *.stat
+del/s *.tvsconfig
+del/s *.deployproj
+del/s *.stat
+rem del/s *.pdb
+rem del/s *.exp
+rem del/s zAI\*.pdb
+rem del/s zAI\*.obj
+rem del/s zAI\*.lib
+rem del/s zAI\*.tlog
+rem del/s zAI\*.db
+rem rd/q/s zAI\AI_Build\cuda\dlib_build\dlib\Debug
+rem rd/q/s zAI\AI_Build\cuda\dlib_build\dlib\Release
+rem rd/q/s zAI\AI_Build\cuda\dlib_build\dlib\x64
+rem rd/q/s zAI\AI_Build\cuda\Debug
+rem rd/q/s zAI\AI_Build\cuda\Release
+rem rd/q/s zAI\AI_Build\cuda\x64

contrib/CoreCipher/Source/md5_32.asm

@@ -0,0 +1,211 @@
+;{ ****************************************************************************** }
+;{ * https://zpascal.net                                                        * }
+;{ * https://github.com/PassByYou888/zAI                                        * }
+;{ * https://github.com/PassByYou888/ZServer4D                                  * }
+;{ * https://github.com/PassByYou888/PascalString                               * }
+;{ * https://github.com/PassByYou888/zRasterization                             * }
+;{ * https://github.com/PassByYou888/CoreCipher                                 * }
+;{ * https://github.com/PassByYou888/zSound                                     * }
+;{ * https://github.com/PassByYou888/zChinese                                   * }
+;{ * https://github.com/PassByYou888/zExpression                                * }
+;{ * https://github.com/PassByYou888/zGameWare                                  * }
+;{ * https://github.com/PassByYou888/zAnalysis                                  * }
+;{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+;{ * https://github.com/PassByYou888/zTranslate                                 * }
+;{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+;{ * https://github.com/PassByYou888/FastMD5                                    * }
+;{ ****************************************************************************** }
+
+
+; MD5_386.Asm   -  386 optimized helper routine for calculating
+;                  MD Message-Digest values
+; written 2/2/94 by
+;
+; Peter Sawatzki
+; Buchenhof 3
+; D58091 Hagen, Germany Fed Rep
+;
+; EMail: Peter@Sawatzki.de
+; EMail: 100031.3002@compuserve.com
+; WWW:   http://www.sawatzki.de
+;
+;
+; original C Source was found in Dr. Dobbs Journal Sep 91
+; MD5 algorithm from RSA Data Security, Inc.
+
+
+; This is a 32-bit version of MD5_Transform
+; modifief by Maxim Masiutin for Borland 32-bit "register"
+; calling convention. For more information on this calling convension, see
+; https://en.wikipedia.org/wiki/X86_calling_conventions#Borland_register
+
+; You can compile this code using Microsoft Macro Assembler 
+;     ml.exe /c md5_32.asm
+; or using Borland Turbo Assembler
+;     tasm32.exe /m md5_32.asm
+
+           .386
+           .MODEL FLAT
+           .CODE
+
+FF Macro a,b,c,d,x,s,ac
+; a:= ROL (a+x+ac + (b And c Or Not b And d), s) + b
+  Add a, [EBp+(4*x)]
+  Add a, ac
+  Mov ESi, b
+  Not ESi
+  And ESi, d
+  Mov EDi, c
+  And EDi, b
+  Or  ESi, EDi
+  Add a, ESi
+  Rol a, s
+  Add a, b
+EndM
+
+GG Macro a,b,c,d,x,s,ac
+; a:= ROL (a+x+ac + (b And d Or c And Not d), s) + b
+  Add a, [EBp+(4*x)]
+  Add a, ac
+  Mov ESi, d
+  Not ESi
+  And ESi, c
+  Mov EDi, d
+  And EDi, b
+  Or  ESi, EDi
+  Add a, ESi
+  Rol a, s
+  Add a, b
+EndM
+
+HH Macro a,b,c,d,x,s,ac
+; a:= ROL (a+x+ac + (b Xor c Xor d), s) + b
+  Add a, [EBp+(4*x)]
+  Add a, ac
+  Mov ESi, d
+  Xor ESi, c
+  Xor ESi, b
+  Add a, ESi
+  Rol a, s
+  Add a, b
+EndM
+
+II Macro a,b,c,d,x,s,ac
+; a:= ROL (a+x+ac + (c Xor (b Or Not d)), s) + b
+  Add a, [EBp+(4*x)]
+  Add a, ac
+  Mov ESi, d
+  Not ESi
+  Or  ESi, b
+  Xor ESi, c
+  Add a, ESi
+  Rol a, s
+  Add a, b
+EndM
+
+MD5_Transform Proc
+Public MD5_Transform
+
+; Use 32-bit Borland Register calling convention
+; First Parameter in EAX
+; Second Paramerter in EDX
+
+; State buffer offset - in EAx
+; Message offset      - in EDx
+
+  Push EBx
+  Push ESi
+  Push EDi
+  Push EBp
+
+  Mov EBp, EDx        ; Now EBp holds Message offset
+  Push EAx     
+  Mov EDx, [EAx+12]
+  Mov ECx, [EAx+8]
+  Mov EBx, [EAx+4]
+  Mov EAx, [EAx]
+
+  FF EAx,EBx,ECx,EDx,  0,  7, 0d76aa478h  ; 1
+  FF EDx,EAx,EBx,ECx,  1, 12, 0e8c7b756h  ; 2
+  FF ECx,EDx,EAx,EBx,  2, 17, 0242070dbh  ; 3
+  FF EBx,ECx,EDx,EAx,  3, 22, 0c1bdceeeh  ; 4
+  FF EAx,EBx,ECx,EDx,  4,  7, 0f57c0fafh  ; 5
+  FF EDx,EAx,EBx,ECx,  5, 12, 04787c62ah  ; 6
+  FF ECx,EDx,EAx,EBx,  6, 17, 0a8304613h  ; 7
+  FF EBx,ECx,EDx,EAx,  7, 22, 0fd469501h  ; 8
+  FF EAx,EBx,ECx,EDx,  8,  7, 0698098d8h  ; 9
+  FF EDx,EAx,EBx,ECx,  9, 12, 08b44f7afh  ; 10
+  FF ECx,EDx,EAx,EBx, 10, 17, 0ffff5bb1h  ; 11
+  FF EBx,ECx,EDx,EAx, 11, 22, 0895cd7beh  ; 12
+  FF EAx,EBx,ECx,EDx, 12,  7, 06b901122h  ; 13
+  FF EDx,EAx,EBx,ECx, 13, 12, 0fd987193h  ; 14
+  FF ECx,EDx,EAx,EBx, 14, 17, 0a679438eh  ; 15
+  FF EBx,ECx,EDx,EAx, 15, 22, 049b40821h  ; 16
+
+  GG EAx,EBx,ECx,EDx,  1,  5, 0f61e2562h  ; 17
+  GG EDx,EAx,EBx,ECx,  6,  9, 0c040b340h  ; 18
+  GG ECx,EDx,EAx,EBx, 11, 14, 0265e5a51h  ; 19
+  GG EBx,ECx,EDx,EAx,  0, 20, 0e9b6c7aah  ; 20
+  GG EAx,EBx,ECx,EDx,  5,  5, 0d62f105dh  ; 21
+  GG EDx,EAx,EBx,ECx, 10,  9, 002441453h  ; 22
+  GG ECx,EDx,EAx,EBx, 15, 14, 0d8a1e681h  ; 23
+  GG EBx,ECx,EDx,EAx,  4, 20, 0e7d3fbc8h  ; 24
+  GG EAx,EBx,ECx,EDx,  9,  5, 021e1cde6h  ; 25
+  GG EDx,EAx,EBx,ECx, 14,  9, 0c33707d6h  ; 26
+  GG ECx,EDx,EAx,EBx,  3, 14, 0f4d50d87h  ; 27
+  GG EBx,ECx,EDx,EAx,  8, 20, 0455a14edh  ; 28
+  GG EAx,EBx,ECx,EDx, 13,  5, 0a9e3e905h  ; 29
+  GG EDx,EAx,EBx,ECx,  2,  9, 0fcefa3f8h  ; 30
+  GG ECx,EDx,EAx,EBx,  7, 14, 0676f02d9h  ; 31
+  GG EBx,ECx,EDx,EAx, 12, 20, 08d2a4c8ah  ; 32
+
+  HH EAx,EBx,ECx,EDx,  5,  4, 0fffa3942h  ; 33
+  HH EDx,EAx,EBx,ECx,  8, 11, 08771f681h  ; 34
+  HH ECx,EDx,EAx,EBx, 11, 16, 06d9d6122h  ; 35
+  HH EBx,ECx,EDx,EAx, 14, 23, 0fde5380ch  ; 36
+  HH EAx,EBx,ECx,EDx,  1,  4, 0a4beea44h  ; 37
+  HH EDx,EAx,EBx,ECx,  4, 11, 04bdecfa9h  ; 38
+  HH ECx,EDx,EAx,EBx,  7, 16, 0f6bb4b60h  ; 39
+  HH EBx,ECx,EDx,EAx, 10, 23, 0bebfbc70h  ; 40
+  HH EAx,EBx,ECx,EDx, 13,  4, 0289b7ec6h  ; 41
+  HH EDx,EAx,EBx,ECx,  0, 11, 0eaa127fah  ; 42
+  HH ECx,EDx,EAx,EBx,  3, 16, 0d4ef3085h  ; 43
+  HH EBx,ECx,EDx,EAx,  6, 23, 004881d05h  ; 44
+  HH EAx,EBx,ECx,EDx,  9,  4, 0d9d4d039h  ; 45
+  HH EDx,EAx,EBx,ECx, 12, 11, 0e6db99e5h  ; 46
+  HH ECx,EDx,EAx,EBx, 15, 16, 01fa27cf8h  ; 47
+  HH EBx,ECx,EDx,EAx,  2, 23, 0c4ac5665h  ; 48
+
+  II EAx,EBx,ECx,EDx,  0,  6, 0f4292244h  ; 49
+  II EDx,EAx,EBx,ECx,  7, 10, 0432aff97h  ; 50
+  II ECx,EDx,EAx,EBx, 14, 15, 0ab9423a7h  ; 51
+  II EBx,ECx,EDx,EAx,  5, 21, 0fc93a039h  ; 52
+  II EAx,EBx,ECx,EDx, 12,  6, 0655b59c3h  ; 53
+  II EDx,EAx,EBx,ECx,  3, 10, 08f0ccc92h  ; 54
+  II ECx,EDx,EAx,EBx, 10, 15, 0ffeff47dh  ; 55
+  II EBx,ECx,EDx,EAx,  1, 21, 085845dd1h  ; 56
+  II EAx,EBx,ECx,EDx,  8,  6, 06fa87e4fh  ; 57
+  II EDx,EAx,EBx,ECx, 15, 10, 0fe2ce6e0h  ; 58
+  II ECx,EDx,EAx,EBx,  6, 15, 0a3014314h  ; 59
+  II EBx,ECx,EDx,EAx, 13, 21, 04e0811a1h  ; 60
+  II EAx,EBx,ECx,EDx,  4,  6, 0f7537e82h  ; 61
+  II EDx,EAx,EBx,ECx, 11, 10, 0bd3af235h  ; 62
+  II ECx,EDx,EAx,EBx,  2, 15, 02ad7d2bbh  ; 63
+  II EBx,ECx,EDx,EAx,  9, 21, 0eb86d391h  ; 64
+
+  Pop ESi            
+  Add [ESi],    EAx
+  Add [ESi+4],  EBx
+  Add [ESi+8],  ECx
+  Add [ESi+12], EDx
+
+; restore the registers to comply to the calling convention
+  Pop EBp
+  Pop EDi
+  Pop ESi
+  Pop EBx
+
+  Ret
+MD5_Transform EndP
+
+  End

contrib/CoreCipher/Source/md5_64.asm

@@ -0,0 +1,409 @@
+;{ ****************************************************************************** }
+;{ * https://zpascal.net                                                        * }
+;{ * https://github.com/PassByYou888/zAI                                        * }
+;{ * https://github.com/PassByYou888/ZServer4D                                  * }
+;{ * https://github.com/PassByYou888/PascalString                               * }
+;{ * https://github.com/PassByYou888/zRasterization                             * }
+;{ * https://github.com/PassByYou888/CoreCipher                                 * }
+;{ * https://github.com/PassByYou888/zSound                                     * }
+;{ * https://github.com/PassByYou888/zChinese                                   * }
+;{ * https://github.com/PassByYou888/zExpression                                * }
+;{ * https://github.com/PassByYou888/zGameWare                                  * }
+;{ * https://github.com/PassByYou888/zAnalysis                                  * }
+;{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+;{ * https://github.com/PassByYou888/zTranslate                                 * }
+;{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+;{ * https://github.com/PassByYou888/FastMD5                                    * }
+;{ ****************************************************************************** }
+
+
+; MD5_Transform-x64
+; MD5 transform routine oprimized for x64 processors
+; Copyright 2018 Ritlabs, SRL
+; The 64-bit version is written by Maxim Masiutin <max@ritlabs.com>
+
+; The main advantage of this 64-bit version is that
+; it loads 64 bytes of hashed message into 8 64-bit registers 
+; (RBP, R8, R9, R10, R11, R12, R13, R14) at the beginning,
+; to avoid excessive memory load operations 
+; througout the routine.
+
+; To operate with 32-bit values store in higher bits
+; of a 64-bit register (bits 32-63) uses "Ror" by 32;
+; 8 macro variables (M1-M8) are used to keep record
+; or corrent state of whether the register has been
+; Ror'ed or not.
+
+; It also has an ability to use Lea instruction instead
+; of two sequental Adds (uncomment UseLea=1), but it is 
+; slower on Skylake processors. Also, Intel in the 
+; Optimization Reference Maual discourages us of
+; Lea as a replacement of two adds, since it is slower 
+; on the Atom processors.
+
+; MD5_Transform-x64 is released under a dual license, 
+; and you may choose to use it under either the 
+; Mozilla Public License 2.0 (MPL 2.1, available from
+; https://www.mozilla.org/en-US/MPL/2.0/) or the 
+; GNU Lesser General Public License Version 3, 
+; dated 29 June 2007 (LGPL 3, available from
+; https://www.gnu.org/licenses/lgpl.html).
+
+; MD5_Transform-x64 is based 
+; on the following code by Peter Sawatzki. 
+
+; The original notice by Peter Sawatzki follows.
+
+; ==============================================================
+;
+; MD5_386.Asm   -  386 optimized helper routine for calculating
+;                  MD Message-Digest values
+; written 2/2/94 by
+;
+; Peter Sawatzki
+; Buchenhof 3
+; D58091 Hagen, Germany Fed Rep
+;
+; EMail: Peter@Sawatzki.de
+; EMail: 100031.3002@compuserve.com
+; WWW:   http://www.sawatzki.de
+;
+;
+; original C Source was found in Dr. Dobbs Journal Sep 91
+; MD5 algorithm from RSA Data Security, Inc.
+
+
+
+           .CODE
+
+
+; You can compile this code using Microsoft Macro Assembler 
+;     ml64.exe /c md5_64.asm
+
+
+
+; Uncomment the line below if you wish to have 
+; a "Lea" instruction instead of two subsequent "Add".
+
+; UseLea=1
+
+
+
+; The AA macro adds r to ac to a and stores result to r
+; r and a can be either 32-bit (for the "Add" version) 
+; or 64-bit (for the "Lea" version)
+
+AA Macro r32,r64,ac,a32,a64
+  IFDEF UseLea
+     Lea r64, [r64+ac+a64]
+  ELSE
+     Add r32, ac
+     Add r32, a32
+  ENDIF
+EndM
+
+; The JJ macro adds value from state buffer to the "a" register
+; The "a" register can be either 32-bit (for the "Add" version) 
+; or 64-bit (for "Lea") - in this case it is passed as "r"
+
+JJ Macro a,x,ac,r
+IFE x
+  IF M1
+   Ror RBp, 32
+   M1=0
+  ENDIF
+   AA a, r, ac, EBp, RBp
+ENDIF
+IFE x-1
+  IFE M1
+   Ror RBp, 32
+   M1=1
+  ENDIF
+   AA a, r, ac, EBp, RBp
+ENDIF
+IFE x-2
+  IF M2
+   Ror R8, 32
+   M2=0
+  ENDIF
+   AA a, r, ac, R8d, R8
+ENDIF
+IFE x-3
+  IFE M2
+   Ror R8, 32
+   M2=1
+  ENDIF
+   AA a, r, ac, R8d, R8
+ENDIF
+IFE x-4
+  IF M3
+   Ror R9, 32
+   M3=0
+  ENDIF
+   AA a, r, ac, R9d, R9
+ENDIF
+IFE x-5
+  IFE M3
+   Ror R9, 32
+   M3=1
+  ENDIF
+   AA a, r, ac, R9d, R9
+ENDIF
+IFE x-6
+  IF M4
+   Ror R10, 32
+   M4=0
+  ENDIF
+   AA a, r, ac, R10d, R10
+ENDIF
+IFE x-7
+  IFE M4
+   Ror R10, 32
+   M4=1
+  ENDIF
+   AA a, r, ac, R10d, R10
+ENDIF
+IFE x-8
+  IF M5
+   Ror R11, 32
+   M5=0
+  ENDIF
+   AA a, r, ac, R11d, R11
+ENDIF
+IFE x-9
+  IFE M5
+   Ror R11, 32
+   M5=1
+  ENDIF
+   AA a, r, ac, R11d, R11
+ENDIF
+IFE x-10
+  IF M6
+   Ror R12, 32
+   M6=0
+  ENDIF
+   AA a, r, ac, R12d, R12
+ENDIF
+IFE x-11
+  IFE M6
+   Ror R12, 32
+   M6=1
+  ENDIF
+   AA a, r, ac, R12d, R12
+ENDIF
+IFE x-12
+  IF M7
+   Ror R13, 32
+   M7=0
+  ENDIF
+   AA a, r, ac, R13d, R13
+ENDIF
+IFE x-13
+  IFE M7
+   Ror R13, 32
+   M7=1
+  ENDIF
+   AA a, r, ac, R13d, R13
+ENDIF
+IFE x-14
+  IF M8
+   Ror R14, 32
+   M8=0
+  ENDIF
+   AA a, r, ac, R14d, R14
+ENDIF
+IFE x-15
+  IFE M8
+   Ror R14, 32
+   M8=1
+  ENDIF
+   AA a, r, ac, R14d, R14
+ENDIF
+EndM
+
+
+FF Macro a,b,c,d,x,s,ac,r
+; a:= ROL (a+x+ac + (b And c Or Not b And d), s) + b
+  JJ a, x, ac, r
+  Mov ESI, b
+  Not ESI
+  And ESI, d
+  Mov EDI, c
+  And EDI, b
+  Or  ESI, EDI
+  Add a, ESI
+  Rol a, s
+  Add a, b
+EndM
+
+GG Macro a,b,c,d,x,s,ac,r
+; a:= ROL (a+x+ac + (b And d Or c And Not d), s) + b
+  JJ a, x, ac, r
+  Mov ESI, d
+  Not ESI
+  And ESI, c
+  Mov EDI, d
+  And EDI, b
+  Or  ESI, EDI
+  Add a, ESI
+  Rol a, s
+  Add a, b
+EndM
+
+HH Macro a,b,c,d,x,s,ac,r
+; a:= ROL (a+x+ac + (b Xor c Xor d), s) + b
+  JJ a, x, ac, r
+  Mov ESI, d
+  Xor ESI, c
+  Xor ESI, b
+  Add a, ESI
+  Rol a, s
+  Add a, b
+EndM
+
+II Macro a,b,c,d,x,s,ac,r
+; a:= ROL (a+x+ac + (c Xor (b Or Not d)), s) + b
+  JJ a, x, ac, r
+  Mov ESI, d
+  Not ESI
+  Or  ESI, b
+  Xor ESI, c
+  Add a, ESI
+  Rol a, s
+  Add a, b
+EndM
+
+MD5_Transform Proc
+Public MD5_Transform
+
+; save registers that the caller requires to be restored
+  Push RBx
+  Push RSi
+  Push RDi
+
+  Push RBp
+  Push R12
+  Push R13
+  Push R14
+
+; First parameter is passed in RCX, Second - in RDX
+
+; State   - in RCX
+; Message - in RDX
+
+  M1 = 0
+  M2 = 0
+  M3 = 0
+  M4 = 0
+  M5 = 0
+  M6 = 0
+  M7 = 0
+  M8 = 0
+
+  Mov R14, RDX ; Now the message buffer offset is in R14
+
+  Mov RSi, Rcx ; Now state structure offset is in RSi
+  Push Rsi     ; State -> Stack
+  Mov EAx, [RSi]
+  Mov EBx, [RSi+4]
+  Mov ECx, [RSi+8]
+  Mov EDx, [RSi+12]
+
+  Mov RBP, [R14+4*0]
+  FF EAx,EBx,ECx,EDx,  0,  7, 0d76aa478h, RAx  ; 1
+  FF EDx,EAx,EBx,ECx,  1, 12, 0e8c7b756h, RDx  ; 2
+  Mov R8,  [R14+4*2]
+  FF ECx,EDx,EAx,EBx,  2, 17, 0242070dbh, RCx  ; 3
+  FF EBx,ECx,EDx,EAx,  3, 22, 0c1bdceeeh, RBx  ; 4
+  Mov R9,  [R14+4*4]
+  FF EAx,EBx,ECx,EDx,  4,  7, 0f57c0fafh, RAx  ; 5
+  FF EDx,EAx,EBx,ECx,  5, 12, 04787c62ah, RDx  ; 6
+  Mov R10, [R14+4*6]
+  FF ECx,EDx,EAx,EBx,  6, 17, 0a8304613h, RCx  ; 7
+  FF EBx,ECx,EDx,EAx,  7, 22, 0fd469501h, RBx  ; 8
+  Mov R11, [R14+4*8]
+  FF EAx,EBx,ECx,EDx,  8,  7, 0698098d8h, RAx  ; 9
+  FF EDx,EAx,EBx,ECx,  9, 12, 08b44f7afh, RDx  ; 10
+  Mov R12, [R14+4*10]
+  FF ECx,EDx,EAx,EBx, 10, 17, 0ffff5bb1h, RCx  ; 11
+  FF EBx,ECx,EDx,EAx, 11, 22, 0895cd7beh, RBx  ; 12
+  Mov R13, [R14+4*12]
+  FF EAx,EBx,ECx,EDx, 12,  7, 06b901122h, RAx  ; 13
+  FF EDx,EAx,EBx,ECx, 13, 12, 0fd987193h, RDx  ; 14
+  Mov R14, [R14+4*14]
+  FF ECx,EDx,EAx,EBx, 14, 17, 0a679438eh, RCx  ; 15
+  FF EBx,ECx,EDx,EAx, 15, 22, 049b40821h, RBx  ; 16
+
+  GG EAx,EBx,ECx,EDx,  1,  5, 0f61e2562h, RAx  ; 17
+  GG EDx,EAx,EBx,ECx,  6,  9, 0c040b340h, RDx  ; 18
+  GG ECx,EDx,EAx,EBx, 11, 14, 0265e5a51h, RCx  ; 19
+  GG EBx,ECx,EDx,EAx,  0, 20, 0e9b6c7aah, RBx  ; 20
+  GG EAx,EBx,ECx,EDx,  5,  5, 0d62f105dh, RAx  ; 21
+  GG EDx,EAx,EBx,ECx, 10,  9, 002441453h, RDx  ; 22
+  GG ECx,EDx,EAx,EBx, 15, 14, 0d8a1e681h, RCx  ; 23
+  GG EBx,ECx,EDx,EAx,  4, 20, 0e7d3fbc8h, RBx  ; 24
+  GG EAx,EBx,ECx,EDx,  9,  5, 021e1cde6h, RAx  ; 25
+  GG EDx,EAx,EBx,ECx, 14,  9, 0c33707d6h, RDx  ; 26
+  GG ECx,EDx,EAx,EBx,  3, 14, 0f4d50d87h, RCx  ; 27
+  GG EBx,ECx,EDx,EAx,  8, 20, 0455a14edh, RBx  ; 28
+  GG EAx,EBx,ECx,EDx, 13,  5, 0a9e3e905h, RAx  ; 29
+  GG EDx,EAx,EBx,ECx,  2,  9, 0fcefa3f8h, RDx  ; 30
+  GG ECx,EDx,EAx,EBx,  7, 14, 0676f02d9h, RCx  ; 31
+  GG EBx,ECx,EDx,EAx, 12, 20, 08d2a4c8ah, RBx  ; 32
+
+  HH EAx,EBx,ECx,EDx,  5,  4, 0fffa3942h, RAx  ; 33
+  HH EDx,EAx,EBx,ECx,  8, 11, 08771f681h, RDx  ; 34
+  HH ECx,EDx,EAx,EBx, 11, 16, 06d9d6122h, RCx  ; 35
+  HH EBx,ECx,EDx,EAx, 14, 23, 0fde5380ch, RBx  ; 36
+  HH EAx,EBx,ECx,EDx,  1,  4, 0a4beea44h, RAx  ; 37
+  HH EDx,EAx,EBx,ECx,  4, 11, 04bdecfa9h, RDx  ; 38
+  HH ECx,EDx,EAx,EBx,  7, 16, 0f6bb4b60h, RCx  ; 39
+  HH EBx,ECx,EDx,EAx, 10, 23, 0bebfbc70h, RBx  ; 40
+  HH EAx,EBx,ECx,EDx, 13,  4, 0289b7ec6h, RAx  ; 41
+  HH EDx,EAx,EBx,ECx,  0, 11, 0eaa127fah, RDx  ; 42
+  HH ECx,EDx,EAx,EBx,  3, 16, 0d4ef3085h, RCx  ; 43
+  HH EBx,ECx,EDx,EAx,  6, 23, 004881d05h, RBx  ; 44
+  HH EAx,EBx,ECx,EDx,  9,  4, 0d9d4d039h, RAx  ; 45
+  HH EDx,EAx,EBx,ECx, 12, 11, 0e6db99e5h, RDx  ; 46
+  HH ECx,EDx,EAx,EBx, 15, 16, 01fa27cf8h, RCx  ; 47
+  HH EBx,ECx,EDx,EAx,  2, 23, 0c4ac5665h, RBx  ; 48
+
+  II EAx,EBx,ECx,EDx,  0,  6, 0f4292244h, RAx  ; 49
+  II EDx,EAx,EBx,ECx,  7, 10, 0432aff97h, RDx  ; 50
+  II ECx,EDx,EAx,EBx, 14, 15, 0ab9423a7h, RCx  ; 51
+  II EBx,ECx,EDx,EAx,  5, 21, 0fc93a039h, RBx  ; 52
+  II EAx,EBx,ECx,EDx, 12,  6, 0655b59c3h, RAx  ; 53
+  II EDx,EAx,EBx,ECx,  3, 10, 08f0ccc92h, RDx  ; 54
+  II ECx,EDx,EAx,EBx, 10, 15, 0ffeff47dh, RCx  ; 55
+  II EBx,ECx,EDx,EAx,  1, 21, 085845dd1h, RBx  ; 56
+  II EAx,EBx,ECx,EDx,  8,  6, 06fa87e4fh, RAx  ; 57
+  II EDx,EAx,EBx,ECx, 15, 10, 0fe2ce6e0h, RDx  ; 58
+  II ECx,EDx,EAx,EBx,  6, 15, 0a3014314h, RCx  ; 59
+  II EBx,ECx,EDx,EAx, 13, 21, 04e0811a1h, RBx  ; 60
+  II EAx,EBx,ECx,EDx,  4,  6, 0f7537e82h, RAx  ; 61
+  II EDx,EAx,EBx,ECx, 11, 10, 0bd3af235h, RDx  ; 62
+  II ECx,EDx,EAx,EBx,  2, 15, 02ad7d2bbh, RCx  ; 63
+  II EBx,ECx,EDx,EAx,  9, 21, 0eb86d391h, RBx  ; 64
+
+  Pop RSi            ; get State pointer from stack
+  Add [RSi],    EAx
+  Add [RSi+4],  EBx
+  Add [RSi+8],  ECx
+  Add [RSi+12], EDx
+
+; restore volatile registers
+  Pop R14
+  Pop R13
+  Pop R12
+  Pop RBp
+
+  Pop RDi
+  Pop RSi
+  Pop RBx
+
+  Ret
+MD5_Transform EndP
+
+  End
+
+; That's All Folks!

contrib/CoreCipher/Source/zDefine.inc

@@ -0,0 +1,247 @@
+{ * https://zpascal.net                                                        * }
+{ * https://github.com/PassByYou888/zAI                                        * }
+{ * https://github.com/PassByYou888/ZServer4D                                  * }
+{ * https://github.com/PassByYou888/PascalString                               * }
+{ * https://github.com/PassByYou888/zRasterization                             * }
+{ * https://github.com/PassByYou888/CoreCipher                                 * }
+{ * https://github.com/PassByYou888/zSound                                     * }
+{ * https://github.com/PassByYou888/zChinese                                   * }
+{ * https://github.com/PassByYou888/zExpression                                * }
+{ * https://github.com/PassByYou888/zGameWare                                  * }
+{ * https://github.com/PassByYou888/zAnalysis                                  * }
+{ * https://github.com/PassByYou888/FFMPEG-Header                              * }
+{ * https://github.com/PassByYou888/zTranslate                                 * }
+{ * https://github.com/PassByYou888/InfiniteIoT                                * }
+{ * https://github.com/PassByYou888/FastMD5                                    * }
+{ ****************************************************************************** }
+
+{$IFDEF FPC}
+  {$IFDEF FPC_DELPHI_MODE}
+    {$MODE delphi}
+  {$ELSE FPC_DELPHI_MODE}
+    {$MODE objfpc}
+  {$ENDIF FPC_DELPHI_MODE}
+
+  {$MODESWITCH AdvancedRecords}
+  {$MODESWITCH NestedProcVars}
+  {$NOTES OFF}
+  {$STACKFRAMES OFF}
+  {$COPERATORS OFF}
+  {$GOTO ON}
+  {$INLINE ON}
+  {$MACRO OFF}
+
+  {$DEFINE LITTLE_ENDIAN}
+  {$UNDEF BIG_ENDIAN}
+  {$IFDEF FPC_BIG_ENDIAN}
+    {$UNDEF LITTLE_ENDIAN}
+    {$DEFINE BIG_ENDIAN}
+  {$ENDIF}
+
+  {$UNDEF FirstCharInZero}
+
+  {$UNDEF Delphi}
+
+  // nativeint as int or int64 type variable when Modifier is overload
+  {$UNDEF OVERLOAD_NATIVEINT}
+
+  // fast MD5 only delphi supported, https://github.com/PassByYou888/FastMD5
+  {$UNDEF FastMD5}
+
+  // stream is MemoryStream64 or MemoryStream, usage fastMD5 or PurePascal MD5
+  // be associate api: UnicodeMixedLib.umlStreamMD5, Fast_MD5.FastMD5
+  {$DEFINE OptimizationMemoryStreamMD5}
+
+  // multi thread Parallel switch.
+  {$DEFINE Parallel}
+
+  // Parallel for fold make better use CPU of multi core
+  // if rem this "FoldParallel" parallel for block program, thread can use linear address
+  {$DEFINE FoldParallel}
+
+  // MT19937 of seed in the startup TComputeThread is 0
+  {$DEFINE MT19937SeedOnTComputeThreadIs0}
+
+  // automated loading common AI data sets on boot-time
+  {$DEFINE Z_AI_Dataset_Build_In}
+
+  // With SMALL_RASTER_FONT_Build_In and LARGE_RASTER_FONT_Build_In, boot-time memory usage increase by 100M-200M and start-up time to be delay 100ms
+  {$DEFINE SMALL_RASTER_FONT_Build_In}
+  // {$DEFINE LARGE_RASTER_FONT_Build_In}
+
+  // ZDB_BACKUP is automatically made and replica caching is enabled.
+  // usage ZDB_BACKUP so slows the open of large size ZDB file, after time, but does is high performance.
+  // {$DEFINE ZDB_BACKUP}
+
+  // ZDB Flush() uses physical IO as the temp storage device
+  // {$DEFINE ZDB_PHYSICAL_FLUSH}
+
+  // used Critical Simulate Atomic with TMonitor.Enter(obj) and TMonitor.Exit(obj)
+  // CriticalSimulateAtomic defined so performance to be reduced
+  {$DEFINE CriticalSimulateAtomic}
+
+  // used soft Simulate Critical(ring)
+  // SoftCritical defined so performance to be reduced
+  // {$DEFINE SoftCritical}
+  // {$DEFINE ANTI_DEAD_ATOMIC_LOCK}
+
+  {$UNDEF debug}
+  {$DEFINE release}
+  {$DEFINE INLINE_ASM}
+  {$R-} { range check }
+{$ELSE FPC} { IF DELPHI }
+  {$DEFINE LITTLE_ENDIAN}
+  {$UNDEF BIG_ENDIAN}
+
+  {$IFDEF VER340}
+    {$UNDEF FirstCharInZero}
+  {$ELSE VER340}
+    {$IFDEF ANDROID}
+      {$DEFINE FirstCharInZero}
+    {$ENDIF ANDROID}
+
+    {$IFDEF IOS}
+      {$DEFINE FirstCharInZero}
+    {$ENDIF IOS}
+  {$ENDIF VER340}
+
+  {$DEFINE Delphi}
+
+  // nativeint as int or int64 type variable when Modifier is overload
+  {$DEFINE OVERLOAD_NATIVEINT}
+
+  // fast MD5 only delphi supported, https://github.com/PassByYou888/FastMD5
+  // {$DEFINE FastMD5}
+
+  // stream is MemoryStream64 or MemoryStream, usage fastMD5 or PurePascal MD5
+  // be associate api: UnicodeMixedLib.umlStreamMD5, Fast_MD5.FastMD5
+  {$DEFINE OptimizationMemoryStreamMD5}
+
+  // multi thread Parallel switch.
+  {$DEFINE Parallel}
+
+  // Parallel for fold make better use CPU of multi core
+  // if rem this "FoldParallel" is parallel for block program, thread can use linear address
+  {$DEFINE FoldParallel}
+
+  // Parallel programs use the delphi default TParallel
+  // {$DEFINE SystemParallel}
+
+  // paper: Mersenne Twister: A 623-dimensionallyequidistributed uniformpseudorandom number generator
+  // Using this paper replace of Delphi Random() and Randomize() function, work on xe 10.3 or laster
+  // {$DEFINE InstallMT19937CoreToDelphi}
+
+  // MT19937 of seed in the startup TComputeThread is 0
+  {$DEFINE MT19937SeedOnTComputeThreadIs0}
+
+  // automated loading common AI data sets on boot-time
+  // {$DEFINE Z_AI_Dataset_Build_In}
+
+  // With SMALL_RASTER_FONT_Build_In and LARGE_RASTER_FONT_Build_In, boot-time memory usage increase by 100M-200M and start-up time to be delay 100ms
+  // {$DEFINE SMALL_RASTER_FONT_Build_In}
+  // {$DEFINE LARGE_RASTER_FONT_Build_In}
+
+  // ZDB_BACKUP is automatically made and replica caching is enabled.
+  // usage ZDB_BACKUP so slows the open of large size ZDB file, after time, but does is high performance.
+  // {$DEFINE ZDB_BACKUP}
+
+  // ZDB Flush() uses physical IO as the temp storage device
+  // {$DEFINE ZDB_PHYSICAL_FLUSH}
+
+  // used Critical Simulate Atomic with TMonitor.Enter(obj) and TMonitor.Exit(obj)
+  // CriticalSimulateAtomic defined so performance to be reduced
+  // {$DEFINE CriticalSimulateAtomic}
+
+  // used soft Simulate Critical(ring)
+  // SoftCritical defined so performance to be reduced
+  // {$DEFINE SoftCritical}
+  // {$DEFINE ANTI_DEAD_ATOMIC_LOCK}
+
+  {$IFDEF release}
+    {$DEFINE INLINE_ASM}
+    {$R-} { range check }
+    {$I-} { Input output checking }
+    {$IF Defined(Android) or Defined(IOS)}
+      {$O-} { close optimization }
+    {$ELSE}
+      {$O+} { open optimization }
+      {$INLINE AUTO} { inline }
+    {$IFEND}
+  {$ELSE}
+    {$UNDEF INLINE_ASM}
+    {$O-} { close optimization }
+    {$R-} { range check }
+    {$I-} { Input output checking }
+    {$D+} { debug information }
+  {$ENDIF}
+
+  {$IF Defined(Android) or Defined(IOS)}
+    {$DEFINE SMALL_RASTER_FONT_Build_In}
+    {$DEFINE PhysicsIO_On_Indy}
+  {$ELSE}
+    // PhysicsIO interface
+    // {$DEFINE PhysicsIO_On_ICS}
+    {$DEFINE PhysicsIO_On_CrossSocket}
+    // {$DEFINE PhysicsIO_On_DIOCP}
+    // {$DEFINE PhysicsIO_On_Indy}
+    // {$DEFINE PhysicsIO_On_Synapse}
+  {$IFEND}
+
+  {$X+} { Extended syntax }
+  {$Z1} { Minimum enum size }
+{$ENDIF FPC}
+
+
+
+{$IFDEF DEBUG}
+  // initialization status prompt
+  {$DEFINE initializationStatus}
+  // warning prompt
+  {$WARNINGS ON}
+{$ELSE DEBUG}
+  // initialization status prompt
+  {$UNDEF initializationStatus}
+  // warning prompt
+  {$WARNINGS OFF}
+{$ENDIF DEBUG}
+
+{$HINTS OFF}
+{$C+} { Assertions }
+{$M-} { Run-Time Type Information }
+{$H+} { long string }
+{$A+} { Word Align Data }
+{$Q-} { Overflow checking }
+{$B-} { Complete boolean evaluation }
+{$J+} { Writeable typed constants }
+
+(*
+  Pointer math is simply treating any given typed pointer in some narrow,
+  instances as a scaled ordinal where you can perform simple arithmetic operations directly on the pointer variable.
+*)
+{$POINTERMATH OFF}
+
+{$UNDEF CPU64}
+
+{$IFDEF CPU64BITS}
+  {$DEFINE CPU64}
+{$ELSE CPU64BITS}
+  {$IFDEF CPUX64}
+    {$DEFINE CPU64}
+  {$ENDIF CPUX64}
+{$ENDIF CPU64BITS}
+
+{$IFNDEF CPU64}
+  {$DEFINE CPU32}
+{$ENDIF CPU64}
+
+{$IFDEF BIG_ENDIAN}
+  {$MESSAGE FATAL 'Big-endian system not supported'}
+{$ENDIF BIG_ENDIAN}
+
+{$IFOPT R+}
+  {$DEFINE RangeCheck}
+{$ENDIF}
+
+{$IFOPT Q+}
+  {$DEFINE OverflowCheck}
+{$ENDIF}