├── .gitattributes ├── alipay.jpg ├── clear_with_dcu.bat ├── lib ├── Cadencer.pas ├── CoreAtomic.inc ├── CoreCipher.pas ├── CoreClasses.pas ├── CoreCompress.pas ├── CoreComputeThread.inc ├── CoreEndian.inc ├── CoreThreadPost.inc ├── Core_AtomVar.inc ├── Core_DelphiParallelFor.inc ├── Core_FPCParallelFor.inc ├── Core_LineProcessor.inc ├── Core_MT19937.inc ├── Core_OrderData.inc ├── DataFrameEngine.pas ├── DoStatusIO.pas ├── FPCGenericStructlist.pas ├── Fast_MD5.pas ├── GHashList.pas ├── Geometry2DUnit.pas ├── Geometry3DUnit.pas ├── GeometryLib.pas ├── GeometryRotationUnit.pas ├── GeometrySplit.inc ├── GeometrySplitHeader.inc ├── LinearAction.pas ├── ListEngine.pas ├── MH.pas ├── MH_1.pas ├── MH_2.pas ├── MH_3.pas ├── MH_ZDB.pas ├── MH_delphi.inc ├── MH_fpc.inc ├── MemoryStream64.pas ├── NotifyObjectBase.pas ├── NumberBase.pas ├── OpCode.pas ├── PascalStrings.pas ├── TextDataEngine.pas ├── TextParsing.pas ├── TextTable.pas ├── UPascalStrings.pas ├── UnicodeMixedLib.pas ├── ZIOThread.pas ├── ZJson.pas ├── ZJson_delphi.inc ├── ZJson_fpc.inc ├── ZS_JsonDataObjects.pas ├── clear_with_dcu.bat ├── md5_32.asm ├── md5_32.obj ├── md5_64.asm ├── md5_64.obj ├── zDefine.inc └── zExpression.pas ├── readme.md ├── samples ├── Delphi │ ├── Console │ │ ├── console.dpr │ │ ├── console.dproj │ │ ├── console.dproj.local │ │ ├── console.identcache │ │ └── console.res │ ├── NumberTransform │ │ ├── NumTrans.dpr │ │ ├── NumTrans.dproj │ │ ├── NumTrans.dproj.local │ │ ├── NumTrans.identcache │ │ ├── NumTrans.res │ │ ├── NumTransFrm.dfm │ │ └── NumTransFrm.pas │ ├── Pascal Code Dependency Anslysis │ │ ├── PascalCodeDependencyAnslysis.dpr │ │ ├── PascalCodeDependencyAnslysis.dproj │ │ ├── PascalCodeDependencyAnslysis.dproj.local │ │ ├── PascalCodeDependencyAnslysis.identcache │ │ └── PascalCodeDependencyAnslysis.res │ ├── TextParsing │ │ ├── TextParsingDemo.dpr │ │ ├── TextParsingDemo.dproj │ │ ├── TextParsingDemo.dproj.local │ │ ├── TextParsingDemo.identcache │ │ ├── TextParsingDemo.res │ │ ├── TextParsingFrm.dfm │ │ └── TextParsingFrm.pas │ ├── all.groupproj │ ├── all.groupproj.local │ └── zExpressionSupport │ │ ├── zExpressionSupport.dpr │ │ ├── zExpressionSupport.dproj │ │ ├── zExpressionSupport.dproj.local │ │ ├── zExpressionSupport.identcache │ │ ├── zExpressionSupport.res │ │ ├── zExpressionSupportMainFrm.fmx │ │ └── zExpressionSupportMainFrm.pas └── fpc │ ├── demofrm.lfm │ ├── demofrm.pas │ ├── fpcDemo.ico │ ├── fpcDemo.lpi │ ├── fpcDemo.lpr │ ├── fpcDemo.lps │ └── fpcDemo.res └── tools ├── PascalCodeUnification ├── PascalCodeUnification.dpr ├── PascalCodeUnification.dproj ├── PascalCodeUnification.dproj.local ├── PascalCodeUnification.identcache ├── PascalCodeUnification.res ├── PascalCodeUnification.stat ├── PascalCodeUnificationFrm.dfm ├── PascalCodeUnificationFrm.pas └── 辅助编译工具：基于ObjectPascal的大规模统一化.txt ├── StringTranslate ├── StringTranslate.dpr ├── StringTranslate.dproj ├── StringTranslate.dproj.local ├── StringTranslate.identcache ├── StringTranslate.res ├── StringTranslate.stat ├── StringTranslateFrm.dfm └── StringTranslateFrm.pas └── ToolsPG.groupproj /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /alipay.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/alipay.jpg -------------------------------------------------------------------------------- /clear_with_dcu.bat: -------------------------------------------------------------------------------- 1 | del/s *.dcu 2 | del/s *.o 3 | del/s *.ppu 4 | del/s *.rsm 5 | del/s *.bak -------------------------------------------------------------------------------- /lib/Cadencer.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * cadencer imp library written by QQ 600585@qq.com * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | 20 | unit Cadencer; 21 | 22 | {$INCLUDE zDefine.inc} 23 | 24 | interface 25 | 26 | uses CoreClasses; 27 | 28 | type 29 | { 30 | Progression event for time-base animations/simulations. 31 | deltaTime is the time delta since last progress and newTime is the new 32 | time after the progress event is completed. 33 | } 34 | TCadencerProgressMethod = procedure(Sender: TObject; const deltaTime, newTime: Double) of object; 35 | TCadencerProgressCall = procedure(Sender: TObject; const deltaTime, newTime: Double); 36 | {$IFDEF FPC} 37 | TCadencerProgressProc = procedure(Sender: TObject; const deltaTime, newTime: Double) is nested; 38 | {$ELSE FPC} 39 | TCadencerProgressProc = reference to procedure(Sender: TObject; const deltaTime, newTime: Double); 40 | {$ENDIF FPC} 41 | 42 | ICadencerProgressInterface = interface 43 | procedure CadencerProgress(const deltaTime, newTime: Double); 44 | end; 45 | 46 | { 47 | This component allows auto-progression of animation. 48 | Basicly dropping this component and linking it to your app will send 49 | it real-time progression events (time will be measured in seconds) while 50 | keeping the CPU 100% busy if possible (ie. if things change in your app). 51 | The progression time (the one you'll see in you progression events) 52 | is calculated using (CurrentTime-OriginTime)*TimeMultiplier, 53 | CurrentTime being either manually or automatically updated using 54 | TimeReference (setting CurrentTime does NOT trigger progression). 55 | } 56 | TCadencer = class(TCoreClassObject) 57 | private 58 | { Private Declarations } 59 | FTimeMultiplier: Double; 60 | LastTime, DownTime, LastMultiplier: Double; 61 | FLastDeltaTime: Double; 62 | FEnabled: Boolean; 63 | FSleepLength: Integer; 64 | FCurrentTime: Double; 65 | FOriginTime: Double; 66 | FMaxDeltaTime, FMinDeltaTime, FFixedDeltaTime: Double; 67 | FOnProgress: TCadencerProgressMethod; 68 | FOnProgressCall: TCadencerProgressCall; 69 | FOnProgressProc: TCadencerProgressProc; 70 | FProgressing: Integer; 71 | FProgressIntf: ICadencerProgressInterface; 72 | protected 73 | function StoreTimeMultiplier: Boolean; 74 | procedure SetEnabled(const val_: Boolean); 75 | procedure SetTimeMultiplier(const val_: Double); 76 | procedure SetCurrentTime(const Value: Double); 77 | { Returns raw ref time (no multiplier, no offset) } 78 | function GetRawReferenceTime: Double; 79 | public 80 | constructor Create; 81 | destructor Destroy; override; 82 | 83 | { Allows to manually trigger a progression. Time stuff is handled automatically. If cadencer is disabled, this functions does nothing. } 84 | procedure Progress; 85 | 86 | { Adjusts CurrentTime if necessary, then returns its value. } 87 | function UpdateCurrentTime: Double; 88 | 89 | { Returns True if a "Progress" is underway. } 90 | function IsBusy: Boolean; 91 | 92 | { Reset the time parameters and returns to zero. } 93 | procedure Reset; 94 | 95 | { Value soustracted to current time to obtain progression time. } 96 | property OriginTime: Double read FOriginTime write FOriginTime; 97 | { Current time (manually or automatically set, see TimeReference). } 98 | property CurrentTime: Double read FCurrentTime write SetCurrentTime; 99 | 100 | { Enables/Disables cadencing. 101 | Disabling won't cause a jump when restarting, it is working like a play/pause (ie. may modify OriginTime to keep things smooth). } 102 | property Enabled: Boolean read FEnabled write SetEnabled default True; 103 | 104 | { Multiplier applied to the time reference. } 105 | property TimeMultiplier: Double read FTimeMultiplier write SetTimeMultiplier stored StoreTimeMultiplier; 106 | 107 | { Maximum value for deltaTime in progression events. 108 | If null or negative, no max deltaTime is defined, otherwise, whenever an event whose actual deltaTime would be superior to MaxDeltaTime occurs, 109 | deltaTime is clamped to this max, and the extra time is hidden by the cadencer (it isn't visible in CurrentTime either). 110 | This option allows to limit progression rate in simulations where high values would result in errors/random behaviour. } 111 | property MaxDeltaTime: Double read FMaxDeltaTime write FMaxDeltaTime; 112 | 113 | { Minimum value for deltaTime in progression events. 114 | If superior to zero, this value specifies the minimum time step between two progression events. 115 | This option allows to limit progression rate in simulations where low values would result in errors/random behaviour. } 116 | property MinDeltaTime: Double read FMinDeltaTime write FMinDeltaTime; 117 | 118 | { Fixed time-step value for progression events. 119 | If superior to zero, progression steps will happen with that fixed delta time. 120 | The progression remains time based, 121 | so zero to N events may be fired depending on the actual deltaTime (if deltaTime is inferior to FixedDeltaTime, no event will be fired, 122 | if it is superior to two times FixedDeltaTime, two events will be fired, etc.). 123 | This option allows to use fixed time steps in simulations (while the animation and rendering itself may happen at a lower or higher framerate). } 124 | property FixedDeltaTime: Double read FFixedDeltaTime write FFixedDeltaTime; 125 | 126 | { Allows relinquishing time to other threads/processes. 127 | A "sleep" is issued BEFORE each progress if SleepLength>=0 (see help for the "sleep" procedure in delphi for details). } 128 | property SleepLength: Integer read FSleepLength write FSleepLength default -1; 129 | 130 | { LastDeltaTime from progress. } 131 | property LastDeltaTime: Double read FLastDeltaTime; 132 | 133 | { backcall } 134 | property OnProgress: TCadencerProgressMethod read FOnProgress write FOnProgress; 135 | property OnProgressCall: TCadencerProgressCall read FOnProgressCall write FOnProgressCall; 136 | property OnProgressProc: TCadencerProgressProc read FOnProgressProc write FOnProgressProc; 137 | { interface } 138 | property ProgressInterface: ICadencerProgressInterface read FProgressIntf write FProgressIntf; 139 | property OnProgressInterface: ICadencerProgressInterface read FProgressIntf write FProgressIntf; 140 | end; 141 | 142 | implementation 143 | 144 | function TCadencer.StoreTimeMultiplier: Boolean; 145 | begin 146 | Result := (FTimeMultiplier <> 1); 147 | end; 148 | 149 | procedure TCadencer.SetEnabled(const val_: Boolean); 150 | begin 151 | if FEnabled <> val_ then 152 | begin 153 | FEnabled := val_; 154 | if Enabled then 155 | FOriginTime := FOriginTime + GetRawReferenceTime - DownTime 156 | else 157 | DownTime := GetRawReferenceTime; 158 | end; 159 | end; 160 | 161 | procedure TCadencer.SetTimeMultiplier(const val_: Double); 162 | var 163 | rawRef: Double; 164 | begin 165 | if val_ <> FTimeMultiplier then 166 | begin 167 | if val_ = 0 then 168 | begin 169 | LastMultiplier := FTimeMultiplier; 170 | Enabled := False; 171 | end 172 | else 173 | begin 174 | rawRef := GetRawReferenceTime; 175 | if FTimeMultiplier = 0 then 176 | begin 177 | Enabled := True; 178 | FOriginTime := rawRef - (rawRef - FOriginTime) * LastMultiplier / val_; 179 | end 180 | else 181 | FOriginTime := rawRef - (rawRef - FOriginTime) * FTimeMultiplier / val_; 182 | end; 183 | FTimeMultiplier := val_; 184 | end; 185 | end; 186 | 187 | procedure TCadencer.SetCurrentTime(const Value: Double); 188 | begin 189 | LastTime := Value - (FCurrentTime - LastTime); 190 | FOriginTime := FOriginTime + (FCurrentTime - Value); 191 | FCurrentTime := Value; 192 | end; 193 | 194 | function TCadencer.GetRawReferenceTime: Double; 195 | begin 196 | Result := GetTimeTick * 0.001; 197 | end; 198 | 199 | constructor TCadencer.Create; 200 | begin 201 | inherited Create; 202 | DownTime := GetRawReferenceTime; 203 | FOriginTime := DownTime; 204 | FTimeMultiplier := 1; 205 | LastTime := 0; 206 | LastMultiplier := 0; 207 | FLastDeltaTime := 0; 208 | FSleepLength := -1; 209 | Enabled := True; 210 | FOnProgress := nil; 211 | FOnProgressCall := nil; 212 | FOnProgressProc := nil; 213 | FProgressIntf := nil; 214 | end; 215 | 216 | destructor TCadencer.Destroy; 217 | begin 218 | while FProgressing > 0 do 219 | TCompute.Sleep(1); 220 | inherited Destroy; 221 | end; 222 | 223 | procedure TCadencer.Progress; 224 | var 225 | deltaTime, newTime, totalDelta: Double; 226 | begin 227 | { basic protection against infinite loops, } 228 | { shall never happen, unless there is a bug in user code } 229 | if FProgressing < 0 then 230 | Exit; 231 | if Enabled then 232 | begin 233 | { avoid stalling everything else... } 234 | if SleepLength >= 0 then 235 | TCoreClassThread.Sleep(SleepLength); 236 | end; 237 | AtomInc(FProgressing); 238 | try 239 | if Enabled then 240 | begin 241 | { One of the processed messages might have disabled us } 242 | if Enabled then 243 | begin 244 | { ...and progress ! } 245 | newTime := UpdateCurrentTime; 246 | deltaTime := newTime - LastTime; 247 | if (deltaTime >= MinDeltaTime) and (deltaTime >= FixedDeltaTime) then 248 | begin 249 | if FMaxDeltaTime > 0 then 250 | begin 251 | if deltaTime > FMaxDeltaTime then 252 | begin 253 | FOriginTime := FOriginTime + (deltaTime - FMaxDeltaTime) / FTimeMultiplier; 254 | deltaTime := FMaxDeltaTime; 255 | newTime := LastTime + deltaTime; 256 | end; 257 | end; 258 | totalDelta := deltaTime; 259 | if FixedDeltaTime > 0 then 260 | deltaTime := FixedDeltaTime; 261 | while totalDelta >= deltaTime do 262 | begin 263 | LastTime := LastTime + deltaTime; 264 | FLastDeltaTime := deltaTime; 265 | try 266 | if Assigned(FOnProgress) then 267 | FOnProgress(Self, deltaTime, newTime); 268 | if Assigned(FOnProgressCall) then 269 | FOnProgressCall(Self, deltaTime, newTime); 270 | if Assigned(FOnProgressProc) then 271 | FOnProgressProc(Self, deltaTime, newTime); 272 | if Assigned(FProgressIntf) then 273 | FProgressIntf.CadencerProgress(deltaTime, newTime); 274 | except 275 | end; 276 | 277 | if deltaTime <= 0 then 278 | Break; 279 | totalDelta := totalDelta - deltaTime; 280 | end; 281 | end; 282 | end; 283 | end; 284 | finally 285 | AtomDec(FProgressing); 286 | end; 287 | end; 288 | 289 | function TCadencer.UpdateCurrentTime: Double; 290 | begin 291 | Result := (GetRawReferenceTime - FOriginTime) * FTimeMultiplier; 292 | FCurrentTime := Result; 293 | end; 294 | 295 | function TCadencer.IsBusy: Boolean; 296 | begin 297 | Result := (FProgressing > 0); 298 | end; 299 | 300 | procedure TCadencer.Reset; 301 | begin 302 | LastTime := 0; 303 | DownTime := GetRawReferenceTime; 304 | FOriginTime := DownTime; 305 | end; 306 | 307 | initialization 308 | 309 | finalization 310 | 311 | end. 312 | -------------------------------------------------------------------------------- /lib/CoreThreadPost.inc: -------------------------------------------------------------------------------- 1 | procedure TThreadPostData.Init; 2 | begin 3 | OnCall1 := nil; 4 | OnCall2 := nil; 5 | OnCall3 := nil; 6 | OnCall4 := nil; 7 | OnMethod1 := nil; 8 | OnMethod2 := nil; 9 | OnMethod3 := nil; 10 | OnMethod4 := nil; 11 | OnProc1 := nil; 12 | OnProc2 := nil; 13 | OnProc3 := nil; 14 | OnProc4 := nil; 15 | Data1 := nil; 16 | Data2 := nil; 17 | Data3 := NULL; 18 | end; 19 | 20 | procedure TThreadPost.FreeThreadProgressPostData(p: TThreadPostDataOrder.PT_); 21 | begin 22 | Dispose(p); 23 | end; 24 | 25 | constructor TThreadPost.Create(ThreadID_: TThreadID); 26 | begin 27 | inherited Create; 28 | FCritical := TCritical.Create; 29 | FThreadID := ThreadID_; 30 | FSyncPool := TThreadPostDataOrder.Create; 31 | FSyncPool.OnFreeOrderStruct := {$IFDEF FPC}@{$ENDIF FPC}FreeThreadProgressPostData; 32 | FProgressing := TAtomBool.Create(False); 33 | FOneStep := True; 34 | FResetRandomSeed := False; 35 | end; 36 | 37 | destructor TThreadPost.Destroy; 38 | begin 39 | FCritical.Acquire; 40 | FSyncPool.Clear; 41 | FSyncPool.Clear; 42 | FCritical.Release; 43 | DisposeObject(FSyncPool); 44 | FCritical.Free; 45 | FProgressing.Free; 46 | inherited Destroy; 47 | end; 48 | 49 | function TThreadPost.Count: Integer; 50 | begin 51 | FCritical.Acquire; 52 | Result := FSyncPool.Num; 53 | FCritical.Release; 54 | end; 55 | 56 | function TThreadPost.Busy: Boolean; 57 | begin 58 | Result := (Count > 0) or (FProgressing.V); 59 | end; 60 | 61 | function TThreadPost.Progress(ThreadID_: TThreadID): Integer; 62 | var 63 | i: Integer; 64 | temp: TThreadPostDataOrder; 65 | t_: TThreadPostData; 66 | begin 67 | Result := 0; 68 | if ThreadID_ <> FThreadID then 69 | exit; 70 | 71 | if FOneStep then 72 | begin 73 | if FSyncPool.Current <> nil then 74 | begin 75 | FProgressing.V := True; 76 | FCritical.Acquire; 77 | t_ := FSyncPool.Current^.Data^; 78 | FSyncPool.Next; 79 | FCritical.Release; 80 | 81 | if FResetRandomSeed then 82 | SetMT19937Seed(0); 83 | try 84 | if Assigned(t_.OnCall1) then 85 | t_.OnCall1(); 86 | if Assigned(t_.OnCall2) then 87 | t_.OnCall2(t_.Data1); 88 | if Assigned(t_.OnCall3) then 89 | t_.OnCall3(t_.Data1, t_.Data2, t_.Data3); 90 | if Assigned(t_.OnCall4) then 91 | t_.OnCall4(t_.Data1, t_.Data2); 92 | 93 | if Assigned(t_.OnMethod1) then 94 | t_.OnMethod1(); 95 | if Assigned(t_.OnMethod2) then 96 | t_.OnMethod2(t_.Data1); 97 | if Assigned(t_.OnMethod3) then 98 | t_.OnMethod3(t_.Data1, t_.Data2, t_.Data3); 99 | if Assigned(t_.OnMethod4) then 100 | t_.OnMethod4(t_.Data1, t_.Data2); 101 | 102 | if Assigned(t_.OnProc1) then 103 | t_.OnProc1(); 104 | if Assigned(t_.OnProc2) then 105 | t_.OnProc2(t_.Data1); 106 | if Assigned(t_.OnProc3) then 107 | t_.OnProc3(t_.Data1, t_.Data2, t_.Data3); 108 | if Assigned(t_.OnProc4) then 109 | t_.OnProc4(t_.Data1, t_.Data2); 110 | except 111 | end; 112 | 113 | FProgressing.V := False; 114 | Result := 1; 115 | end; 116 | end 117 | else 118 | while (not FProgressing.V) and (Count > 0) do 119 | begin 120 | FProgressing.V := True; 121 | FCritical.Acquire; 122 | temp := FSyncPool; 123 | FSyncPool := TThreadPostDataOrder.Create; 124 | FCritical.Release; 125 | Result := temp.Num; 126 | while temp.Current <> nil do 127 | begin 128 | if FResetRandomSeed then 129 | SetMT19937Seed(0); 130 | try 131 | if Assigned(temp.Current^.Data^.OnCall1) then 132 | temp.Current^.Data^.OnCall1(); 133 | if Assigned(temp.Current^.Data^.OnCall2) then 134 | temp.Current^.Data^.OnCall2(temp.Current^.Data^.Data1); 135 | if Assigned(temp.Current^.Data^.OnCall3) then 136 | temp.Current^.Data^.OnCall3(temp.Current^.Data^.Data1, temp.Current^.Data^.Data2, temp.Current^.Data^.Data3); 137 | if Assigned(temp.Current^.Data^.OnCall4) then 138 | temp.Current^.Data^.OnCall4(temp.Current^.Data^.Data1, temp.Current^.Data^.Data2); 139 | 140 | if Assigned(temp.Current^.Data^.OnMethod1) then 141 | temp.Current^.Data^.OnMethod1(); 142 | if Assigned(temp.Current^.Data^.OnMethod2) then 143 | temp.Current^.Data^.OnMethod2(temp.Current^.Data^.Data1); 144 | if Assigned(temp.Current^.Data^.OnMethod3) then 145 | temp.Current^.Data^.OnMethod3(temp.Current^.Data^.Data1, temp.Current^.Data^.Data2, temp.Current^.Data^.Data3); 146 | if Assigned(temp.Current^.Data^.OnMethod4) then 147 | temp.Current^.Data^.OnMethod4(temp.Current^.Data^.Data1, temp.Current^.Data^.Data2); 148 | 149 | if Assigned(temp.Current^.Data^.OnProc1) then 150 | temp.Current^.Data^.OnProc1(); 151 | if Assigned(temp.Current^.Data^.OnProc2) then 152 | temp.Current^.Data^.OnProc2(temp.Current^.Data^.Data1); 153 | if Assigned(temp.Current^.Data^.OnProc3) then 154 | temp.Current^.Data^.OnProc3(temp.Current^.Data^.Data1, temp.Current^.Data^.Data2, temp.Current^.Data^.Data3); 155 | if Assigned(temp.Current^.Data^.OnProc4) then 156 | temp.Current^.Data^.OnProc4(temp.Current^.Data^.Data1, temp.Current^.Data^.Data2); 157 | except 158 | end; 159 | temp.Next; 160 | end; 161 | DisposeObject(temp); 162 | FProgressing.V := False; 163 | end; 164 | end; 165 | 166 | function TThreadPost.Progress(Thread_: TThread): Integer; 167 | begin 168 | Result := Progress(Thread_.ThreadID); 169 | end; 170 | 171 | function TThreadPost.Progress(): Integer; 172 | begin 173 | Result := Progress(TThread.CurrentThread); 174 | end; 175 | 176 | procedure TThreadPost.PostC1(OnSync: TThreadPostCall1); 177 | var 178 | t_: TThreadPostData; 179 | begin 180 | t_.Init(); 181 | t_.OnCall1 := OnSync; 182 | FCritical.Acquire; 183 | FSyncPool.Push(t_); 184 | FCritical.Release; 185 | end; 186 | 187 | procedure TThreadPost.PostC2(Data1: Pointer; OnSync: TThreadPostCall2); 188 | var 189 | t_: TThreadPostData; 190 | begin 191 | t_.Init(); 192 | t_.Data1 := Data1; 193 | t_.OnCall2 := OnSync; 194 | FCritical.Acquire; 195 | FSyncPool.Push(t_); 196 | FCritical.Release; 197 | end; 198 | 199 | procedure TThreadPost.PostC3(Data1: Pointer; Data2: TCoreClassObject; Data3: Variant; OnSync: TThreadPostCall3); 200 | var 201 | t_: TThreadPostData; 202 | begin 203 | t_.Init(); 204 | t_.Data1 := Data1; 205 | t_.Data2 := Data2; 206 | t_.Data3 := Data3; 207 | t_.OnCall3 := OnSync; 208 | FCritical.Acquire; 209 | FSyncPool.Push(t_); 210 | FCritical.Release; 211 | end; 212 | 213 | procedure TThreadPost.PostC4(Data1: Pointer; Data2: TCoreClassObject; OnSync: TThreadPostCall4); 214 | var 215 | t_: TThreadPostData; 216 | begin 217 | t_.Init(); 218 | t_.Data1 := Data1; 219 | t_.Data2 := Data2; 220 | t_.OnCall4 := OnSync; 221 | FCritical.Acquire; 222 | FSyncPool.Push(t_); 223 | FCritical.Release; 224 | end; 225 | 226 | procedure TThreadPost.PostM1(OnSync: TThreadPostMethod1); 227 | var 228 | t_: TThreadPostData; 229 | begin 230 | t_.Init(); 231 | t_.OnMethod1 := OnSync; 232 | FCritical.Acquire; 233 | FSyncPool.Push(t_); 234 | FCritical.Release; 235 | end; 236 | 237 | procedure TThreadPost.PostM2(Data1: Pointer; OnSync: TThreadPostMethod2); 238 | var 239 | t_: TThreadPostData; 240 | begin 241 | t_.Init(); 242 | t_.Data1 := Data1; 243 | t_.OnMethod2 := OnSync; 244 | FCritical.Acquire; 245 | FSyncPool.Push(t_); 246 | FCritical.Release; 247 | end; 248 | 249 | procedure TThreadPost.PostM3(Data1: Pointer; Data2: TCoreClassObject; Data3: Variant; OnSync: TThreadPostMethod3); 250 | var 251 | t_: TThreadPostData; 252 | begin 253 | t_.Init(); 254 | t_.Data1 := Data1; 255 | t_.Data2 := Data2; 256 | t_.Data3 := Data3; 257 | t_.OnMethod3 := OnSync; 258 | FCritical.Acquire; 259 | FSyncPool.Push(t_); 260 | FCritical.Release; 261 | end; 262 | 263 | procedure TThreadPost.PostM4(Data1: Pointer; Data2: TCoreClassObject; OnSync: TThreadPostMethod4); 264 | var 265 | t_: TThreadPostData; 266 | begin 267 | t_.Init(); 268 | t_.Data1 := Data1; 269 | t_.Data2 := Data2; 270 | t_.OnMethod4 := OnSync; 271 | FCritical.Acquire; 272 | FSyncPool.Push(t_); 273 | FCritical.Release; 274 | end; 275 | 276 | procedure TThreadPost.PostP1(OnSync: TThreadPostProc1); 277 | var 278 | t_: TThreadPostData; 279 | begin 280 | t_.Init(); 281 | t_.OnProc1 := OnSync; 282 | FCritical.Acquire; 283 | FSyncPool.Push(t_); 284 | FCritical.Release; 285 | end; 286 | 287 | procedure TThreadPost.PostP2(Data1: Pointer; OnSync: TThreadPostProc2); 288 | var 289 | t_: TThreadPostData; 290 | begin 291 | t_.Init(); 292 | t_.Data1 := Data1; 293 | t_.OnProc2 := OnSync; 294 | FCritical.Acquire; 295 | FSyncPool.Push(t_); 296 | FCritical.Release; 297 | end; 298 | 299 | procedure TThreadPost.PostP3(Data1: Pointer; Data2: TCoreClassObject; Data3: Variant; OnSync: TThreadPostProc3); 300 | var 301 | t_: TThreadPostData; 302 | begin 303 | t_.Init(); 304 | t_.Data1 := Data1; 305 | t_.Data2 := Data2; 306 | t_.Data3 := Data3; 307 | t_.OnProc3 := OnSync; 308 | FCritical.Acquire; 309 | FSyncPool.Push(t_); 310 | FCritical.Release; 311 | end; 312 | 313 | procedure TThreadPost.PostP4(Data1: Pointer; Data2: TCoreClassObject; OnSync: TThreadPostProc4); 314 | var 315 | t_: TThreadPostData; 316 | begin 317 | t_.Init(); 318 | t_.Data1 := Data1; 319 | t_.Data2 := Data2; 320 | t_.OnProc4 := OnSync; 321 | FCritical.Acquire; 322 | FSyncPool.Push(t_); 323 | FCritical.Release; 324 | end; 325 | -------------------------------------------------------------------------------- /lib/Core_AtomVar.inc: -------------------------------------------------------------------------------- 1 | function TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.GetValue: T_; 2 | begin 3 | Critical.Acquire; 4 | Result := FValue__; 5 | Critical.Release; 6 | end; 7 | 8 | procedure TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.SetValue(const Value_: T_); 9 | begin 10 | Critical.Acquire; 11 | FValue__ := Value_; 12 | Critical.Release; 13 | end; 14 | 15 | function TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.GetValueP: PT_; 16 | begin 17 | Result := @FValue__; 18 | end; 19 | 20 | constructor TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.Create(Value_: T_); 21 | begin 22 | inherited Create; 23 | FValue__ := Value_; 24 | Critical := TCritical_.Create; 25 | end; 26 | 27 | destructor TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.Destroy; 28 | begin 29 | Critical.Free; 30 | inherited Destroy; 31 | end; 32 | 33 | function TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.Lock: T_; 34 | begin 35 | Critical.Acquire; 36 | Result := FValue__; 37 | end; 38 | 39 | function TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.LockP: PT_; 40 | begin 41 | Critical.Acquire; 42 | Result := @FValue__; 43 | end; 44 | 45 | procedure TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.UnLock(const Value_: T_); 46 | begin 47 | FValue__ := Value_; 48 | Critical.Release; 49 | end; 50 | 51 | procedure TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.UnLock(const Value_: PT_); 52 | begin 53 | FValue__ := Value_^; 54 | Critical.Release; 55 | end; 56 | 57 | procedure TAtomVar{$IFNDEF FPC}{$ENDIF FPC}.UnLock(); 58 | begin 59 | Critical.Release; 60 | end; 61 | -------------------------------------------------------------------------------- /lib/Core_LineProcessor.inc: -------------------------------------------------------------------------------- 1 | {$IFDEF RangeCheck}{$R-}{$ENDIF} 2 | {$IFDEF OverflowCheck}{$Q-}{$ENDIF} 3 | 4 | 5 | procedure TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.CreateDone; 6 | begin 7 | end; 8 | 9 | constructor TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.Create(const data_: Pointer; const width_, height_: NativeInt; const Value_: T_; const LineTail_: Boolean); 10 | begin 11 | inherited Create; 12 | FData := PTArry_(data_); 13 | FWidth := width_; 14 | FHeight := height_; 15 | FValue := Value_; 16 | FLineTail := LineTail_; 17 | CreateDone(); 18 | end; 19 | 20 | destructor TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.Destroy; 21 | begin 22 | inherited Destroy; 23 | end; 24 | 25 | procedure TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.VertLine(X, y1, y2: NativeInt); 26 | var 27 | i: NativeInt; 28 | p: PT_; 29 | begin 30 | if (X < 0) or (X >= FWidth) then 31 | Exit; 32 | 33 | if y1 < 0 then 34 | y1 := 0; 35 | if y1 >= FHeight then 36 | y1 := FHeight - 1; 37 | 38 | if y2 < 0 then 39 | y2 := 0; 40 | if y2 >= FHeight then 41 | y2 := FHeight - 1; 42 | 43 | if y2 < y1 then 44 | Swap(y1, y2); 45 | 46 | p := @FData^[X + y1 * FWidth]; 47 | for i := y1 to y2 do 48 | begin 49 | Process(p, FValue); 50 | inc(p, FWidth); 51 | end; 52 | end; 53 | 54 | procedure TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.HorzLine(x1, Y, x2: NativeInt); 55 | var 56 | i: NativeInt; 57 | p: PT_; 58 | begin 59 | if (Y < 0) or (Y >= FHeight) then 60 | Exit; 61 | 62 | if x1 < 0 then 63 | x1 := 0; 64 | if x1 >= FWidth then 65 | x1 := FWidth - 1; 66 | 67 | if x2 < 0 then 68 | x2 := 0; 69 | if x2 >= FWidth then 70 | x2 := FWidth - 1; 71 | 72 | if x1 > x2 then 73 | Swap(x1, x2); 74 | 75 | p := @FData^[x1 + Y * FWidth]; 76 | 77 | for i := x1 to x2 do 78 | begin 79 | Process(p, FValue); 80 | inc(p); 81 | end; 82 | end; 83 | 84 | procedure TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.Line(x1, y1, x2, y2: NativeInt); 85 | var 86 | dy, dx, SY, SX, i, Delta: NativeInt; 87 | pi, pl: NativeInt; 88 | begin 89 | if (x1 = x2) and (y1 = y2) then 90 | begin 91 | Process(@FData^[x1 + y1 * FWidth], FValue); 92 | Exit; 93 | end; 94 | 95 | dx := x2 - x1; 96 | dy := y2 - y1; 97 | 98 | if dx > 0 then 99 | SX := 1 100 | else if dx < 0 then 101 | begin 102 | dx := -dx; 103 | SX := -1; 104 | end 105 | else // Dx = 0 106 | begin 107 | if dy > 0 then 108 | VertLine(x1, y1, y2 - 1) 109 | else if dy < 0 then 110 | VertLine(x1, y2 + 1, y1); 111 | if FLineTail then 112 | Process(@FData^[x2 + y2 * FWidth], FValue); 113 | Exit; 114 | end; 115 | 116 | if dy > 0 then 117 | SY := 1 118 | else if dy < 0 then 119 | begin 120 | dy := -dy; 121 | SY := -1; 122 | end 123 | else // Dy = 0 124 | begin 125 | if x2 > x1 then 126 | HorzLine(x1, y1, x2 - 1) 127 | else 128 | HorzLine(x2 + 1, y1, x1); 129 | if FLineTail then 130 | Process(@FData^[x2 + y2 * FWidth], FValue); 131 | Exit; 132 | end; 133 | 134 | pi := x1 + y1 * FWidth; 135 | SY := SY * FWidth; 136 | pl := FWidth * FHeight; 137 | 138 | if dx > dy then 139 | begin 140 | Delta := dx shr 1; 141 | for i := 0 to dx - 1 do 142 | begin 143 | if (pi >= 0) and (pi < pl) then 144 | Process(@FData^[pi], FValue); 145 | 146 | inc(pi, SX); 147 | inc(Delta, dy); 148 | if Delta >= dx then 149 | begin 150 | inc(pi, SY); 151 | dec(Delta, dx); 152 | end; 153 | end; 154 | end 155 | else // Dx < Dy 156 | begin 157 | Delta := dy shr 1; 158 | for i := 0 to dy - 1 do 159 | begin 160 | if (pi >= 0) and (pi < pl) then 161 | Process(@FData^[pi], FValue); 162 | 163 | inc(pi, SY); 164 | inc(Delta, dx); 165 | if Delta >= dy then 166 | begin 167 | inc(pi, SX); 168 | dec(Delta, dy); 169 | end; 170 | end; 171 | end; 172 | if (FLineTail) and (pi >= 0) and (pi < pl) then 173 | Process(@FData^[pi], FValue); 174 | end; 175 | 176 | procedure TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.FillBox(x1, y1, x2, y2: NativeInt); 177 | var 178 | i: Integer; 179 | begin 180 | if y1 > y2 then 181 | Swap(y1, y2); 182 | for i := y1 to y2 do 183 | HorzLine(x1, i, x2); 184 | end; 185 | 186 | procedure TLineProcessor{$IFNDEF FPC}{$ENDIF FPC}.Process(const vp: PT_; const v: T_); 187 | begin 188 | vp^ := v; 189 | end; 190 | {$IFDEF RangeCheck}{$R+}{$ENDIF} 191 | {$IFDEF OverflowCheck}{$Q+}{$ENDIF} 192 | -------------------------------------------------------------------------------- /lib/Core_OrderData.inc: -------------------------------------------------------------------------------- 1 | procedure TOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.DoInternalFree(p: POrderStruct_); 2 | begin 3 | try 4 | DoFree(p^.Data); 5 | Dispose(p); 6 | except 7 | end; 8 | end; 9 | 10 | constructor TOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Create; 11 | begin 12 | inherited Create; 13 | FFirst := nil; 14 | FLast := nil; 15 | FNum := 0; 16 | FOnFreeOrderStruct := nil; 17 | end; 18 | 19 | destructor TOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Destroy; 20 | begin 21 | Clear; 22 | inherited Destroy; 23 | end; 24 | 25 | procedure TOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.DoFree(var Data: T_); 26 | begin 27 | if Assigned(FOnFreeOrderStruct) then 28 | FOnFreeOrderStruct(Data); 29 | end; 30 | 31 | procedure TOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Clear; 32 | var 33 | p, tmp: POrderStruct_; 34 | begin 35 | p := FFirst; 36 | while p <> nil do 37 | begin 38 | tmp := p^.Next; 39 | DoInternalFree(p); 40 | p := tmp; 41 | end; 42 | FFirst := nil; 43 | FLast := nil; 44 | FNum := 0; 45 | end; 46 | 47 | procedure TOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Next; 48 | var 49 | tmp: POrderStruct_; 50 | begin 51 | if FFirst <> nil then 52 | begin 53 | tmp := FFirst^.Next; 54 | DoInternalFree(FFirst); 55 | FFirst := tmp; 56 | if FFirst = nil then 57 | FLast := nil; 58 | Dec(FNum); 59 | end; 60 | end; 61 | 62 | procedure TOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Push(Data: T_); 63 | var 64 | p: POrderStruct_; 65 | begin 66 | new(p); 67 | p^.Data := Data; 68 | p^.Next := nil; 69 | 70 | Inc(FNum); 71 | if (FFirst = nil) and (FLast = nil) then 72 | begin 73 | FFirst := p; 74 | FLast := p; 75 | end 76 | else if FLast <> nil then 77 | begin 78 | FLast^.Next := p; 79 | FLast := p; 80 | end; 81 | end; 82 | 83 | procedure TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.DoInternalFree(p: POrderPtrStruct_); 84 | begin 85 | try 86 | DoFree(p^.Data); 87 | Dispose(p); 88 | except 89 | end; 90 | end; 91 | 92 | constructor TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Create; 93 | begin 94 | inherited Create; 95 | FFirst := nil; 96 | FLast := nil; 97 | FNum := 0; 98 | FOnFreeOrderStruct := nil; 99 | end; 100 | 101 | destructor TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Destroy; 102 | begin 103 | Clear; 104 | inherited Destroy; 105 | end; 106 | 107 | procedure TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.DoFree(Data: PT_); 108 | begin 109 | if Assigned(FOnFreeOrderStruct) then 110 | FOnFreeOrderStruct(Data) 111 | else 112 | Dispose(Data); 113 | end; 114 | 115 | procedure TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Clear; 116 | var 117 | p, tmp: POrderPtrStruct_; 118 | begin 119 | p := FFirst; 120 | while p <> nil do 121 | begin 122 | tmp := p^.Next; 123 | DoInternalFree(p); 124 | p := tmp; 125 | end; 126 | FFirst := nil; 127 | FLast := nil; 128 | FNum := 0; 129 | end; 130 | 131 | procedure TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Next; 132 | var 133 | tmp: POrderPtrStruct_; 134 | begin 135 | if FFirst <> nil then 136 | begin 137 | tmp := FFirst^.Next; 138 | DoInternalFree(FFirst); 139 | FFirst := tmp; 140 | if FFirst = nil then 141 | FLast := nil; 142 | Dec(FNum); 143 | end; 144 | end; 145 | 146 | procedure TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Push(Data: T_); 147 | var 148 | p: POrderPtrStruct_; 149 | begin 150 | new(p); 151 | new(p^.Data); 152 | p^.Data^ := Data; 153 | p^.Next := nil; 154 | 155 | Inc(FNum); 156 | if (FFirst = nil) and (FLast = nil) then 157 | begin 158 | FFirst := p; 159 | FLast := p; 160 | end 161 | else if FLast <> nil then 162 | begin 163 | FLast^.Next := p; 164 | FLast := p; 165 | end; 166 | end; 167 | 168 | procedure TOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.PushPtr(Data: PT_); 169 | var 170 | p: POrderPtrStruct_; 171 | begin 172 | new(p); 173 | p^.Data := Data; 174 | p^.Next := nil; 175 | 176 | Inc(FNum); 177 | if (FFirst = nil) and (FLast = nil) then 178 | begin 179 | FFirst := p; 180 | FLast := p; 181 | end 182 | else if FLast <> nil then 183 | begin 184 | FLast^.Next := p; 185 | FLast := p; 186 | end; 187 | end; 188 | 189 | procedure TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.DoInternalFree(p: POrderStruct_); 190 | begin 191 | try 192 | DoFree(p^.Data); 193 | Dispose(p); 194 | except 195 | end; 196 | end; 197 | 198 | constructor TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Create; 199 | begin 200 | inherited Create; 201 | FCritical := TCritical.Create; 202 | FFirst := nil; 203 | FLast := nil; 204 | FNum := 0; 205 | FOnFreeCriticalOrderStruct := nil; 206 | end; 207 | 208 | destructor TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Destroy; 209 | begin 210 | Clear; 211 | FCritical.Free; 212 | inherited Destroy; 213 | end; 214 | 215 | procedure TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.DoFree(var Data: T_); 216 | begin 217 | if Assigned(FOnFreeCriticalOrderStruct) then 218 | FOnFreeCriticalOrderStruct(Data); 219 | end; 220 | 221 | procedure TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Clear; 222 | var 223 | p, tmp: POrderStruct_; 224 | begin 225 | FCritical.Lock; 226 | p := FFirst; 227 | while p <> nil do 228 | begin 229 | tmp := p^.Next; 230 | DoInternalFree(p); 231 | p := tmp; 232 | end; 233 | FFirst := nil; 234 | FLast := nil; 235 | FNum := 0; 236 | FCritical.UnLock; 237 | end; 238 | 239 | function TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.GetCurrent: POrderStruct_; 240 | begin 241 | FCritical.Lock; 242 | Result := FFirst; 243 | FCritical.UnLock; 244 | end; 245 | 246 | procedure TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Next; 247 | var 248 | tmp: POrderStruct_; 249 | begin 250 | FCritical.Lock; 251 | if FFirst <> nil then 252 | begin 253 | tmp := FFirst^.Next; 254 | DoInternalFree(FFirst); 255 | FFirst := tmp; 256 | if FFirst = nil then 257 | FLast := nil; 258 | Dec(FNum); 259 | end; 260 | FCritical.UnLock; 261 | end; 262 | 263 | procedure TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.Push(Data: T_); 264 | var 265 | p: POrderStruct_; 266 | begin 267 | new(p); 268 | p^.Data := Data; 269 | p^.Next := nil; 270 | 271 | FCritical.Lock; 272 | Inc(FNum); 273 | if (FFirst = nil) and (FLast = nil) then 274 | begin 275 | FFirst := p; 276 | FLast := p; 277 | end 278 | else if FLast <> nil then 279 | begin 280 | FLast^.Next := p; 281 | FLast := p; 282 | end; 283 | FCritical.UnLock; 284 | end; 285 | 286 | function TCriticalOrderStruct{$IFNDEF FPC}{$ENDIF FPC}.GetNum: NativeInt; 287 | begin 288 | FCritical.Lock; 289 | Result := FNum; 290 | FCritical.UnLock; 291 | end; 292 | 293 | procedure TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.DoInternalFree(p: POrderPtrStruct_); 294 | begin 295 | try 296 | DoFree(p^.Data); 297 | Dispose(p); 298 | except 299 | end; 300 | end; 301 | 302 | constructor TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Create; 303 | begin 304 | inherited Create; 305 | FCritical := TCritical.Create; 306 | FFirst := nil; 307 | FLast := nil; 308 | FNum := 0; 309 | FOnFreeCriticalOrderStruct := nil; 310 | end; 311 | 312 | destructor TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Destroy; 313 | begin 314 | Clear; 315 | FCritical.Free; 316 | inherited Destroy; 317 | end; 318 | 319 | procedure TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.DoFree(Data: PT_); 320 | begin 321 | if Assigned(FOnFreeCriticalOrderStruct) then 322 | FOnFreeCriticalOrderStruct(Data) 323 | else 324 | Dispose(Data); 325 | end; 326 | 327 | procedure TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Clear; 328 | var 329 | p, tmp: POrderPtrStruct_; 330 | begin 331 | FCritical.Lock; 332 | p := FFirst; 333 | while p <> nil do 334 | begin 335 | tmp := p^.Next; 336 | DoInternalFree(p); 337 | p := tmp; 338 | end; 339 | FFirst := nil; 340 | FLast := nil; 341 | FNum := 0; 342 | FCritical.UnLock; 343 | end; 344 | 345 | function TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.GetCurrent: POrderPtrStruct_; 346 | begin 347 | FCritical.Lock; 348 | Result := FFirst; 349 | FCritical.UnLock; 350 | end; 351 | 352 | procedure TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Next; 353 | var 354 | tmp: POrderPtrStruct_; 355 | begin 356 | FCritical.Lock; 357 | if FFirst <> nil then 358 | begin 359 | tmp := FFirst^.Next; 360 | DoInternalFree(FFirst); 361 | FFirst := tmp; 362 | if FFirst = nil then 363 | FLast := nil; 364 | Dec(FNum); 365 | end; 366 | FCritical.UnLock; 367 | end; 368 | 369 | procedure TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.Push(Data: T_); 370 | var 371 | p: POrderPtrStruct_; 372 | begin 373 | new(p); 374 | new(p^.Data); 375 | p^.Data^ := Data; 376 | p^.Next := nil; 377 | 378 | FCritical.Lock; 379 | Inc(FNum); 380 | if (FFirst = nil) and (FLast = nil) then 381 | begin 382 | FFirst := p; 383 | FLast := p; 384 | end 385 | else if FLast <> nil then 386 | begin 387 | FLast^.Next := p; 388 | FLast := p; 389 | end; 390 | FCritical.UnLock; 391 | end; 392 | 393 | procedure TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.PushPtr(Data: PT_); 394 | var 395 | p: POrderPtrStruct_; 396 | begin 397 | new(p); 398 | p^.Data := Data; 399 | p^.Next := nil; 400 | 401 | FCritical.Lock; 402 | Inc(FNum); 403 | if (FFirst = nil) and (FLast = nil) then 404 | begin 405 | FFirst := p; 406 | FLast := p; 407 | end 408 | else if FLast <> nil then 409 | begin 410 | FLast^.Next := p; 411 | FLast := p; 412 | end; 413 | FCritical.UnLock; 414 | end; 415 | 416 | function TCriticalOrderPtrStruct{$IFNDEF FPC}{$ENDIF FPC}.GetNum: NativeInt; 417 | begin 418 | FCritical.Lock; 419 | Result := FNum; 420 | FCritical.UnLock; 421 | end; 422 | -------------------------------------------------------------------------------- /lib/FPCGenericStructlist.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * Generic list of any type (TGenericStructList). * } 3 | { ****************************************************************************** } 4 | { * https://zpascal.net * } 5 | { * https://github.com/PassByYou888/zAI * } 6 | { * https://github.com/PassByYou888/ZServer4D * } 7 | { * https://github.com/PassByYou888/PascalString * } 8 | { * https://github.com/PassByYou888/zRasterization * } 9 | { * https://github.com/PassByYou888/CoreCipher * } 10 | { * https://github.com/PassByYou888/zSound * } 11 | { * https://github.com/PassByYou888/zChinese * } 12 | { * https://github.com/PassByYou888/zExpression * } 13 | { * https://github.com/PassByYou888/zGameWare * } 14 | { * https://github.com/PassByYou888/zAnalysis * } 15 | { * https://github.com/PassByYou888/FFMPEG-Header * } 16 | { * https://github.com/PassByYou888/zTranslate * } 17 | { * https://github.com/PassByYou888/InfiniteIoT * } 18 | { * https://github.com/PassByYou888/FastMD5 * } 19 | { ****************************************************************************** } 20 | { 21 | Based on FPC FGL unit, copyright by FPC team. 22 | License of FPC RTL is the same as our engine (modified LGPL, 23 | see COPYING.txt for details). 24 | Fixed to compile also under FPC 2.4.0 and 2.2.4. 25 | Some small comfortable methods added. 26 | } 27 | 28 | unit FPCGenericStructlist; 29 | 30 | {$IFDEF FPC} 31 | {$mode objfpc}{$H+} 32 | 33 | {$IF defined(VER2_2)} {$DEFINE OldSyntax} {$IFEND} 34 | {$IF defined(VER2_4)} {$DEFINE OldSyntax} {$IFEND} 35 | 36 | {$define HAS_ENUMERATOR} 37 | {$ifdef VER2_2} {$undef HAS_ENUMERATOR} {$endif} 38 | {$ifdef VER2_4_0} {$undef HAS_ENUMERATOR} {$endif} 39 | { Just undef enumerator always, in FPC 2.7.1 it's either broken 40 | or I shouldn't overuse TFPGListEnumeratorSpec. } 41 | {$undef HAS_ENUMERATOR} 42 | 43 | { FPC < 2.6.0 had buggy version of the Extract function, 44 | also with different interface, see http://bugs.freepascal.org/view.php?id=19960. } 45 | {$define HAS_EXTRACT} 46 | {$ifdef VER2_2} {$undef HAS_EXTRACT} {$endif} 47 | {$ifdef VER2_4} {$undef HAS_EXTRACT} {$endif} 48 | {$ENDIF FPC} 49 | 50 | interface 51 | 52 | {$IFDEF FPC} 53 | 54 | uses fgl; 55 | 56 | type 57 | { Generic list of types that are compared by CompareByte. 58 | 59 | This is equivalent to TFPGList, except it doesn't override IndexOf, 60 | so your type doesn't need to have a "=" operator built-in inside FPC. 61 | When calling IndexOf or Remove, it will simply compare values using 62 | CompareByte, this is what TFPSList.IndexOf uses. 63 | This way it works to create lists of records, vectors (constant size arrays), 64 | old-style TP objects, and also is suitable to create a list of methods 65 | (since for methods, the "=" is broken, for Delphi compatibility, 66 | see http://bugs.freepascal.org/view.php?id=9228). 67 | 68 | We also add some trivial helper methods like @link(Add) and @link(L). } 69 | generic TGenericsList = class(TFPSList) 70 | private 71 | type 72 | TCompareFunc = function(const Item1, Item2: t): Integer; 73 | TTypeList = array[0..MaxGListSize] of t; 74 | PTypeList = ^TTypeList; 75 | {$ifdef HAS_ENUMERATOR} TFPGListEnumeratorSpec = specialize TFPGListEnumerator; {$endif} 76 | 77 | {$ifndef OldSyntax}protected var{$else} 78 | {$ifdef PASDOC}protected var{$else} { PasDoc can't handle "var protected", and I don't know how/if they should be handled? } 79 | var protected{$endif}{$endif} FOnCompare: TCompareFunc; 80 | 81 | procedure CopyItem(Src, dest: Pointer); override; 82 | procedure Deref(Item: Pointer); override; 83 | function Get(index: Integer): t; {$ifdef CLASSESINLINE} inline; {$endif} 84 | function GetList: PTypeList; {$ifdef CLASSESINLINE} inline; {$endif} 85 | function ItemPtrCompare(Item1, Item2: Pointer): Integer; 86 | procedure Put(index: Integer; const Item: t); {$ifdef CLASSESINLINE} inline; {$endif} 87 | public 88 | constructor Create; 89 | function Add(const Item: t): Integer; {$ifdef CLASSESINLINE} inline; {$endif} 90 | {$ifdef HAS_EXTRACT} function Extract(const Item: t): t; {$ifdef CLASSESINLINE} inline; {$endif} {$endif} 91 | function First: t; {$ifdef CLASSESINLINE} inline; {$endif} 92 | {$ifdef HAS_ENUMERATOR} function GetEnumerator: TFPGListEnumeratorSpec; {$ifdef CLASSESINLINE} inline; {$endif} {$endif} 93 | function IndexOf(const Item: t): Integer; 94 | procedure Insert(index: Integer; const Item: t); {$ifdef CLASSESINLINE} inline; {$endif} 95 | function Last: t; {$ifdef CLASSESINLINE} inline; {$endif} 96 | {$ifndef OldSyntax} 97 | procedure Assign(Source: TGenericsList); 98 | {$endif OldSyntax} 99 | function Remove(const Item: t): Integer; {$ifdef CLASSESINLINE} inline; {$endif} 100 | procedure Sort(Compare: TCompareFunc); 101 | property Items[index: Integer]: t read Get write Put; default; 102 | property List: PTypeList read GetList; 103 | property ListData: PTypeList read GetList; 104 | end; 105 | 106 | {$ENDIF FPC} 107 | 108 | implementation 109 | 110 | {$IFDEF FPC} 111 | constructor TGenericsList.Create; 112 | begin 113 | inherited Create(SizeOf(t)); 114 | end; 115 | 116 | procedure TGenericsList.CopyItem(Src, dest: Pointer); 117 | begin 118 | t(dest^) := t(Src^); 119 | end; 120 | 121 | procedure TGenericsList.Deref(Item: Pointer); 122 | begin 123 | Finalize(t(Item^)); 124 | end; 125 | 126 | function TGenericsList.Get(index: Integer): t; 127 | begin 128 | Result := t(inherited Get(index)^); 129 | end; 130 | 131 | function TGenericsList.GetList: PTypeList; 132 | begin 133 | Result := PTypeList(FList); 134 | end; 135 | 136 | function TGenericsList.ItemPtrCompare(Item1, Item2: Pointer): Integer; 137 | begin 138 | Result := FOnCompare(t(Item1^), t(Item2^)); 139 | end; 140 | 141 | procedure TGenericsList.Put(index: Integer; const Item: t); 142 | begin 143 | inherited Put(index, @Item); 144 | end; 145 | 146 | function TGenericsList.Add(const Item: t): Integer; 147 | begin 148 | Result := inherited Add(@Item); 149 | end; 150 | 151 | {$ifdef HAS_EXTRACT} 152 | function TGenericsList.Extract(const Item: t): t; 153 | begin 154 | inherited Extract(@Item, @Result); 155 | end; 156 | {$endif} 157 | 158 | function TGenericsList.First: t; 159 | begin 160 | Result := t(inherited First^); 161 | end; 162 | 163 | {$ifdef HAS_ENUMERATOR} 164 | function TGenericsList.GetEnumerator: TFPGListEnumeratorSpec; 165 | begin 166 | Result := TFPGListEnumeratorSpec.Create(Self); 167 | end; 168 | {$endif} 169 | 170 | function TGenericsList.IndexOf(const Item: t): Integer; 171 | begin 172 | Result := inherited IndexOf(@Item); 173 | end; 174 | 175 | procedure TGenericsList.Insert(index: Integer; const Item: t); 176 | begin 177 | t(inherited Insert(index)^) := Item; 178 | end; 179 | 180 | function TGenericsList.Last: t; 181 | begin 182 | Result := t(inherited Last^); 183 | end; 184 | 185 | {$ifndef OldSyntax} 186 | procedure TGenericsList.Assign(Source: TGenericsList); 187 | var 188 | i: Integer; 189 | begin 190 | Clear; 191 | for i := 0 to Source.Count - 1 do 192 | Add(Source[i]); 193 | end; 194 | {$endif OldSyntax} 195 | 196 | function TGenericsList.Remove(const Item: t): Integer; 197 | begin 198 | Result := IndexOf(Item); 199 | if Result >= 0 then 200 | Delete(Result); 201 | end; 202 | 203 | procedure TGenericsList.Sort(Compare: TCompareFunc); 204 | begin 205 | FOnCompare := Compare; 206 | inherited Sort(@ItemPtrCompare); 207 | end; 208 | 209 | {$ENDIF FPC} 210 | 211 | end. 212 | 213 | 214 | 215 | -------------------------------------------------------------------------------- /lib/Fast_MD5.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * Fast md5 * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | unit Fast_MD5; 20 | 21 | {$INCLUDE zDefine.inc} 22 | 23 | interface 24 | 25 | 26 | uses CoreClasses, UnicodeMixedLib; 27 | 28 | {$IF Defined(MSWINDOWS) and Defined(Delphi)} 29 | procedure MD5_Transform(var Accu; const Buf); 30 | {$ENDIF Defined(MSWINDOWS) and Defined(Delphi)} 31 | 32 | function FastMD5(const buffPtr: PByte; bufSiz: nativeUInt): TMD5; overload; 33 | function FastMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5; overload; 34 | 35 | implementation 36 | 37 | {$IF Defined(MSWINDOWS) and Defined(Delphi)} 38 | 39 | 40 | uses MemoryStream64; 41 | 42 | (* 43 | fastMD5 algorithm by Maxim Masiutin 44 | https://github.com/maximmasiutin/MD5_Transform-x64 45 | 46 | delphi imp by 600585@qq.com 47 | https://github.com/PassByYou888/FastMD5 48 | *) 49 | 50 | {$IF Defined(WIN32)} 51 | (* 52 | ; ============================================================== 53 | ; 54 | ; MD5_386.Asm - 386 optimized helper routine for calculating 55 | ; MD Message-Digest values 56 | ; written 2/2/94 by 57 | ; 58 | ; Peter Sawatzki 59 | ; Buchenhof 3 60 | ; D58091 Hagen, Germany Fed Rep 61 | ; 62 | ; EMail: Peter@Sawatzki.de 63 | ; EMail: 100031.3002@compuserve.com 64 | ; WWW: http://www.sawatzki.de 65 | ; 66 | ; 67 | ; original C Source was found in Dr. Dobbs Journal Sep 91 68 | ; MD5 algorithm from RSA Data Security, Inc. 69 | *) 70 | {$L MD5_32.obj} 71 | {$ELSEIF Defined(WIN64)} 72 | (* 73 | ; MD5_Transform-x64 74 | ; MD5 transform routine oprimized for x64 processors 75 | ; Copyright 2018 Ritlabs, SRL 76 | ; The 64-bit version is written by Maxim Masiutin 77 | 78 | ; The main advantage of this 64-bit version is that 79 | ; it loads 64 bytes of hashed message into 8 64-bit registers 80 | ; (RBP, R8, R9, R10, R11, R12, R13, R14) at the beginning, 81 | ; to avoid excessive memory load operations 82 | ; througout the routine. 83 | 84 | ; To operate with 32-bit values store in higher bits 85 | ; of a 64-bit register (bits 32-63) uses "Ror" by 32; 86 | ; 8 macro variables (M1-M8) are used to keep record 87 | ; or corrent state of whether the register has been 88 | ; Ror'ed or not. 89 | 90 | ; It also has an ability to use Lea instruction instead 91 | ; of two sequental Adds (uncomment UseLea=1), but it is 92 | ; slower on Skylake processors. Also, Intel in the 93 | ; Optimization Reference Maual discourages us of 94 | ; Lea as a replacement of two adds, since it is slower 95 | ; on the Atom processors. 96 | 97 | ; MD5_Transform-x64 is released under a dual license, 98 | ; and you may choose to use it under either the 99 | ; Mozilla Public License 2.0 (MPL 2.1, available from 100 | ; https://www.mozilla.org/en-US/MPL/2.0/) or the 101 | ; GNU Lesser General Public License Version 3, 102 | ; dated 29 June 2007 (LGPL 3, available from 103 | ; https://www.gnu.org/licenses/lgpl.html). 104 | 105 | ; MD5_Transform-x64 is based 106 | ; on the following code by Peter Sawatzki. 107 | 108 | ; The original notice by Peter Sawatzki follows. 109 | *) 110 | {$L MD5_64.obj} 111 | {$ENDIF} 112 | 113 | procedure MD5_Transform(var Accu; const Buf); register; external; 114 | 115 | function FastMD5(const buffPtr: PByte; bufSiz: nativeUInt): TMD5; 116 | var 117 | Digest: TMD5; 118 | Lo, Hi: Cardinal; 119 | p: PByte; 120 | ChunkIndex: Byte; 121 | ChunkBuff: array [0 .. 63] of Byte; 122 | begin 123 | Lo := 0; 124 | Hi := 0; 125 | PCardinal(@Digest[0])^ := $67452301; 126 | PCardinal(@Digest[4])^ := $EFCDAB89; 127 | PCardinal(@Digest[8])^ := $98BADCFE; 128 | PCardinal(@Digest[12])^ := $10325476; 129 | 130 | inc(Lo, bufSiz shl 3); 131 | inc(Hi, bufSiz shr 29); 132 | 133 | p := buffPtr; 134 | 135 | while bufSiz >= $40 do 136 | begin 137 | MD5_Transform(Digest, p^); 138 | inc(p, $40); 139 | dec(bufSiz, $40); 140 | end; 141 | if bufSiz > 0 then 142 | CopyPtr(p, @ChunkBuff[0], bufSiz); 143 | 144 | Result := PMD5(@Digest[0])^; 145 | ChunkBuff[bufSiz] := $80; 146 | ChunkIndex := bufSiz + 1; 147 | if ChunkIndex > $38 then 148 | begin 149 | if ChunkIndex < $40 then 150 | FillPtrByte(@ChunkBuff[ChunkIndex], $40 - ChunkIndex, 0); 151 | MD5_Transform(Result, ChunkBuff); 152 | ChunkIndex := 0 153 | end; 154 | FillPtrByte(@ChunkBuff[ChunkIndex], $38 - ChunkIndex, 0); 155 | PCardinal(@ChunkBuff[$38])^ := Lo; 156 | PCardinal(@ChunkBuff[$3C])^ := Hi; 157 | MD5_Transform(Result, ChunkBuff); 158 | end; 159 | 160 | function FastMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5; 161 | const 162 | deltaSize: Cardinal = $40 * $FFFF; 163 | 164 | var 165 | Digest: TMD5; 166 | Lo, Hi: Cardinal; 167 | DeltaBuf: Pointer; 168 | bufSiz: Int64; 169 | Rest: Cardinal; 170 | p: PByte; 171 | ChunkIndex: Byte; 172 | ChunkBuff: array [0 .. 63] of Byte; 173 | begin 174 | if StartPos > EndPos then 175 | Swap(StartPos, EndPos); 176 | StartPos := umlClamp(StartPos, 0, stream.Size); 177 | EndPos := umlClamp(EndPos, 0, stream.Size); 178 | if EndPos - StartPos <= 0 then 179 | begin 180 | Result := FastMD5(nil, 0); 181 | exit; 182 | end; 183 | {$IFDEF OptimizationMemoryStreamMD5} 184 | if stream is TCoreClassMemoryStream then 185 | begin 186 | Result := FastMD5(Pointer(nativeUInt(TCoreClassMemoryStream(stream).Memory) + StartPos), EndPos - StartPos); 187 | exit; 188 | end; 189 | if stream is TMemoryStream64 then 190 | begin 191 | Result := FastMD5(TMemoryStream64(stream).PositionAsPtr(StartPos), EndPos - StartPos); 192 | exit; 193 | end; 194 | {$ENDIF} 195 | // 196 | Lo := 0; 197 | Hi := 0; 198 | PCardinal(@Digest[0])^ := $67452301; 199 | PCardinal(@Digest[4])^ := $EFCDAB89; 200 | PCardinal(@Digest[8])^ := $98BADCFE; 201 | PCardinal(@Digest[12])^ := $10325476; 202 | 203 | bufSiz := EndPos - StartPos; 204 | Rest := 0; 205 | 206 | inc(Lo, bufSiz shl 3); 207 | inc(Hi, bufSiz shr 29); 208 | 209 | DeltaBuf := GetMemory(deltaSize); 210 | stream.Position := StartPos; 211 | 212 | if bufSiz < $40 then 213 | begin 214 | stream.read(DeltaBuf^, bufSiz); 215 | p := DeltaBuf; 216 | end 217 | else 218 | while bufSiz >= $40 do 219 | begin 220 | if Rest = 0 then 221 | begin 222 | if bufSiz >= deltaSize then 223 | Rest := deltaSize 224 | else 225 | Rest := bufSiz; 226 | stream.ReadBuffer(DeltaBuf^, Rest); 227 | 228 | p := DeltaBuf; 229 | end; 230 | MD5_Transform(Digest, p^); 231 | inc(p, $40); 232 | dec(bufSiz, $40); 233 | dec(Rest, $40); 234 | end; 235 | 236 | if bufSiz > 0 then 237 | CopyPtr(p, @ChunkBuff[0], bufSiz); 238 | 239 | FreeMemory(DeltaBuf); 240 | 241 | Result := PMD5(@Digest[0])^; 242 | ChunkBuff[bufSiz] := $80; 243 | ChunkIndex := bufSiz + 1; 244 | if ChunkIndex > $38 then 245 | begin 246 | if ChunkIndex < $40 then 247 | FillPtrByte(@ChunkBuff[ChunkIndex], $40 - ChunkIndex, 0); 248 | MD5_Transform(Result, ChunkBuff); 249 | ChunkIndex := 0 250 | end; 251 | FillPtrByte(@ChunkBuff[ChunkIndex], $38 - ChunkIndex, 0); 252 | PCardinal(@ChunkBuff[$38])^ := Lo; 253 | PCardinal(@ChunkBuff[$3C])^ := Hi; 254 | MD5_Transform(Result, ChunkBuff); 255 | end; 256 | 257 | {$ELSE} 258 | 259 | 260 | function FastMD5(const buffPtr: PByte; bufSiz: nativeUInt): TMD5; 261 | begin 262 | Result := umlMD5(buffPtr, bufSiz); 263 | end; 264 | 265 | function FastMD5(stream: TCoreClassStream; StartPos, EndPos: Int64): TMD5; 266 | begin 267 | Result := umlStreamMD5(stream, StartPos, EndPos); 268 | end; 269 | 270 | {$ENDIF Defined(MSWINDOWS) and Defined(Delphi)} 271 | 272 | end. 273 | -------------------------------------------------------------------------------- /lib/LinearAction.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * linear action written by QQ 600585@qq.com * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | unit LinearAction; 20 | 21 | {$INCLUDE zDefine.inc} 22 | 23 | interface 24 | 25 | uses CoreClasses, DoStatusIO, PascalStrings, UnicodeMixedLib; 26 | 27 | type 28 | TCoreActionID = Integer; 29 | TCoreActionString = SystemString; 30 | TCoreActionState = (asPlaying, asPause, asStop, asOver); 31 | TCoreActionStates = set of TCoreActionState; 32 | TCoreAction = class; 33 | TCoreActionList = class; 34 | TCoreActionLinear = class; 35 | 36 | TCoreAction = class(TCoreClassObject) 37 | public 38 | Owner: TCoreActionList; 39 | State: TCoreActionStates; 40 | ID: TCoreActionID; 41 | Desc: TCoreActionString; 42 | 43 | constructor Create(Owner_: TCoreActionList); virtual; 44 | destructor Destroy; override; 45 | 46 | procedure Run(); virtual; 47 | procedure Over(); virtual; 48 | procedure Stop(); virtual; 49 | procedure Pause(); virtual; 50 | procedure Progress(deltaTime: Double); virtual; 51 | end; 52 | 53 | TCoreActionClass = class of TCoreAction; 54 | 55 | TCoreActionList = class(TCoreClassObject) 56 | protected 57 | FSequenceList: TCoreClassListForObj; 58 | FFocusIndex: Integer; 59 | FLast: TCoreAction; 60 | public 61 | Owner: TCoreActionLinear; 62 | constructor Create(Owner_: TCoreActionLinear); 63 | destructor Destroy; override; 64 | procedure Clear; 65 | function Add(ActionClass_: TCoreActionClass): TCoreAction; overload; 66 | procedure Run(); 67 | procedure Over(); 68 | procedure Stop(); 69 | function IsOver(): Boolean; 70 | function IsStop(): Boolean; 71 | property Last: TCoreAction read FLast; 72 | procedure Progress(deltaTime: Double); 73 | end; 74 | 75 | TCoreActionLinear = class(TCoreClassObject) 76 | protected 77 | FSequenceList: TCoreClassListForObj; 78 | FFocusIndex: Integer; 79 | FLast: TCoreActionList; 80 | public 81 | constructor Create(); 82 | destructor Destroy; override; 83 | procedure Clear; 84 | function Add: TCoreActionList; 85 | procedure Run(); 86 | procedure Stop(); 87 | procedure Over(); 88 | property Last: TCoreActionList read FLast; 89 | procedure Progress(deltaTime: Double); 90 | 91 | class procedure Test(); 92 | end; 93 | 94 | implementation 95 | 96 | constructor TCoreAction.Create(Owner_: TCoreActionList); 97 | begin 98 | inherited Create; 99 | Owner := Owner_; 100 | State := []; 101 | ID := 0; 102 | Desc := ''; 103 | end; 104 | 105 | destructor TCoreAction.Destroy; 106 | begin 107 | inherited Destroy; 108 | end; 109 | 110 | procedure TCoreAction.Run; 111 | begin 112 | State := [asPlaying]; 113 | end; 114 | 115 | procedure TCoreAction.Over; 116 | begin 117 | if asPlaying in State then 118 | State := [asOver]; 119 | end; 120 | 121 | procedure TCoreAction.Stop; 122 | begin 123 | if asPlaying in State then 124 | State := [asStop]; 125 | end; 126 | 127 | procedure TCoreAction.Pause; 128 | begin 129 | if asPlaying in State then 130 | State := [asPlaying, asPause]; 131 | end; 132 | 133 | procedure TCoreAction.Progress(deltaTime: Double); 134 | begin 135 | 136 | end; 137 | 138 | constructor TCoreActionList.Create(Owner_: TCoreActionLinear); 139 | begin 140 | inherited Create; 141 | FSequenceList := TCoreClassListForObj.Create; 142 | FFocusIndex := -1; 143 | FLast := nil; 144 | Owner := Owner_; 145 | end; 146 | 147 | destructor TCoreActionList.Destroy; 148 | begin 149 | Clear; 150 | DisposeObject(FSequenceList); 151 | inherited Destroy; 152 | end; 153 | 154 | procedure TCoreActionList.Clear; 155 | var 156 | i: Integer; 157 | begin 158 | for i := FSequenceList.Count - 1 downto 0 do 159 | DisposeObject(FSequenceList[i]); 160 | FSequenceList.Clear; 161 | end; 162 | 163 | function TCoreActionList.Add(ActionClass_: TCoreActionClass): TCoreAction; 164 | begin 165 | Result := ActionClass_.Create(Self); 166 | FSequenceList.Add(Result); 167 | end; 168 | 169 | procedure TCoreActionList.Run(); 170 | begin 171 | if FSequenceList.Count > 0 then 172 | begin 173 | FFocusIndex := 0; 174 | FLast := FSequenceList[FFocusIndex] as TCoreAction; 175 | end 176 | else 177 | begin 178 | FFocusIndex := -1; 179 | FLast := nil; 180 | end; 181 | end; 182 | 183 | procedure TCoreActionList.Over; 184 | begin 185 | if FLast <> nil then 186 | FFocusIndex := FSequenceList.Count; 187 | end; 188 | 189 | procedure TCoreActionList.Stop; 190 | begin 191 | if FLast <> nil then 192 | FFocusIndex := -1; 193 | end; 194 | 195 | function TCoreActionList.IsOver: Boolean; 196 | begin 197 | Result := FFocusIndex >= FSequenceList.Count; 198 | end; 199 | 200 | function TCoreActionList.IsStop: Boolean; 201 | begin 202 | Result := FFocusIndex < 0; 203 | end; 204 | 205 | procedure TCoreActionList.Progress(deltaTime: Double); 206 | begin 207 | if (FFocusIndex < 0) or (FFocusIndex >= FSequenceList.Count) then 208 | Exit; 209 | 210 | FLast := FSequenceList[FFocusIndex] as TCoreAction; 211 | 212 | if FLast.State = [] then 213 | begin 214 | FLast.Run; 215 | Exit; 216 | end; 217 | 218 | if asPlaying in FLast.State then 219 | begin 220 | FLast.Progress(deltaTime); 221 | Exit; 222 | end; 223 | 224 | if asStop in FLast.State then 225 | begin 226 | FFocusIndex := -1; 227 | if Owner <> nil then 228 | Owner.Stop; 229 | Exit; 230 | end; 231 | 232 | if asOver in FLast.State then 233 | begin 234 | inc(FFocusIndex); 235 | if (FFocusIndex >= FSequenceList.Count) and (Owner <> nil) then 236 | Owner.Over; 237 | Exit; 238 | end; 239 | end; 240 | 241 | constructor TCoreActionLinear.Create(); 242 | begin 243 | inherited Create; 244 | FSequenceList := TCoreClassListForObj.Create; 245 | FFocusIndex := -1; 246 | FLast := nil; 247 | end; 248 | 249 | destructor TCoreActionLinear.Destroy; 250 | begin 251 | Clear; 252 | DisposeObject(FSequenceList); 253 | inherited Destroy; 254 | end; 255 | 256 | procedure TCoreActionLinear.Clear; 257 | var 258 | i: Integer; 259 | begin 260 | for i := FSequenceList.Count - 1 downto 0 do 261 | DisposeObject(FSequenceList[i]); 262 | FSequenceList.Clear; 263 | FFocusIndex := -1; 264 | FLast := nil; 265 | end; 266 | 267 | function TCoreActionLinear.Add: TCoreActionList; 268 | begin 269 | Result := TCoreActionList.Create(Self); 270 | FSequenceList.Add(Result); 271 | end; 272 | 273 | procedure TCoreActionLinear.Run; 274 | begin 275 | if FSequenceList.Count > 0 then 276 | begin 277 | FFocusIndex := 0; 278 | FLast := FSequenceList[FFocusIndex] as TCoreActionList; 279 | end 280 | else 281 | begin 282 | FFocusIndex := -1; 283 | FLast := nil; 284 | end; 285 | end; 286 | 287 | procedure TCoreActionLinear.Stop; 288 | begin 289 | Clear; 290 | end; 291 | 292 | procedure TCoreActionLinear.Over; 293 | begin 294 | inc(FFocusIndex); 295 | if FFocusIndex < FSequenceList.Count then 296 | begin 297 | FLast := FSequenceList[FFocusIndex] as TCoreActionList; 298 | end 299 | else 300 | begin 301 | Clear; 302 | end; 303 | end; 304 | 305 | procedure TCoreActionLinear.Progress(deltaTime: Double); 306 | begin 307 | if FLast <> nil then 308 | FLast.Progress(deltaTime); 309 | end; 310 | 311 | class procedure TCoreActionLinear.Test(); 312 | var 313 | al: TCoreActionList; 314 | i: Integer; 315 | begin 316 | al := TCoreActionList.Create(nil); 317 | for i := 1 to 2 do 318 | with al.Add(TCoreAction) do 319 | begin 320 | ID := i; 321 | Desc := PFormat('description %d', [i]); 322 | end; 323 | al.Run; 324 | while True do 325 | begin 326 | al.Progress(0.1); 327 | al.Last.Over; 328 | if al.IsOver or al.IsStop then 329 | Break; 330 | end; 331 | 332 | DisposeObject(al); 333 | end; 334 | 335 | end. 336 | -------------------------------------------------------------------------------- /lib/MH.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * Low MemoryHook written by QQ 600585@qq.com * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | 20 | (* 21 | update history 22 | 2017-12-31 23 | *) 24 | 25 | unit MH; 26 | 27 | {$INCLUDE zDefine.inc} 28 | 29 | interface 30 | 31 | uses CoreClasses, SyncObjs, ListEngine; 32 | 33 | procedure BeginMemoryHook_1; 34 | procedure EndMemoryHook_1; 35 | function GetHookMemorySize_1: nativeUInt; 36 | function GetHookPtrList_1: TPointerHashNativeUIntList; 37 | 38 | procedure BeginMemoryHook_2; 39 | procedure EndMemoryHook_2; 40 | function GetHookMemorySize_2: nativeUInt; 41 | function GetHookPtrList_2: TPointerHashNativeUIntList; 42 | 43 | procedure BeginMemoryHook_3; 44 | procedure EndMemoryHook_3; 45 | function GetHookMemorySize_3: nativeUInt; 46 | function GetHookPtrList_3: TPointerHashNativeUIntList; 47 | 48 | implementation 49 | 50 | uses MH_ZDB, MH_1, MH_2, MH_3, DoStatusIO, PascalStrings; 51 | 52 | procedure BeginMemoryHook_1; 53 | begin 54 | MH_1.BeginMemoryHook($FFFF); 55 | end; 56 | 57 | procedure EndMemoryHook_1; 58 | begin 59 | MH_1.EndMemoryHook; 60 | end; 61 | 62 | function GetHookMemorySize_1: nativeUInt; 63 | begin 64 | Result := MH_1.GetHookMemorySize; 65 | end; 66 | 67 | function GetHookPtrList_1: TPointerHashNativeUIntList; 68 | begin 69 | Result := MH_1.GetHookPtrList; 70 | end; 71 | 72 | procedure BeginMemoryHook_2; 73 | begin 74 | MH_2.BeginMemoryHook($FFFF); 75 | end; 76 | 77 | procedure EndMemoryHook_2; 78 | begin 79 | MH_2.EndMemoryHook; 80 | end; 81 | 82 | function GetHookMemorySize_2: nativeUInt; 83 | begin 84 | Result := MH_2.GetHookMemorySize; 85 | end; 86 | 87 | function GetHookPtrList_2: TPointerHashNativeUIntList; 88 | begin 89 | Result := MH_2.GetHookPtrList; 90 | end; 91 | 92 | procedure BeginMemoryHook_3; 93 | begin 94 | MH_3.BeginMemoryHook($FFFF); 95 | end; 96 | 97 | procedure EndMemoryHook_3; 98 | begin 99 | MH_3.EndMemoryHook; 100 | end; 101 | 102 | function GetHookMemorySize_3: nativeUInt; 103 | begin 104 | Result := MH_3.GetHookMemorySize; 105 | end; 106 | 107 | function GetHookPtrList_3: TPointerHashNativeUIntList; 108 | begin 109 | Result := MH_3.GetHookPtrList; 110 | end; 111 | 112 | var 113 | MHStatusCritical: TCriticalSection; 114 | OriginDoStatusHook: TDoStatusCall; 115 | 116 | procedure InternalDoStatus(Text: SystemString; const ID: Integer); 117 | var 118 | hook_state_bak: Boolean; 119 | begin 120 | hook_state_bak := GlobalMemoryHook.V; 121 | GlobalMemoryHook.V := False; 122 | MHStatusCritical.Acquire; 123 | try 124 | OriginDoStatusHook(Text, ID); 125 | finally 126 | MHStatusCritical.Release; 127 | GlobalMemoryHook.V := hook_state_bak; 128 | end; 129 | end; 130 | 131 | initialization 132 | 133 | MHStatusCritical := TCriticalSection.Create; 134 | OriginDoStatusHook := OnDoStatusHook; 135 | OnDoStatusHook := {$IFDEF FPC}@{$ENDIF FPC}InternalDoStatus; 136 | 137 | finalization 138 | 139 | DisposeObject(MHStatusCritical); 140 | OnDoStatusHook := OriginDoStatusHook; 141 | 142 | end. 143 | -------------------------------------------------------------------------------- /lib/MH_1.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * Low MemoryHook written by QQ 600585@qq.com * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | 20 | (* 21 | update history 22 | 2017-12-31 23 | *) 24 | 25 | unit MH_1; 26 | 27 | {$INCLUDE zDefine.inc} 28 | 29 | interface 30 | 31 | uses ListEngine, CoreClasses; 32 | 33 | procedure BeginMemoryHook; overload; 34 | procedure BeginMemoryHook(cacheLen: Integer); overload; 35 | procedure EndMemoryHook; 36 | function GetHookMemorySize: nativeUInt; overload; 37 | function GetHookMemorySize(p: Pointer): nativeUInt; overload; 38 | function GetHookMemoryMinimizePtr: Pointer; 39 | function GetHookMemoryMaximumPtr: Pointer; 40 | function GetHookPtrList: TPointerHashNativeUIntList; 41 | function GetMemoryHooked: TAtomBool; 42 | 43 | implementation 44 | 45 | var 46 | HookPtrList: TPointerHashNativeUIntList; 47 | MemoryHooked: TAtomBool; 48 | 49 | {$IFDEF FPC} 50 | {$INCLUDE MH_fpc.inc} 51 | {$ELSE} 52 | {$INCLUDE MH_delphi.inc} 53 | {$ENDIF} 54 | 55 | 56 | initialization 57 | 58 | InstallMemoryHook; 59 | 60 | finalization 61 | 62 | UnInstallMemoryHook; 63 | 64 | end. 65 | -------------------------------------------------------------------------------- /lib/MH_2.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * Low MemoryHook written by QQ 600585@qq.com * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | 20 | (* 21 | update history 22 | 2017-12-31 23 | *) 24 | 25 | unit MH_2; 26 | 27 | {$INCLUDE zDefine.inc} 28 | 29 | interface 30 | 31 | uses ListEngine, CoreClasses; 32 | 33 | procedure BeginMemoryHook; overload; 34 | procedure BeginMemoryHook(cacheLen: Integer); overload; 35 | procedure EndMemoryHook; 36 | function GetHookMemorySize: nativeUInt; overload; 37 | function GetHookMemorySize(p: Pointer): nativeUInt; overload; 38 | function GetHookMemoryMinimizePtr: Pointer; 39 | function GetHookMemoryMaximumPtr: Pointer; 40 | function GetHookPtrList: TPointerHashNativeUIntList; 41 | function GetMemoryHooked: TAtomBool; 42 | 43 | implementation 44 | 45 | var 46 | HookPtrList: TPointerHashNativeUIntList; 47 | MemoryHooked: TAtomBool; 48 | 49 | {$IFDEF FPC} 50 | {$INCLUDE MH_fpc.inc} 51 | {$ELSE} 52 | {$INCLUDE MH_delphi.inc} 53 | {$ENDIF} 54 | 55 | initialization 56 | 57 | InstallMemoryHook; 58 | 59 | finalization 60 | 61 | UnInstallMemoryHook; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /lib/MH_3.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * Low MemoryHook written by QQ 600585@qq.com * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | 20 | (* 21 | update history 22 | 2017-12-31 23 | *) 24 | 25 | unit MH_3; 26 | 27 | {$INCLUDE zDefine.inc} 28 | 29 | interface 30 | 31 | uses ListEngine, CoreClasses; 32 | 33 | procedure BeginMemoryHook; overload; 34 | procedure BeginMemoryHook(cacheLen: Integer); overload; 35 | procedure EndMemoryHook; 36 | function GetHookMemorySize: nativeUInt; overload; 37 | function GetHookMemorySize(p: Pointer): nativeUInt; overload; 38 | function GetHookMemoryMinimizePtr: Pointer; 39 | function GetHookMemoryMaximumPtr: Pointer; 40 | function GetHookPtrList: TPointerHashNativeUIntList; 41 | function GetMemoryHooked: TAtomBool; 42 | 43 | implementation 44 | 45 | var 46 | HookPtrList: TPointerHashNativeUIntList; 47 | MemoryHooked: TAtomBool; 48 | 49 | {$IFDEF FPC} 50 | {$INCLUDE MH_fpc.inc} 51 | {$ELSE} 52 | {$INCLUDE MH_delphi.inc} 53 | {$ENDIF} 54 | 55 | initialization 56 | 57 | InstallMemoryHook; 58 | 59 | finalization 60 | 61 | UnInstallMemoryHook; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /lib/MH_ZDB.pas: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * Low MemoryHook written by QQ 600585@qq.com * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | 20 | (* 21 | update history 22 | 2017-12-31 23 | *) 24 | 25 | unit MH_ZDB; 26 | 27 | {$INCLUDE zDefine.inc} 28 | 29 | interface 30 | 31 | uses ListEngine, CoreClasses; 32 | 33 | procedure BeginMemoryHook; overload; 34 | procedure BeginMemoryHook(cacheLen: Integer); overload; 35 | procedure EndMemoryHook; 36 | function GetHookMemorySize: nativeUInt; overload; 37 | function GetHookMemorySize(p: Pointer): nativeUInt; overload; 38 | function GetHookMemoryMinimizePtr: Pointer; 39 | function GetHookMemoryMaximumPtr: Pointer; 40 | function GetHookPtrList: TPointerHashNativeUIntList; 41 | function GetMemoryHooked: TAtomBool; 42 | 43 | implementation 44 | 45 | var 46 | HookPtrList: TPointerHashNativeUIntList; 47 | MemoryHooked: TAtomBool; 48 | 49 | {$IFDEF FPC} 50 | {$INCLUDE MH_fpc.inc} 51 | {$ELSE} 52 | {$INCLUDE MH_delphi.inc} 53 | {$ENDIF} 54 | 55 | initialization 56 | 57 | InstallMemoryHook; 58 | 59 | finalization 60 | 61 | UnInstallMemoryHook; 62 | 63 | end. 64 | -------------------------------------------------------------------------------- /lib/MH_delphi.inc: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * https://zpascal.net * } 3 | { * https://github.com/PassByYou888/zAI * } 4 | { * https://github.com/PassByYou888/ZServer4D * } 5 | { * https://github.com/PassByYou888/PascalString * } 6 | { * https://github.com/PassByYou888/zRasterization * } 7 | { * https://github.com/PassByYou888/CoreCipher * } 8 | { * https://github.com/PassByYou888/zSound * } 9 | { * https://github.com/PassByYou888/zChinese * } 10 | { * https://github.com/PassByYou888/zExpression * } 11 | { * https://github.com/PassByYou888/zGameWare * } 12 | { * https://github.com/PassByYou888/zAnalysis * } 13 | { * https://github.com/PassByYou888/FFMPEG-Header * } 14 | { * https://github.com/PassByYou888/zTranslate * } 15 | { * https://github.com/PassByYou888/InfiniteIoT * } 16 | { * https://github.com/PassByYou888/FastMD5 * } 17 | { ****************************************************************************** } 18 | type 19 | MPtrUInt = nativeUInt; 20 | MPtr = Pointer; 21 | PMPtrUInt = ^MPtrUInt; 22 | 23 | var 24 | OriginMM: TMemoryManagerEx; 25 | HookMM: TMemoryManagerEx; 26 | CurrentHookThread: TCoreClassThread; 27 | 28 | procedure BeginMemoryHook; 29 | begin 30 | if (MemoryHooked.V) or (CurrentHookThread <> nil) then 31 | RaiseInfo('illegal BeginMemoryHook'); 32 | 33 | CurrentHookThread := TCoreClassThread.CurrentThread; 34 | HookPtrList.FastClear; 35 | MemoryHooked.V := True; 36 | end; 37 | 38 | procedure BeginMemoryHook(cacheLen: Integer); 39 | begin 40 | if (MemoryHooked.V) or (CurrentHookThread <> nil) then 41 | RaiseInfo('illegal BeginMemoryHook'); 42 | 43 | CurrentHookThread := TCoreClassThread.CurrentThread; 44 | if length(HookPtrList.ListBuffer^) <> cacheLen then 45 | HookPtrList.SetHashBlockCount(cacheLen) 46 | else 47 | HookPtrList.FastClear; 48 | 49 | MemoryHooked.V := True; 50 | end; 51 | 52 | procedure EndMemoryHook; 53 | begin 54 | if not MemoryHooked.V then 55 | RaiseInfo('illegal EndMemoryHook'); 56 | 57 | MemoryHooked.V := False; 58 | CurrentHookThread := nil; 59 | end; 60 | 61 | function GetHookMemorySize: nativeUInt; 62 | begin 63 | Result := HookPtrList.Total; 64 | end; 65 | 66 | function GetHookMemorySize(p: Pointer): nativeUInt; 67 | begin 68 | Result := HookPtrList[p]; 69 | end; 70 | 71 | function GetHookMemoryMinimizePtr: Pointer; 72 | begin 73 | Result := HookPtrList.MinimizePtr; 74 | end; 75 | 76 | function GetHookMemoryMaximumPtr: Pointer; 77 | begin 78 | Result := HookPtrList.MaximumPtr; 79 | end; 80 | 81 | function GetHookPtrList: TPointerHashNativeUIntList; 82 | begin 83 | Result := HookPtrList; 84 | end; 85 | 86 | function GetMemoryHooked: TAtomBool; 87 | begin 88 | Result := MemoryHooked; 89 | end; 90 | 91 | function Hash_GetMem(Size: NativeInt): MPtr; 92 | begin 93 | Result := OriginMM.GetMem(DeltaStep(Size, C_MH_MemoryDelta)); 94 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (Result = nil) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 95 | Exit; 96 | MemoryHooked.V := False; 97 | GlobalMemoryHook.V := False; 98 | HookPtrList.Add(Result, Size, False); 99 | MemoryHooked.V := True; 100 | GlobalMemoryHook.V := True; 101 | end; 102 | 103 | function Hash_FreeMem(p: MPtr): Integer; 104 | begin 105 | Result := OriginMM.FreeMem(p); 106 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (p = nil) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 107 | Exit; 108 | MemoryHooked.V := False; 109 | GlobalMemoryHook.V := False; 110 | HookPtrList.Delete(p); 111 | MemoryHooked.V := True; 112 | GlobalMemoryHook.V := True; 113 | end; 114 | 115 | function Hash_ReallocMem(p: MPtr; Size: NativeInt): MPtr; 116 | begin 117 | Result := OriginMM.ReallocMem(p, DeltaStep(Size, C_MH_MemoryDelta)); 118 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 119 | Exit; 120 | MemoryHooked.V := False; 121 | GlobalMemoryHook.V := False; 122 | if p <> nil then 123 | begin 124 | if HookPtrList.Delete(p) then 125 | if Result <> nil then 126 | HookPtrList.Add(Result, Size, False); 127 | end 128 | else if Result <> nil then 129 | HookPtrList.Add(Result, Size, False); 130 | MemoryHooked.V := True; 131 | GlobalMemoryHook.V := True; 132 | end; 133 | 134 | function Hash_AllocMem(Size: NativeInt): MPtr; 135 | begin 136 | Result := OriginMM.AllocMem(DeltaStep(Size, C_MH_MemoryDelta)); 137 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (Result = nil) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 138 | Exit; 139 | MemoryHooked.V := False; 140 | GlobalMemoryHook.V := False; 141 | HookPtrList.Add(Result, Size, False); 142 | MemoryHooked.V := True; 143 | GlobalMemoryHook.V := True; 144 | end; 145 | 146 | procedure InstallMemoryHook; 147 | begin 148 | HookPtrList := TPointerHashNativeUIntList.CustomCreate(32); 149 | CurrentHookThread := nil; 150 | 151 | GetMemoryManager(OriginMM); 152 | HookMM := OriginMM; 153 | 154 | MemoryHooked := TAtomBool.Create(False); 155 | 156 | HookMM.GetMem := Hash_GetMem; 157 | HookMM.FreeMem := Hash_FreeMem; 158 | HookMM.ReallocMem := Hash_ReallocMem; 159 | HookMM.AllocMem := Hash_AllocMem; 160 | 161 | SetMemoryManager(HookMM); 162 | end; 163 | 164 | procedure UnInstallMemoryHook; 165 | begin 166 | SetMemoryManager(OriginMM); 167 | DisposeObject(HookPtrList); 168 | MemoryHooked.Free; 169 | MemoryHooked := nil; 170 | end; 171 | -------------------------------------------------------------------------------- /lib/MH_fpc.inc: -------------------------------------------------------------------------------- 1 | { * https://zpascal.net * } 2 | { * https://github.com/PassByYou888/zAI * } 3 | { * https://github.com/PassByYou888/ZServer4D * } 4 | { * https://github.com/PassByYou888/PascalString * } 5 | { * https://github.com/PassByYou888/zRasterization * } 6 | { * https://github.com/PassByYou888/CoreCipher * } 7 | { * https://github.com/PassByYou888/zSound * } 8 | { * https://github.com/PassByYou888/zChinese * } 9 | { * https://github.com/PassByYou888/zExpression * } 10 | { * https://github.com/PassByYou888/zGameWare * } 11 | { * https://github.com/PassByYou888/zAnalysis * } 12 | { * https://github.com/PassByYou888/FFMPEG-Header * } 13 | { * https://github.com/PassByYou888/zTranslate * } 14 | { * https://github.com/PassByYou888/InfiniteIoT * } 15 | { * https://github.com/PassByYou888/FastMD5 * } 16 | { ****************************************************************************** } 17 | 18 | type 19 | MPtrUInt = ptruint; 20 | MPtr = Pointer; 21 | PMPtrUInt = ^MPtrUInt; 22 | 23 | var 24 | OriginMM: TMemoryManager; 25 | HookMM: TMemoryManager; 26 | CurrentHookThread: TCoreClassThread; 27 | 28 | procedure BeginMemoryHook; 29 | begin 30 | if (MemoryHooked.V) or (CurrentHookThread <> nil) then 31 | RaiseInfo('illegal BeginMemoryHook'); 32 | 33 | CurrentHookThread := TCoreClassThread.CurrentThread; 34 | HookPtrList.FastClear; 35 | MemoryHooked.V := True; 36 | end; 37 | 38 | procedure BeginMemoryHook(cacheLen: Integer); 39 | begin 40 | if (MemoryHooked.V) or (CurrentHookThread <> nil) then 41 | RaiseInfo('illegal BeginMemoryHook'); 42 | 43 | CurrentHookThread := TCoreClassThread.CurrentThread; 44 | if length(HookPtrList.ListBuffer^) <> cacheLen then 45 | HookPtrList.SetHashBlockCount(cacheLen) 46 | else 47 | HookPtrList.FastClear; 48 | 49 | MemoryHooked.V := True; 50 | end; 51 | 52 | procedure EndMemoryHook; 53 | begin 54 | if not MemoryHooked.V then 55 | RaiseInfo('illegal EndMemoryHook'); 56 | 57 | MemoryHooked.V := False; 58 | CurrentHookThread := nil; 59 | end; 60 | 61 | function GetHookMemorySize: nativeUInt; 62 | begin 63 | Result := HookPtrList.Total; 64 | end; 65 | 66 | function GetHookMemorySize(p: Pointer): nativeUInt; 67 | begin 68 | Result := HookPtrList[p]; 69 | end; 70 | 71 | function GetHookMemoryMinimizePtr: Pointer; 72 | begin 73 | Result := HookPtrList.MinimizePtr; 74 | end; 75 | 76 | function GetHookMemoryMaximumPtr: Pointer; 77 | begin 78 | Result := HookPtrList.MaximumPtr; 79 | end; 80 | 81 | function GetHookPtrList: TPointerHashNativeUIntList; 82 | begin 83 | Result := HookPtrList; 84 | end; 85 | 86 | function GetMemoryHooked: TAtomBool; 87 | begin 88 | Result := MemoryHooked; 89 | end; 90 | 91 | function Hash_GetMem(Size: ptruint): Pointer; 92 | begin 93 | Result := OriginMM.GetMem(DeltaStep(Size, C_MH_MemoryDelta)); 94 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (Result = nil) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 95 | Exit; 96 | MemoryHooked.V := False; 97 | GlobalMemoryHook.V := False; 98 | HookPtrList.Add(Result, Size, False); 99 | MemoryHooked.V := True; 100 | GlobalMemoryHook.V := True; 101 | end; 102 | 103 | function Hash_FreeMem(p: Pointer): ptruint; 104 | begin 105 | Result := OriginMM.FreeMem(p); 106 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (p = nil) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 107 | Exit; 108 | MemoryHooked.V := False; 109 | GlobalMemoryHook.V := False; 110 | HookPtrList.Delete(p); 111 | MemoryHooked.V := True; 112 | GlobalMemoryHook.V := True; 113 | end; 114 | 115 | function Hash_FreememSize(p: Pointer; Size: ptruint): ptruint; 116 | begin 117 | Result := OriginMM.FreememSize(p, DeltaStep(Size, C_MH_MemoryDelta)); 118 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (p = nil) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 119 | Exit; 120 | MemoryHooked.V := False; 121 | GlobalMemoryHook.V := False; 122 | HookPtrList.Delete(p); 123 | MemoryHooked.V := True; 124 | GlobalMemoryHook.V := True; 125 | end; 126 | 127 | function Hash_AllocMem(Size: ptruint): Pointer; 128 | begin 129 | Result := OriginMM.AllocMem(DeltaStep(Size, C_MH_MemoryDelta)); 130 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (Result = nil) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 131 | Exit; 132 | MemoryHooked.V := False; 133 | GlobalMemoryHook.V := False; 134 | HookPtrList.Add(Result, Size, True); 135 | MemoryHooked.V := True; 136 | GlobalMemoryHook.V := True; 137 | end; 138 | 139 | function Hash_ReallocMem(var p: Pointer; Size: ptruint): Pointer; 140 | begin 141 | Result := OriginMM.ReallocMem(p, DeltaStep(Size, C_MH_MemoryDelta)); 142 | if (not MemoryHooked.V) or (not GlobalMemoryHook.V) or (CurrentHookThread <> TCoreClassThread.CurrentThread) then 143 | Exit; 144 | MemoryHooked.V := False; 145 | GlobalMemoryHook.V := False; 146 | if p <> nil then 147 | begin 148 | if HookPtrList.Delete(p) then 149 | if Result <> nil then 150 | HookPtrList.Add(Result, Size, False); 151 | end 152 | else if Result <> nil then 153 | HookPtrList.Add(Result, Size, False); 154 | MemoryHooked.V := True; 155 | GlobalMemoryHook.V := True; 156 | end; 157 | 158 | procedure InstallMemoryHook; 159 | begin 160 | HookPtrList := TPointerHashNativeUIntList.CustomCreate(32); 161 | CurrentHookThread := nil; 162 | 163 | GetMemoryManager(OriginMM); 164 | HookMM := OriginMM; 165 | 166 | MemoryHooked := TAtomBool.Create(False); 167 | 168 | HookMM.GetMem := @Hash_GetMem; 169 | HookMM.FreeMem := @Hash_FreeMem; 170 | HookMM.FreememSize := @Hash_FreememSize; 171 | HookMM.AllocMem := @Hash_AllocMem; 172 | HookMM.ReallocMem := @Hash_ReallocMem; 173 | 174 | SetMemoryManager(HookMM); 175 | end; 176 | 177 | procedure UnInstallMemoryHook; 178 | begin 179 | SetMemoryManager(OriginMM); 180 | DisposeObject(HookPtrList); 181 | MemoryHooked.Free; 182 | MemoryHooked := nil; 183 | end; 184 | -------------------------------------------------------------------------------- /lib/ZJson_delphi.inc: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * json object library for delphi/objfpc * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | 20 | procedure TZ_JsonArray.Clear; 21 | begin 22 | FInstance.Clear; 23 | end; 24 | 25 | procedure TZ_JsonArray.Delete(Index: Integer); 26 | begin 27 | FInstance.Delete(index); 28 | end; 29 | 30 | procedure TZ_JsonArray.Add(const v_: string); 31 | begin 32 | FInstance.Add(v_); 33 | end; 34 | 35 | procedure TZ_JsonArray.Add(const v_: TPascalString); 36 | begin 37 | FInstance.Add(v_.Text); 38 | end; 39 | 40 | procedure TZ_JsonArray.Add(const v_: Integer); 41 | begin 42 | FInstance.Add(v_); 43 | end; 44 | 45 | procedure TZ_JsonArray.Add(const v_: Int64); 46 | begin 47 | FInstance.Add(v_); 48 | end; 49 | 50 | procedure TZ_JsonArray.Add(const v_: UInt64); 51 | begin 52 | FInstance.Add(v_); 53 | end; 54 | 55 | procedure TZ_JsonArray.AddF(const v_: Double); 56 | begin 57 | FInstance.Add(v_); 58 | end; 59 | 60 | procedure TZ_JsonArray.Add(const v_: TDateTime); 61 | begin 62 | FInstance.Add(umlDateTimeToStr(v_).Text); 63 | end; 64 | 65 | procedure TZ_JsonArray.Add(const v_: Boolean); 66 | begin 67 | FInstance.Add(v_); 68 | end; 69 | 70 | function TZ_JsonArray.AddArray: TZ_JsonArray; 71 | begin 72 | Result := TZ_JsonArray.Create(self); 73 | Result.FInstance := FInstance.AddArray; 74 | end; 75 | 76 | function TZ_JsonArray.AddObject: TZ_JsonObject; 77 | begin 78 | Result := TZ_JsonObject.Create(self); 79 | Result.FInstance := FInstance.AddObject; 80 | end; 81 | 82 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: string); 83 | begin 84 | FInstance.Insert(index, v_); 85 | end; 86 | 87 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Integer); 88 | begin 89 | FInstance.Insert(index, v_); 90 | end; 91 | 92 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Int64); 93 | begin 94 | FInstance.Insert(index, v_); 95 | end; 96 | 97 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: UInt64); 98 | begin 99 | FInstance.Insert(index, v_); 100 | end; 101 | 102 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Double); 103 | begin 104 | FInstance.Insert(index, v_); 105 | end; 106 | 107 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: TDateTime); 108 | begin 109 | FInstance.Insert(index, umlDateTimeToStr(v_).Text); 110 | end; 111 | 112 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Boolean); 113 | begin 114 | FInstance.Insert(index, v_); 115 | end; 116 | 117 | function TZ_JsonArray.InsertArray(Index: Integer): TZ_JsonArray; 118 | begin 119 | Result := TZ_JsonArray.Create(self); 120 | Result.FInstance := FInstance.InsertArray(index); 121 | end; 122 | 123 | function TZ_JsonArray.InsertObject(Index: Integer): TZ_JsonObject; 124 | begin 125 | Result := TZ_JsonObject.Create(self); 126 | Result.FInstance := FInstance.InsertObject(index); 127 | end; 128 | 129 | function TZ_JsonArray.GetString(Index: Integer): string; 130 | begin 131 | Result := FInstance.S[index]; 132 | end; 133 | 134 | procedure TZ_JsonArray.SetString(Index: Integer; const Value: string); 135 | begin 136 | FInstance.S[index] := Value; 137 | end; 138 | 139 | function TZ_JsonArray.GetInt(Index: Integer): Integer; 140 | begin 141 | Result := FInstance.I[index]; 142 | end; 143 | 144 | procedure TZ_JsonArray.SetInt(Index: Integer; const Value: Integer); 145 | begin 146 | FInstance.I[index] := Value; 147 | end; 148 | 149 | function TZ_JsonArray.GetLong(Index: Integer): Int64; 150 | begin 151 | Result := FInstance.I64[index]; 152 | end; 153 | 154 | procedure TZ_JsonArray.SetLong(Index: Integer; const Value: Int64); 155 | begin 156 | FInstance.I64[index] := Value; 157 | end; 158 | 159 | function TZ_JsonArray.GetULong(Index: Integer): UInt64; 160 | begin 161 | Result := FInstance.U64[index]; 162 | end; 163 | 164 | procedure TZ_JsonArray.SetULong(Index: Integer; const Value: UInt64); 165 | begin 166 | FInstance.U64[index] := Value; 167 | end; 168 | 169 | function TZ_JsonArray.GetFloat(Index: Integer): Double; 170 | begin 171 | Result := FInstance.F[index]; 172 | end; 173 | 174 | procedure TZ_JsonArray.SetFloat(Index: Integer; const Value: Double); 175 | begin 176 | FInstance.F[index] := Value; 177 | end; 178 | 179 | function TZ_JsonArray.GetDateTime(Index: Integer): TDateTime; 180 | begin 181 | Result := umlStrToDateTime(FInstance.S[index]); 182 | end; 183 | 184 | procedure TZ_JsonArray.SetDateTime(Index: Integer; const Value: TDateTime); 185 | begin 186 | FInstance.S[index] := umlDateTimeToStr(Value).Text; 187 | end; 188 | 189 | function TZ_JsonArray.GetBool(Index: Integer): Boolean; 190 | begin 191 | Result := FInstance.B[index]; 192 | end; 193 | 194 | procedure TZ_JsonArray.SetBool(Index: Integer; const Value: Boolean); 195 | begin 196 | FInstance.B[index] := Value; 197 | end; 198 | 199 | function TZ_JsonArray.GetArray(Index: Integer): TZ_JsonArray; 200 | var 201 | arry: TZ_Instance_JsonArray; 202 | j: Integer; 203 | begin 204 | arry := FInstance.A[index]; 205 | for j := FList.Count - 1 downto 0 do 206 | if (FList[j] is TZ_JsonArray) and (TZ_JsonArray(FList[j]).FInstance = arry) then 207 | begin 208 | Result := TZ_JsonArray(FList[j]); 209 | exit; 210 | end; 211 | Result := TZ_JsonArray.Create(self); 212 | Result.FInstance := arry; 213 | end; 214 | 215 | function TZ_JsonArray.GetObject(Index: Integer): TZ_JsonObject; 216 | var 217 | Obj_: TZ_Instance_JsonObject; 218 | j: Integer; 219 | begin 220 | Obj_ := FInstance.O[Index]; 221 | for j := FList.Count - 1 downto 0 do 222 | if (FList[j] is TZ_JsonObject) and (TZ_JsonObject(FList[j]).FInstance = Obj_) then 223 | begin 224 | Result := TZ_JsonObject(FList[j]); 225 | exit; 226 | end; 227 | Result := TZ_JsonObject.Create(self); 228 | Result.FInstance := Obj_; 229 | end; 230 | 231 | function TZ_JsonArray.GetCount: Integer; 232 | begin 233 | Result := FInstance.Count; 234 | end; 235 | 236 | procedure TZ_JsonObject.Clear; 237 | begin 238 | FInstance.Clear; 239 | end; 240 | 241 | function TZ_JsonObject.IndexOf(const Name: string): Integer; 242 | begin 243 | Result := FInstance.IndexOf(Name); 244 | end; 245 | 246 | function TZ_JsonObject.GetString(const Name: string): string; 247 | begin 248 | Result := FInstance.S[Name]; 249 | end; 250 | 251 | procedure TZ_JsonObject.SetString(const Name, Value: string); 252 | begin 253 | FInstance.S[Name] := Value; 254 | end; 255 | 256 | function TZ_JsonObject.GetInt(const Name: string): Integer; 257 | begin 258 | Result := FInstance.I[Name]; 259 | end; 260 | 261 | procedure TZ_JsonObject.SetInt(const Name: string; const Value: Integer); 262 | begin 263 | FInstance.I[Name] := Value; 264 | end; 265 | 266 | function TZ_JsonObject.GetLong(const Name: string): Int64; 267 | begin 268 | Result := FInstance.I64[Name]; 269 | end; 270 | 271 | procedure TZ_JsonObject.SetLong(const Name: string; const Value: Int64); 272 | begin 273 | FInstance.I64[Name] := Value; 274 | end; 275 | 276 | function TZ_JsonObject.GetULong(const Name: string): UInt64; 277 | begin 278 | Result := FInstance.U[Name]; 279 | end; 280 | 281 | procedure TZ_JsonObject.SetULong(const Name: string; const Value: UInt64); 282 | begin 283 | FInstance.U[Name] := Value; 284 | end; 285 | 286 | function TZ_JsonObject.GetFloat(const Name: string): Double; 287 | begin 288 | Result := FInstance.F[Name]; 289 | end; 290 | 291 | procedure TZ_JsonObject.SetFloat(const Name: string; const Value: Double); 292 | begin 293 | FInstance.F[Name] := Value; 294 | end; 295 | 296 | function TZ_JsonObject.GetDateTime(const Name: string): TDateTime; 297 | begin 298 | Result := umlStrToDateTime(FInstance.S[Name]); 299 | end; 300 | 301 | procedure TZ_JsonObject.SetDateTime(const Name: string; const Value: TDateTime); 302 | begin 303 | FInstance.S[Name] := umlDateTimeToStr(Value).Text; 304 | end; 305 | 306 | function TZ_JsonObject.GetBool(const Name: string): Boolean; 307 | begin 308 | Result := FInstance.B[Name]; 309 | end; 310 | 311 | procedure TZ_JsonObject.SetBool(const Name: string; const Value: Boolean); 312 | begin 313 | FInstance.B[Name] := Value; 314 | end; 315 | 316 | function TZ_JsonObject.GetArray(const Name: string): TZ_JsonArray; 317 | var 318 | arry: TZ_Instance_JsonArray; 319 | j: Integer; 320 | begin 321 | arry := FInstance.A[Name]; 322 | for j := FList.Count - 1 downto 0 do 323 | if (FList[j] is TZ_JsonArray) and (TZ_JsonArray(FList[j]).FInstance = arry) then 324 | begin 325 | Result := TZ_JsonArray(FList[j]); 326 | exit; 327 | end; 328 | Result := TZ_JsonArray.Create(self); 329 | Result.FInstance := arry; 330 | end; 331 | 332 | function TZ_JsonObject.GetObject(const Name: string): TZ_JsonObject; 333 | var 334 | Obj_: TZ_Instance_JsonObject; 335 | j: Integer; 336 | begin 337 | Obj_ := FInstance.O[Name]; 338 | for j := FList.Count - 1 downto 0 do 339 | if (FList[j] is TZ_JsonObject) and (TZ_JsonObject(FList[j]).FInstance = Obj_) then 340 | begin 341 | Result := TZ_JsonObject(FList[j]); 342 | exit; 343 | end; 344 | Result := TZ_JsonObject.Create(self); 345 | Result.FInstance := Obj_; 346 | end; 347 | 348 | function TZ_JsonObject.GetName(Index: Integer): string; 349 | begin 350 | Result := FInstance.Names[Index]; 351 | end; 352 | 353 | function TZ_JsonObject.GetCount: Integer; 354 | begin 355 | Result := FInstance.Count; 356 | end; 357 | 358 | procedure TZ_JsonObject.SaveToStream(stream: TCoreClassStream; Formated_: Boolean); 359 | begin 360 | FInstance.SaveToStream(stream, not Formated_, TEncoding.UTF8, True); 361 | end; 362 | 363 | procedure TZ_JsonObject.LoadFromStream(stream: TCoreClassStream); 364 | begin 365 | FInstance.LoadFromStream(stream, TEncoding.UTF8, True); 366 | end; 367 | -------------------------------------------------------------------------------- /lib/ZJson_fpc.inc: -------------------------------------------------------------------------------- 1 | { ****************************************************************************** } 2 | { * json object library for delphi/objfpc * } 3 | { * https://zpascal.net * } 4 | { * https://github.com/PassByYou888/zAI * } 5 | { * https://github.com/PassByYou888/ZServer4D * } 6 | { * https://github.com/PassByYou888/PascalString * } 7 | { * https://github.com/PassByYou888/zRasterization * } 8 | { * https://github.com/PassByYou888/CoreCipher * } 9 | { * https://github.com/PassByYou888/zSound * } 10 | { * https://github.com/PassByYou888/zChinese * } 11 | { * https://github.com/PassByYou888/zExpression * } 12 | { * https://github.com/PassByYou888/zGameWare * } 13 | { * https://github.com/PassByYou888/zAnalysis * } 14 | { * https://github.com/PassByYou888/FFMPEG-Header * } 15 | { * https://github.com/PassByYou888/zTranslate * } 16 | { * https://github.com/PassByYou888/InfiniteIoT * } 17 | { * https://github.com/PassByYou888/FastMD5 * } 18 | { ****************************************************************************** } 19 | procedure TZ_JsonArray.Clear; 20 | begin 21 | FInstance.Clear; 22 | end; 23 | 24 | procedure TZ_JsonArray.Delete(Index: Integer); 25 | begin 26 | FInstance.Delete(index); 27 | end; 28 | 29 | procedure TZ_JsonArray.Add(const v_: string); 30 | begin 31 | FInstance.Add(v_); 32 | end; 33 | 34 | procedure TZ_JsonArray.Add(const v_: TPascalString); 35 | begin 36 | FInstance.Add(v_.Text); 37 | end; 38 | 39 | procedure TZ_JsonArray.Add(const v_: Integer); 40 | begin 41 | FInstance.Add(v_); 42 | end; 43 | 44 | procedure TZ_JsonArray.Add(const v_: Int64); 45 | begin 46 | FInstance.Add(v_); 47 | end; 48 | 49 | procedure TZ_JsonArray.Add(const v_: UInt64); 50 | begin 51 | FInstance.Add(v_); 52 | end; 53 | 54 | procedure TZ_JsonArray.AddF(const v_: Double); 55 | begin 56 | FInstance.Add(v_); 57 | end; 58 | 59 | procedure TZ_JsonArray.Add(const v_: TDateTime); 60 | begin 61 | FInstance.Add(umlDateTimeToStr(v_).Text); 62 | end; 63 | 64 | procedure TZ_JsonArray.Add(const v_: Boolean); 65 | begin 66 | FInstance.Add(v_); 67 | end; 68 | 69 | function TZ_JsonArray.AddArray: TZ_JsonArray; 70 | begin 71 | Result := TZ_JsonArray.Create(self); 72 | Result.FInstance := TZ_Instance_JsonArray.Create; 73 | FInstance.Add(Result.FInstance); 74 | end; 75 | 76 | function TZ_JsonArray.AddObject: TZ_JsonObject; 77 | begin 78 | Result := TZ_JsonObject.Create(self); 79 | Result.FInstance := TZ_Instance_JsonObject.Create; 80 | FInstance.Add(Result.FInstance); 81 | end; 82 | 83 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: string); 84 | begin 85 | FInstance.Insert(index, v_); 86 | end; 87 | 88 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Integer); 89 | begin 90 | FInstance.Insert(index, v_); 91 | end; 92 | 93 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Int64); 94 | begin 95 | FInstance.Insert(index, v_); 96 | end; 97 | 98 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: UInt64); 99 | begin 100 | FInstance.Insert(index, v_); 101 | end; 102 | 103 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Double); 104 | begin 105 | FInstance.Insert(index, v_); 106 | end; 107 | 108 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: TDateTime); 109 | begin 110 | FInstance.Insert(index, umlDateTimeToStr(v_).Text); 111 | end; 112 | 113 | procedure TZ_JsonArray.Insert(Index: Integer; const v_: Boolean); 114 | begin 115 | FInstance.Insert(index, v_); 116 | end; 117 | 118 | function TZ_JsonArray.InsertArray(Index: Integer): TZ_JsonArray; 119 | begin 120 | Result := TZ_JsonArray.Create(self); 121 | Result.FInstance := TZ_Instance_JsonArray.Create; 122 | FInstance.Insert(index, Result.FInstance); 123 | end; 124 | 125 | function TZ_JsonArray.InsertObject(Index: Integer): TZ_JsonObject; 126 | begin 127 | Result := TZ_JsonObject.Create(self); 128 | Result.FInstance := TZ_Instance_JsonObject.Create; 129 | FInstance.Insert(index, Result.FInstance); 130 | end; 131 | 132 | function TZ_JsonArray.GetString(Index: Integer): string; 133 | begin 134 | Result := FInstance.Strings[index]; 135 | end; 136 | 137 | procedure TZ_JsonArray.SetString(Index: Integer; const Value: string); 138 | begin 139 | FInstance.Strings[index] := Value; 140 | end; 141 | 142 | function TZ_JsonArray.GetInt(Index: Integer): Integer; 143 | begin 144 | Result := FInstance.Integers[index]; 145 | end; 146 | 147 | procedure TZ_JsonArray.SetInt(Index: Integer; const Value: Integer); 148 | begin 149 | FInstance.Integers[index] := Value; 150 | end; 151 | 152 | function TZ_JsonArray.GetLong(Index: Integer): Int64; 153 | begin 154 | Result := FInstance.Int64s[index]; 155 | end; 156 | 157 | procedure TZ_JsonArray.SetLong(Index: Integer; const Value: Int64); 158 | begin 159 | FInstance.Int64s[index] := Value; 160 | end; 161 | 162 | function TZ_JsonArray.GetULong(Index: Integer): UInt64; 163 | begin 164 | Result := FInstance.QWords[index]; 165 | end; 166 | 167 | procedure TZ_JsonArray.SetULong(Index: Integer; const Value: UInt64); 168 | begin 169 | FInstance.QWords[index] := Value; 170 | end; 171 | 172 | function TZ_JsonArray.GetFloat(Index: Integer): Double; 173 | begin 174 | Result := FInstance.Floats[index]; 175 | end; 176 | 177 | procedure TZ_JsonArray.SetFloat(Index: Integer; const Value: Double); 178 | begin 179 | FInstance.Floats[index] := Value; 180 | end; 181 | 182 | function TZ_JsonArray.GetDateTime(Index: Integer): TDateTime; 183 | begin 184 | Result := umlStrToDateTime(FInstance.Strings[index]); 185 | end; 186 | 187 | procedure TZ_JsonArray.SetDateTime(Index: Integer; const Value: TDateTime); 188 | begin 189 | FInstance.Strings[index] := umlDateTimeToStr(Value).Text; 190 | end; 191 | 192 | function TZ_JsonArray.GetBool(Index: Integer): Boolean; 193 | begin 194 | Result := FInstance.Booleans[index]; 195 | end; 196 | 197 | procedure TZ_JsonArray.SetBool(Index: Integer; const Value: Boolean); 198 | begin 199 | FInstance.Booleans[index] := Value; 200 | end; 201 | 202 | function TZ_JsonArray.GetArray(Index: Integer): TZ_JsonArray; 203 | var 204 | arry: TZ_Instance_JsonArray; 205 | j: Integer; 206 | begin 207 | arry := FInstance.Arrays[index]; 208 | for j := FList.Count - 1 downto 0 do 209 | if (FList[j] is TZ_JsonArray) and (TZ_JsonArray(FList[j]).FInstance = arry) then 210 | begin 211 | Result := TZ_JsonArray(FList[j]); 212 | exit; 213 | end; 214 | Result := TZ_JsonArray.Create(self); 215 | Result.FInstance := arry; 216 | end; 217 | 218 | function TZ_JsonArray.GetObject(Index: Integer): TZ_JsonObject; 219 | var 220 | Obj_: TZ_Instance_JsonObject; 221 | j: Integer; 222 | begin 223 | Obj_ := FInstance.Objects[Index]; 224 | for j := FList.Count - 1 downto 0 do 225 | if (FList[j] is TZ_JsonObject) and (TZ_JsonObject(FList[j]).FInstance = Obj_) then 226 | begin 227 | Result := TZ_JsonObject(FList[j]); 228 | exit; 229 | end; 230 | Result := TZ_JsonObject.Create(self); 231 | Result.FInstance := Obj_; 232 | end; 233 | 234 | function TZ_JsonArray.GetCount: Integer; 235 | begin 236 | Result := FInstance.Count; 237 | end; 238 | 239 | procedure TZ_JsonObject.Clear; 240 | begin 241 | FInstance.Clear; 242 | end; 243 | 244 | function TZ_JsonObject.IndexOf(const Name: string): Integer; 245 | begin 246 | Result := FInstance.IndexOfName(Name); 247 | end; 248 | 249 | function TZ_JsonObject.GetString(const Name: string): string; 250 | begin 251 | Result := FInstance.Strings[Name]; 252 | end; 253 | 254 | procedure TZ_JsonObject.SetString(const Name, Value: string); 255 | begin 256 | FInstance.Strings[Name] := Value; 257 | end; 258 | 259 | function TZ_JsonObject.GetInt(const Name: string): Integer; 260 | begin 261 | Result := FInstance.Integers[Name]; 262 | end; 263 | 264 | procedure TZ_JsonObject.SetInt(const Name: string; const Value: Integer); 265 | begin 266 | FInstance.Integers[Name] := Value; 267 | end; 268 | 269 | function TZ_JsonObject.GetLong(const Name: string): Int64; 270 | begin 271 | Result := FInstance.Int64s[Name]; 272 | end; 273 | 274 | procedure TZ_JsonObject.SetLong(const Name: string; const Value: Int64); 275 | begin 276 | FInstance.Int64s[Name] := Value; 277 | end; 278 | 279 | function TZ_JsonObject.GetULong(const Name: string): UInt64; 280 | begin 281 | Result := FInstance.QWords[Name]; 282 | end; 283 | 284 | procedure TZ_JsonObject.SetULong(const Name: string; const Value: UInt64); 285 | begin 286 | FInstance.QWords[Name] := Value; 287 | end; 288 | 289 | function TZ_JsonObject.GetFloat(const Name: string): Double; 290 | begin 291 | Result := FInstance.Floats[Name]; 292 | end; 293 | 294 | procedure TZ_JsonObject.SetFloat(const Name: string; const Value: Double); 295 | begin 296 | FInstance.Floats[Name] := Value; 297 | end; 298 | 299 | function TZ_JsonObject.GetDateTime(const Name: string): TDateTime; 300 | begin 301 | Result := umlStrToDateTime(FInstance.Strings[Name]); 302 | end; 303 | 304 | procedure TZ_JsonObject.SetDateTime(const Name: string; const Value: TDateTime); 305 | begin 306 | FInstance.Strings[Name] := umlDateTimeToStr(Value).Text; 307 | end; 308 | 309 | function TZ_JsonObject.GetBool(const Name: string): Boolean; 310 | begin 311 | Result := FInstance.Booleans[Name]; 312 | end; 313 | 314 | procedure TZ_JsonObject.SetBool(const Name: string; const Value: Boolean); 315 | begin 316 | FInstance.Booleans[Name] := Value; 317 | end; 318 | 319 | function TZ_JsonObject.GetArray(const Name: string): TZ_JsonArray; 320 | var 321 | arry: TZ_Instance_JsonArray; 322 | j: Integer; 323 | begin 324 | if FInstance.Find(Name, arry) then 325 | begin 326 | for j := FList.Count - 1 downto 0 do 327 | if (FList[j] is TZ_JsonArray) and (TZ_JsonArray(FList[j]).FInstance = arry) then 328 | begin 329 | Result := TZ_JsonArray(FList[j]); 330 | exit; 331 | end; 332 | end; 333 | 334 | arry := TZ_Instance_JsonArray.Create(); 335 | FInstance.Arrays[Name] := arry; 336 | Result := TZ_JsonArray.Create(self); 337 | Result.FInstance := arry; 338 | end; 339 | 340 | function TZ_JsonObject.GetObject(const Name: string): TZ_JsonObject; 341 | var 342 | Obj_: TZ_Instance_JsonObject; 343 | j: Integer; 344 | begin 345 | if FInstance.Find(Name, Obj_) then 346 | begin 347 | for j := FList.Count - 1 downto 0 do 348 | if (FList[j] is TZ_JsonObject) and (TZ_JsonObject(FList[j]).FInstance = Obj_) then 349 | begin 350 | Result := TZ_JsonObject(FList[j]); 351 | exit; 352 | end; 353 | end; 354 | 355 | Obj_ := TZ_Instance_JsonObject.Create(); 356 | FInstance.Objects[Name] := Obj_; 357 | Result := TZ_JsonObject.Create(self); 358 | Result.FInstance := Obj_; 359 | end; 360 | 361 | function TZ_JsonObject.GetName(Index: Integer): string; 362 | begin 363 | Result := FInstance.Names[index]; 364 | end; 365 | 366 | function TZ_JsonObject.GetCount: Integer; 367 | begin 368 | Result := FInstance.Count; 369 | end; 370 | 371 | procedure TZ_JsonObject.SaveToStream(stream: TCoreClassStream; Formated_: Boolean); 372 | var 373 | s_: TPascalString; 374 | buff: TBytes; 375 | begin 376 | if Formated_ then 377 | s_.Text := FInstance.FormatJSON() 378 | else 379 | s_.Text := FInstance.AsJSON; 380 | buff := s_.Bytes; 381 | s_ := ''; 382 | stream.Write(buff[0], length(buff)); 383 | SetLength(buff, 0); 384 | end; 385 | 386 | procedure TZ_JsonObject.LoadFromStream(stream: TCoreClassStream); 387 | Var 388 | P: TJSONParser; 389 | j: TJSONData; 390 | begin 391 | DisposeObjectAndNil(FInstance); 392 | P := TJSONParser.Create(stream, [joUTF8]); 393 | try 394 | j := P.Parse; 395 | if j is TZ_Instance_JsonObject then 396 | FInstance := TZ_Instance_JsonObject(j) 397 | except 398 | end; 399 | FreeAndNil(P); 400 | end; 401 | -------------------------------------------------------------------------------- /lib/clear_with_dcu.bat: -------------------------------------------------------------------------------- 1 | del/s *.dcu 2 | del/s *.o 3 | del/s *.ppu 4 | del/s *.rsm 5 | del/s *.replay 6 | del/s *.loginpackage 7 | del/s *.dres 8 | del/s *.local 9 | del/s *.identcache 10 | del/s *.stat 11 | del/s *.tvsconfig 12 | del/s *.deployproj 13 | del/s *.stat 14 | del/s *.delphilsp.json 15 | rem del/s *.pdb 16 | rem del/s *.exp 17 | rem del/s zAI\*.pdb 18 | rem del/s zAI\*.obj 19 | rem del/s zAI\*.lib 20 | rem del/s zAI\*.tlog 21 | rem del/s zAI\*.db 22 | rem rd/q/s zAI\AI_Build\cuda\dlib_build\dlib\Debug 23 | rem rd/q/s zAI\AI_Build\cuda\dlib_build\dlib\Release 24 | rem rd/q/s zAI\AI_Build\cuda\dlib_build\dlib\x64 25 | rem rd/q/s zAI\AI_Build\cuda\Debug 26 | rem rd/q/s zAI\AI_Build\cuda\Release 27 | rem rd/q/s zAI\AI_Build\cuda\x64 28 | -------------------------------------------------------------------------------- /lib/md5_32.asm: -------------------------------------------------------------------------------- 1 | ;{ ****************************************************************************** } 2 | ;{ * https://zpascal.net * } 3 | ;{ * https://github.com/PassByYou888/zAI * } 4 | ;{ * https://github.com/PassByYou888/ZServer4D * } 5 | ;{ * https://github.com/PassByYou888/PascalString * } 6 | ;{ * https://github.com/PassByYou888/zRasterization * } 7 | ;{ * https://github.com/PassByYou888/CoreCipher * } 8 | ;{ * https://github.com/PassByYou888/zSound * } 9 | ;{ * https://github.com/PassByYou888/zChinese * } 10 | ;{ * https://github.com/PassByYou888/zExpression * } 11 | ;{ * https://github.com/PassByYou888/zGameWare * } 12 | ;{ * https://github.com/PassByYou888/zAnalysis * } 13 | ;{ * https://github.com/PassByYou888/FFMPEG-Header * } 14 | ;{ * https://github.com/PassByYou888/zTranslate * } 15 | ;{ * https://github.com/PassByYou888/InfiniteIoT * } 16 | ;{ * https://github.com/PassByYou888/FastMD5 * } 17 | ;{ ****************************************************************************** } 18 | 19 | 20 | ; MD5_386.Asm - 386 optimized helper routine for calculating 21 | ; MD Message-Digest values 22 | ; written 2/2/94 by 23 | ; 24 | ; Peter Sawatzki 25 | ; Buchenhof 3 26 | ; D58091 Hagen, Germany Fed Rep 27 | ; 28 | ; EMail: Peter@Sawatzki.de 29 | ; EMail: 100031.3002@compuserve.com 30 | ; WWW: http://www.sawatzki.de 31 | ; 32 | ; 33 | ; original C Source was found in Dr. Dobbs Journal Sep 91 34 | ; MD5 algorithm from RSA Data Security, Inc. 35 | 36 | 37 | ; This is a 32-bit version of MD5_Transform 38 | ; modifief by Maxim Masiutin for Borland 32-bit "register" 39 | ; calling convention. For more information on this calling convension, see 40 | ; https://en.wikipedia.org/wiki/X86_calling_conventions#Borland_register 41 | 42 | ; You can compile this code using Microsoft Macro Assembler 43 | ; ml.exe /c md5_32.asm 44 | ; or using Borland Turbo Assembler 45 | ; tasm32.exe /m md5_32.asm 46 | 47 | .386 48 | .MODEL FLAT 49 | .CODE 50 | 51 | FF Macro a,b,c,d,x,s,ac 52 | ; a:= ROL (a+x+ac + (b And c Or Not b And d), s) + b 53 | Add a, [EBp+(4*x)] 54 | Add a, ac 55 | Mov ESi, b 56 | Not ESi 57 | And ESi, d 58 | Mov EDi, c 59 | And EDi, b 60 | Or ESi, EDi 61 | Add a, ESi 62 | Rol a, s 63 | Add a, b 64 | EndM 65 | 66 | GG Macro a,b,c,d,x,s,ac 67 | ; a:= ROL (a+x+ac + (b And d Or c And Not d), s) + b 68 | Add a, [EBp+(4*x)] 69 | Add a, ac 70 | Mov ESi, d 71 | Not ESi 72 | And ESi, c 73 | Mov EDi, d 74 | And EDi, b 75 | Or ESi, EDi 76 | Add a, ESi 77 | Rol a, s 78 | Add a, b 79 | EndM 80 | 81 | HH Macro a,b,c,d,x,s,ac 82 | ; a:= ROL (a+x+ac + (b Xor c Xor d), s) + b 83 | Add a, [EBp+(4*x)] 84 | Add a, ac 85 | Mov ESi, d 86 | Xor ESi, c 87 | Xor ESi, b 88 | Add a, ESi 89 | Rol a, s 90 | Add a, b 91 | EndM 92 | 93 | II Macro a,b,c,d,x,s,ac 94 | ; a:= ROL (a+x+ac + (c Xor (b Or Not d)), s) + b 95 | Add a, [EBp+(4*x)] 96 | Add a, ac 97 | Mov ESi, d 98 | Not ESi 99 | Or ESi, b 100 | Xor ESi, c 101 | Add a, ESi 102 | Rol a, s 103 | Add a, b 104 | EndM 105 | 106 | MD5_Transform Proc 107 | Public MD5_Transform 108 | 109 | ; Use 32-bit Borland Register calling convention 110 | ; First Parameter in EAX 111 | ; Second Paramerter in EDX 112 | 113 | ; State buffer offset - in EAx 114 | ; Message offset - in EDx 115 | 116 | Push EBx 117 | Push ESi 118 | Push EDi 119 | Push EBp 120 | 121 | Mov EBp, EDx ; Now EBp holds Message offset 122 | Push EAx 123 | Mov EDx, [EAx+12] 124 | Mov ECx, [EAx+8] 125 | Mov EBx, [EAx+4] 126 | Mov EAx, [EAx] 127 | 128 | FF EAx,EBx,ECx,EDx, 0, 7, 0d76aa478h ; 1 129 | FF EDx,EAx,EBx,ECx, 1, 12, 0e8c7b756h ; 2 130 | FF ECx,EDx,EAx,EBx, 2, 17, 0242070dbh ; 3 131 | FF EBx,ECx,EDx,EAx, 3, 22, 0c1bdceeeh ; 4 132 | FF EAx,EBx,ECx,EDx, 4, 7, 0f57c0fafh ; 5 133 | FF EDx,EAx,EBx,ECx, 5, 12, 04787c62ah ; 6 134 | FF ECx,EDx,EAx,EBx, 6, 17, 0a8304613h ; 7 135 | FF EBx,ECx,EDx,EAx, 7, 22, 0fd469501h ; 8 136 | FF EAx,EBx,ECx,EDx, 8, 7, 0698098d8h ; 9 137 | FF EDx,EAx,EBx,ECx, 9, 12, 08b44f7afh ; 10 138 | FF ECx,EDx,EAx,EBx, 10, 17, 0ffff5bb1h ; 11 139 | FF EBx,ECx,EDx,EAx, 11, 22, 0895cd7beh ; 12 140 | FF EAx,EBx,ECx,EDx, 12, 7, 06b901122h ; 13 141 | FF EDx,EAx,EBx,ECx, 13, 12, 0fd987193h ; 14 142 | FF ECx,EDx,EAx,EBx, 14, 17, 0a679438eh ; 15 143 | FF EBx,ECx,EDx,EAx, 15, 22, 049b40821h ; 16 144 | 145 | GG EAx,EBx,ECx,EDx, 1, 5, 0f61e2562h ; 17 146 | GG EDx,EAx,EBx,ECx, 6, 9, 0c040b340h ; 18 147 | GG ECx,EDx,EAx,EBx, 11, 14, 0265e5a51h ; 19 148 | GG EBx,ECx,EDx,EAx, 0, 20, 0e9b6c7aah ; 20 149 | GG EAx,EBx,ECx,EDx, 5, 5, 0d62f105dh ; 21 150 | GG EDx,EAx,EBx,ECx, 10, 9, 002441453h ; 22 151 | GG ECx,EDx,EAx,EBx, 15, 14, 0d8a1e681h ; 23 152 | GG EBx,ECx,EDx,EAx, 4, 20, 0e7d3fbc8h ; 24 153 | GG EAx,EBx,ECx,EDx, 9, 5, 021e1cde6h ; 25 154 | GG EDx,EAx,EBx,ECx, 14, 9, 0c33707d6h ; 26 155 | GG ECx,EDx,EAx,EBx, 3, 14, 0f4d50d87h ; 27 156 | GG EBx,ECx,EDx,EAx, 8, 20, 0455a14edh ; 28 157 | GG EAx,EBx,ECx,EDx, 13, 5, 0a9e3e905h ; 29 158 | GG EDx,EAx,EBx,ECx, 2, 9, 0fcefa3f8h ; 30 159 | GG ECx,EDx,EAx,EBx, 7, 14, 0676f02d9h ; 31 160 | GG EBx,ECx,EDx,EAx, 12, 20, 08d2a4c8ah ; 32 161 | 162 | HH EAx,EBx,ECx,EDx, 5, 4, 0fffa3942h ; 33 163 | HH EDx,EAx,EBx,ECx, 8, 11, 08771f681h ; 34 164 | HH ECx,EDx,EAx,EBx, 11, 16, 06d9d6122h ; 35 165 | HH EBx,ECx,EDx,EAx, 14, 23, 0fde5380ch ; 36 166 | HH EAx,EBx,ECx,EDx, 1, 4, 0a4beea44h ; 37 167 | HH EDx,EAx,EBx,ECx, 4, 11, 04bdecfa9h ; 38 168 | HH ECx,EDx,EAx,EBx, 7, 16, 0f6bb4b60h ; 39 169 | HH EBx,ECx,EDx,EAx, 10, 23, 0bebfbc70h ; 40 170 | HH EAx,EBx,ECx,EDx, 13, 4, 0289b7ec6h ; 41 171 | HH EDx,EAx,EBx,ECx, 0, 11, 0eaa127fah ; 42 172 | HH ECx,EDx,EAx,EBx, 3, 16, 0d4ef3085h ; 43 173 | HH EBx,ECx,EDx,EAx, 6, 23, 004881d05h ; 44 174 | HH EAx,EBx,ECx,EDx, 9, 4, 0d9d4d039h ; 45 175 | HH EDx,EAx,EBx,ECx, 12, 11, 0e6db99e5h ; 46 176 | HH ECx,EDx,EAx,EBx, 15, 16, 01fa27cf8h ; 47 177 | HH EBx,ECx,EDx,EAx, 2, 23, 0c4ac5665h ; 48 178 | 179 | II EAx,EBx,ECx,EDx, 0, 6, 0f4292244h ; 49 180 | II EDx,EAx,EBx,ECx, 7, 10, 0432aff97h ; 50 181 | II ECx,EDx,EAx,EBx, 14, 15, 0ab9423a7h ; 51 182 | II EBx,ECx,EDx,EAx, 5, 21, 0fc93a039h ; 52 183 | II EAx,EBx,ECx,EDx, 12, 6, 0655b59c3h ; 53 184 | II EDx,EAx,EBx,ECx, 3, 10, 08f0ccc92h ; 54 185 | II ECx,EDx,EAx,EBx, 10, 15, 0ffeff47dh ; 55 186 | II EBx,ECx,EDx,EAx, 1, 21, 085845dd1h ; 56 187 | II EAx,EBx,ECx,EDx, 8, 6, 06fa87e4fh ; 57 188 | II EDx,EAx,EBx,ECx, 15, 10, 0fe2ce6e0h ; 58 189 | II ECx,EDx,EAx,EBx, 6, 15, 0a3014314h ; 59 190 | II EBx,ECx,EDx,EAx, 13, 21, 04e0811a1h ; 60 191 | II EAx,EBx,ECx,EDx, 4, 6, 0f7537e82h ; 61 192 | II EDx,EAx,EBx,ECx, 11, 10, 0bd3af235h ; 62 193 | II ECx,EDx,EAx,EBx, 2, 15, 02ad7d2bbh ; 63 194 | II EBx,ECx,EDx,EAx, 9, 21, 0eb86d391h ; 64 195 | 196 | Pop ESi 197 | Add [ESi], EAx 198 | Add [ESi+4], EBx 199 | Add [ESi+8], ECx 200 | Add [ESi+12], EDx 201 | 202 | ; restore the registers to comply to the calling convention 203 | Pop EBp 204 | Pop EDi 205 | Pop ESi 206 | Pop EBx 207 | 208 | Ret 209 | MD5_Transform EndP 210 | 211 | End 212 | -------------------------------------------------------------------------------- /lib/md5_32.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/lib/md5_32.obj -------------------------------------------------------------------------------- /lib/md5_64.asm: -------------------------------------------------------------------------------- 1 | ;{ ****************************************************************************** } 2 | ;{ * https://zpascal.net * } 3 | ;{ * https://github.com/PassByYou888/zAI * } 4 | ;{ * https://github.com/PassByYou888/ZServer4D * } 5 | ;{ * https://github.com/PassByYou888/PascalString * } 6 | ;{ * https://github.com/PassByYou888/zRasterization * } 7 | ;{ * https://github.com/PassByYou888/CoreCipher * } 8 | ;{ * https://github.com/PassByYou888/zSound * } 9 | ;{ * https://github.com/PassByYou888/zChinese * } 10 | ;{ * https://github.com/PassByYou888/zExpression * } 11 | ;{ * https://github.com/PassByYou888/zGameWare * } 12 | ;{ * https://github.com/PassByYou888/zAnalysis * } 13 | ;{ * https://github.com/PassByYou888/FFMPEG-Header * } 14 | ;{ * https://github.com/PassByYou888/zTranslate * } 15 | ;{ * https://github.com/PassByYou888/InfiniteIoT * } 16 | ;{ * https://github.com/PassByYou888/FastMD5 * } 17 | ;{ ****************************************************************************** } 18 | 19 | 20 | ; MD5_Transform-x64 21 | ; MD5 transform routine oprimized for x64 processors 22 | ; Copyright 2018 Ritlabs, SRL 23 | ; The 64-bit version is written by Maxim Masiutin 24 | 25 | ; The main advantage of this 64-bit version is that 26 | ; it loads 64 bytes of hashed message into 8 64-bit registers 27 | ; (RBP, R8, R9, R10, R11, R12, R13, R14) at the beginning, 28 | ; to avoid excessive memory load operations 29 | ; througout the routine. 30 | 31 | ; To operate with 32-bit values store in higher bits 32 | ; of a 64-bit register (bits 32-63) uses "Ror" by 32; 33 | ; 8 macro variables (M1-M8) are used to keep record 34 | ; or corrent state of whether the register has been 35 | ; Ror'ed or not. 36 | 37 | ; It also has an ability to use Lea instruction instead 38 | ; of two sequental Adds (uncomment UseLea=1), but it is 39 | ; slower on Skylake processors. Also, Intel in the 40 | ; Optimization Reference Maual discourages us of 41 | ; Lea as a replacement of two adds, since it is slower 42 | ; on the Atom processors. 43 | 44 | ; MD5_Transform-x64 is released under a dual license, 45 | ; and you may choose to use it under either the 46 | ; Mozilla Public License 2.0 (MPL 2.1, available from 47 | ; https://www.mozilla.org/en-US/MPL/2.0/) or the 48 | ; GNU Lesser General Public License Version 3, 49 | ; dated 29 June 2007 (LGPL 3, available from 50 | ; https://www.gnu.org/licenses/lgpl.html). 51 | 52 | ; MD5_Transform-x64 is based 53 | ; on the following code by Peter Sawatzki. 54 | 55 | ; The original notice by Peter Sawatzki follows. 56 | 57 | ; ============================================================== 58 | ; 59 | ; MD5_386.Asm - 386 optimized helper routine for calculating 60 | ; MD Message-Digest values 61 | ; written 2/2/94 by 62 | ; 63 | ; Peter Sawatzki 64 | ; Buchenhof 3 65 | ; D58091 Hagen, Germany Fed Rep 66 | ; 67 | ; EMail: Peter@Sawatzki.de 68 | ; EMail: 100031.3002@compuserve.com 69 | ; WWW: http://www.sawatzki.de 70 | ; 71 | ; 72 | ; original C Source was found in Dr. Dobbs Journal Sep 91 73 | ; MD5 algorithm from RSA Data Security, Inc. 74 | 75 | 76 | 77 | .CODE 78 | 79 | 80 | ; You can compile this code using Microsoft Macro Assembler 81 | ; ml64.exe /c md5_64.asm 82 | 83 | 84 | 85 | ; Uncomment the line below if you wish to have 86 | ; a "Lea" instruction instead of two subsequent "Add". 87 | 88 | ; UseLea=1 89 | 90 | 91 | 92 | ; The AA macro adds r to ac to a and stores result to r 93 | ; r and a can be either 32-bit (for the "Add" version) 94 | ; or 64-bit (for the "Lea" version) 95 | 96 | AA Macro r32,r64,ac,a32,a64 97 | IFDEF UseLea 98 | Lea r64, [r64+ac+a64] 99 | ELSE 100 | Add r32, ac 101 | Add r32, a32 102 | ENDIF 103 | EndM 104 | 105 | ; The JJ macro adds value from state buffer to the "a" register 106 | ; The "a" register can be either 32-bit (for the "Add" version) 107 | ; or 64-bit (for "Lea") - in this case it is passed as "r" 108 | 109 | JJ Macro a,x,ac,r 110 | IFE x 111 | IF M1 112 | Ror RBp, 32 113 | M1=0 114 | ENDIF 115 | AA a, r, ac, EBp, RBp 116 | ENDIF 117 | IFE x-1 118 | IFE M1 119 | Ror RBp, 32 120 | M1=1 121 | ENDIF 122 | AA a, r, ac, EBp, RBp 123 | ENDIF 124 | IFE x-2 125 | IF M2 126 | Ror R8, 32 127 | M2=0 128 | ENDIF 129 | AA a, r, ac, R8d, R8 130 | ENDIF 131 | IFE x-3 132 | IFE M2 133 | Ror R8, 32 134 | M2=1 135 | ENDIF 136 | AA a, r, ac, R8d, R8 137 | ENDIF 138 | IFE x-4 139 | IF M3 140 | Ror R9, 32 141 | M3=0 142 | ENDIF 143 | AA a, r, ac, R9d, R9 144 | ENDIF 145 | IFE x-5 146 | IFE M3 147 | Ror R9, 32 148 | M3=1 149 | ENDIF 150 | AA a, r, ac, R9d, R9 151 | ENDIF 152 | IFE x-6 153 | IF M4 154 | Ror R10, 32 155 | M4=0 156 | ENDIF 157 | AA a, r, ac, R10d, R10 158 | ENDIF 159 | IFE x-7 160 | IFE M4 161 | Ror R10, 32 162 | M4=1 163 | ENDIF 164 | AA a, r, ac, R10d, R10 165 | ENDIF 166 | IFE x-8 167 | IF M5 168 | Ror R11, 32 169 | M5=0 170 | ENDIF 171 | AA a, r, ac, R11d, R11 172 | ENDIF 173 | IFE x-9 174 | IFE M5 175 | Ror R11, 32 176 | M5=1 177 | ENDIF 178 | AA a, r, ac, R11d, R11 179 | ENDIF 180 | IFE x-10 181 | IF M6 182 | Ror R12, 32 183 | M6=0 184 | ENDIF 185 | AA a, r, ac, R12d, R12 186 | ENDIF 187 | IFE x-11 188 | IFE M6 189 | Ror R12, 32 190 | M6=1 191 | ENDIF 192 | AA a, r, ac, R12d, R12 193 | ENDIF 194 | IFE x-12 195 | IF M7 196 | Ror R13, 32 197 | M7=0 198 | ENDIF 199 | AA a, r, ac, R13d, R13 200 | ENDIF 201 | IFE x-13 202 | IFE M7 203 | Ror R13, 32 204 | M7=1 205 | ENDIF 206 | AA a, r, ac, R13d, R13 207 | ENDIF 208 | IFE x-14 209 | IF M8 210 | Ror R14, 32 211 | M8=0 212 | ENDIF 213 | AA a, r, ac, R14d, R14 214 | ENDIF 215 | IFE x-15 216 | IFE M8 217 | Ror R14, 32 218 | M8=1 219 | ENDIF 220 | AA a, r, ac, R14d, R14 221 | ENDIF 222 | EndM 223 | 224 | 225 | FF Macro a,b,c,d,x,s,ac,r 226 | ; a:= ROL (a+x+ac + (b And c Or Not b And d), s) + b 227 | JJ a, x, ac, r 228 | Mov ESI, b 229 | Not ESI 230 | And ESI, d 231 | Mov EDI, c 232 | And EDI, b 233 | Or ESI, EDI 234 | Add a, ESI 235 | Rol a, s 236 | Add a, b 237 | EndM 238 | 239 | GG Macro a,b,c,d,x,s,ac,r 240 | ; a:= ROL (a+x+ac + (b And d Or c And Not d), s) + b 241 | JJ a, x, ac, r 242 | Mov ESI, d 243 | Not ESI 244 | And ESI, c 245 | Mov EDI, d 246 | And EDI, b 247 | Or ESI, EDI 248 | Add a, ESI 249 | Rol a, s 250 | Add a, b 251 | EndM 252 | 253 | HH Macro a,b,c,d,x,s,ac,r 254 | ; a:= ROL (a+x+ac + (b Xor c Xor d), s) + b 255 | JJ a, x, ac, r 256 | Mov ESI, d 257 | Xor ESI, c 258 | Xor ESI, b 259 | Add a, ESI 260 | Rol a, s 261 | Add a, b 262 | EndM 263 | 264 | II Macro a,b,c,d,x,s,ac,r 265 | ; a:= ROL (a+x+ac + (c Xor (b Or Not d)), s) + b 266 | JJ a, x, ac, r 267 | Mov ESI, d 268 | Not ESI 269 | Or ESI, b 270 | Xor ESI, c 271 | Add a, ESI 272 | Rol a, s 273 | Add a, b 274 | EndM 275 | 276 | MD5_Transform Proc 277 | Public MD5_Transform 278 | 279 | ; save registers that the caller requires to be restored 280 | Push RBx 281 | Push RSi 282 | Push RDi 283 | 284 | Push RBp 285 | Push R12 286 | Push R13 287 | Push R14 288 | 289 | ; First parameter is passed in RCX, Second - in RDX 290 | 291 | ; State - in RCX 292 | ; Message - in RDX 293 | 294 | M1 = 0 295 | M2 = 0 296 | M3 = 0 297 | M4 = 0 298 | M5 = 0 299 | M6 = 0 300 | M7 = 0 301 | M8 = 0 302 | 303 | Mov R14, RDX ; Now the message buffer offset is in R14 304 | 305 | Mov RSi, Rcx ; Now state structure offset is in RSi 306 | Push Rsi ; State -> Stack 307 | Mov EAx, [RSi] 308 | Mov EBx, [RSi+4] 309 | Mov ECx, [RSi+8] 310 | Mov EDx, [RSi+12] 311 | 312 | Mov RBP, [R14+4*0] 313 | FF EAx,EBx,ECx,EDx, 0, 7, 0d76aa478h, RAx ; 1 314 | FF EDx,EAx,EBx,ECx, 1, 12, 0e8c7b756h, RDx ; 2 315 | Mov R8, [R14+4*2] 316 | FF ECx,EDx,EAx,EBx, 2, 17, 0242070dbh, RCx ; 3 317 | FF EBx,ECx,EDx,EAx, 3, 22, 0c1bdceeeh, RBx ; 4 318 | Mov R9, [R14+4*4] 319 | FF EAx,EBx,ECx,EDx, 4, 7, 0f57c0fafh, RAx ; 5 320 | FF EDx,EAx,EBx,ECx, 5, 12, 04787c62ah, RDx ; 6 321 | Mov R10, [R14+4*6] 322 | FF ECx,EDx,EAx,EBx, 6, 17, 0a8304613h, RCx ; 7 323 | FF EBx,ECx,EDx,EAx, 7, 22, 0fd469501h, RBx ; 8 324 | Mov R11, [R14+4*8] 325 | FF EAx,EBx,ECx,EDx, 8, 7, 0698098d8h, RAx ; 9 326 | FF EDx,EAx,EBx,ECx, 9, 12, 08b44f7afh, RDx ; 10 327 | Mov R12, [R14+4*10] 328 | FF ECx,EDx,EAx,EBx, 10, 17, 0ffff5bb1h, RCx ; 11 329 | FF EBx,ECx,EDx,EAx, 11, 22, 0895cd7beh, RBx ; 12 330 | Mov R13, [R14+4*12] 331 | FF EAx,EBx,ECx,EDx, 12, 7, 06b901122h, RAx ; 13 332 | FF EDx,EAx,EBx,ECx, 13, 12, 0fd987193h, RDx ; 14 333 | Mov R14, [R14+4*14] 334 | FF ECx,EDx,EAx,EBx, 14, 17, 0a679438eh, RCx ; 15 335 | FF EBx,ECx,EDx,EAx, 15, 22, 049b40821h, RBx ; 16 336 | 337 | GG EAx,EBx,ECx,EDx, 1, 5, 0f61e2562h, RAx ; 17 338 | GG EDx,EAx,EBx,ECx, 6, 9, 0c040b340h, RDx ; 18 339 | GG ECx,EDx,EAx,EBx, 11, 14, 0265e5a51h, RCx ; 19 340 | GG EBx,ECx,EDx,EAx, 0, 20, 0e9b6c7aah, RBx ; 20 341 | GG EAx,EBx,ECx,EDx, 5, 5, 0d62f105dh, RAx ; 21 342 | GG EDx,EAx,EBx,ECx, 10, 9, 002441453h, RDx ; 22 343 | GG ECx,EDx,EAx,EBx, 15, 14, 0d8a1e681h, RCx ; 23 344 | GG EBx,ECx,EDx,EAx, 4, 20, 0e7d3fbc8h, RBx ; 24 345 | GG EAx,EBx,ECx,EDx, 9, 5, 021e1cde6h, RAx ; 25 346 | GG EDx,EAx,EBx,ECx, 14, 9, 0c33707d6h, RDx ; 26 347 | GG ECx,EDx,EAx,EBx, 3, 14, 0f4d50d87h, RCx ; 27 348 | GG EBx,ECx,EDx,EAx, 8, 20, 0455a14edh, RBx ; 28 349 | GG EAx,EBx,ECx,EDx, 13, 5, 0a9e3e905h, RAx ; 29 350 | GG EDx,EAx,EBx,ECx, 2, 9, 0fcefa3f8h, RDx ; 30 351 | GG ECx,EDx,EAx,EBx, 7, 14, 0676f02d9h, RCx ; 31 352 | GG EBx,ECx,EDx,EAx, 12, 20, 08d2a4c8ah, RBx ; 32 353 | 354 | HH EAx,EBx,ECx,EDx, 5, 4, 0fffa3942h, RAx ; 33 355 | HH EDx,EAx,EBx,ECx, 8, 11, 08771f681h, RDx ; 34 356 | HH ECx,EDx,EAx,EBx, 11, 16, 06d9d6122h, RCx ; 35 357 | HH EBx,ECx,EDx,EAx, 14, 23, 0fde5380ch, RBx ; 36 358 | HH EAx,EBx,ECx,EDx, 1, 4, 0a4beea44h, RAx ; 37 359 | HH EDx,EAx,EBx,ECx, 4, 11, 04bdecfa9h, RDx ; 38 360 | HH ECx,EDx,EAx,EBx, 7, 16, 0f6bb4b60h, RCx ; 39 361 | HH EBx,ECx,EDx,EAx, 10, 23, 0bebfbc70h, RBx ; 40 362 | HH EAx,EBx,ECx,EDx, 13, 4, 0289b7ec6h, RAx ; 41 363 | HH EDx,EAx,EBx,ECx, 0, 11, 0eaa127fah, RDx ; 42 364 | HH ECx,EDx,EAx,EBx, 3, 16, 0d4ef3085h, RCx ; 43 365 | HH EBx,ECx,EDx,EAx, 6, 23, 004881d05h, RBx ; 44 366 | HH EAx,EBx,ECx,EDx, 9, 4, 0d9d4d039h, RAx ; 45 367 | HH EDx,EAx,EBx,ECx, 12, 11, 0e6db99e5h, RDx ; 46 368 | HH ECx,EDx,EAx,EBx, 15, 16, 01fa27cf8h, RCx ; 47 369 | HH EBx,ECx,EDx,EAx, 2, 23, 0c4ac5665h, RBx ; 48 370 | 371 | II EAx,EBx,ECx,EDx, 0, 6, 0f4292244h, RAx ; 49 372 | II EDx,EAx,EBx,ECx, 7, 10, 0432aff97h, RDx ; 50 373 | II ECx,EDx,EAx,EBx, 14, 15, 0ab9423a7h, RCx ; 51 374 | II EBx,ECx,EDx,EAx, 5, 21, 0fc93a039h, RBx ; 52 375 | II EAx,EBx,ECx,EDx, 12, 6, 0655b59c3h, RAx ; 53 376 | II EDx,EAx,EBx,ECx, 3, 10, 08f0ccc92h, RDx ; 54 377 | II ECx,EDx,EAx,EBx, 10, 15, 0ffeff47dh, RCx ; 55 378 | II EBx,ECx,EDx,EAx, 1, 21, 085845dd1h, RBx ; 56 379 | II EAx,EBx,ECx,EDx, 8, 6, 06fa87e4fh, RAx ; 57 380 | II EDx,EAx,EBx,ECx, 15, 10, 0fe2ce6e0h, RDx ; 58 381 | II ECx,EDx,EAx,EBx, 6, 15, 0a3014314h, RCx ; 59 382 | II EBx,ECx,EDx,EAx, 13, 21, 04e0811a1h, RBx ; 60 383 | II EAx,EBx,ECx,EDx, 4, 6, 0f7537e82h, RAx ; 61 384 | II EDx,EAx,EBx,ECx, 11, 10, 0bd3af235h, RDx ; 62 385 | II ECx,EDx,EAx,EBx, 2, 15, 02ad7d2bbh, RCx ; 63 386 | II EBx,ECx,EDx,EAx, 9, 21, 0eb86d391h, RBx ; 64 387 | 388 | Pop RSi ; get State pointer from stack 389 | Add [RSi], EAx 390 | Add [RSi+4], EBx 391 | Add [RSi+8], ECx 392 | Add [RSi+12], EDx 393 | 394 | ; restore volatile registers 395 | Pop R14 396 | Pop R13 397 | Pop R12 398 | Pop RBp 399 | 400 | Pop RDi 401 | Pop RSi 402 | Pop RBx 403 | 404 | Ret 405 | MD5_Transform EndP 406 | 407 | End 408 | 409 | ; That's All Folks! 410 | -------------------------------------------------------------------------------- /lib/md5_64.obj: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/lib/md5_64.obj -------------------------------------------------------------------------------- /lib/zDefine.inc: -------------------------------------------------------------------------------- 1 | { * https://zpascal.net * } 2 | { * https://github.com/PassByYou888/zAI * } 3 | { * https://github.com/PassByYou888/ZServer4D * } 4 | { * https://github.com/PassByYou888/PascalString * } 5 | { * https://github.com/PassByYou888/zRasterization * } 6 | { * https://github.com/PassByYou888/CoreCipher * } 7 | { * https://github.com/PassByYou888/zSound * } 8 | { * https://github.com/PassByYou888/zChinese * } 9 | { * https://github.com/PassByYou888/zExpression * } 10 | { * https://github.com/PassByYou888/zGameWare * } 11 | { * https://github.com/PassByYou888/zAnalysis * } 12 | { * https://github.com/PassByYou888/FFMPEG-Header * } 13 | { * https://github.com/PassByYou888/zTranslate * } 14 | { * https://github.com/PassByYou888/InfiniteIoT * } 15 | { * https://github.com/PassByYou888/FastMD5 * } 16 | { ****************************************************************************** } 17 | 18 | {$IFDEF FPC} 19 | {$IFDEF FPC_DELPHI_MODE} 20 | {$MODE delphi} 21 | {$ELSE FPC_DELPHI_MODE} 22 | {$MODE objfpc} 23 | {$ENDIF FPC_DELPHI_MODE} 24 | 25 | {$MODESWITCH AdvancedRecords} 26 | {$MODESWITCH NestedProcVars} 27 | {$MODESWITCH NESTEDCOMMENTS} 28 | {$NOTES OFF} 29 | {$STACKFRAMES OFF} 30 | {$COPERATORS OFF} 31 | {$GOTO ON} 32 | {$INLINE ON} 33 | {$MACRO ON} 34 | {$HINTS ON} 35 | {$IEEEERRORS ON} 36 | 37 | {$DEFINE LITTLE_ENDIAN} 38 | {$UNDEF BIG_ENDIAN} 39 | {$IFDEF FPC_BIG_ENDIAN} 40 | {$UNDEF LITTLE_ENDIAN} 41 | {$DEFINE BIG_ENDIAN} 42 | {$ENDIF} 43 | 44 | {$UNDEF FirstCharInZero} 45 | 46 | {$UNDEF Delphi} 47 | 48 | // nativeint as int or int64 type variable when Modifier is overload 49 | {$UNDEF OVERLOAD_NATIVEINT} 50 | 51 | // fast MD5 only delphi supported, https://github.com/PassByYou888/FastMD5 52 | {$UNDEF FastMD5} 53 | 54 | // stream is MemoryStream64 or MemoryStream, usage fastMD5 or PurePascal MD5 55 | // be associate api: UnicodeMixedLib.umlStreamMD5, Fast_MD5.FastMD5 56 | {$DEFINE OptimizationMemoryStreamMD5} 57 | 58 | // multi thread Parallel switch. 59 | {$DEFINE Parallel} 60 | 61 | // Parallel for fold make better use CPU of multi core 62 | // if rem this "FoldParallel" parallel for block program, thread can use linear address 63 | {$DEFINE FoldParallel} 64 | 65 | // MT19937 of seed in the startup TCompute is 0 66 | {$DEFINE MT19937SeedOnTComputeThreadIs0} 67 | 68 | // automated loading common AI datasets on boot-time 69 | {$DEFINE Z_AI_Dataset_Build_In} 70 | 71 | // 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 72 | {$DEFINE SMALL_RASTER_FONT_Build_In} 73 | // {$DEFINE LARGE_RASTER_FONT_Build_In} 74 | 75 | // ZDB_BACKUP is automatically made and replica caching is enabled. 76 | // usage ZDB_BACKUP so slows the open of large size ZDB file, after time, but does is high performance. 77 | // {$DEFINE ZDB_BACKUP} 78 | 79 | // ZDB Flush() uses physical IO as the temp storage device 80 | // {$DEFINE ZDB_PHYSICAL_FLUSH} 81 | 82 | // used Critical Simulate Atomic with TMonitor.Enter(obj) and TMonitor.Exit(obj) 83 | // CriticalSimulateAtomic defined so performance to be reduced 84 | {$DEFINE CriticalSimulateAtomic} 85 | 86 | // used soft Simulate Critical(ring) 87 | // SoftCritical defined so performance to be reduced 88 | // {$DEFINE SoftCritical} 89 | // {$DEFINE ANTI_DEAD_ATOMIC_LOCK} 90 | 91 | {$UNDEF debug} 92 | {$DEFINE release} 93 | {$DEFINE INLINE_ASM} 94 | {$R-} 95 | {$I-} 96 | {$S-} 97 | {$OPTIMIZATION ON} 98 | {$ELSE FPC} { IF DELPHI } 99 | {$DEFINE Delphi} 100 | 101 | {$DEFINE LITTLE_ENDIAN} 102 | {$UNDEF BIG_ENDIAN} 103 | 104 | {$IFDEF ANDROID} 105 | {$DEFINE FirstCharInZero} 106 | {$ENDIF ANDROID} 107 | 108 | {$IFDEF IOS} 109 | {$DEFINE FirstCharInZero} 110 | {$ENDIF IOS} 111 | 112 | // nativeint as int or int64 type variable when Modifier is overload 113 | {$DEFINE OVERLOAD_NATIVEINT} 114 | 115 | // fast MD5 only delphi supported, https://github.com/PassByYou888/FastMD5 116 | {$DEFINE FastMD5} 117 | 118 | // stream is MemoryStream64 or MemoryStream, usage fastMD5 or PurePascal MD5 119 | // be associate api: UnicodeMixedLib.umlStreamMD5, Fast_MD5.FastMD5 120 | {$DEFINE OptimizationMemoryStreamMD5} 121 | 122 | // multi thread Parallel switch. 123 | {$DEFINE Parallel} 124 | 125 | // Parallel for fold make better use CPU of multi core 126 | // if rem this "FoldParallel" is parallel for block program, thread can use linear address 127 | {$DEFINE FoldParallel} 128 | 129 | // Parallel programs use the delphi default TParallel 130 | // {$DEFINE SystemParallel} 131 | 132 | // paper: Mersenne Twister: A 623-dimensionallyequidistributed uniformpseudorandom number generator 133 | // Using this paper replace of Delphi Random() and Randomize() function, work on xe 10.3 or laster 134 | {$UNDEF InstallMT19937CoreToDelphi} 135 | 136 | // delphi 10.3 137 | {$IFDEF VER330} 138 | {$DEFINE InstallMT19937CoreToDelphi} 139 | {$ENDIF VER330} 140 | 141 | // delphi 10.4 142 | {$IFDEF VER340} 143 | {$DEFINE InstallMT19937CoreToDelphi} 144 | {$UNDEF FirstCharInZero} 145 | {$ENDIF VER340} 146 | 147 | // delphi 11.0 148 | {$IFDEF VER350} 149 | {$DEFINE InstallMT19937CoreToDelphi} 150 | {$UNDEF FirstCharInZero} 151 | {$ENDIF VER350} 152 | 153 | // delphi 11.x 154 | {$IFDEF VER360} 155 | {$DEFINE InstallMT19937CoreToDelphi} 156 | {$UNDEF FirstCharInZero} 157 | {$ENDIF VER360} 158 | 159 | // MT19937 of seed in the startup TCompute is 0 160 | {$DEFINE MT19937SeedOnTComputeThreadIs0} 161 | 162 | // automated loading common AI datasets on boot-time 163 | // {$DEFINE Z_AI_Dataset_Build_In} 164 | 165 | // 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 166 | // {$DEFINE SMALL_RASTER_FONT_Build_In} 167 | // {$DEFINE LARGE_RASTER_FONT_Build_In} 168 | 169 | {$IF Defined(Android) or Defined(IOS)} 170 | {$DEFINE SMALL_RASTER_FONT_Build_In} 171 | {$ENDIF} 172 | 173 | // ZDB_BACKUP is automatically made and replica caching is enabled. 174 | // usage ZDB_BACKUP so slows the open of large size ZDB file, after time, but does is high performance. 175 | // {$DEFINE ZDB_BACKUP} 176 | 177 | // ZDB Flush() uses physical IO as the temp storage device 178 | // {$DEFINE ZDB_PHYSICAL_FLUSH} 179 | 180 | // used Critical Simulate Atomic with TMonitor.Enter(obj) and TMonitor.Exit(obj) 181 | // CriticalSimulateAtomic defined so performance to be reduced 182 | // {$DEFINE CriticalSimulateAtomic} 183 | 184 | // used soft Simulate Critical(ring) 185 | // SoftCritical defined so performance to be reduced 186 | // {$DEFINE SoftCritical} 187 | // {$DEFINE ANTI_DEAD_ATOMIC_LOCK} 188 | 189 | {$IFDEF release} 190 | {$DEFINE INLINE_ASM} 191 | {$R-} { range check } 192 | {$I-} { Input output checking } 193 | {$IF Defined(Android) or Defined(IOS)} 194 | {$O-} { close optimization } 195 | {$ELSE} 196 | {$O+} { open optimization } 197 | {$INLINE AUTO} { inline } 198 | {$IFEND} 199 | {$ELSE} 200 | {$UNDEF INLINE_ASM} 201 | {$O-} { close optimization } 202 | {$R-} { range check } 203 | {$I-} { Input output checking } 204 | {$D+} { debug information } 205 | {$ENDIF} 206 | 207 | {$IF Defined(Android) or Defined(IOS)} 208 | {$DEFINE SMALL_RASTER_FONT_Build_In} 209 | {$DEFINE PhysicsIO_On_Indy} 210 | {$ELSE} 211 | // PhysicsIO interface 212 | // {$DEFINE PhysicsIO_On_ICS} 213 | {$DEFINE PhysicsIO_On_CrossSocket} 214 | // {$DEFINE PhysicsIO_On_DIOCP} 215 | // {$DEFINE PhysicsIO_On_Indy} 216 | // {$DEFINE PhysicsIO_On_Synapse} 217 | {$IFEND} 218 | 219 | {$X+} { Extended syntax } 220 | {$Z1} { Minimum enum size } 221 | {$ENDIF FPC} 222 | 223 | // ZDB2.0 optimized TMemoryStream/TMemoryStream64 for Replace 224 | {$DEFINE ZDB2_Core_Used_Mem64} 225 | 226 | // Using fillchar replace of FillPtr 227 | // Maybe fillchar works on MMX / SSE2, 228 | // {$Define FillPtr_Used_FillChar} 229 | 230 | // Using Move replace of CopyPtr 231 | // {$Define CopyPtr_Used_Move} 232 | 233 | // Sequence packets default are opened in Physics-IO 234 | // Sequence package can support multi platform keep-alive mode 235 | // building a network CS system, the symmetry of compiler(FPC/Delphi) "UsedSequencePacket" 236 | {$DEFINE UsedSequencePacket} 237 | 238 | // Sequence package can support multi platform keep-alive mode 239 | // building a network CS system, the symmetry of compiler(FPC/Delphi) "UsedSequencePacketOnP2PVM" 240 | // Sequence packets default are closed in P2PVM-IO 241 | {$UNDEF UsedSequencePacketOnP2PVM} 242 | 243 | // CommunicationFramework used QuietMode 244 | {$UNDEF Communication_QuietMode} 245 | 246 | {$IFDEF DEBUG} 247 | // initialization status prompt 248 | {$DEFINE initializationStatus} 249 | // warning prompt 250 | {$WARNINGS ON} 251 | // JPEG support can output debug info 252 | {$UNDEF JPEG_Debug} 253 | {$ELSE DEBUG} 254 | // initialization status prompt 255 | {$UNDEF initializationStatus} 256 | // warning prompt 257 | {$WARNINGS OFF} 258 | // JPEG support can output debug info 259 | {$UNDEF JPEG_Debug} 260 | {$ENDIF DEBUG} 261 | 262 | {$IFDEF Parallel} 263 | // TMemoryRaster Parallel switch. 264 | {$UNDEF MemoryRaster_Parallel} 265 | // TRasterVertex Parallel switch. 266 | {$UNDEF Vertex_Parallel} 267 | // TMorphomatics Parallel switch. 268 | {$DEFINE Morphomatics_Parallel} 269 | // TMorphologyBinaryzation Parallel switch. 270 | {$DEFINE MorphologyBinaryzation_Parallel} 271 | {$ENDIF Parallel} 272 | 273 | {$HINTS OFF} 274 | {$C+} { Assertions } 275 | {$M-} { Run-Time Type Information } 276 | {$H+} { long string } 277 | {$A+} { Word Align Data } 278 | {$Q-} { Overflow checking } 279 | {$B-} { Complete boolean evaluation } 280 | {$J+} { Writeable typed constants } 281 | 282 | (* 283 | Pointer math is simply treating any given typed pointer in some narrow, 284 | instances as a scaled ordinal where you can perform simple arithmetic operations directly on the pointer variable. 285 | *) 286 | {$POINTERMATH OFF} 287 | 288 | {$UNDEF CPU64} 289 | 290 | {$IFDEF CPU64BITS} 291 | {$DEFINE CPU64} 292 | {$ELSE CPU64BITS} 293 | {$IFDEF CPUX64} 294 | {$DEFINE CPU64} 295 | {$ENDIF CPUX64} 296 | {$ENDIF CPU64BITS} 297 | 298 | {$IFNDEF CPU64} 299 | {$DEFINE CPU32} 300 | {$ENDIF CPU64} 301 | 302 | {$IFDEF BIG_ENDIAN} 303 | {$MESSAGE FATAL 'Big-endian system not supported'} 304 | {$ENDIF BIG_ENDIAN} 305 | 306 | {$IFOPT R+} 307 | {$DEFINE RangeCheck} 308 | {$ENDIF} 309 | 310 | {$IFOPT Q+} 311 | {$DEFINE OverflowCheck} 312 | {$ENDIF} 313 | -------------------------------------------------------------------------------- /readme.md: -------------------------------------------------------------------------------- 1 | ## zExpression 句法编译器+解释器，脚本引擎内核 2 | 3 | 4 | ## 技术体系解释： 5 | - 在编译原理的技术体系中，凡是处理文本化的代码前，都需要做一次预处理，其中我们常说的语法，语法糖，都是一种预处理程序 6 | - 词法：词法是对文本关键字，数字，符号，进行分类整理，最后形成词法树，并且严格遵循顺序化处理原则 7 | - 申明：在预处理代码中，申明部分，叫做申明树，申明树又依赖于词法顺序预处理，因为对词法预处理是一种简化手段 8 | - 句法：在经过了申明预处理以后，是对代码表达式的单行逻辑操作进行处理，这一步叫句法，取为zExpression句法编译器是我从曾经撰写的编译器中特意剥离出来的解决方案，它可以独立出来分发和使用，可以实用数字化预处理，图形图像，科学计算等等领域，也可以作为学习提高自己的手段 9 | 10 | 11 | 12 | ## 核心思路 13 | - 实现zExpression采用的是对等复杂化原则，面向解决编译器问题而编写，复杂度相比于常规程序会高许多，因为解决了最终问题，代码在命名和堆结构上也看不出漏洞，所以它是成熟句法解释器方案 14 | 15 | ## zExpression特点 16 | - 完整的单步原子化操作 17 | - 完整的符号优先级后处理 18 | - 能预处理字面错误，并反馈错误发生在哪 19 | - 能识别浮点和整数的自然数写法 20 | - 支持函数调用 21 | - 支持自定义脚本语法 22 | - 逆波兰2.0符号优先级处理 23 | - 支持安卓和苹果各型号手机 24 | - 完整的功能Demo，完整性能和解析准确性评估框架 25 | - 在编译以后，能形成原子化op代码，可以通过stream高速载入并运行，不限制cpu类型 26 | - OP代码框架可以轻松译码成ARMv7 ARMx64 x64 x86等平台的机器码 27 | - 矩阵和向量表达式支持 28 | 29 | ## 平台支持，test with Delphi 10.3 update 2 and FPC 3.0.4 30 | 31 | - Windows: delphi-CrossSocket(C/S OK), delphi-DIOCP(C/S OK), delphi-ICS(C/S OK), delphi-Indy(C/S OK),delphi+fpc Synapse(C/S OK) 32 | - Android:Indy(C/S OK), CrossSocket(Only Client) 33 | - IOS Device: Indy(C/S OK), CrossSocket(Only Client) 34 | - IOS Simulaor: n/a 35 | - OSX: Indy(C/S OK)，ICS(未测试), CrossSocket(C/S OK) 36 | - Ubuntu16.04 x64 server: Indy(C/S OK), CrossSocket(C/S OK) 37 | - Ubuntu18.04 x86+x64 Desktop:only fpc3.0.4 Synapse(C/S OK) 38 | - Ubuntu18.04 x86+x64 Server:only fpc3.0.4 Synapse(C/S OK) 39 | - Ubuntu18.04 arm32+arm neon Server:only fpc3.0.4 Synapse(C/S OK) 40 | - Ubuntu18.04 arm32+arm neon desktop:only fpc3.0.4 compile ok,no test on run. 41 | - Ubuntu16.04 Mate arm32 desktop:only fpc3.0.4 compile ok, test passed 42 | - Raspberry Pi 3 Debian linux armv7 desktop,only fpc 3.0.4,test passed. 43 | - wince(arm eabi hard flaot),windows 10 IOT,only fpc 3.3.1,test passed. 44 | 45 | ## CPU架构支持，test with Delphi 10.3 update 2 and FPC 3.0.4 46 | 47 | - MIPS(fpc-little endian), soft float, test pass on QEMU 48 | - intel X86(fpc-x86), soft float 49 | - intel X86(delphi+fpc), hard float,80386,PENTIUM,PENTIUM2,PENTIUM3,PENTIUM4,PENTIUMM,COREI,COREAVX,COREAVX2 50 | - intel X64(fpc-x86_64), soft float 51 | - intel X64(delphi+fpc), hard float,ATHLON64,COREI,COREAVX,COREAVX2 52 | - ARM(fpc-arm32-eabi,soft float):ARMV3,ARMV4,ARMV4T,ARMV5,ARMV5T,ARMV5TE,ARMV5TEJ 53 | - ARM(fpc-arm32-eabi,hard float):ARMV6,ARMV6K,ARMV6T2,ARMV6Z,ARMV6M,ARMV7,ARMV7A,ARMV7R,ARMV7M,ARMV7EM 54 | - ARM(fpc-arm64-eabi,hard float):ARMV8，aarch64 55 | 56 | 57 | ## 更新日志 58 | 59 | ### 2021-9-22 60 | 61 | - 在NumberBase库内置了zExpression驱动，详见zCloud的网络变量服务 https://github.com/PassByYou888/zCloud 62 | - 修复OpCache没有初始化的问题 63 | - 优化OpRunTime 64 | - 支持delphi 11 65 | - 支持fpc for IOT设备 66 | 67 | ### 2021-7 68 | 69 | - 修复字符表达式-2.0E-3这类识别问题 70 | - 修复OpCode.pas库因为大小写敏感不兼容win/linux问题 71 | 72 | ### 2020-3 73 | 74 | - 对注册函数新增申明信息 75 | - 修复函数前符号 -func(1+1) 76 | - 修复函数后符号 func(1+1)-1 77 | 78 | ### 2019-7 79 | 80 | **矩阵表达式支持** 81 | 82 | ```delphi 83 | // 构建3*3的variant矩阵，使用c语法表达式 84 | procedure MatrixExp; 85 | var 86 | m: TExpressionValueMatrix; 87 | begin 88 | DoStatus(''); 89 | m := EvaluateExpressionMatrix(3, 3, 90 | '"hello"+"-baby"/*备注：字符串联合*/,true,false,' + 91 | '1+1,2+2,3+3,' + 92 | '4*4,4*5,4*6', tsC); 93 | DoStatus(m); 94 | end; 95 | 96 | // 构建variant向量数组，使用pascal语法表达式 97 | procedure MatrixVec; 98 | var 99 | v: TExpressionValueVector; 100 | begin 101 | DoStatus(''); 102 | v := EvaluateExpressionVector('0.1*(0.1+max(0.15,0.11)){备注内容},1,2,3,4,5,6,7,8,9', tsPascal); 103 | DoStatus(v); 104 | end; 105 | ``` 106 | 107 | 108 | ### 2019-4 109 | 110 | - 修复TextParsing备注编码后的bug 111 | - OpCode新增回调调用类型(参考zAI工具链中的Script支持) 112 | 113 | ### 2018-9-29 114 | 115 | - 新技术:新增文本探头技术：可将蚂蚁程序的编程复杂度降低50% 116 | - 新技术:逐字符文本字符爬取性能提升%500 117 | - 多平台:全面支持多种IOT系统以及多处理器硬件架构 118 | - 新Demo:新增一个FPC的Demo，该Demo不使用匿名函数 119 | - 工艺:兼容基于FPC对IOT的支持：从底层到高级，大规模统一调整命名，此项调整会影响很多工程的代码细节 120 | 121 | ```delphi 122 | // 本项目中的回调分为3种 123 | // call: 直接指针回调，fpc+delphi有效 124 | // method: 方法回调，会继承一个方法宿主的地址，fpc+delphi有效 125 | // proc: 匿名过程回调，只有delphi有效 126 | 127 | // 如果本项调整对于改造现有工程有一定的工作量，请使用字符串批量处理工具 128 | // 在任何有回调重载的地方，方法与函数，均需要在后缀曾加回调类型首字母说明 129 | 130 | // 如 131 | RunOp 变更为 RunOpP() // 后缀加P表示匿名类型回调 132 | RunOp 变更为 RunOpM() // 后缀加M表示方法类型的回调 133 | RunOp 变更为 RunOpC() // 后缀加C表示指针类型的回调 134 | 135 | ``` 136 | 137 | 138 | ### 2018-7-6 139 | - 大幅修正底层库的命名规则 140 | - 对fpc/86/64平台支持，全部基础库支持Linux下的无故障编译和运行 141 | - 对fpc编译器3.1.1全面支持 142 | - 新增大小字节序支持 143 | - 修复对32位fpc编译器不认for用Int64的问题 144 | - 修复字符串在fpc编译器运行于linux发生异常的问题 145 | - 新增pascal预编译工具，将pascal代码规范成c风格的全部统一大小写，全面兼容Linux区分大小写文件名的机制 146 | 147 | ### 2018-4-12 148 | 149 | - 修复内核中的内存越界bug：该bug的症状为无故提示内存无法访问，通过正常debug很难排除，这是是内存越界时所造成的bug 150 | 151 | ### 2018-3-1 152 | 153 | - 在TPascalString内核中新增模糊字符串对比函数（SmithWaterman），优化与测试完成 154 | - 该算法属于生物基因工程学科 Smith-Waterman的维基百科地址 https://en.wikipedia.org/wiki/Smith%E2%80%93Waterman_algorithm 155 | 156 | ### 2018-2-28 157 | 158 | - 修复c转义字符buf，感谢阿木qq345148965 159 | - 将charPos的参数命名更改成了cOffset，并且加入const修饰符 160 | 161 | ### 2018-2-26 162 | 163 | - 修复使用Release模式无法编译问题 164 | - 修复zExpression的切割分段不正确问题 165 | - 小幅提升字符探头的切割性能(splitToken,splitChar) 166 | - 因为底层重写了一个原子锁，在很多record申明前加入了packed修饰符 167 | 168 | ### 2018-2-25 169 | 170 | - 新增自定义表达式符号支持 171 | - 新增自定义表达式符号的演示 172 | 173 | ### 2018-2-25 174 | 175 | - 修复嵌套函数参数不能正确展开接口的问题 176 | - 修复解析引擎的数字探头不能识别16进制自然数和函数问题 177 | - 新增一个赋值的demo范例，包含变量申明，静态复用，动态复用，总共三部曲，请在范例演示中自行研究 178 | - 修复字符串和数字匹配联合的问题 179 | - 支持c代码风格0x16进制语法 180 | 181 | ### 2018-2-6 182 | 183 | 184 | - 重写了一次解析器内核，支持函数调用，从现在起，zExpression会不断更新 185 | 186 | 187 | ---------- 188 | 189 | 190 | 191 | 使用zExpression有疑问请加互助qq群490269542，请不要直接联系作者 192 | 193 | by.qq600585 194 | 2017-6 195 | 196 | -------------------------------------------------------------------------------- /samples/Delphi/Console/console.dpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/Console/console.dpr -------------------------------------------------------------------------------- /samples/Delphi/Console/console.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | -------------------------------------------------------------------------------- /samples/Delphi/Console/console.identcache: -------------------------------------------------------------------------------- 1 | ?E:\developer\git\zExpression\samples\Delphi\Console\console.dpr -------------------------------------------------------------------------------- /samples/Delphi/Console/console.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/Console/console.res -------------------------------------------------------------------------------- /samples/Delphi/NumberTransform/NumTrans.dpr: -------------------------------------------------------------------------------- 1 | program NumTrans; 2 | 3 | uses 4 | Vcl.Forms, 5 | NumTransFrm in 'NumTransFrm.pas' {NumTransForm}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TNumTransForm, NumTransForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /samples/Delphi/NumberTransform/NumTrans.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | -------------------------------------------------------------------------------- /samples/Delphi/NumberTransform/NumTrans.identcache: -------------------------------------------------------------------------------- 1 | KE:\developer\git\zExpression\samples\Delphi\NumberTransform\NumTransFrm.pasHE:\developer\git\zExpression\samples\Delphi\NumberTransform\NumTrans.dpr -------------------------------------------------------------------------------- /samples/Delphi/NumberTransform/NumTrans.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/NumberTransform/NumTrans.res -------------------------------------------------------------------------------- /samples/Delphi/NumberTransform/NumTransFrm.dfm: -------------------------------------------------------------------------------- 1 | object NumTransForm: TNumTransForm 2 | Left = 0 3 | Top = 0 4 | AutoSize = True 5 | BorderStyle = bsDialog 6 | BorderWidth = 10 7 | Caption = 'number transform. create by.qq600585' 8 | ClientHeight = 353 9 | ClientWidth = 936 10 | Color = clBtnFace 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -11 14 | Font.Name = 'Tahoma' 15 | Font.Style = [] 16 | OldCreateOrder = False 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object Memo1: TMemo 20 | Left = 0 21 | Top = 0 22 | Width = 401 23 | Height = 353 24 | Lines.Strings = ( 25 | 'const' 26 | ' SInvalidFileFormat: SystemString = '#39'Invalid file format'#39';' 27 | '' 28 | ' { -Blowfish lookup tables }' 29 | '' 30 | ' bf_P: array [0 .. (BFRounds + 1)] of DWord = (' 31 | ' $243F6A88, $85A308D3, $13198A2E, $03707344,' 32 | ' $A4093822, $299F31D0, $082EFA98, $EC4E6C89,' 33 | ' $452821E6, $38D01377, $BE5466CF, $34E90C6C,' 34 | ' $C0AC29B7, $C97C50DD, $3F84D5B5, $B5470917,' 35 | ' $9216D5D9, $8979FB1B);' 36 | '' 37 | '' 38 | 'const' 39 | 'tab_coef_num: array[0..3, 0..16, 0..3] of vlc_bits_len =' 40 | '(' 41 | ' (' 42 | 43 | ' ( (%1, 1), (%0, 1), ' + 44 | ' (%0, 1), (%0, 1)),' 45 | 46 | ' ( (%000101, 6), (%01, 2), ' + 47 | ' (%0, 1), (%0, 1)),' 48 | 49 | ' ( (%00000111, 8), (%000100, 6), ' + 50 | ' (%001, 3), (%0, 1)),' 51 | 52 | ' ( (%000000111, 9), (%00000110, 8), ' + 53 | ' (%0000101, 7), (%00011, 5)),' 54 | 55 | ' ( (%0000000111, 10), (%000000110, 9), ' + 56 | '(%00000101, 8), (%000011, 6)),' 57 | 58 | ' ( (%00000000111, 11), (%0000000110, 10), (' + 59 | '%000000101, 9), (%0000100, 7)),' 60 | 61 | ' ( (%0000000001111, 13), (%00000000110, 11), (%0' + 62 | '000000101, 10), (%00000100, 8)),' 63 | 64 | ' ( (%0000000001011, 13), (%0000000001110, 13), (%00' + 65 | '000000101, 11), (%000000100, 9)),' 66 | 67 | ' ( (%0000000001000, 13), (%0000000001010, 13), (%0000' + 68 | '000001101, 13), (%0000000100, 10)),' 69 | 70 | ' ( (%00000000001111, 14), (%00000000001110, 14), (%0000' + 71 | '000001001, 13), (%00000000100, 11)),' 72 | 73 | ' ( (%00000000001011, 14), (%00000000001010, 14), (%00000' + 74 | '000001101, 14), (%0000000001100, 13)),' 75 | 76 | ' ( (%000000000001111, 15), (%000000000001110, 15), (%00000' + 77 | '000001001, 14), (%00000000001100, 14)),' 78 | 79 | ' ( (%000000000001011, 15), (%000000000001010, 15), (%000000' + 80 | '000001101, 15), (%00000000001000, 14)),' 81 | 82 | ' ((%0000000000001111, 16), (%000000000000001, 15), (%000000' + 83 | '000001001, 15), (%000000000001100, 15)),' 84 | 85 | ' ((%0000000000001011, 16), (%0000000000001110, 16), (%0000000' + 86 | '000001101, 16), (%000000000001000, 15)),' 87 | 88 | ' ((%0000000000000111, 16), (%0000000000001010, 16), (%0000000' + 89 | '000001001, 16), (%0000000000001100, 16)),' 90 | 91 | ' ((%0000000000000100, 16), (%0000000000000110, 16), (%0000000' + 92 | '000000101, 16), (%0000000000001000, 16))' 93 | ' ),' 94 | ' (' 95 | 96 | ' ( (%11, 2), (%0, 1), ' + 97 | ' (%0, 1), (%0, 1)),' 98 | 99 | ' ( (%001011, 6), (%10, 2), ' + 100 | ' (%0, 1), (%0, 1)),' 101 | 102 | ' ( (%000111, 6), (%00111, 5), ' + 103 | ' (%011, 3), (%0, 1)),' 104 | 105 | ' ( (%0000111, 7), (%001010, 6), ' + 106 | ' (%001001, 6), (%0101, 4)),' 107 | 108 | ' ( (%00000111, 8), (%000110, 6), ' + 109 | ' (%000101, 6), (%0100, 4)),' 110 | 111 | ' ( (%00000100, 8), (%0000110, 7), ' + 112 | ' (%0000101, 7), (%00110, 5)),' 113 | 114 | ' ( (%000000111, 9), (%00000110, 8), ' + 115 | '(%00000101, 8), (%001000, 6)),' 116 | 117 | ' ( (%00000001111, 11), (%000000110, 9), (' + 118 | '%000000101, 9), (%000100, 6)),' 119 | 120 | ' ( (%00000001011, 11), (%00000001110, 11), (%00' + 121 | '000001101, 11), (%0000100, 7)),' 122 | 123 | ' ( (%000000001111, 12), (%00000001010, 11), (%00' + 124 | '000001001, 11), (%000000100, 9)),' 125 | 126 | ' ( (%000000001011, 12), (%000000001110, 12), (%000' + 127 | '000001101, 12), (%00000001100, 11)),' 128 | 129 | ' ( (%000000001000, 12), (%000000001010, 12), (%000' + 130 | '000001001, 12), (%00000001000, 11)),' 131 | 132 | ' ( (%0000000001111, 13), (%0000000001110, 13), (%0000' + 133 | '000001101, 13), (%000000001100, 12)),' 134 | 135 | ' ( (%0000000001011, 13), (%0000000001010, 13), (%0000' + 136 | '000001001, 13), (%0000000001100, 13)),' 137 | 138 | ' ( (%0000000000111, 13), (%00000000001011, 14), (%0000' + 139 | '000000110, 13), (%0000000001000, 13)),' 140 | 141 | ' ( (%00000000001001, 14), (%00000000001000, 14), (%00000' + 142 | '000001010, 14), (%0000000000001, 13)),' 143 | 144 | ' ( (%00000000000111, 14), (%00000000000110, 14), (%00000' + 145 | '000000101, 14), (%00000000000100, 14))' 146 | ' ),' 147 | ' (' 148 | 149 | ' ( (%1111, 4), (%0, 1), ' + 150 | ' (%0, 1), (%0, 1)),' 151 | 152 | ' ( (%001111, 6), (%1110, 4), ' + 153 | ' (%0, 1), (%0, 1)),' 154 | 155 | ' ( (%001011, 6), (%01111, 5), ' + 156 | ' (%1101, 4), (%0, 1)),' 157 | 158 | ' ( (%001000, 6), (%01100, 5), ' + 159 | ' (%01110, 5), (%1100, 4)),' 160 | 161 | ' ( (%0001111, 7), (%01010, 5), ' + 162 | ' (%01011, 5), (%1011, 4)),' 163 | 164 | ' ( (%0001011, 7), (%01000, 5), ' + 165 | ' (%01001, 5), (%1010, 4)),' 166 | 167 | ' ( (%0001001, 7), (%001110, 6), ' + 168 | ' (%001101, 6), (%1001, 4)),' 169 | 170 | ' ( (%0001000, 7), (%001010, 6), ' + 171 | ' (%001001, 6), (%1000, 4)),' 172 | 173 | ' ( (%00001111, 8), (%0001110, 7), ' + 174 | ' (%0001101, 7), (%01101, 5)),' 175 | 176 | ' ( (%00001011, 8), (%00001110, 8), ' + 177 | ' (%0001010, 7), (%001100, 6)),' 178 | 179 | ' ( (%000001111, 9), (%00001010, 8), ' + 180 | '(%00001101, 8), (%0001100, 7)),' 181 | 182 | ' ( (%000001011, 9), (%000001110, 9), ' + 183 | '(%00001001, 8), (%00001100, 8)),' 184 | 185 | ' ( (%000001000, 9), (%000001010, 9), (' + 186 | '%000001101, 9), (%00001000, 8)),' 187 | 188 | ' ( (%0000001101, 10), (%000000111, 9), (' + 189 | '%000001001, 9), (%000001100, 9)),' 190 | 191 | ' ( (%0000001001, 10), (%0000001100, 10), (%0' + 192 | '000001011, 10), (%0000001010, 10)),' 193 | 194 | ' ( (%0000000101, 10), (%0000001000, 10), (%0' + 195 | '000000111, 10), (%0000000110, 10)),' 196 | 197 | ' ( (%0000000001, 10), (%0000000100, 10), (%0' + 198 | '000000011, 10), (%0000000010, 10))' 199 | ' ),' 200 | ' (' 201 | 202 | ' ( (%000011, 6), (%0, 1), ' + 203 | ' (%0, 1), (%0, 1)),' 204 | 205 | ' ( (%000000, 6), (%000001, 6), ' + 206 | ' (%0, 1), (%0, 1)),' 207 | 208 | ' ( (%000100, 6), (%000101, 6), ' + 209 | ' (%000110, 6), (%0, 1)),' 210 | 211 | ' ( (%001000, 6), (%001001, 6), ' + 212 | ' (%001010, 6), (%001011, 6)),' 213 | 214 | ' ( (%001100, 6), (%001101, 6), ' + 215 | ' (%001110, 6), (%001111, 6)),' 216 | 217 | ' ( (%010000, 6), (%010001, 6), ' + 218 | ' (%010010, 6), (%010011, 6)),' 219 | 220 | ' ( (%010100, 6), (%010101, 6), ' + 221 | ' (%010110, 6), (%010111, 6)),' 222 | 223 | ' ( (%011000, 6), (%011001, 6), ' + 224 | ' (%011010, 6), (%011011, 6)),' 225 | 226 | ' ( (%011100, 6), (%011101, 6), ' + 227 | ' (%011110, 6), (%011111, 6)),' 228 | 229 | ' ( (%100000, 6), (%100001, 6), ' + 230 | ' (%100010, 6), (%100011, 6)),' 231 | 232 | ' ( (%100100, 6), (%100101, 6), ' + 233 | ' (%100110, 6), (%100111, 6)),' 234 | 235 | ' ( (%101000, 6), (%101001, 6), ' + 236 | ' (%101010, 6), (%101011, 6)),' 237 | 238 | ' ( (%101100, 6), (%101101, 6), ' + 239 | ' (%101110, 6), (%101111, 6)),' 240 | 241 | ' ( (%110000, 6), (%110001, 6), ' + 242 | ' (%110010, 6), (%110011, 6)),' 243 | 244 | ' ( (%110100, 6), (%110101, 6), ' + 245 | ' (%110110, 6), (%110111, 6)),' 246 | 247 | ' ( (%111000, 6), (%111001, 6), ' + 248 | ' (%111010, 6), (%111011, 6)),' 249 | 250 | ' ( (%111100, 6), (%111101, 6), ' + 251 | ' (%111110, 6), (%111111, 6))' 252 | ' )' 253 | ');' 254 | '' 255 | '{' 256 | 'separate table for nC == -1 (chroma DC)' 257 | '3+3 bit code/length' 258 | '}' 259 | 'tab_coef_num_chroma_dc: array[0..4, 0..3] of vlc_bits_len =' 260 | '(' 261 | ' ( (%01, 2), (%0, 1), (%0, 1), (%0, 1)),' 262 | ' ((%000111, 6), (%1, 1), (%0, 1), (%0, 1)),' 263 | ' ((%000100, 6), (%000110, 6), (%001, 3), (%0, 1)),' 264 | ' ((%000011, 6), (%0000011, 7), (%0000010, 7), (%000101, 6)),' 265 | ' ((%000010, 6), (%00000011, 8), (%00000010, 8), (%0000000, 7))' 266 | ');') 267 | ScrollBars = ssBoth 268 | TabOrder = 0 269 | WordWrap = False 270 | end 271 | object Memo2: TMemo 272 | Left = 535 273 | Top = 0 274 | Width = 401 275 | Height = 353 276 | ScrollBars = ssBoth 277 | TabOrder = 1 278 | WordWrap = False 279 | end 280 | object Button1: TButton 281 | Left = 407 282 | Top = 24 283 | Width = 121 284 | Height = 25 285 | Caption = 'Binary -> Dec' 286 | TabOrder = 2 287 | OnClick = Button1Click 288 | end 289 | object Button2: TButton 290 | Left = 408 291 | Top = 55 292 | Width = 121 293 | Height = 25 294 | Caption = 'Binary <- Dec' 295 | TabOrder = 3 296 | OnClick = Button2Click 297 | end 298 | end 299 | -------------------------------------------------------------------------------- /samples/Delphi/NumberTransform/NumTransFrm.pas: -------------------------------------------------------------------------------- 1 | unit NumTransFrm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 8 | 9 | System.Math, 10 | 11 | CoreClasses, PascalStrings, TextParsing, UnicodeMixedLib; 12 | 13 | type 14 | TNumTransForm = class(TForm) 15 | Memo1: TMemo; 16 | Memo2: TMemo; 17 | Button1: TButton; 18 | Button2: TButton; 19 | procedure Button1Click(Sender: TObject); 20 | procedure Button2Click(Sender: TObject); 21 | private 22 | { Private declarations } 23 | public 24 | { Public declarations } 25 | end; 26 | 27 | var 28 | NumTransForm: TNumTransForm; 29 | 30 | implementation 31 | 32 | {$R *.dfm} 33 | 34 | 35 | function BinToInt(Value: U_String): UInt64; 36 | var 37 | i, Size: Integer; 38 | begin 39 | Result := 0; 40 | Size := length(Value); 41 | for i := Size downto 1 do 42 | begin 43 | if Value[i] = '1' then 44 | Result := Result + (1 shl (Size - i)); 45 | end; 46 | end; 47 | 48 | function IntToBin(v: UInt64): U_String; 49 | begin 50 | if v = 0 then 51 | begin 52 | Result := '0'; 53 | exit; 54 | end; 55 | Result := ''; 56 | while v > 0 do 57 | begin 58 | if v and $1 = 1 then 59 | Result := '1' + Result 60 | else 61 | Result := '0' + Result; 62 | v := v shr 1; 63 | end; 64 | while Result.First = '0' do 65 | Result.DeleteFirst; 66 | end; 67 | 68 | procedure TNumTransForm.Button1Click(Sender: TObject); 69 | var 70 | dest: TPascalString; 71 | procedure Append(s: SystemString); 72 | begin 73 | dest.Append(s); 74 | end; 75 | 76 | var 77 | T: TTextParsing; 78 | i: Integer; 79 | p: PTokenData; 80 | Prev: PTokenData; 81 | n: TPascalString; 82 | begin 83 | T := TTextParsing.Create(Memo1.Text, TTextStyle.tsPascal); 84 | 85 | dest := ''; 86 | Prev := nil; 87 | for i := 0 to T.TokenCount - 1 do 88 | begin 89 | p := T.Tokens[i]; 90 | case p^.tokenType of 91 | ttTextDecl: 92 | begin 93 | n := TTextParsing.TranslatePascalDeclToText(p^.Text); 94 | Append(TTextParsing.TranslateTextToPascalDecl(n)); 95 | end; 96 | ttComment: 97 | begin 98 | n := TTextParsing.TranslatePascalDeclCommentToText(p^.Text); 99 | Append(TTextParsing.TranslateTextToPascalDeclComment(umlTrimSpace(n))); 100 | end; 101 | ttNumber: 102 | begin 103 | if (Prev <> nil) and (Prev^.tokenType = ttSymbol) and (Prev^.Text = '%') then 104 | begin 105 | while (dest.Len > 0) and (dest.Last <> '%') do 106 | dest.DeleteLast; 107 | if (dest.Len > 0) and (dest.Last = '%') then 108 | dest.DeleteLast; 109 | 110 | Append(IntToStr(BinToInt(p^.Text))); 111 | end 112 | else if (Prev <> nil) and (Prev^.tokenType = ttSymbol) and (Prev^.Text = '$') then 113 | begin 114 | while (dest.Len > 0) and (dest.Last <> '$') do 115 | dest.DeleteLast; 116 | if (dest.Len > 0) and (dest.Last = '$') then 117 | dest.DeleteLast; 118 | 119 | Append(IntToStr(StrToInt('$' + p^.Text))); 120 | end 121 | else 122 | begin 123 | if p^.Text.First = '$' then 124 | Append(IntToStr(StrToInt64(p^.Text))) 125 | else 126 | Append(p^.Text); 127 | end; 128 | end; 129 | ttSymbol: Append(p^.Text); 130 | ttAscii: Append(p^.Text); 131 | ttSpecialSymbol: Append(p^.Text); 132 | else Append(p^.Text); 133 | end; 134 | 135 | if p^.tokenType <> ttUnknow then 136 | Prev := p; 137 | end; 138 | Memo2.Text := dest; 139 | end; 140 | 141 | procedure TNumTransForm.Button2Click(Sender: TObject); 142 | var 143 | dest: TPascalString; 144 | procedure Append(s: SystemString); 145 | begin 146 | dest.Append(s); 147 | end; 148 | 149 | var 150 | T: TTextParsing; 151 | i: Integer; 152 | p: PTokenData; 153 | Prev: PTokenData; 154 | n: TPascalString; 155 | begin 156 | T := TTextParsing.Create(Memo2.Text, TTextStyle.tsPascal); 157 | 158 | dest := ''; 159 | Prev := nil; 160 | for i := 0 to T.TokenCount - 1 do 161 | begin 162 | p := T.Tokens[i]; 163 | case p^.tokenType of 164 | ttTextDecl: 165 | begin 166 | n := TTextParsing.TranslatePascalDeclToText(p^.Text); 167 | Append(TTextParsing.TranslateTextToPascalDecl(n)); 168 | end; 169 | ttComment: 170 | begin 171 | n := TTextParsing.TranslatePascalDeclCommentToText(p^.Text); 172 | Append(TTextParsing.TranslateTextToPascalDeclComment(umlTrimSpace(n))); 173 | end; 174 | ttNumber: 175 | begin 176 | if not umlIsFloatNumber(Prev^.Text) then 177 | begin 178 | Append('%' + IntToBin(umlStrToInt64(p^.Text, 0))); 179 | end 180 | else 181 | begin 182 | Append(p^.Text); 183 | end; 184 | end; 185 | ttSymbol: Append(p^.Text); 186 | ttAscii: Append(p^.Text); 187 | ttSpecialSymbol: Append(p^.Text); 188 | else Append(p^.Text); 189 | end; 190 | 191 | if p^.tokenType <> ttUnknow then 192 | Prev := p; 193 | end; 194 | Memo1.Text := dest; 195 | end; 196 | 197 | end. 198 | -------------------------------------------------------------------------------- /samples/Delphi/Pascal Code Dependency Anslysis/PascalCodeDependencyAnslysis.dpr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/Pascal Code Dependency Anslysis/PascalCodeDependencyAnslysis.dpr -------------------------------------------------------------------------------- /samples/Delphi/Pascal Code Dependency Anslysis/PascalCodeDependencyAnslysis.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | -------------------------------------------------------------------------------- /samples/Delphi/Pascal Code Dependency Anslysis/PascalCodeDependencyAnslysis.identcache: -------------------------------------------------------------------------------- 1 | lE:\developer\git\zExpression\samples\Delphi\Pascal Code Dependency Anslysis\PascalCodeDependencyAnslysis.dpr -------------------------------------------------------------------------------- /samples/Delphi/Pascal Code Dependency Anslysis/PascalCodeDependencyAnslysis.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/Pascal Code Dependency Anslysis/PascalCodeDependencyAnslysis.res -------------------------------------------------------------------------------- /samples/Delphi/TextParsing/TextParsingDemo.dpr: -------------------------------------------------------------------------------- 1 | program TextParsingDemo; 2 | 3 | uses 4 | Vcl.Forms, 5 | TextParsingFrm in 'TextParsingFrm.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /samples/Delphi/TextParsing/TextParsingDemo.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | -------------------------------------------------------------------------------- /samples/Delphi/TextParsing/TextParsingDemo.identcache: -------------------------------------------------------------------------------- 1 | JE:\developer\git\zExpression\samples\Delphi\TextParsing\TextParsingFrm.pasKE:\developer\git\zExpression\samples\Delphi\TextParsing\TextParsingDemo.dpr -------------------------------------------------------------------------------- /samples/Delphi/TextParsing/TextParsingDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/TextParsing/TextParsingDemo.res -------------------------------------------------------------------------------- /samples/Delphi/TextParsing/TextParsingFrm.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Form1' 5 | ClientHeight = 440 6 | ClientWidth = 896 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object PageControl1: TPageControl 17 | Left = 0 18 | Top = 0 19 | Width = 896 20 | Height = 440 21 | ActivePage = TabSheet1 22 | Align = alClient 23 | TabOrder = 0 24 | object TabSheet1: TTabSheet 25 | Caption = 'symbol list' 26 | ExplicitLeft = 0 27 | ExplicitTop = 0 28 | ExplicitWidth = 0 29 | ExplicitHeight = 0 30 | object Memo1: TMemo 31 | Left = 16 32 | Top = 19 33 | Width = 369 34 | Height = 337 35 | Lines.Strings = ( 36 | #39#26631#35760#31526#34920#39 37 | 'abc' 38 | '"'#26631#35760#31526#34920'"' 39 | '123' 40 | '-2.020952E+00 * (10 - 7.000000E+00) - 9.516623E+00') 41 | TabOrder = 0 42 | end 43 | object Button1: TButton 44 | Left = 391 45 | Top = 41 46 | Width = 75 47 | Height = 25 48 | Caption = 'pascal style' 49 | TabOrder = 1 50 | OnClick = Button1Click 51 | end 52 | object Memo2: TMemo 53 | Left = 472 54 | Top = 19 55 | Width = 393 56 | Height = 337 57 | TabOrder = 2 58 | end 59 | object Button2: TButton 60 | Left = 391 61 | Top = 72 62 | Width = 75 63 | Height = 25 64 | Caption = 'c style' 65 | TabOrder = 3 66 | OnClick = Button2Click 67 | end 68 | end 69 | object TabSheet2: TTabSheet 70 | Caption = 'pascal proc list' 71 | ImageIndex = 1 72 | ExplicitLeft = 0 73 | ExplicitTop = 0 74 | ExplicitWidth = 0 75 | ExplicitHeight = 0 76 | object Memo3: TMemo 77 | Left = 24 78 | Top = 27 79 | Width = 369 80 | Height = 337 81 | Lines.Strings = ( 82 | 'program test;' 83 | '' 84 | 'function test;' 85 | 'procedure abc;' 86 | '' 87 | 'begin' 88 | 'end.') 89 | TabOrder = 0 90 | end 91 | object Button3: TButton 92 | Left = 399 93 | Top = 49 94 | Width = 75 95 | Height = 25 96 | Caption = 'pascal style' 97 | TabOrder = 1 98 | OnClick = Button3Click 99 | end 100 | object Memo4: TMemo 101 | Left = 480 102 | Top = 27 103 | Width = 393 104 | Height = 337 105 | TabOrder = 2 106 | end 107 | end 108 | object TabSheet3: TTabSheet 109 | Caption = 'zExpression Demo' 110 | ImageIndex = 2 111 | ExplicitLeft = 0 112 | ExplicitTop = 0 113 | ExplicitWidth = 0 114 | ExplicitHeight = 0 115 | object Memo5: TMemo 116 | Left = 0 117 | Top = 49 118 | Width = 888 119 | Height = 363 120 | Align = alClient 121 | TabOrder = 0 122 | end 123 | object Panel1: TPanel 124 | Left = 0 125 | Top = 0 126 | Width = 888 127 | Height = 49 128 | Align = alTop 129 | BevelOuter = bvNone 130 | TabOrder = 1 131 | object Button4: TButton 132 | Left = 8 133 | Top = 10 134 | Width = 75 135 | Height = 25 136 | Caption = 'demo1' 137 | TabOrder = 0 138 | OnClick = Button4Click 139 | end 140 | object Button5: TButton 141 | Left = 89 142 | Top = 10 143 | Width = 75 144 | Height = 25 145 | Caption = 'demo2' 146 | TabOrder = 1 147 | OnClick = Button5Click 148 | end 149 | object Button6: TButton 150 | Left = 170 151 | Top = 10 152 | Width = 75 153 | Height = 25 154 | Caption = 'demo3' 155 | TabOrder = 2 156 | OnClick = Button6Click 157 | end 158 | object Button7: TButton 159 | Left = 251 160 | Top = 10 161 | Width = 75 162 | Height = 25 163 | Caption = 'demo4' 164 | TabOrder = 3 165 | OnClick = Button7Click 166 | end 167 | object Button8: TButton 168 | Left = 332 169 | Top = 10 170 | Width = 75 171 | Height = 25 172 | Caption = 'demo5' 173 | TabOrder = 4 174 | OnClick = Button8Click 175 | end 176 | object Button9: TButton 177 | Left = 413 178 | Top = 10 179 | Width = 100 180 | Height = 25 181 | Caption = 'special function' 182 | TabOrder = 5 183 | OnClick = Button9Click 184 | end 185 | end 186 | end 187 | end 188 | end 189 | -------------------------------------------------------------------------------- /samples/Delphi/TextParsing/TextParsingFrm.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/TextParsing/TextParsingFrm.pas -------------------------------------------------------------------------------- /samples/Delphi/all.groupproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {50BDD959-4829-402C-990D-8BA71A0DFAF8} 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | Default.Personality.12 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | -------------------------------------------------------------------------------- /samples/Delphi/all.groupproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2019/08/05 13:29:58.000.033,C:\Users\Administrator\Documents\Embarcadero\Studio\Projects\ProjectGroup1.groupproj=E:\developer\git\zExpression\samples\Delphi\all.groupproj 5 | 6 | 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /samples/Delphi/zExpressionSupport/zExpressionSupport.dpr: -------------------------------------------------------------------------------- 1 | program zExpressionSupport; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | zExpressionSupportMainFrm in 'zExpressionSupportMainFrm.pas' {zExpressionSupportMainForm}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | Application.Initialize; 12 | Application.CreateForm(TzExpressionSupportMainForm, zExpressionSupportMainForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /samples/Delphi/zExpressionSupport/zExpressionSupport.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 8 | -------------------------------------------------------------------------------- /samples/Delphi/zExpressionSupport/zExpressionSupport.identcache: -------------------------------------------------------------------------------- 1 | UE:\developer\git\zExpression\samples\Delphi\zExpressionSupport\zExpressionSupport.dpr\E:\developer\git\zExpression\samples\Delphi\zExpressionSupport\zExpressionSupportMainFrm.pas -------------------------------------------------------------------------------- /samples/Delphi/zExpressionSupport/zExpressionSupport.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/zExpressionSupport/zExpressionSupport.res -------------------------------------------------------------------------------- /samples/Delphi/zExpressionSupport/zExpressionSupportMainFrm.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/Delphi/zExpressionSupport/zExpressionSupportMainFrm.pas -------------------------------------------------------------------------------- /samples/fpc/demofrm.lfm: -------------------------------------------------------------------------------- 1 | object DemoForm: TDemoForm 2 | Left = 516 3 | Height = 668 4 | Top = 157 5 | Width = 922 6 | Caption = 'DemoForm' 7 | ClientHeight = 668 8 | ClientWidth = 922 9 | OnCreate = FormCreate 10 | LCLVersion = '2.0.6.0' 11 | object Memo1: TMemo 12 | Left = 0 13 | Height = 668 14 | Top = 0 15 | Width = 922 16 | Align = alClient 17 | ScrollBars = ssBoth 18 | TabOrder = 0 19 | WordWrap = False 20 | end 21 | object Button1: TButton 22 | Left = 816 23 | Height = 25 24 | Top = 8 25 | Width = 75 26 | Caption = 'run' 27 | OnClick = Button1Click 28 | TabOrder = 1 29 | end 30 | end 31 | -------------------------------------------------------------------------------- /samples/fpc/fpcDemo.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/fpc/fpcDemo.ico -------------------------------------------------------------------------------- /samples/fpc/fpcDemo.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | <ResourceType Value="res"/> 11 | <UseXPManifest Value="True"/> 12 | <Icon Value="0"/> 13 | </General> 14 | <BuildModes Count="1"> 15 | <Item1 Name="Default" Default="True"/> 16 | </BuildModes> 17 | <PublishOptions> 18 | <Version Value="2"/> 19 | </PublishOptions> 20 | <RunParams> 21 | <FormatVersion Value="2"/> 22 | <Modes Count="1"> 23 | <Mode0 Name="default"/> 24 | </Modes> 25 | </RunParams> 26 | <RequiredPackages Count="2"> 27 | <Item1> 28 | <PackageName Value="multithreadprocslaz"/> 29 | </Item1> 30 | <Item2> 31 | <PackageName Value="LCL"/> 32 | </Item2> 33 | </RequiredPackages> 34 | <Units Count="2"> 35 | <Unit0> 36 | <Filename Value="fpcDemo.lpr"/> 37 | <IsPartOfProject Value="True"/> 38 | </Unit0> 39 | <Unit1> 40 | <Filename Value="demofrm.pas"/> 41 | <IsPartOfProject Value="True"/> 42 | <ComponentName Value="DemoForm"/> 43 | <HasResources Value="True"/> 44 | <ResourceBaseClass Value="Form"/> 45 | <UnitName Value="demoFrm"/> 46 | </Unit1> 47 | </Units> 48 | </ProjectOptions> 49 | <CompilerOptions> 50 | <Version Value="11"/> 51 | <PathDelim Value="\"/> 52 | <Target> 53 | <Filename Value="fpcDemo"/> 54 | </Target> 55 | <SearchPaths> 56 | <IncludeFiles Value="$(ProjOutDir)"/> 57 | <OtherUnitFiles Value="..\..\lib"/> 58 | <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> 59 | </SearchPaths> 60 | <Linking> 61 | <Options> 62 | <Win32> 63 | <GraphicApplication Value="True"/> 64 | </Win32> 65 | </Options> 66 | </Linking> 67 | </CompilerOptions> 68 | <Debugging> 69 | <Exceptions Count="3"> 70 | <Item1> 71 | <Name Value="EAbort"/> 72 | </Item1> 73 | <Item2> 74 | <Name Value="ECodetoolError"/> 75 | </Item2> 76 | <Item3> 77 | <Name Value="EFOpenError"/> 78 | </Item3> 79 | </Exceptions> 80 | </Debugging> 81 | </CONFIG> 82 | -------------------------------------------------------------------------------- /samples/fpc/fpcDemo.lpr: -------------------------------------------------------------------------------- 1 | program fpcDemo; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, demoFrm 11 | { you can add units after this }; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | RequireDerivedFormResource:=True; 17 | Application.Initialize; 18 | Application.CreateForm(TDemoForm, DemoForm); 19 | Application.Run; 20 | end. 21 | 22 | -------------------------------------------------------------------------------- /samples/fpc/fpcDemo.lps: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectSession> 4 | <PathDelim Value="\"/> 5 | <Version Value="11"/> 6 | <BuildModes Active="Default"/> 7 | <Units Count="11"> 8 | <Unit0> 9 | <Filename Value="fpcDemo.lpr"/> 10 | <IsPartOfProject Value="True"/> 11 | <EditorIndex Value="-1"/> 12 | <WindowIndex Value="-1"/> 13 | <TopLine Value="-1"/> 14 | <CursorPos X="-1" Y="-1"/> 15 | <UsageCount Value="21"/> 16 | </Unit0> 17 | <Unit1> 18 | <Filename Value="demofrm.pas"/> 19 | <IsPartOfProject Value="True"/> 20 | <ComponentName Value="DemoForm"/> 21 | <HasResources Value="True"/> 22 | <ResourceBaseClass Value="Form"/> 23 | <UnitName Value="demoFrm"/> 24 | <IsVisibleTab Value="True"/> 25 | <UsageCount Value="21"/> 26 | <Loaded Value="True"/> 27 | <LoadedDesigner Value="True"/> 28 | </Unit1> 29 | <Unit2> 30 | <Filename Value="..\..\lib\CoreClasses.pas"/> 31 | <EditorIndex Value="-1"/> 32 | <TopLine Value="57"/> 33 | <CursorPos X="3" Y="77"/> 34 | <UsageCount Value="10"/> 35 | </Unit2> 36 | <Unit3> 37 | <Filename Value="C:\lazarus\components\multithreadprocs\mtprocs.pas"/> 38 | <UnitName Value="MTProcs"/> 39 | <EditorIndex Value="-1"/> 40 | <TopLine Value="834"/> 41 | <CursorPos X="3" Y="726"/> 42 | <UsageCount Value="10"/> 43 | </Unit3> 44 | <Unit4> 45 | <Filename Value="..\..\lib\DataFrameEngine.pas"/> 46 | <EditorIndex Value="-1"/> 47 | <TopLine Value="6"/> 48 | <CursorPos X="41" Y="31"/> 49 | <UsageCount Value="10"/> 50 | </Unit4> 51 | <Unit5> 52 | <Filename Value="C:\lazarus\fpc\3.0.4\source\rtl\objpas\classes\classesh.inc"/> 53 | <EditorIndex Value="-1"/> 54 | <TopLine Value="1438"/> 55 | <CursorPos X="16" Y="1458"/> 56 | <UsageCount Value="10"/> 57 | </Unit5> 58 | <Unit6> 59 | <Filename Value="C:\lazarus\fpc\3.0.4\source\rtl\objpas\classes\writer.inc"/> 60 | <EditorIndex Value="-1"/> 61 | <TopLine Value="482"/> 62 | <CursorPos X="3" Y="494"/> 63 | <UsageCount Value="10"/> 64 | </Unit6> 65 | <Unit7> 66 | <Filename Value="..\..\lib\OpCode.pas"/> 67 | <EditorIndex Value="-1"/> 68 | <TopLine Value="62"/> 69 | <CursorPos X="63" Y="82"/> 70 | <UsageCount Value="10"/> 71 | </Unit7> 72 | <Unit8> 73 | <Filename Value="..\..\lib\zExpression.pas"/> 74 | <EditorIndex Value="1"/> 75 | <TopLine Value="13"/> 76 | <CursorPos X="23" Y="239"/> 77 | <UsageCount Value="10"/> 78 | <Loaded Value="True"/> 79 | </Unit8> 80 | <Unit9> 81 | <Filename Value="..\..\lib\zDefine.inc"/> 82 | <EditorIndex Value="-1"/> 83 | <CursorPos X="19" Y="14"/> 84 | <UsageCount Value="10"/> 85 | </Unit9> 86 | <Unit10> 87 | <Filename Value="..\..\lib\TextParsing.pas"/> 88 | <EditorIndex Value="-1"/> 89 | <TopLine Value="163"/> 90 | <CursorPos X="17" Y="181"/> 91 | <UsageCount Value="10"/> 92 | </Unit10> 93 | </Units> 94 | <JumpHistory Count="30" HistoryIndex="29"> 95 | <Position1> 96 | <Filename Value="demofrm.pas"/> 97 | <Caret Line="487" Column="41" TopLine="455"/> 98 | </Position1> 99 | <Position2> 100 | <Filename Value="demofrm.pas"/> 101 | <Caret Line="521" Column="106" TopLine="479"/> 102 | </Position2> 103 | <Position3> 104 | <Filename Value="demofrm.pas"/> 105 | <Caret Line="520" Column="41" TopLine="489"/> 106 | </Position3> 107 | <Position4> 108 | <Filename Value="demofrm.pas"/> 109 | <Caret Line="520" Column="125" TopLine="489"/> 110 | </Position4> 111 | <Position5> 112 | <Filename Value="demofrm.pas"/> 113 | <Caret Line="663" TopLine="615"/> 114 | </Position5> 115 | <Position6> 116 | <Filename Value="demofrm.pas"/> 117 | <Caret Line="447" Column="18" TopLine="416"/> 118 | </Position6> 119 | <Position7> 120 | <Filename Value="demofrm.pas"/> 121 | <Caret Line="424" TopLine="416"/> 122 | </Position7> 123 | <Position8> 124 | <Filename Value="demofrm.pas"/> 125 | <Caret Line="425" TopLine="416"/> 126 | </Position8> 127 | <Position9> 128 | <Filename Value="demofrm.pas"/> 129 | <Caret Line="426" TopLine="416"/> 130 | </Position9> 131 | <Position10> 132 | <Filename Value="demofrm.pas"/> 133 | <Caret Line="504" Column="12" TopLine="481"/> 134 | </Position10> 135 | <Position11> 136 | <Filename Value="demofrm.pas"/> 137 | <Caret Line="503" Column="32" TopLine="472"/> 138 | </Position11> 139 | <Position12> 140 | <Filename Value="demofrm.pas"/> 141 | <Caret Line="503" Column="9" TopLine="472"/> 142 | </Position12> 143 | <Position13> 144 | <Filename Value="demofrm.pas"/> 145 | <Caret Line="504" Column="34" TopLine="472"/> 146 | </Position13> 147 | <Position14> 148 | <Filename Value="demofrm.pas"/> 149 | <Caret Line="503" Column="8" TopLine="472"/> 150 | </Position14> 151 | <Position15> 152 | <Filename Value="demofrm.pas"/> 153 | <Caret Line="504" Column="36" TopLine="484"/> 154 | </Position15> 155 | <Position16> 156 | <Filename Value="demofrm.pas"/> 157 | <Caret Line="506" Column="35" TopLine="484"/> 158 | </Position16> 159 | <Position17> 160 | <Filename Value="demofrm.pas"/> 161 | <Caret Line="504" Column="31" TopLine="484"/> 162 | </Position17> 163 | <Position18> 164 | <Filename Value="demofrm.pas"/> 165 | <Caret Line="503" Column="30" TopLine="484"/> 166 | </Position18> 167 | <Position19> 168 | <Filename Value="demofrm.pas"/> 169 | <Caret Line="504" Column="41" TopLine="488"/> 170 | </Position19> 171 | <Position20> 172 | <Filename Value="demofrm.pas"/> 173 | <Caret Line="527" Column="115" TopLine="508"/> 174 | </Position20> 175 | <Position21> 176 | <Filename Value="demofrm.pas"/> 177 | <Caret Line="516" Column="36" TopLine="503"/> 178 | </Position21> 179 | <Position22> 180 | <Filename Value="demofrm.pas"/> 181 | <Caret Line="659" Column="52" TopLine="653"/> 182 | </Position22> 183 | <Position23> 184 | <Filename Value="demofrm.pas"/> 185 | <Caret Line="79" Column="30" TopLine="50"/> 186 | </Position23> 187 | <Position24> 188 | <Filename Value="demofrm.pas"/> 189 | <Caret Line="481" Column="40" TopLine="462"/> 190 | </Position24> 191 | <Position25> 192 | <Filename Value="demofrm.pas"/> 193 | <Caret Line="559" Column="51" TopLine="539"/> 194 | </Position25> 195 | <Position26> 196 | <Filename Value="demofrm.pas"/> 197 | <Caret Line="553" Column="49" TopLine="539"/> 198 | </Position26> 199 | <Position27> 200 | <Filename Value="demofrm.pas"/> 201 | <Caret Line="568" Column="53" TopLine="556"/> 202 | </Position27> 203 | <Position28> 204 | <Filename Value="demofrm.pas"/> 205 | <Caret Line="557" Column="35" TopLine="517"/> 206 | </Position28> 207 | <Position29> 208 | <Filename Value="demofrm.pas"/> 209 | <Caret Line="22" Column="34"/> 210 | </Position29> 211 | <Position30> 212 | <Filename Value="demofrm.pas"/> 213 | <Caret Line="553" Column="38" TopLine="538"/> 214 | </Position30> 215 | </JumpHistory> 216 | <RunParams> 217 | <FormatVersion Value="2"/> 218 | <Modes Count="0" ActiveMode="default"/> 219 | </RunParams> 220 | </ProjectSession> 221 | </CONFIG> 222 | -------------------------------------------------------------------------------- /samples/fpc/fpcDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/samples/fpc/fpcDemo.res -------------------------------------------------------------------------------- /tools/PascalCodeUnification/PascalCodeUnification.dpr: -------------------------------------------------------------------------------- 1 | program PascalCodeUnification; 2 | 3 | uses 4 | Vcl.Forms, 5 | PascalCodeUnificationFrm in 'PascalCodeUnificationFrm.pas' {PascalCodeUnificationForm}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TPascalCodeUnificationForm, PascalCodeUnificationForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /tools/PascalCodeUnification/PascalCodeUnification.dproj.local: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="utf-8"?> 2 | <BorlandProject/> 3 | -------------------------------------------------------------------------------- /tools/PascalCodeUnification/PascalCodeUnification.identcache: -------------------------------------------------------------------------------- 1 | ���UE:\developer\git\zExpression\tools\PascalCodeUnification\PascalCodeUnificationFrm.pas������������RE:\developer\git\zExpression\tools\PascalCodeUnification\PascalCodeUnification.dpr������������ -------------------------------------------------------------------------------- /tools/PascalCodeUnification/PascalCodeUnification.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/tools/PascalCodeUnification/PascalCodeUnification.res -------------------------------------------------------------------------------- /tools/PascalCodeUnification/PascalCodeUnification.stat: -------------------------------------------------------------------------------- 1 | [Stats] 2 | EditorSecs=6 3 | DesignerSecs=1 4 | InspectorSecs=1 5 | CompileSecs=4488 6 | OtherSecs=26 7 | StartTime=2018/7/6 10:03:11 8 | RealKeys=0 9 | EffectiveKeys=0 10 | DebugSecs=1 11 | -------------------------------------------------------------------------------- /tools/PascalCodeUnification/PascalCodeUnificationFrm.dfm: -------------------------------------------------------------------------------- 1 | object PascalCodeUnificationForm: TPascalCodeUnificationForm 2 | Left = 0 3 | Top = 0 4 | AutoSize = True 5 | BorderWidth = 15 6 | Caption = 'Pascal code Unification...' 7 | ClientHeight = 689 8 | ClientWidth = 1123 9 | Color = clBtnFace 10 | DoubleBuffered = True 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -11 14 | Font.Name = 'Tahoma' 15 | Font.Style = [] 16 | OldCreateOrder = False 17 | OnCreate = FormCreate 18 | OnDestroy = FormDestroy 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object StateLabel: TLabel 22 | Left = 96 23 | Top = 8 24 | Width = 36 25 | Height = 13 26 | Caption = 'Info:...' 27 | end 28 | object dictInputInfoLabel: TLabel 29 | Left = 712 30 | Top = 16 31 | Width = 48 32 | Height = 13 33 | Caption = 'dict input:' 34 | end 35 | object dictOutputInfoLabel: TLabel 36 | Left = 920 37 | Top = 12 38 | Width = 56 39 | Height = 13 40 | Caption = 'dict output:' 41 | end 42 | object FileListMemo: TMemo 43 | Left = 0 44 | Top = 31 45 | Width = 705 46 | Height = 370 47 | ScrollBars = ssVertical 48 | TabOrder = 0 49 | WordWrap = False 50 | end 51 | object AddFileButton: TButton 52 | Left = 0 53 | Top = 0 54 | Width = 75 55 | Height = 25 56 | Caption = 'Add files...' 57 | TabOrder = 1 58 | OnClick = AddFileButtonClick 59 | end 60 | object FixedButton: TButton 61 | Left = 0 62 | Top = 441 63 | Width = 169 64 | Height = 33 65 | Caption = 'Process...' 66 | TabOrder = 2 67 | OnClick = FixedButtonClick 68 | end 69 | object StatusMemo: TMemo 70 | Left = 0 71 | Top = 480 72 | Width = 705 73 | Height = 209 74 | ScrollBars = ssVertical 75 | TabOrder = 3 76 | end 77 | object ProgressBar: TProgressBar 78 | Left = 175 79 | Top = 449 80 | Width = 370 81 | Height = 17 82 | TabOrder = 4 83 | end 84 | object WordDefineMemo: TMemo 85 | Left = 711 86 | Top = 31 87 | Width = 203 88 | Height = 658 89 | ScrollBars = ssVertical 90 | TabOrder = 5 91 | WordWrap = False 92 | end 93 | object WordOutputMemo: TMemo 94 | Left = 920 95 | Top = 31 96 | Width = 203 97 | Height = 658 98 | ScrollBars = ssVertical 99 | TabOrder = 6 100 | WordWrap = False 101 | end 102 | object FixedWordCheckBox: TCheckBox 103 | Left = 0 104 | Top = 418 105 | Width = 265 106 | Height = 17 107 | Caption = 'Unification code case with C Style...' 108 | Checked = True 109 | State = cbChecked 110 | TabOrder = 7 111 | OnClick = FixedWordCheckBoxClick 112 | end 113 | object OpenDialog: TFileOpenDialog 114 | FavoriteLinks = <> 115 | FileTypes = < 116 | item 117 | DisplayName = 'All Pascal Unit(*.pas;*.pp;*.inc;*.dpr)' 118 | FileMask = '*.pas;*.pp;*.inc;*.dpr' 119 | end> 120 | Options = [fdoAllowMultiSelect, fdoPathMustExist, fdoFileMustExist] 121 | Left = 184 122 | Top = 176 123 | end 124 | end 125 | -------------------------------------------------------------------------------- /tools/PascalCodeUnification/辅助编译工具：基于ObjectPascal的大规模统一化.txt: -------------------------------------------------------------------------------- 1 | 2 | 解答为什么需要辅助编译工具？ 3 | 4 | 1，工程大了以后，函数名大小写，变量大小写，各种申明大小写，全部统一化是件很麻烦的事 5 | 2，在Linux平台中，所有的代码文件名都会区分大小写，假如写错一个Uses，就会报告找不到文件，例如Uses xx,$R xx,$I xx,$L xx，这类问题缕缕碰见 6 | 3，Pascal的机制陷阱：在大规模CrossBuild工程编译时，Unit名+文件名如果不统一，build将会非常麻烦，因为编译器不会自动化帮助我们修复这类bug 7 | 8 | 处于以上3个理由，于是，我今天抽空写了这样一个预编译工具，并且开源 9 | 10 | 使用方法，将你的工程+控件+库，所有的.pas(delphi) or .pp(fpc)的代码，添加进来，然后点Process即可，全自动化的预编译处理 11 | 12 | by.qq600585 13 | 2018-7 14 | -------------------------------------------------------------------------------- /tools/StringTranslate/StringTranslate.dpr: -------------------------------------------------------------------------------- 1 | program StringTranslate; 2 | 3 | uses 4 | Vcl.Forms, 5 | StringTranslateFrm in 'StringTranslateFrm.pas' {StringTranslateForm}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TStringTranslateForm, StringTranslateForm); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /tools/StringTranslate/StringTranslate.dproj.local: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="utf-8"?> 2 | <BorlandProject/> 3 | -------------------------------------------------------------------------------- /tools/StringTranslate/StringTranslate.identcache: -------------------------------------------------------------------------------- 1 | ���IE:\developer\git\zExpression\tools\StringTranslate\StringTranslateFrm.pas������������FE:\developer\git\zExpression\tools\StringTranslate\StringTranslate.dpr������������ -------------------------------------------------------------------------------- /tools/StringTranslate/StringTranslate.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PassByYou888/zExpression/0b119e921e8e5700b5cbb0f5dac8cba451aca08c/tools/StringTranslate/StringTranslate.res -------------------------------------------------------------------------------- /tools/StringTranslate/StringTranslate.stat: -------------------------------------------------------------------------------- 1 | [Stats] 2 | EditorSecs=9 3 | DesignerSecs=5 4 | InspectorSecs=1 5 | CompileSecs=1581 6 | OtherSecs=4 7 | StartTime=2018/7/7 0:27:23 8 | RealKeys=0 9 | EffectiveKeys=0 10 | DebugSecs=1 11 | -------------------------------------------------------------------------------- /tools/StringTranslate/StringTranslateFrm.dfm: -------------------------------------------------------------------------------- 1 | object StringTranslateForm: TStringTranslateForm 2 | Left = 0 3 | Top = 0 4 | AutoSize = True 5 | BorderStyle = bsDialog 6 | BorderWidth = 15 7 | Caption = 'declaration translate..' 8 | ClientHeight = 393 9 | ClientWidth = 1138 10 | Color = clBtnFace 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -11 14 | Font.Name = 'Tahoma' 15 | Font.Style = [] 16 | OldCreateOrder = False 17 | Position = poDesktopCenter 18 | ScreenSnap = True 19 | PixelsPerInch = 96 20 | TextHeight = 13 21 | object Memo1: TMemo 22 | Left = 0 23 | Top = 0 24 | Width = 498 25 | Height = 393 26 | ScrollBars = ssBoth 27 | TabOrder = 0 28 | WordWrap = False 29 | end 30 | object Memo2: TMemo 31 | Left = 640 32 | Top = 0 33 | Width = 498 34 | Height = 393 35 | ScrollBars = ssBoth 36 | TabOrder = 1 37 | WordWrap = False 38 | end 39 | object Hex2AsciiButton: TButton 40 | Left = 504 41 | Top = 70 42 | Width = 130 43 | Height = 25 44 | Caption = 'hex 2 ascii ->' 45 | TabOrder = 2 46 | OnClick = Hex2AsciiButtonClick 47 | end 48 | object Ascii2HexButton: TButton 49 | Left = 504 50 | Top = 39 51 | Width = 130 52 | Height = 25 53 | Caption = '<- ascii 2 hex' 54 | TabOrder = 3 55 | OnClick = Ascii2HexButtonClick 56 | end 57 | object Ascii2DeclButton: TButton 58 | Left = 504 59 | Top = 144 60 | Width = 130 61 | Height = 25 62 | Caption = '<- ascii 2 declaration' 63 | TabOrder = 4 64 | OnClick = Ascii2DeclButtonClick 65 | end 66 | object Ascii2PascalDeclButton: TButton 67 | Left = 504 68 | Top = 175 69 | Width = 130 70 | Height = 25 71 | Caption = '<- ascii 2 pascal' 72 | TabOrder = 5 73 | OnClick = Ascii2PascalDeclButtonClick 74 | end 75 | object PascalDecl2AsciiButton: TButton 76 | Left = 504 77 | Top = 206 78 | Width = 130 79 | Height = 25 80 | Caption = 'pascal 2 ascii ->' 81 | TabOrder = 6 82 | OnClick = PascalDecl2AsciiButtonClick 83 | end 84 | object Ascii2cButton: TButton 85 | Left = 504 86 | Top = 279 87 | Width = 130 88 | Height = 25 89 | Caption = '<- ascii 2 c' 90 | TabOrder = 7 91 | OnClick = Ascii2cButtonClick 92 | end 93 | object c2AsciiButton: TButton 94 | Left = 504 95 | Top = 310 96 | Width = 130 97 | Height = 25 98 | Caption = 'c 2 ascii ->' 99 | TabOrder = 8 100 | OnClick = c2AsciiButtonClick 101 | end 102 | end 103 | -------------------------------------------------------------------------------- /tools/StringTranslate/StringTranslateFrm.pas: -------------------------------------------------------------------------------- 1 | unit StringTranslateFrm; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, 8 | UnicodeMixedLib, PascalStrings, TextParsing, zExpression; 9 | 10 | type 11 | TStringTranslateForm = class(TForm) 12 | Memo1: TMemo; 13 | Memo2: TMemo; 14 | Hex2AsciiButton: TButton; 15 | Ascii2HexButton: TButton; 16 | Ascii2DeclButton: TButton; 17 | Ascii2PascalDeclButton: TButton; 18 | PascalDecl2AsciiButton: TButton; 19 | Ascii2cButton: TButton; 20 | c2AsciiButton: TButton; 21 | procedure Hex2AsciiButtonClick(Sender: TObject); 22 | procedure Ascii2HexButtonClick(Sender: TObject); 23 | procedure Ascii2DeclButtonClick(Sender: TObject); 24 | procedure Ascii2PascalDeclButtonClick(Sender: TObject); 25 | procedure PascalDecl2AsciiButtonClick(Sender: TObject); 26 | procedure Ascii2cButtonClick(Sender: TObject); 27 | procedure c2AsciiButtonClick(Sender: TObject); 28 | private 29 | { Private declarations } 30 | public 31 | { Public declarations } 32 | end; 33 | 34 | var 35 | StringTranslateForm: TStringTranslateForm; 36 | 37 | implementation 38 | 39 | {$R *.dfm} 40 | 41 | 42 | procedure TStringTranslateForm.Hex2AsciiButtonClick(Sender: TObject); 43 | var 44 | s, n: u_String; 45 | c: Char; 46 | output: string; 47 | begin 48 | s := Memo1.Text; 49 | output := ''; 50 | 51 | while s <> '' do 52 | begin 53 | n := umlGetFirstStr(s, ','); 54 | s := umlDeleteFirstStr(s, ','); 55 | c := Char(umlStrToInt(n, 0)); 56 | output := output + c; 57 | end; 58 | 59 | Memo2.Text := output; 60 | end; 61 | 62 | procedure TStringTranslateForm.Ascii2HexButtonClick(Sender: TObject); 63 | var 64 | s: string; 65 | c: Char; 66 | cnt: Integer; 67 | output: string; 68 | begin 69 | s := Memo2.Text; 70 | output := ''; 71 | cnt := 0; 72 | for c in s do 73 | begin 74 | if cnt > 40 then 75 | begin 76 | output := Format('%s,' + #13#10 + '%s', [output, '$' + IntToHex(ord(c), 2)]); 77 | cnt := 0; 78 | end 79 | else 80 | begin 81 | if output <> '' then 82 | output := Format('%s, %s', [output, '$' + IntToHex(ord(c), 2)]) 83 | else 84 | output := '$' + IntToHex(ord(c), 2); 85 | end; 86 | 87 | inc(cnt); 88 | end; 89 | 90 | Memo1.Text := output; 91 | end; 92 | 93 | procedure TStringTranslateForm.Ascii2DeclButtonClick(Sender: TObject); 94 | var 95 | s: string; 96 | c: Char; 97 | cnt: Integer; 98 | output: string; 99 | begin 100 | s := Memo2.Text; 101 | output := ''; 102 | cnt := 0; 103 | for c in s do 104 | begin 105 | if cnt > 40 then 106 | begin 107 | output := Format('%s' + #13#10 + '%s', [output, '#' + IntToStr(ord(c))]); 108 | cnt := 0; 109 | end 110 | else 111 | begin 112 | if output <> '' then 113 | output := Format('%s%s', [output, '#' + IntToStr(ord(c))]) 114 | else 115 | output := '#' + IntToStr(ord(c)); 116 | end; 117 | 118 | inc(cnt); 119 | end; 120 | 121 | Memo1.Text := output; 122 | end; 123 | 124 | procedure TStringTranslateForm.Ascii2PascalDeclButtonClick(Sender: TObject); 125 | var 126 | i: Integer; 127 | begin 128 | Memo1.Clear; 129 | for i := 0 to Memo2.Lines.Count - 1 do 130 | begin 131 | if i = Memo2.Lines.Count - 1 then 132 | Memo1.Lines.Add(TTextParsing.TranslateTextToPascalDecl(Memo2.Lines[i] + #13#10) + ';') 133 | else 134 | Memo1.Lines.Add(TTextParsing.TranslateTextToPascalDecl(Memo2.Lines[i] + #13#10) + '+'); 135 | end; 136 | end; 137 | 138 | procedure TStringTranslateForm.PascalDecl2AsciiButtonClick(Sender: TObject); 139 | begin 140 | Memo2.Text:=EvaluateExpressionValue(tsPascal, Memo1.Text); 141 | end; 142 | 143 | procedure TStringTranslateForm.Ascii2cButtonClick(Sender: TObject); 144 | var 145 | i: Integer; 146 | begin 147 | Memo1.Clear; 148 | for i := 0 to Memo2.Lines.Count - 1 do 149 | begin 150 | if i = Memo2.Lines.Count - 1 then 151 | Memo1.Lines.Add(TTextParsing.TranslateTextToC_Decl(Memo2.Lines[i] + #13#10) + ';') 152 | else 153 | Memo1.Lines.Add(TTextParsing.TranslateTextToC_Decl(Memo2.Lines[i] + #13#10) + '+'); 154 | end; 155 | end; 156 | 157 | procedure TStringTranslateForm.c2AsciiButtonClick(Sender: TObject); 158 | begin 159 | Memo2.Text:=EvaluateExpressionValue(tsC, Memo1.Text); 160 | end; 161 | 162 | end. 163 | -------------------------------------------------------------------------------- /tools/ToolsPG.groupproj: -------------------------------------------------------------------------------- 1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003"> 2 | <PropertyGroup> 3 | <ProjectGuid>{B2F58E22-BD9A-4140-81D8-2AC370404D08}</ProjectGuid> 4 | </PropertyGroup> 5 | <ItemGroup> 6 | <Projects Include="StringTranslate\StringTranslate.dproj"> 7 | <Dependencies/> 8 | </Projects> 9 | <Projects Include="PascalCodeUnification\PascalCodeUnification.dproj"> 10 | <Dependencies/> 11 | </Projects> 12 | </ItemGroup> 13 | <ProjectExtensions> 14 | <Borland.Personality>Default.Personality.12</Borland.Personality> 15 | <Borland.ProjectType/> 16 | <BorlandProject> 17 | <Default.Personality/> 18 | </BorlandProject> 19 | </ProjectExtensions> 20 | <Target Name="StringTranslate"> 21 | <MSBuild Projects="StringTranslate\StringTranslate.dproj"/> 22 | </Target> 23 | <Target Name="StringTranslate:Clean"> 24 | <MSBuild Projects="StringTranslate\StringTranslate.dproj" Targets="Clean"/> 25 | </Target> 26 | <Target Name="StringTranslate:Make"> 27 | <MSBuild Projects="StringTranslate\StringTranslate.dproj" Targets="Make"/> 28 | </Target> 29 | <Target Name="PascalCodeUnification"> 30 | <MSBuild Projects="PascalCodeUnification\PascalCodeUnification.dproj"/> 31 | </Target> 32 | <Target Name="PascalCodeUnification:Clean"> 33 | <MSBuild Projects="PascalCodeUnification\PascalCodeUnification.dproj" Targets="Clean"/> 34 | </Target> 35 | <Target Name="PascalCodeUnification:Make"> 36 | <MSBuild Projects="PascalCodeUnification\PascalCodeUnification.dproj" Targets="Make"/> 37 | </Target> 38 | <Target Name="Build"> 39 | <CallTarget Targets="StringTranslate;PascalCodeUnification"/> 40 | </Target> 41 | <Target Name="Clean"> 42 | <CallTarget Targets="StringTranslate:Clean;PascalCodeUnification:Clean"/> 43 | </Target> 44 | <Target Name="Make"> 45 | <CallTarget Targets="StringTranslate:Make;PascalCodeUnification:Make"/> 46 | </Target> 47 | <Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/> 48 | </Project> 49 | --------------------------------------------------------------------------------