source upload

This commit is contained in:
Razor12911 2022-01-17 22:16:47 +02:00
parent 12936d065b
commit 098e8c48de
1778 changed files with 1206749 additions and 0 deletions

252
common/Threading.pas Normal file
View File

@ -0,0 +1,252 @@
unit Threading;
interface
uses
System.SysUtils, System.Classes;
type
TThreadStatus = (tsReady, tsRunning, tsErrored, tsTerminated);
EThreadException = class(Exception);
TTask = class(TThread)
private
FSync: Boolean;
FErrorMsg: string;
FStatus: TThreadStatus;
FProc0: TProc;
FProc1: TProc<IntPtr>;
FProc2: TProc<IntPtr, IntPtr>;
FProc3: TProc<IntPtr, IntPtr, IntPtr>;
FProc4: TProc<IntPtr, IntPtr, IntPtr, IntPtr>;
FArgs: array [0 .. 3] of IntPtr;
FStarted: Boolean;
public
constructor Create(Arg1: IntPtr = 0; Arg2: IntPtr = 0; Arg3: IntPtr = 0;
Arg4: IntPtr = 0);
destructor Destroy; override;
procedure Update(Arg1: IntPtr = 0; Arg2: IntPtr = 0; Arg3: IntPtr = 0;
Arg4: IntPtr = 0);
procedure Perform(const Proc: TProc); overload;
procedure Perform(const Proc: TProc<IntPtr>); overload;
procedure Perform(const Proc: TProc<IntPtr, IntPtr>); overload;
procedure Perform(const Proc: TProc<IntPtr, IntPtr, IntPtr>); overload;
procedure Perform(const Proc: TProc<IntPtr, IntPtr, IntPtr,
IntPtr>); overload;
procedure Execute; override;
procedure Start;
procedure Wait;
procedure RaiseLastError;
property Status: TThreadStatus read FStatus;
property Sync: Boolean read FSync write FSync;
end;
procedure WaitForAll(const Tasks: array of TTask);
function WaitForAny(const Tasks: array of TTask): Integer;
function IsErrored(const Tasks: array of TTask): Boolean;
implementation
constructor TTask.Create(Arg1, Arg2, Arg3, Arg4: IntPtr);
begin
inherited Create(True);
FSync := False;
FErrorMsg := '';
FStatus := tsReady;
FProc0 := nil;
FProc1 := nil;
FProc2 := nil;
FProc3 := nil;
FProc4 := nil;
FArgs[0] := Arg1;
FArgs[1] := Arg2;
FArgs[2] := Arg3;
FArgs[3] := Arg4;
FStarted := False;
end;
destructor TTask.Destroy;
begin
FStatus := tsTerminated;
inherited Destroy;
end;
procedure TTask.Update(Arg1, Arg2, Arg3, Arg4: IntPtr);
begin
FArgs[0] := Arg1;
FArgs[1] := Arg2;
FArgs[2] := Arg3;
FArgs[3] := Arg4;
end;
procedure TTask.Perform(const Proc: TProc);
begin
FProc0 := Proc;
FProc1 := nil;
FProc2 := nil;
FProc3 := nil;
FProc4 := nil;
end;
procedure TTask.Perform(const Proc: TProc<IntPtr>);
begin
FProc0 := nil;
FProc1 := Proc;
FProc2 := nil;
FProc3 := nil;
FProc4 := nil;
end;
procedure TTask.Perform(const Proc: TProc<IntPtr, IntPtr>);
begin
FProc0 := nil;
FProc1 := nil;
FProc2 := Proc;
FProc3 := nil;
FProc4 := nil;
end;
procedure TTask.Perform(const Proc: TProc<IntPtr, IntPtr, IntPtr>);
begin
FProc0 := nil;
FProc1 := nil;
FProc2 := nil;
FProc3 := Proc;
FProc4 := nil;
end;
procedure TTask.Perform(const Proc: TProc<IntPtr, IntPtr, IntPtr, IntPtr>);
begin
FProc0 := nil;
FProc1 := nil;
FProc2 := nil;
FProc3 := nil;
FProc4 := Proc;
end;
procedure TTask.Execute;
label
Restart;
begin
Restart:
while FStatus in [tsReady, tsErrored] do
Sleep(1);
try
if FStatus = tsRunning then
begin
if Assigned(FProc0) or Assigned(FProc1) or Assigned(FProc2) or
Assigned(FProc3) or Assigned(FProc4) then
begin
if FSync then
Self.Synchronize(
procedure
begin
if Assigned(FProc0) then
FProc0
else if Assigned(FProc1) then
FProc1(FArgs[0])
else if Assigned(FProc2) then
FProc2(FArgs[0], FArgs[1])
else if Assigned(FProc3) then
FProc3(FArgs[0], FArgs[1], FArgs[2])
else if Assigned(FProc4) then
FProc4(FArgs[0], FArgs[1], FArgs[2], FArgs[3]);
end)
else
begin
if Assigned(FProc0) then
FProc0
else if Assigned(FProc1) then
FProc1(FArgs[0])
else if Assigned(FProc2) then
FProc2(FArgs[0], FArgs[1])
else if Assigned(FProc3) then
FProc3(FArgs[0], FArgs[1], FArgs[2])
else if Assigned(FProc4) then
FProc4(FArgs[0], FArgs[1], FArgs[2], FArgs[3]);
end;
end;
FStatus := tsReady;
end;
except
on E: Exception do
begin
if E.Message <> '' then
FErrorMsg := E.Message
else
FErrorMsg := 'Unknown error';
FStatus := tsErrored;
end;
end;
if FStatus <> tsTerminated then
goto Restart;
end;
procedure TTask.Start;
begin
if not FStarted then
begin
FStarted := True;
inherited Start;
end;
FStatus := tsRunning;
end;
procedure TTask.Wait;
begin
while FStatus = tsRunning do
Sleep(1);
end;
procedure TTask.RaiseLastError;
begin
if FErrorMsg <> '' then
begin
raise EThreadException.Create(FErrorMsg);
FErrorMsg := '';
end;
end;
procedure WaitForAll(const Tasks: array of TTask);
var
I: Integer;
begin
for I := Low(Tasks) to High(Tasks) do
Tasks[I].Wait;
end;
function WaitForAny(const Tasks: array of TTask): Integer;
var
I: Integer;
begin
while True do
begin
for I := Low(Tasks) to High(Tasks) do
begin
if Tasks[I].Status <> tsRunning then
begin
Result := I;
exit;
end;
end;
Sleep(1);
end;
end;
function IsErrored(const Tasks: array of TTask): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(Tasks) to High(Tasks) do
begin
if Tasks[I].Status = TThreadStatus.tsErrored then
begin
Result := True;
exit;
end;
end;
end;
end.

3138
common/Utils.pas Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,74 @@
# CoreCipher
CoreCipher is a Delphi and FPC library for cryptography. It provides support for RC6,TwoFish,AES, DES, 3DES, Blowfish, MD5,SHA1,MixFunctions,LSC,LQC, all work in parallel and mobile platform!
**supports parallel encryption/decryption**
### multi platform supported:test with Delphi 10.2 upate 2 and FPC 3.0.4
- Windows x86+x64
- Android pad with armv8 aarch64
- Android mobile with armv6 or last
- IOS Device armv7(ip4)+armv8(ipad pro,iphone5s or last aarch64)
- IOS Simulaor:n/a
- OSX
- Ubuntu16.04 x64 server
- Ubuntu18.04 x86+x64 Desktop
- Ubuntu18.04 x86+x64 Server
- Ubuntu18.04 arm32+arm neon Server
- Ubuntu18.04 arm32+arm neon desktop
- Ubuntu16.04 Mate arm32 desktop
- Raspberry Pi 3 Debian linux armv7 desktop,only fpc 3.0.4,test passed.
- wince(arm eabi hard flaot),windows 10 IOT,only fpc 3.3.1,test passed.
### multi cpu architectures supportedtest with Delphi 10.2 upate 2 and FPC 3.0.4
- MIPS(fpc-little endian), soft float, test pass on QEMU
- intel X86(fpc-x86), soft float
- intel X86(delphi+fpc), hard float,ATHLON64,COREI,COREAVX,COREAVX2
- intel X64(fpc-x86_64), soft float
- intel X64(delphi+fpc), hard float,ATHLON64,COREI,COREAVX,COREAVX2
- ARM(fpc-arm32-eabi, hard float):ARMV3,ARMV4,ARMV4T,ARMV5,ARMV5T,ARMV5TE,ARMV5TEJ,ARMV6,ARMV6K,ARMV6T2,ARMV6Z,ARMV6M,ARMV7,ARMV7A,ARMV7R,ARMV7M,ARMV7EM
- ARM(fpc-arm64-eabi, hard float):ARMV8aarch64
enjoy.~
# update history
### 2018-9-29
- fixed rc6 on freepascal for IOT
- IOT power on FPC support
### 2018-7-6
- update the name rules of the Library
- Support for fpc/86/64 platform, all base libraries support for Linux.
- power support for the FPC compiler 3.1.1
- newed Big/Little Endian order support
- fixing the problem of using 32 bit FPC compiler to for with Int64
- fixed string the FPC compiler runs on Linux.
### 2018-5-21
- fixed twofish on memory leak
- update Parallel core(fpc required package:MultiThreadProcsLaz)
- added UPascalStrings.pas(fpc on unicode)
### 2018-3-1
newed SmithWaterman algorithm
The SmithWaterman algorithm performs local sequence alignment; that is, for determining similar regions between two strings of nucleic acid sequences or protein sequences. Instead of looking at the entire sequence, the SmithWaterman algorithm compares segments of all possible lengths and optimizes the similarity measure.
The algorithm was first proposed by Temple F. Smith and Michael S. Waterman in 1981.[1] Like the NeedlemanWunsch algorithm, of which it is a variation, SmithWaterman is a dynamic programming algorithm. As such, it has the desirable property that it is guaranteed to find the optimal local alignment with respect to the scoring system being used (which includes the substitution matrix and the gap-scoring scheme). The main difference to the NeedlemanWunsch algorithm is that negative scoring matrix cells are set to zero, which renders the (thus positively scoring) local alignments visible. Traceback procedure starts at the highest scoring matrix cell and proceeds until a cell with score zero is encountered, yielding the highest scoring local alignment. Because of its cubic computational complexity in time and quadratic complexity in space, it often cannot be practically applied to large-scale problems and is replaced in favor of less general but computationally more efficient alternatives such as (Gotoh, 1982),[2] (Altschul and Erickson, 1986),[3] and (Myers and Miller 1988).
https://en.wikipedia.org/wiki/Smith%E2%80%93Waterman_algorithm
create by QQ 600585@qq.com
2017-11-15

View File

@ -0,0 +1,30 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 480
ClientWidth = 640
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignerMasterStyle = 0
object Memo1: TMemo
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
Align = Client
Size.Width = 640.000000000000000000
Size.Height = 480.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
ReadOnly = True
end
object Button1: TButton
Anchors = [akTop, akRight]
Position.X = 528.000000000000000000
Position.Y = 8.000000000000000000
TabOrder = 1
Text = 'test'
OnClick = Button1Click
end
end

View File

@ -0,0 +1,57 @@
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, CoreCipher,
FMX.StdCtrls, FMX.Controls.Presentation, FMX.Memo,
DoStatusIO, FMX.Layouts;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure DoStatusNear(AText: string; const ID: Integer = 0);
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Visible:=False;
TestCoreCipher;
Button1.Visible:=True;
end;
procedure TForm1.DoStatusNear(AText: string; const ID: Integer);
begin
Memo1.Lines.Add(AText);
Memo1.GoToTextEnd;
Application.ProcessMessages;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AddDoStatusHook(Self, DoStatusNear);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteDoStatusHook(Self);
end;
end.

View File

@ -0,0 +1,23 @@
program fmxPerformance;
uses
System.StartUpCopy,
FMX.Forms,
Unit1 in 'Unit1.pas' {Form1},
CoreCipher in '..\..\Source\CoreCipher.pas',
CoreClasses in '..\..\Source\CoreClasses.pas',
DoStatusIO in '..\..\Source\DoStatusIO.pas',
Fast_MD5 in '..\..\Source\Fast_MD5.pas',
ListEngine in '..\..\Source\ListEngine.pas',
MemoryStream64 in '..\..\Source\MemoryStream64.pas',
PascalStrings in '..\..\Source\PascalStrings.pas',
UnicodeMixedLib in '..\..\Source\UnicodeMixedLib.pas',
UPascalStrings in '..\..\Source\UPascalStrings.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,936 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{F362D654-EE5B-43F1-BBC7-2388178EAAD4}</ProjectGuid>
<ProjectVersion>18.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<MainSource>fmxPerformance.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
<TargetedPlatforms>31</TargetedPlatforms>
<AppType>Application</AppType>
<PlatformSDK Condition="'$(Platform)'=='iOSDevice64'">iPhoneOS10.3.sdk</PlatformSDK>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android' and '$(Base)'=='true') or '$(Base_Android)'!=''">
<Base_Android>true</Base_Android>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSSimulator' and '$(Base)'=='true') or '$(Base_iOSSimulator)'!=''">
<Base_iOSSimulator>true</Base_iOSSimulator>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX32' and '$(Base)'=='true') or '$(Base_OSX32)'!=''">
<Base_OSX32>true</Base_OSX32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win64)'!=''">
<Cfg_1_Win64>true</Cfg_1_Win64>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win64)'!=''">
<Cfg_2_Win64>true</Cfg_2_Win64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
<AUP_ACCESS_FINE_LOCATION>true</AUP_ACCESS_FINE_LOCATION>
<AUP_READ_EXTERNAL_STORAGE>true</AUP_READ_EXTERNAL_STORAGE>
<AUP_INTERNET>true</AUP_INTERNET>
<AUP_ACCESS_COARSE_LOCATION>true</AUP_ACCESS_COARSE_LOCATION>
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<SanitizedProjectName>fmxPerformance</SanitizedProjectName>
<AUP_WRITE_CALENDAR>true</AUP_WRITE_CALENDAR>
<AUP_CAMERA>true</AUP_CAMERA>
<AUP_READ_PHONE_STATE>true</AUP_READ_PHONE_STATE>
<AUP_CALL_PHONE>true</AUP_CALL_PHONE>
<AUP_WRITE_EXTERNAL_STORAGE>true</AUP_WRITE_EXTERNAL_STORAGE>
<AUP_READ_CALENDAR>true</AUP_READ_CALENDAR>
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
<DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
<DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
<DCC_E>false</DCC_E>
<DCC_N>false</DCC_N>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android)'!=''">
<Android_LauncherIcon144>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png</Android_LauncherIcon144>
<Android_SplashImage960>$(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png</Android_SplashImage960>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<Android_LauncherIcon48>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png</Android_LauncherIcon48>
<Android_SplashImage640>$(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png</Android_SplashImage640>
<Android_SplashImage470>$(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png</Android_SplashImage470>
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;FireDACIBDriver;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;ibxpress;xmlrtl;soapmidas;DataSnapNativeClient;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Keys>package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=</VerInfo_Keys>
<Android_LauncherIcon36>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png</Android_LauncherIcon36>
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar</EnabledSysJars>
<Android_SplashImage426>$(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png</Android_SplashImage426>
<Android_LauncherIcon96>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png</Android_LauncherIcon96>
<Android_LauncherIcon72>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png</Android_LauncherIcon72>
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSSimulator)'!=''">
<iPad_Launch1536>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2008.png</iPad_Launch1536>
<iPad_Setting58>$(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_58x58.png</iPad_Setting58>
<iPad_AppIcon152>$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png</iPad_AppIcon152>
<iPad_Launch1024>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x748.png</iPad_Launch1024>
<VerInfo_UIDeviceFamily>iPhoneAndiPad</VerInfo_UIDeviceFamily>
<iPhone_Launch640x1136>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x1136.png</iPhone_Launch640x1136>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<iPhone_Spotlight58>$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_58x58.png</iPhone_Spotlight58>
<iPad_Launch768>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1004.png</iPad_Launch768>
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;FireDACIBDriver;fmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;CloudService;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;ibxpress;xmlrtl;soapmidas;DataSnapNativeClient;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<iPad_SpotLight100>$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_100x100.png</iPad_SpotLight100>
<iPad_Setting29>$(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_29x29.png</iPad_Setting29>
<iPhone_AppIcon114>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_114x114.png</iPhone_AppIcon114>
<iPhone_Launch1242>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png</iPhone_Launch1242>
<iPhone_Spotlight29>$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_29x29.png</iPhone_Spotlight29>
<iPad_SpotLight50>$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_50x50.png</iPad_SpotLight50>
<iPad_SpotLight80>$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png</iPad_SpotLight80>
<iPad_AppIcon144>$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_144x144.png</iPad_AppIcon144>
<iPad_SpotLight40>$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png</iPad_SpotLight40>
<iPhone_Launch750>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png</iPhone_Launch750>
<iPad_Launch1536x2048>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png</iPad_Launch1536x2048>
<iPhone_Launch320>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_320x480.png</iPhone_Launch320>
<iPhone_Launch640>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x960.png</iPhone_Launch640>
<iPhone_Launch2208>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png</iPhone_Launch2208>
<iPhone_Spotlight40>$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png</iPhone_Spotlight40>
<iPad_Launch2048>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1496.png</iPad_Launch2048>
<iPad_Launch768x1024>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png</iPad_Launch768x1024>
<iPad_Launch2048x1536>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png</iPad_Launch2048x1536>
<VerInfo_Keys>CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone &amp; iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSCameraUsageDescription=The reason for accessing the camera</VerInfo_Keys>
<iPhone_AppIcon120>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png</iPhone_AppIcon120>
<iPhone_AppIcon180>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png</iPhone_AppIcon180>
<iPad_Launch1024x768>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png</iPad_Launch1024x768>
<iPad_AppIcon72>$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_72x72.png</iPad_AppIcon72>
<iPhone_Spotlight80>$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png</iPhone_Spotlight80>
<iPhone_AppIcon87>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png</iPhone_AppIcon87>
<iPad_AppIcon76>$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png</iPad_AppIcon76>
<iPhone_AppIcon57>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_57x57.png</iPhone_AppIcon57>
<iPhone_AppIcon60>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png</iPhone_AppIcon60>
<iPhone_Launch1125>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1125x2436.png</iPhone_Launch1125>
<iPhone_Launch2436>$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2436x1125.png</iPhone_Launch2436>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_OSX32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXInterBaseDriver;emsclientfiredac;DataSnapFireDAC;tethering;FireDACMSSQLDriver;bindcompfmx;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;soapserver;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;bindcomp;DBXInformixDriver;IndyIPClient;dbxcds;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Keys>CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts</VerInfo_Keys>
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;svnui;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;frx24;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;SynEdit_RXE7;DBXSybaseASADriver;frxTee24;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;frxe24;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;frxDB24;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)</DCC_Namespace>
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;DBXOracleDriver;inetdb;FmxTeeUI;emsedge;FireDACIBDriver;fmx;fmxdae;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;emsclient;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;CloudService;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;soaprtl;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;SynEdit_RXE7;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage)</DCC_UsePackage>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_DebugDCUs>true</DCC_DebugDCUs>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<DCC_RemoteDebug>false</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win64)'!=''">
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_DebugInformation>0</DCC_DebugInformation>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win64)'!=''">
<AppEnableHighDPI>true</AppEnableHighDPI>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Unit1.pas">
<Form>Form1</Form>
<FormType>fmx</FormType>
</DCCReference>
<DCCReference Include="..\..\Source\CoreCipher.pas"/>
<DCCReference Include="..\..\Source\CoreClasses.pas"/>
<DCCReference Include="..\..\Source\DoStatusIO.pas"/>
<DCCReference Include="..\..\Source\Fast_MD5.pas"/>
<DCCReference Include="..\..\Source\ListEngine.pas"/>
<DCCReference Include="..\..\Source\MemoryStream64.pas"/>
<DCCReference Include="..\..\Source\PascalStrings.pas"/>
<DCCReference Include="..\..\Source\UnicodeMixedLib.pas"/>
<DCCReference Include="..\..\Source\UPascalStrings.pas"/>
<BuildConfiguration Include="Release">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Debug">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType>Application</Borland.ProjectType>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">fmxPerformance.dpr</Source>
</Source>
</Delphi.Personality>
<Deployment Version="3">
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png" Configuration="Release" Class="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png" Configuration="Release" Class="iPad_AppIcon76">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png" Configuration="Release" Class="iPhone_Spotlight40">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="iOSDevice64\Release\ResourceRules.plist" Configuration="Release" Class="ProjectiOSDeviceResourceRules">
<Platform Name="iOSDevice64">
<RemoteName>ResourceRules.plist</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Debug\fmxPerformance.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>fmxPerformance.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_57x57.png" Configuration="Release" Class="iPhone_AppIcon57">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png" Configuration="Release" Class="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_29x29.png" Configuration="Release" Class="iPhone_Spotlight29">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="iOSDevice64\Release\fmxPerformance.dSYM" Configuration="Release" Class="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice64">
<RemoteName>fmxPerformance</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="iOSDevice64\Release\fmxPerformance.info.plist" Configuration="Release" Class="ProjectiOSInfoPList">
<Platform Name="iOSDevice64">
<RemoteName>Info.plist</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x1136.png" Configuration="Release" Class="iPhone_Launch640x1136">
<Platform Name="iOSDevice64">
<RemoteName>Default-568h@2x.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png" Configuration="Release" Class="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png" Configuration="Release" Class="iPad_SpotLight40">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x748.png" Configuration="Release" Class="iPad_Launch1024">
<Platform Name="iOSDevice64">
<RemoteName>Default-Landscape.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2008.png" Configuration="Release" Class="iPad_Launch1536">
<Platform Name="iOSDevice64">
<RemoteName>Default-Portrait@2x.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_50x50.png" Configuration="Release" Class="iPad_SpotLight50">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png" Configuration="Release" Class="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_58x58.png" Configuration="Release" Class="iPad_Setting58">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_320x480.png" Configuration="Release" Class="iPhone_Launch320">
<Platform Name="iOSDevice64">
<RemoteName>Default.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_SettingIcon_29x29.png" Configuration="Release" Class="iPad_Setting29">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_100x100.png" Configuration="Release" Class="iPad_SpotLight100">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png" Configuration="Release" Class="iPhone_Launch2208">
<Platform Name="iOSDevice64">
<RemoteName>Default-Landscape-736h@3x.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="iOSSimulator">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="Win32\Release\fmxPerformance.exe" Configuration="Release" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>fmxPerformance.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png" Configuration="Release" Class="iPhone_AppIcon87">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="iOSDevice64\Release\fmxPerformance" Configuration="Release" Class="ProjectOutput">
<Platform Name="iOSDevice64">
<RemoteName>fmxPerformance</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png" Configuration="Release" Class="iPad_Launch1024x768">
<Platform Name="iOSDevice64">
<RemoteName>Default-Landscape~ipad.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgsqlite3.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png" Configuration="Release" Class="iPad_Launch2048x1536">
<Platform Name="iOSDevice64">
<RemoteName>Default-Landscape@2x~ipad.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_640x960.png" Configuration="Release" Class="iPhone_Launch640">
<Platform Name="iOSDevice64">
<RemoteName>Default@2x.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png" Configuration="Release" Class="iPhone_Launch750">
<Platform Name="iOSDevice64">
<RemoteName>Default-667h@2x.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_114x114.png" Configuration="Release" Class="iPhone_AppIcon114">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png" Configuration="Release" Class="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_58x58.png" Configuration="Release" Class="iPhone_Spotlight58">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1496.png" Configuration="Release" Class="iPad_Launch2048">
<Platform Name="iOSDevice64">
<RemoteName>Default-Landscape@2x.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png" Configuration="Release" Class="iPad_Launch768x1024">
<Platform Name="iOSDevice64">
<RemoteName>Default-Portrait~ipad.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1004.png" Configuration="Release" Class="iPad_Launch768">
<Platform Name="iOSDevice64">
<RemoteName>Default~ipad.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png" Configuration="Release" Class="iPad_Launch1536x2048">
<Platform Name="iOSDevice64">
<RemoteName>Default-Portrait@2x~ipad.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_72x72.png" Configuration="Release" Class="iPad_AppIcon72">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png" Configuration="Release" Class="iPhone_Launch1242">
<Platform Name="iOSDevice64">
<RemoteName>Default-736h@3x.png</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png" Configuration="Release" Class="iPhone_AppIcon60">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_144x144.png" Configuration="Release" Class="iPad_AppIcon144">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployFile LocalName="iOSDevice64\Release\fmxPerformance.entitlements" Configuration="Release" Class="ProjectiOSEntitlements">
<Platform Name="iOSDevice64">
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeX86File">
<Platform Name="Android">
<RemoteDir>library\lib\x86</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640x1136">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements">
<Platform Name="iOSDevice32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSInfoPList">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
</Deployment>
<Platforms>
<Platform value="Android">True</Platform>
<Platform value="iOSSimulator">True</Platform>
<Platform value="OSX32">True</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">True</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,21 @@
program FPCperformanceTest;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, CoreCipher, DoStatusIO
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

Binary file not shown.

View File

@ -0,0 +1,91 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="FPCperformanceTest"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="multithreadprocslaz"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="4">
<Unit0>
<Filename Value="FPCperformanceTest.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
<Unit2>
<Filename Value="..\..\Source\DoStatusIO.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\Source\CoreCipher.pas"/>
<IsPartOfProject Value="True"/>
</Unit3>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="FPCperformanceTest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="..\..\Source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,111 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="10">
<Unit0>
<Filename Value="FPCperformanceTest.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<CursorPos X="40" Y="10"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<CursorPos X="38" Y="17"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\Source\DoStatusIO.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<UsageCount Value="20"/>
</Unit2>
<Unit3>
<Filename Value="..\..\Source\CoreCipher.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="31"/>
<CursorPos X="41" Y="42"/>
<UsageCount Value="20"/>
</Unit3>
<Unit4>
<Filename Value="..\..\Source\Fast_MD5.pas"/>
<EditorIndex Value="-1"/>
<UsageCount Value="10"/>
</Unit4>
<Unit5>
<Filename Value="..\..\Source\CoreClasses.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="14"/>
<CursorPos X="70" Y="39"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="..\..\Source\MemoryStream64.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="198"/>
<CursorPos X="71" Y="218"/>
<UsageCount Value="10"/>
</Unit6>
<Unit7>
<Filename Value="..\..\Source\ListEngine.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="1392"/>
<CursorPos X="42" Y="1422"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\Source\OpCode.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="2"/>
<CursorPos X="91" Y="37"/>
<UsageCount Value="10"/>
</Unit8>
<Unit9>
<Filename Value="..\..\Source\DataFrameEngine.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="10"/>
<CursorPos X="89" Y="42"/>
<UsageCount Value="10"/>
</Unit9>
</Units>
<JumpHistory Count="5" HistoryIndex="4">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="26" Column="39"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="5"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="27" Column="41"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="21" Column="62"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="17" Column="38"/>
</Position5>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode="default"/>
</RunParams>
</ProjectSession>
</CONFIG>

View File

@ -0,0 +1,33 @@
object Form1: TForm1
Left = 499
Height = 502
Top = 128
Width = 715
Caption = 'Form1'
ClientHeight = 502
ClientWidth = 715
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.8.0.6'
object Memo1: TMemo
Left = 0
Height = 502
Top = 0
Width = 715
Align = alClient
Lines.Strings = (
'Memo1'
)
ScrollBars = ssAutoBoth
TabOrder = 0
end
object Button1: TButton
Left = 608
Height = 25
Top = 16
Width = 75
Caption = 'test'
OnClick = Button1Click
TabOrder = 1
end
end

View File

@ -0,0 +1,63 @@
unit Unit1;
{$mode objfpc}{$H+}
{$MODESWITCH AdvancedRecords}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
CoreCipher, DoStatusIO, PascalStrings;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
procedure DoStatusNear(AText: Systemstring; const ID: Integer=0);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.DoStatusNear(AText: Systemstring; const ID: Integer=0);
begin
Form1.Memo1.Lines.Add(AText);
Application.ProcessMessages;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AddDoStatusHook(Self, @DoStatusNear);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Visible:=False;
TestCoreCipher;
Button1.Visible:=True;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteDoStatusHook(Self);
end;
end.

View File

@ -0,0 +1,40 @@
object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 412
ClientWidth = 852
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = (
852
412)
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 0
Top = 0
Width = 852
Height = 412
Align = alClient
ScrollBars = ssBoth
TabOrder = 0
end
object Button1: TButton
Left = 744
Top = 8
Width = 75
Height = 25
Anchors = [akTop, akRight]
Caption = 'test'
TabOrder = 1
OnClick = Button1Click
end
end

View File

@ -0,0 +1,54 @@
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DoStatusIO,
CoreCipher;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure DoStatusNear(AText: string; const ID: Integer = 0);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Button1.Visible:=False;
TestCoreCipher;
Button1.Visible:=True;
end;
procedure TForm1.DoStatusNear(AText: string; const ID: Integer);
begin
Memo1.Lines.Add(AText);
Application.ProcessMessages;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
AddDoStatusHook(Self, DoStatusNear);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteDoStatusHook(Self);
end;
end.

View File

@ -0,0 +1,23 @@
program VCLPerformanceTest;
uses
Vcl.Forms,
Unit1 in 'Unit1.pas' {Form1},
CoreCipher in '..\..\Source\CoreCipher.pas',
CoreClasses in '..\..\Source\CoreClasses.pas',
DoStatusIO in '..\..\Source\DoStatusIO.pas',
Fast_MD5 in '..\..\Source\Fast_MD5.pas',
ListEngine in '..\..\Source\ListEngine.pas',
MemoryStream64 in '..\..\Source\MemoryStream64.pas',
PascalStrings in '..\..\Source\PascalStrings.pas',
UnicodeMixedLib in '..\..\Source\UnicodeMixedLib.pas',
UPascalStrings in '..\..\Source\UPascalStrings.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,553 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{5BBD034A-303B-4981-807F-747F4B9F8F62}</ProjectGuid>
<MainSource>VCLPerformanceTest.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>1</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>18.3</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<VerInfo_Locale>2052</VerInfo_Locale>
<DCC_E>false</DCC_E>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
<SanitizedProjectName>VCLPerformanceTest</SanitizedProjectName>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_N>false</DCC_N>
<DCC_K>false</DCC_K>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=</VerInfo_Keys>
<DCC_S>false</DCC_S>
<DCC_F>false</DCC_F>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<VerInfo_Locale>1033</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="Unit1.pas">
<Form>Form1</Form>
</DCCReference>
<DCCReference Include="..\..\Source\CoreCipher.pas"/>
<DCCReference Include="..\..\Source\CoreClasses.pas"/>
<DCCReference Include="..\..\Source\DoStatusIO.pas"/>
<DCCReference Include="..\..\Source\Fast_MD5.pas"/>
<DCCReference Include="..\..\Source\ListEngine.pas"/>
<DCCReference Include="..\..\Source\MemoryStream64.pas"/>
<DCCReference Include="..\..\Source\PascalStrings.pas"/>
<DCCReference Include="..\..\Source\UnicodeMixedLib.pas"/>
<DCCReference Include="..\..\Source\UPascalStrings.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">VCLPerformanceTest.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
<Deployment Version="3">
<DeployFile LocalName="VCLPerformanceTest.exe" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>VCLPerformanceTest.exe</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeX86File"/>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\Resources\StartUp\</RemoteDir>
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1024">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch1536">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2048">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch768">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch320">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch640x1136">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceResourceRules">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements">
<Platform Name="iOSDevice32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSInfoPList">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXEntitlements">
<Platform Name="OSX32">
<RemoteDir>..\</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXInfoPList">
<Platform Name="OSX32">
<RemoteDir>Contents</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<RemoteDir>Contents\MacOS</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
</Deployment>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

Binary file not shown.

View File

@ -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;

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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;

View File

@ -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}

View File

@ -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;

File diff suppressed because it is too large Load Diff

View File

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -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;

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

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

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

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

View File

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

Binary file not shown.

View File

@ -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!

Binary file not shown.

View File

@ -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}

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,10 @@
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

View File

@ -0,0 +1,9 @@
# These files are text and should be normalized (convert crlf =&gt; lf)
*.pas text
*.dpr text
*.dproj text
*.dfm text
*.fmx text
*.local text
*.inc text
*.txt text

View File

@ -0,0 +1,39 @@
---
name: Bug report
about: Create a report to help us improve
title: ''
labels: bug
assignees: MHumm
---
**Describe the bug**
A clear and concise description of what the bug is.
**To Reproduce**
Steps to reproduce the behavior:
1. Go to '...'
2. Click on '....'
3. Scroll down to '....'
4. See error
**Expected and actual behavior**
A clear and concise description of what you expected to happen
and what you see happening.
**Screenshots**
If applicable, add screenshots to help explain your problem.
**Desktop (please complete the following information):**
- OS: [e.g. iOS]
- Browser [e.g. chrome, safari]
- Version [e.g. 22]
**Smartphone (please complete the following information):**
- Device: [e.g. iPhone6]
- OS: [e.g. iOS8.1]
- Browser [e.g. stock browser, safari]
- Version [e.g. 22]
**Additional context**
Add any other context about the problem here.

View File

@ -0,0 +1,23 @@
---
name: Feature request
about: Suggest an idea for this project
title: ''
labels: enhancement
assignees: MHumm
---
**Is your feature request related to a problem? Please describe.**
A clear and concise description of what the problem is. Ex. I'm always frustrated when [...]
**Describe the solution you'd like**
A clear and concise description of what you want to happen.
**Describe alternatives you've considered**
A clear and concise description of any alternative solutions or features you've considered.
**Additional context**
Add any other context or screenshots about the feature request here.
**Minimum Delphi version you need this for**
Which is the minimum Delphi version this feature needs to work with?

View File

@ -0,0 +1,18 @@
/Compiled
/Source/BuildAll.log
backup
__history
__recovery
**/Android/
**/Android64/
**/Win32/
**/Win64/
*.local
*.identcache
*.dsk
*.~*
*.stat
Thumbs.db

View File

@ -0,0 +1,89 @@
# Delphi Encryption Compendium Code of Conduct
## 1. Purpose
A primary goal of Delphi Encryption Compendium is to be inclusive to the largest number of contributors.
As such, we are committed to providing a friendly, safe and welcoming environment for all, regardless
of gender, sexual orientation, ability, ethnicity, socioeconomic status, and religion (or lack thereof).
This code of conduct outlines our expectations for all those who participate in our community, as well as
the consequences for unacceptable behavior.
We invite all those who participate in Delphi Encryption Compendium to help us create safe and positive
experiences for everyone.
## 2. Expected Behavior
The following behaviors are expected and requested of all community members:
* Participate in an authentic and active way. In doing so, you contribute to the health and longevity of
this community.
* Exercise consideration and respect in your speech and actions.
* Attempt collaboration before conflict.
* Refrain from demeaning, discriminatory, or harassing behavior and speech.
* Be mindful of your surroundings and of your fellow participants. Alert community leaders if you notice
a dangerous situation, someone in distress, or violations of this Code of Conduct, even if they seem
inconsequential.
## 3. Unacceptable Behavior
The following behaviors are considered harassment and are unacceptable within our community:
* Violence, threats of violence or violent language directed against another person.
* Sexist, racist, homophobic, transphobic, ableist or otherwise discriminatory jokes and language.
* Posting or displaying sexually explicit or violent material.
* Posting or threatening to post other people's personally identifying information ("doxing").
* Personal insults, particularly those related to gender, sexual orientation, race, religion, or disability.
* Inappropriate photography or recording.
* Inappropriate physical contact. You should have someone's consent before touching them.
* Unwelcome sexual attention. This includes, sexualized comments or jokes; inappropriate touching, groping,
and unwelcomed sexual advances.
* Deliberate intimidation, stalking or following (online or in person).
* Advocating for, or encouraging, any of the above behavior.
* Sustained disruption of community events, including talks and presentations.
## 4. Weapons Policy
Since this is a virtual community site no weapons policy is needed currently.
If a physical community event should be planned, a weapons policy will be created and enforced.
## 5. Consequences of Unacceptable Behavior
Unacceptable behavior from any community member, including sponsors and those with decision-making authority,
will not be tolerated.
Anyone asked to stop unacceptable behavior is expected to comply immediately.
If a community member engages in unacceptable behavior, the community organizers may take any action they deem
appropriate, up to and including a temporary ban or permanent expulsion from the community without warning
(and without refund in the case of a paid event).
## 6. Reporting Guidelines
If you are subject to or witness unacceptable behavior, or have any other concerns, please notify a community
organizer as soon as possible.
Additionally, community organizers are available to help community members engage with local law enforcement or
to otherwise help those experiencing unacceptable behavior feel safe. In the context of in-person events,
organizers will also provide escorts as desired by the person experiencing distress.
## 7. Addressing Grievances
If you feel you have been falsely or unfairly accused of violating this Code of Conduct, you should notify
with a concise description of your grievance. Your grievance will be handled in accordance with our existing
governing policies.
## 8. Scope
We expect all community participants (contributors, paid or otherwise; sponsors; and other guests) to abide by
this Code of Conduct in all community venues--online and in-person--as well as in all one-on-one communications
pertaining to community business.
## 9. Contact info
See NOTICE.txt from the project repository. Preferably contact the person marked as "main contact" in this file.
## 10. License and attribution
The Citizen Code of Conduct is distributed by "TeamDEC" under a [Creative Commons Attribution-ShareAlike license](http://creativecommons.org/licenses/by-sa/3.0/)
and it is based on the one from [Stumptown Syndicate].

View File

@ -0,0 +1,6 @@
We welcome contributions from the Delphi and FPC communities!
If you like to contribute then either submit a pull request with your proposed
changes along with a description about what you like to achieve with the
modification/addition you propose or send an e-mail to the person listed as main contact
in notice.txt

View File

@ -0,0 +1,261 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Condition="Exists('$(BDS)\bin\CodeGear.Deployment.targets')" Project="$(BDS)\bin\CodeGear.Deployment.targets"/>
<ProjectExtensions>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<PropertyGroup>
<DeviceId Condition="'$(Platform)'=='Android'">CB512EA59X</DeviceId>
<DeviceId Condition="'$(Platform)'=='Android64'"/>
</PropertyGroup>
<ItemGroup Condition="'$(Platform)'=='Win32'">
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Win32__Demos\Cipher_Console.exe" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\</RemoteDir>
<RemoteName>Cipher_Console.exe</RemoteName>
<DeployClass>ProjectOutput</DeployClass>
<Operation>0</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
<Required>True</Required>
</DeployFile>
</ItemGroup>
<ItemGroup Condition="'$(Platform)'=='Win64'"/>
<ItemGroup Condition="'$(Platform)'=='Android'">
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-xxhdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon72</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-ldpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon36</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\AndroidManifest.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\</RemoteDir>
<RemoteName>AndroidManifest.xml</RemoteName>
<DeployClass>ProjectAndroidManifest</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\colors.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\values\</RemoteDir>
<RemoteName>colors.xml</RemoteName>
<DeployClass>Android_Colors</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-hdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon72</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-large\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage640</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-xlarge\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage960</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-small\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage426</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\styles.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\values\</RemoteDir>
<RemoteName>styles.xml</RemoteName>
<DeployClass>AndroidSplashStyles</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\classes.dex" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\classes\</RemoteDir>
<RemoteName>classes.dex</RemoteName>
<DeployClass>AndroidClassesDexFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-hdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon36</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-mdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon48</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\lib\android\debug\mips\libnative-activity.so" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\library\lib\mips\</RemoteDir>
<RemoteName>libCipher_Console.so</RemoteName>
<DeployClass>AndroidLibnativeMipsFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(NDKBasePath)\prebuilt\android-arm\gdbserver\gdbserver" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\library\lib\armeabi-v7a\</RemoteDir>
<RemoteName>gdbserver</RemoteName>
<DeployClass>AndroidGDBServer</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\libCipher_Console.so" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\library\lib\armeabi-v7a\</RemoteDir>
<RemoteName>libCipher_Console.so</RemoteName>
<DeployClass>ProjectOutput</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
<Required>True</Required>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\strings.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\values\</RemoteDir>
<RemoteName>strings.xml</RemoteName>
<DeployClass>Android_Strings</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-xxxhdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon96</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-xxhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon144</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\styles-v21.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\values-v21\</RemoteDir>
<RemoteName>styles.xml</RemoteName>
<DeployClass>AndroidSplashStylesV21</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\lib\android\debug\armeabi\libnative-activity.so" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\library\lib\armeabi\</RemoteDir>
<RemoteName>libCipher_Console.so</RemoteName>
<DeployClass>AndroidLibnativeArmeabiFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-normal\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage470</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\splash_image_def.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable\</RemoteDir>
<RemoteName>splash_image_def.xml</RemoteName>
<DeployClass>AndroidSplashImageDef</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-mdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon24</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-xhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon96</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-xhdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon48</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_Console\res\drawable-xxxhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon192</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
</ItemGroup>
<ItemGroup Condition="'$(Platform)'=='Android64'"/>
</Project>

View File

@ -0,0 +1,96 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory of
this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Most simple demonstration of using a DEC cipher
/// </summary>
program Cipher_Console;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
DECCipherBase,
DECCipherModes,
DECCipherFormats,
DECCiphers;
var
Cipher : TCipher_1DES;
// We use raw byte string here since Unicode handling of Windows console
// is not given
SourceText : RawByteString;
// Key for the initialization of our encryption run
CipherKey : RawByteString;
IV : RawByteString;
Input,
Output : TBytes;
i : Integer;
begin
Cipher := TCipher_1DES.Create;
try
try
// Init our encryption
CipherKey := 'Passwort';
IV := #0#0#0#0#0#0#0#0;
Cipher.Init(CipherKey, IV, 0);
Cipher.Mode := cmCBCx;
SourceText := 'Beispielklartext';
WriteLn('Source text: ' + SourceText);
Input := System.SysUtils.BytesOf(SourceText);
// Encrypt
Output := Cipher.EncodeBytes(Input);
Write('Encrypted data in hex: ');
for i := 0 to high(Output) do
Write(IntToHex(Output[i], 2), ' ');
WriteLn;
// Decrypt
Cipher.Init(CipherKey, IV, 0);
Output := Cipher.DecodeBytes(Output);
SourceText := RawByteString(System.SysUtils.StringOf(Output));
WriteLn('Decrypted data: ' + SourceText);
// Show that using a different key results in a different output
WriteLn;
CipherKey := 'Password';
Cipher.Init(CipherKey, IV, 0);
Output := Cipher.DecodeBytes(Output);
SourceText := RawByteString(System.SysUtils.StringOf(Output));
WriteLn('Decrypted with different key: ' + SourceText);
ReadLn;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
finally
Cipher.Free;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,2 @@
<?xml version="1.0"?>
<TgConfig Version="3" SubLevelDisabled="False" />

View File

@ -0,0 +1,42 @@
<?xml version="1.0" encoding="utf-8"?>
<!-- BEGIN_INCLUDE(manifest) -->
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="%package%"
android:versionCode="%versionCode%"
android:versionName="%versionName%"
android:installLocation="%installLocation%">
<!-- This is the platform API where NativeActivity was introduced. -->
<uses-sdk android:minSdkVersion="%minSdkVersion%" android:targetSdkVersion="%targetSdkVersion%" />
<%uses-permission%>
<uses-feature android:glEsVersion="0x00020000" android:required="True"/>
<application android:persistent="%persistent%"
android:restoreAnyVersion="%restoreAnyVersion%"
android:label="%label%"
android:debuggable="%debuggable%"
android:largeHeap="%largeHeap%"
android:icon="%icon%"
android:theme="%theme%"
android:hardwareAccelerated="%hardwareAccelerated%">
<%application-meta-data%>
<%services%>
<!-- Our activity is a subclass of the built-in NativeActivity framework class.
This will take care of integrating with our NDK code. -->
<activity android:name="com.embarcadero.firemonkey.FMXNativeActivity"
android:label="%activityLabel%"
android:configChanges="orientation|keyboard|keyboardHidden|screenSize"
android:launchMode="singleTask">
<!-- Tell NativeActivity the name of our .so -->
<meta-data android:name="android.app.lib_name"
android:value="%libNameValue%" />
<intent-filter>
<action android:name="android.intent.action.MAIN" />
<category android:name="android.intent.category.LAUNCHER" />
</intent-filter>
</activity>
<%activity%>
<%receivers%>
</application>
</manifest>
<!-- END_INCLUDE(manifest) -->

View File

@ -0,0 +1,434 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Condition="Exists('$(BDS)\bin\CodeGear.Deployment.targets')" Project="$(BDS)\bin\CodeGear.Deployment.targets"/>
<ProjectExtensions>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<PropertyGroup>
<DeviceId Condition="'$(Platform)'=='Android'">CB512EA59X</DeviceId>
<DeviceId Condition="'$(Platform)'=='Android64'"/>
</PropertyGroup>
<ItemGroup Condition="'$(Platform)'=='Win32'">
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Win32__Demos\Cipher_FMX.exe" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\</RemoteDir>
<RemoteName>Cipher_FMX.exe</RemoteName>
<DeployClass>ProjectOutput</DeployClass>
<Operation>0</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
<Required>True</Required>
</DeployFile>
</ItemGroup>
<ItemGroup Condition="'$(Platform)'=='Win64'"/>
<ItemGroup Condition="'$(Platform)'=='Android'">
<DeployFile Include="CryptoIcon_48.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-mdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon48</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\classes.dex" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\classes\</RemoteDir>
<RemoteName>classes.dex</RemoteName>
<DeployClass>AndroidClassesDexFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-hdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon36</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\lib\android\debug\mips\libnative-activity.so" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\library\lib\mips\</RemoteDir>
<RemoteName>libCipher_FMX.so</RemoteName>
<DeployClass>AndroidLibnativeMipsFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\splash_image_def.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable\</RemoteDir>
<RemoteName>splash_image_def.xml</RemoteName>
<DeployClass>AndroidSplashImageDef</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_96.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-xhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon96</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_36.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-ldpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon36</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Crypto_640_480.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-large\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage640</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\strings.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\values\</RemoteDir>
<RemoteName>strings.xml</RemoteName>
<DeployClass>Android_Strings</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-xxxhdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon96</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\AndroidManifest.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\</RemoteDir>
<RemoteName>AndroidManifest.xml</RemoteName>
<DeployClass>ProjectAndroidManifest</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\lib\android\debug\armeabi\libnative-activity.so" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\library\lib\armeabi\</RemoteDir>
<RemoteName>libCipher_FMX.so</RemoteName>
<DeployClass>AndroidLibnativeArmeabiFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\styles-v21.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\values-v21\</RemoteDir>
<RemoteName>styles.xml</RemoteName>
<DeployClass>AndroidSplashStylesV21</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-mdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon24</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Crypto_470_320.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-normal\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage470</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-xhdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon48</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_72.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-hdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon72</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-xxhdpi\</RemoteDir>
<RemoteName>ic_notification.png</RemoteName>
<DeployClass>Android_NotificationIcon72</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_144.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-xxhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon144</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\colors.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\values\</RemoteDir>
<RemoteName>colors.xml</RemoteName>
<DeployClass>Android_Colors</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_192.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-xxxhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon192</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\libCipher_FMX.so" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\library\lib\armeabi-v7a\</RemoteDir>
<RemoteName>libCipher_FMX.so</RemoteName>
<DeployClass>ProjectOutput</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
<Required>True</Required>
</DeployFile>
<DeployFile Include="Crypto_426_320.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-small\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage426</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Android\Debug\classes.dex" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\classes\</RemoteDir>
<RemoteName>classes.dex</RemoteName>
<DeployClass>AndroidClassesDexFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="$(NDKBasePath)\prebuilt\android-arm\gdbserver\gdbserver" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\library\lib\armeabi-v7a\</RemoteDir>
<RemoteName>gdbserver</RemoteName>
<DeployClass>AndroidGDBServer</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android__Demos\styles.xml" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\values\</RemoteDir>
<RemoteName>styles.xml</RemoteName>
<DeployClass>AndroidSplashStyles</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Crypto_960_720.png" Condition="'$(Config)'=='Debug'">
<RemoteDir>Cipher_FMX\res\drawable-xlarge\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage960</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
</ItemGroup>
<ItemGroup Condition="'$(Platform)'=='Android64'">
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\splash_image_def.xml" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable\</RemoteDir>
<RemoteName>splash_image_def.xml</RemoteName>
<DeployClass>AndroidSplashImageDef</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\libCipher_FMX.so" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\library\lib\arm64-v8a\</RemoteDir>
<RemoteName>libCipher_FMX.so</RemoteName>
<DeployClass>ProjectOutput</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
<Required>True</Required>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\classes.dex" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\classes\</RemoteDir>
<RemoteName>classes.dex</RemoteName>
<DeployClass>AndroidClassesDexFile</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Crypto_960_720.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-xlarge\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage960</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\styles.xml" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\values\</RemoteDir>
<RemoteName>styles.xml</RemoteName>
<DeployClass>AndroidSplashStyles</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_48.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-mdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon48</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Crypto_426_320.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-small\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage426</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\AndroidManifest.xml" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\</RemoteDir>
<RemoteName>AndroidManifest.xml</RemoteName>
<DeployClass>ProjectAndroidManifest</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Crypto_470_320.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-normal\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage470</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="Crypto_640_480.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-large\</RemoteDir>
<RemoteName>splash_image.png</RemoteName>
<DeployClass>Android_SplashImage640</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_96.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-xhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon96</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_192.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-xxxhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon192</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_36.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-ldpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon36</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\styles-v21.xml" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\values-v21\</RemoteDir>
<RemoteName>styles.xml</RemoteName>
<DeployClass>AndroidSplashStylesV21</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\colors.xml" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\values\</RemoteDir>
<RemoteName>colors.xml</RemoteName>
<DeployClass>Android_Colors</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_72.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-hdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon72</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="CryptoIcon_144.png" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\drawable-xxhdpi\</RemoteDir>
<RemoteName>ic_launcher.png</RemoteName>
<DeployClass>Android_LauncherIcon144</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
<DeployFile Include="..\..\Compiled\BIN_IDExx.x_Android64__Demos\strings.xml" Condition="'$(Config)'=='Release'">
<RemoteDir>Cipher_FMX\res\values\</RemoteDir>
<RemoteName>strings.xml</RemoteName>
<DeployClass>Android_Strings</DeployClass>
<Operation>1</Operation>
<LocalCommand/>
<RemoteCommand/>
<Overwrite>True</Overwrite>
</DeployFile>
</ItemGroup>
</Project>

View File

@ -0,0 +1,14 @@
program Cipher_FMX;
uses
System.StartUpCopy,
FMX.Forms,
MainForm in 'MainForm.pas' {FormMain};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TFormMain, FormMain);
Application.Run;
end.

File diff suppressed because it is too large Load Diff

Binary file not shown.

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 31 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 4.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 9.0 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 282 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 308 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 580 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 MiB

View File

@ -0,0 +1,91 @@
inherited MainForm_LgXhdpiPh: TMainForm_LgXhdpiPh
ClientHeight = 695
ClientWidth = 450
DesignerMasterStyle = 0
inherited VertScrollBox1: TVertScrollBox
Size.Width = 450.000000000000000000
Size.Height = 695.000000000000000000
Viewport.Width = 445.000000000000000000
Viewport.Height = 695.000000000000000000
inherited LayoutTop: TLayout
inherited Label2: TLabel
Size.Width = 124.000000000000000000
Size.Height = 22.000000000000000000
end
inherited ComboBoxHashFunction: TComboBox
TabOrder = 3
end
inherited Label5: TLabel
Size.Width = 139.000000000000000000
Size.Height = 22.000000000000000000
end
inherited ComboBoxInputFormatting: TComboBox
TabOrder = 4
end
inherited Label6: TLabel
Size.Width = 178.000000000000000000
Size.Height = 22.000000000000000000
end
inherited ComboBoxOutputFormatting: TComboBox
TabOrder = 6
end
inherited Label1: TLabel
Size.Width = 119.000000000000000000
Size.Height = 22.000000000000000000
end
inherited EditKey: TEdit
TabOrder = 15
Size.Height = 32.000000000000000000
end
inherited Label3: TLabel
Size.Width = 81.000000000000000000
Size.Height = 22.000000000000000000
end
inherited Edit1: TEdit
TabOrder = 14
Size.Height = 32.000000000000000000
end
inherited Label4: TLabel
Size.Width = 79.000000000000000000
Size.Height = 22.000000000000000000
end
inherited EditFiller: TEdit
TabOrder = 13
Size.Height = 32.000000000000000000
end
inherited Label7: TLabel
Size.Width = 103.000000000000000000
Size.Height = 22.000000000000000000
end
inherited Label8: TLabel
Size.Width = 139.000000000000000000
Size.Height = 22.000000000000000000
end
inherited StringGrid1: TStringGrid
Viewport.Width = 380.000000000000000000
Viewport.Height = 68.000000000000000000
inherited StringColumn1: TStringColumn
Size.Width = 250.000000000000000000
end
end
inherited Label9: TLabel
Size.Width = 139.000000000000000000
Size.Height = 22.000000000000000000
end
inherited Label10: TLabel
Size.Width = 139.000000000000000000
Size.Height = 22.000000000000000000
end
inherited EditPlainText: TEdit
Size.Height = 32.000000000000000000
end
inherited EditCipherText: TEdit
Size.Height = 32.000000000000000000
end
inherited Label11: TLabel
Size.Width = 88.000000000000000000
Size.Height = 22.000000000000000000
end
end
end
end

View File

@ -0,0 +1,304 @@
object FormMain: TFormMain
Left = 0
Top = 0
ActiveControl = ComboBoxCipherAlgorithm
Caption = 'FMX Cipher Demo'
ClientHeight = 711
ClientWidth = 425
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
OnCreate = FormCreate
OnResize = FormResize
DesignerMasterStyle = 0
object VertScrollBox1: TVertScrollBox
Align = Client
Size.Width = 425.000000000000000000
Size.Height = 711.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'scrollboxstyle'
TabOrder = 0
Viewport.Width = 409.000000000000000000
Viewport.Height = 711.000000000000000000
object LayoutTop: TLayout
Size.Width = 425.000000000000000000
Size.Height = 1170.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
object Label2: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 16.000000000000000000
Size.Width = 82.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Cipher function'
end
object ComboBoxCipherAlgorithm: TComboBox
Anchors = [akLeft, akTop, akRight]
Position.X = 16.000000000000000000
Position.Y = 44.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 32.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'comboboxstyle'
TabOrder = 0
OnChange = ComboBoxCipherAlgorithmChange
end
object Label5: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 88.000000000000000000
Size.Width = 91.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Input is in format'
end
object ComboBoxInputFormatting: TComboBox
Anchors = [akLeft, akTop, akRight]
Position.X = 16.000000000000000000
Position.Y = 116.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 32.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'comboboxstyle'
TabOrder = 1
end
object Label6: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 160.000000000000000000
Size.Width = 119.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Desired output format'
end
object ComboBoxOutputFormatting: TComboBox
Anchors = [akLeft, akTop, akRight]
Position.X = 16.000000000000000000
Position.Y = 188.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 32.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'comboboxstyle'
TabOrder = 2
end
object Label1: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 240.000000000000000000
Size.Width = 117.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Encryption key (ASCII)'
end
object EditKey: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Anchors = [akLeft, akTop, akRight]
StyleLookup = 'editstyle'
TabOrder = 3
Position.X = 16.000000000000000000
Position.Y = 272.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
end
object Label3: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 312.000000000000000000
Size.Width = 130.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Init vector (hexadecimal)'
end
object EditInitVector: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Anchors = [akLeft, akTop, akRight]
StyleLookup = 'editstyle'
TabOrder = 4
Position.X = 16.000000000000000000
Position.Y = 344.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
end
object Label4: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 384.000000000000000000
Size.Width = 128.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Filler byte (hexadecimal)'
end
object EditFiller: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Anchors = [akLeft, akTop, akRight]
StyleLookup = 'editstyle'
TabOrder = 5
Position.X = 16.000000000000000000
Position.Y = 408.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
end
object Label7: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 448.000000000000000000
Size.Width = 69.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Cipher mode'
end
object ComboBoxChainingMethod: TComboBox
Anchors = [akLeft, akTop, akRight]
Position.X = 16.000000000000000000
Position.Y = 476.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 32.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'comboboxstyle'
TabOrder = 6
end
object CheckBoxLiveCalc: TCheckBox
Anchors = [akLeft, akTop, akRight]
Position.X = 16.000000000000000000
Position.Y = 528.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 19.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'checkboxstyle'
TabOrder = 7
Text = 'Live calculation'
end
object Label8: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 568.000000000000000000
Size.Width = 93.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Cipher properties'
end
object StringGridContext: TStringGrid
Anchors = [akLeft, akTop, akRight]
CanFocus = True
ClipChildren = True
Position.X = 16.000000000000000000
Position.Y = 600.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 100.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'gridstyle'
TabOrder = 8
Viewport.Width = 365.000000000000000000
Viewport.Height = 75.000000000000000000
object StringColumn1: TStringColumn
Header = 'Property'
Size.Width = 250.000000000000000000
end
object StringColumn2: TStringColumn
Header = 'Value'
end
end
object Label9: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 720.000000000000000000
Size.Width = 49.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Plain text'
end
object Label10: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 784.000000000000000000
Size.Width = 58.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = 'Cipher text'
end
object EditPlainText: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Anchors = [akLeft, akTop, akRight]
StyleLookup = 'editstyle'
TabOrder = 9
Position.X = 16.000000000000000000
Position.Y = 752.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
OnChangeTracking = EditPlainTextChangeTracking
end
object EditCipherText: TEdit
Touch.InteractiveGestures = [LongTap, DoubleTap]
Anchors = [akLeft, akTop, akRight]
StyleLookup = 'editstyle'
TabOrder = 10
Position.X = 16.000000000000000000
Position.Y = 816.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
end
object ButtonEncrypt: TButton
Anchors = [akLeft, akTop, akRight]
Position.X = 16.000000000000000000
Position.Y = 864.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 33.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'buttonstyle'
TabOrder = 11
Text = 'Encrypt'
OnClick = ButtonEncryptClick
end
object ButtonDecrypt: TButton
Anchors = [akLeft, akTop, akRight]
Position.X = 16.000000000000000000
Position.Y = 920.000000000000000000
Size.Width = 385.000000000000000000
Size.Height = 33.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'buttonstyle'
TabOrder = 12
Text = 'Decrypt'
OnClick = ButtonDecryptClick
end
object LabelVersion: TLabel
AutoSize = True
Position.X = 16.000000000000000000
Position.Y = 968.000000000000000000
Size.Width = 178.000000000000000000
Size.Height = 16.000000000000000000
Size.PlatformDefault = False
StyleLookup = 'labelstyle'
TextSettings.WordWrap = False
Text = #169' 2018-2021 by Team DEC V%0:s'
end
end
end
end

View File

@ -0,0 +1,397 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory of
this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
unit MainForm;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts,
FMX.StdCtrls, FMX.ListBox, FMX.Controls.Presentation, FMX.Edit, System.Rtti,
{$IF RTLVersion < 31}
{$ELSE}
FMX.Grid.Style,
{$ENDIF}
FMX.Grid, FMX.ScrollBox, DECCipherBase, DECFormatBase;
type
/// <summary>
/// Form of the cross platform FMX Cipher demo
/// </summary>
TFormMain = class(TForm)
VertScrollBox1: TVertScrollBox;
LayoutTop: TLayout;
Label2: TLabel;
ComboBoxCipherAlgorithm: TComboBox;
Label5: TLabel;
ComboBoxInputFormatting: TComboBox;
Label6: TLabel;
ComboBoxOutputFormatting: TComboBox;
Label1: TLabel;
EditKey: TEdit;
Label3: TLabel;
EditInitVector: TEdit;
Label4: TLabel;
EditFiller: TEdit;
Label7: TLabel;
ComboBoxChainingMethod: TComboBox;
CheckBoxLiveCalc: TCheckBox;
Label8: TLabel;
StringGridContext: TStringGrid;
StringColumn1: TStringColumn;
StringColumn2: TStringColumn;
Label9: TLabel;
Label10: TLabel;
EditPlainText: TEdit;
EditCipherText: TEdit;
ButtonEncrypt: TButton;
ButtonDecrypt: TButton;
LabelVersion: TLabel;
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ComboBoxCipherAlgorithmChange(Sender: TObject);
procedure ButtonEncryptClick(Sender: TObject);
procedure EditPlainTextChangeTracking(Sender: TObject);
procedure ButtonDecryptClick(Sender: TObject);
private
procedure InitFormatCombos;
procedure InitCipherCombo;
procedure InitCipherModes;
procedure ShowErrorMessage(ErrorMsg: string);
function GetSelectedCipherMode: TCipherMode;
function GetSettings(var InputFormatting : TDECFormatClass;
var OutputFormatting : TDECFormatClass): Boolean;
function GetCipherAlgorithm(var Cipher: TDECCipher): Boolean;
public
end;
var
FormMain: TFormMain;
implementation
uses
System.TypInfo, Generics.Collections, FMX.Platform,
DECBaseClass, DECFormat, DECCipherModes,
DECCipherFormats, DECCiphers, DECUtil
{$IFDEF Android}
,
Androidapi.JNI.GraphicsContentViewText,
Androidapi.Helpers,
Androidapi.JNI.App
{$ENDIF};
{$R *.fmx}
procedure TFormMain.ButtonDecryptClick(Sender: TObject);
var
Cipher : TDECCipher;
InputFormatting : TDECFormatClass;
OutputFormatting : TDECFormatClass;
InputBuffer : TBytes;
OutputBuffer : TBytes;
begin
if not GetSettings(InputFormatting, OutputFormatting) then
exit;
if ComboBoxCipherAlgorithm.ItemIndex >= 0 then
begin
if not GetCipherAlgorithm(Cipher) then
exit;
try
InputBuffer := System.SysUtils.BytesOf(EditCipherText.Text);
if InputFormatting.IsValid(InputBuffer) then
begin
OutputBuffer := (Cipher as TDECFormattedCipher).DecodeBytes(InputFormatting.Decode(InputBuffer));
EditPlainText.Text := string(DECUtil.BytesToRawString(OutputFormatting.Encode(OutputBuffer)));
end
else
ShowErrorMessage('Input has wrong format');
finally
Cipher.Free;
end;
end
else
ShowErrorMessage('No cipher algorithm selected');
end;
procedure TFormMain.ButtonEncryptClick(Sender: TObject);
var
Cipher : TDECCipher;
InputFormatting : TDECFormatClass;
OutputFormatting : TDECFormatClass;
InputBuffer : TBytes;
OutputBuffer : TBytes;
begin
if not GetSettings(InputFormatting, OutputFormatting) then
exit;
if ComboBoxCipherAlgorithm.ItemIndex >= 0 then
begin
if not GetCipherAlgorithm(Cipher) then
exit;
try
InputBuffer := System.SysUtils.BytesOf(EditPlainText.Text);
if InputFormatting.IsValid(InputBuffer) then
begin
OutputBuffer := (Cipher as TDECFormattedCipher).EncodeBytes(InputFormatting.Decode(InputBuffer));
EditCipherText.Text := string(DECUtil.BytesToRawString(OutputFormatting.Encode(OutputBuffer)));
end
else
ShowErrorMessage('Input has wrong format');
finally
Cipher.Free;
end;
end
else
ShowErrorMessage('No cipher algorithm selected');
end;
function TFormMain.GetSettings(var InputFormatting : TDECFormatClass;
var OutputFormatting : TDECFormatClass): Boolean;
begin
result := false;
if ComboBoxInputFormatting.ItemIndex >= 0 then
begin
// Find the class type of the selected formatting class and create an instance of it
InputFormatting := TDECFormat.ClassByName(
ComboBoxInputFormatting.Items[ComboBoxInputFormatting.ItemIndex]);
end
else
begin
ShowErrorMessage('No input format selected');
exit;
end;
if ComboBoxOutputFormatting.ItemIndex >= 0 then
begin
// Find the class type of the selected formatting class and create an instance of it
OutputFormatting := TDECFormat.ClassByName(
ComboBoxOutputFormatting.Items[ComboBoxOutputFormatting.ItemIndex]);
end
else
begin
ShowErrorMessage('No output format selected');
exit;
end;
if EditKey.Text.IsEmpty or EditInitVector.Text.IsEmpty or EditFiller.Text.IsEmpty then
begin
ShowErrorMessage('No key, initialization vector or filler byte given');
exit;
end;
result := true;
end;
function TFormMain.GetCipherAlgorithm(var Cipher : TDECCipher):Boolean;
begin
result := false;
// Find the class type of the selected cipher class and create an instance of it
Cipher := TDECCipher.ClassByName(
ComboBoxCipherAlgorithm.Items[ComboBoxCipherAlgorithm.ItemIndex]).Create;
if TFormat_HEX.IsValid(RawByteString(EditInitVector.Text)) and
TFormat_HEX.IsValid(RawByteString(EditFiller.Text)) then
begin
Cipher.Init(RawByteString(EditKey.Text),
TFormat_HEX.Decode(RawByteString(EditInitVector.Text)),
StrToInt('0x' + EditFiller.Text));
Cipher.Mode := GetSelectedCipherMode;
end
else
begin
ShowErrorMessage('Init vector or filler byte not given in hexadecimal representation');
exit;
end;
result := true;
end;
function TFormMain.GetSelectedCipherMode:TCipherMode;
begin
// Determine selected block chaining method via RTTI (runtime type information)
result := TCipherMode(System.TypInfo.GetEnumValue(
TypeInfo(TCipherMode),
ComboBoxChainingMethod.Items[ComboBoxChainingMethod.ItemIndex]));
end;
procedure TFormMain.ShowErrorMessage(ErrorMsg: string);
{$IF RTLVersion > 30}
var
AsyncDlg : IFMXDialogServiceASync;
{$ENDIF}
begin
{$IF RTLVersion > 30}
if TPlatformServices.Current.SupportsPlatformService(IFMXDialogServiceAsync,
IInterface(AsyncDlg)) then
AsyncDlg.MessageDialogAsync(Translate(ErrorMsg),
TMsgDlgType.mtError, [TMsgDlgBtn.mbOk], TMsgDlgBtn.mbOk, 0,
procedure (const AResult: TModalResult)
begin
end);
{$ELSE}
MessageDlg(Translate(ErrorMsg),
TMsgDlgType.mtError, [TMsgDlgBtn.mbOk], 0);
{$ENDIF}
end;
procedure TFormMain.ComboBoxCipherAlgorithmChange(Sender: TObject);
var
Context : TCipherContext;
begin
Context := TDECCipher.ClassByName(
ComboBoxCipherAlgorithm.Items[ComboBoxCipherAlgorithm.ItemIndex]).Context;
StringGridContext.RowCount := 7;
StringGridContext.Cells[0, 0] := 'Key size (bit)';
StringGridContext.Cells[0, 1] := 'Block size (bit)';
StringGridContext.Cells[0, 2] := 'Buffer size (bit)';
StringGridContext.Cells[0, 3] := 'User size (bit)';
StringGridContext.Cells[0, 4] := 'User save';
StringGridContext.Cells[0, 5] := 'Cipher mode';
StringGridContext.Cells[0, 6] := 'Cipher key';
StringGridContext.Cells[1, 0] := IntToStr(Context.KeySize*8);
StringGridContext.Cells[1, 1] := IntToStr(Context.BlockSize*8);
StringGridContext.Cells[1, 2] := IntToStr(Context.BufferSize*8);
StringGridContext.Cells[1, 3] := IntToStr(Context.AdditionalBufferSize*8);
StringGridContext.Cells[1, 4] := BoolToStr(Context.NeedsAdditionalBufferBackup, true);
if ctBlock in Context.CipherType then
StringGridContext.Cells[1, 5] := 'block cipher'
else
StringGridContext.Cells[1, 5] := 'stream cipher';
if ctSymmetric in Context.CipherType then
StringGridContext.Cells[1, 6] := 'symmetric'
else
StringGridContext.Cells[1, 6] := 'asymmetric';
end;
procedure TFormMain.EditPlainTextChangeTracking(Sender: TObject);
begin
if CheckBoxLiveCalc.IsChecked then
ButtonEncryptClick(self)
end;
procedure TFormMain.FormCreate(Sender: TObject);
var
AppService : IFMXApplicationService;
begin
if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationService,
IInterface(AppService)) then
LabelVersion.Text := format(LabelVersion.Text, [AppService.AppVersion])
else
LabelVersion.Text := format(LabelVersion.Text, ['']);
InitFormatCombos;
InitCipherCombo;
InitCipherModes;
end;
procedure TFormMain.FormResize(Sender: TObject);
begin
LayoutTop.Width := VertScrollBox1.Width;
end;
procedure TFormMain.InitFormatCombos;
var
MyClass : TPair<Int64, TDECClass>;
Formats : TStringList;
CopyIdx : Integer;
begin
Formats := TStringList.Create;
try
for MyClass in TDECFormat.ClassList do
Formats.Add(MyClass.Value.ClassName);
Formats.Sort;
ComboBoxInputFormatting.Items.AddStrings(Formats);
ComboBoxOutputFormatting.Items.AddStrings(Formats);
if Formats.Count > 0 then
begin
if Formats.Find('TFormat_Copy', CopyIdx) then
begin
ComboBoxInputFormatting.ItemIndex := CopyIdx;
ComboBoxOutputFormatting.ItemIndex := CopyIdx;
end
else
begin
ComboBoxInputFormatting.ItemIndex := 0;
ComboBoxOutputFormatting.ItemIndex := 0;
end;
end;
finally
Formats.Free;
end;
end;
procedure TFormMain.InitCipherCombo;
var
MyClass : TPair<Int64, TDECClass>;
Ciphers : TStringList;
begin
Ciphers := TStringList.Create;
try
// Alternatively you can use TDECCipher.ClassList.GetClassList(Ciphers); but
// then it's harder to remove TCipher_Null from the list
for MyClass in TDECCipher.ClassList do
begin
if (MyClass.Value <> TCipher_Null) then
Ciphers.Add(MyClass.Value.ClassName);
end;
Ciphers.Sort;
ComboBoxCipherAlgorithm.Items.AddStrings(Ciphers);
if Ciphers.Count > 0 then
ComboBoxCipherAlgorithm.ItemIndex := 0;
finally
Ciphers.Free;
end;
end;
procedure TFormMain.InitCipherModes;
var
Mode : TCipherMode;
begin
for Mode := low(TCipherMode) to high(TCipherMode) do
begin
ComboBoxChainingMethod.Items.Add(System.TypInfo.GetEnumName(
TypeInfo(TCipherMode),
Integer(Mode)));
end;
if ComboBoxChainingMethod.Items.Count > 0 then
ComboBoxChainingMethod.ItemIndex := 0;
end;
end.

View File

@ -0,0 +1,51 @@
{*****************************************************************************
The DEC team (see file NOTICE.txt) licenses this file
to you under the Apache License, Version 2.0 (the
"License"); you may not use this file except in compliance
with the License. A copy of this licence is found in the root directory of
this project in the file LICENCE.txt or alternatively at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing,
software distributed under the License is distributed on an
"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
KIND, either express or implied. See the License for the
specific language governing permissions and limitations
under the License.
*****************************************************************************}
/// <summary>
/// Most simple demonstration of DEC formatting routines
/// </summary>
program Format_Console;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
DECFormat;
var
s, s1 : string;
begin
try
s := 'Hello world!';
// Convert the string to be encoded in a byte array
// and te result into a string for output
s1 := System.SysUtils.StringOf(TFormat_HEX.Encode(System.SysUtils.BytesOf(s)));
WriteLn(s + ' encoded in hex is: ' + s1);
// the same for decoding
WriteLn('Hex ' + s1 + ' is ' +
System.SysUtils.StringOf(TFormat_HEX.Decode(System.SysUtils.BytesOf(s1))) +
' unencoded');
ReadLn;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,45 @@
<?xml version="1.0" encoding="utf-8"?>
<!-- BEGIN_INCLUDE(manifest) -->
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="%package%"
android:versionCode="%versionCode%"
android:versionName="%versionName%"
android:installLocation="%installLocation%">
<uses-sdk android:minSdkVersion="%minSdkVersion%" android:targetSdkVersion="%targetSdkVersion%" />
<%uses-permission%>
<uses-feature android:glEsVersion="0x00020000" android:required="True"/>
<application android:persistent="%persistent%"
android:restoreAnyVersion="%restoreAnyVersion%"
android:label="%label%"
android:debuggable="%debuggable%"
android:largeHeap="%largeHeap%"
android:icon="%icon%"
android:theme="%theme%"
android:hardwareAccelerated="%hardwareAccelerated%"
android:resizeableActivity="false"
android:requestLegacyExternalStorage="true">
<%provider%>
<%application-meta-data%>
<%uses-libraries%>
<%services%>
<!-- Our activity is a subclass of the built-in NativeActivity framework class.
This will take care of integrating with our NDK code. -->
<activity android:name="com.embarcadero.firemonkey.FMXNativeActivity"
android:label="%activityLabel%"
android:configChanges="orientation|keyboard|keyboardHidden|screenSize"
android:launchMode="singleTask">
<!-- Tell NativeActivity the name of our .so -->
<meta-data android:name="android.app.lib_name"
android:value="%libNameValue%" />
<intent-filter>
<action android:name="android.intent.action.MAIN" />
<category android:name="android.intent.category.LAUNCHER" />
</intent-filter>
</activity>
<%activity%>
<%receivers%>
</application>
</manifest>
<!-- END_INCLUDE(manifest) -->

Binary file not shown.

After

Width:  |  Height:  |  Size: 282 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 308 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 580 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.1 MiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 151 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 14 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 24 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 31 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.9 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 3.2 KiB

Some files were not shown because too many files have changed in this diff Show More