├── beep0.wav ├── beep1.wav ├── Ollama_Git.png ├── logollama.png ├── ollamawin.gif ├── O_chattings10.png ├── Ollma_Client.dres ├── Ollma_Client.res ├── SpeechLib_TLB.pas ├── Unit_Common.pas ├── ollamawaiting.gif ├── Android ├── ollama.png ├── OllamaClient.res ├── ollamallava.png ├── OllamaClient.dres ├── OllamaClientResource.rc ├── OllamaClient.Artwork │ └── Android │ │ ├── FM_LauncherIcon_36x36.png │ │ ├── FM_LauncherIcon_48x48.png │ │ ├── FM_LauncherIcon_72x72.png │ │ ├── FM_LauncherIcon_96x96.png │ │ ├── FM_LauncherIcon_144x144.png │ │ ├── FM_LauncherIcon_192x192.png │ │ ├── FM_SplashImage_426x320.png │ │ ├── FM_SplashImage_470x320.png │ │ ├── FM_SplashImage_640x480.png │ │ ├── FM_SplashImage_960x720.png │ │ ├── FM_NotificationIcon_24x24.png │ │ ├── FM_NotificationIcon_36x36.png │ │ ├── FM_NotificationIcon_48x48.png │ │ ├── FM_NotificationIcon_72x72.png │ │ ├── FM_NotificationIcon_96x96.png │ │ ├── FM_PlayStoreAppIcon_512x512.png │ │ ├── FM_AdaptiveIcon_Background.xml │ │ ├── FM_VectorizedNotificationIcon.xml │ │ ├── FM_AdaptiveIcon_Foreground.xml │ │ ├── FM_AdaptiveIcon_Monochrome.xml │ │ ├── FM_VectorizedSplash.xml │ │ ├── FM_VectorizedSplashDark.xml │ │ ├── FM_VectorizedSplashV31.xml │ │ └── FM_VectorizedSplashV31Dark.xml ├── Unit_Main.vlb ├── OllamaClient.dpr ├── DW.Androidapi.JNI.Widget.Toast.pas ├── AndroidManifest.template.xml ├── Unit_Setting.LgXhdpiPh.fmx ├── Unit_Setting.NmXhdpiPh.fmx ├── Unit_Collections.pas ├── DW.Toast.Android.pas ├── DW.JSON.pas └── Unit_Setting.pas ├── Images ├── O_about.png ├── O_chattings.png ├── O_welcome.png ├── android_1.png ├── android_2.png ├── android_3.png ├── GitHub_Icon2.png ├── GitHub_Icon3.png ├── O_chattings10.png ├── O_chattings2.png ├── O_chattings3.png ├── O_chattings4.png ├── O_chattings5.png ├── O_chattings6.png ├── O_chattings7.png ├── O_chattings8.png ├── O_chattings9.png ├── O_skin_themes.png ├── sn_20240618_070418_1.png ├── sn_20240618_071403_1.png └── sn_20240618_071425_1.png ├── Unit_Jsonworks.pas ├── Include ├── VirtualTrees.res ├── NetCom7 │ └── Source │ │ ├── ncLines.pas │ │ ├── _ncLines.pas │ │ ├── NetComRegister.dcr │ │ ├── NetComRegister.pas │ │ ├── ncSerializeValue.pas │ │ ├── ncCompression.pas │ │ ├── ncDBCommands.pas │ │ ├── ncSocketList.pas │ │ ├── ncCommandHandlers.pas │ │ ├── ncPendingCommandsList.pas │ │ ├── Encryption │ │ ├── ncEncTea.pas │ │ ├── ncEncRc5.pas │ │ ├── ncEncRc4.pas │ │ ├── ncEncRc2.pas │ │ └── ncEncRc6.pas │ │ └── ncCommandPacking.pas └── ReadMe.txt ├── Unit_ChattingBoxClass.pas ├── Ollma_Client.Artwork └── Windows │ ├── Uwp_44.png │ ├── AppIcon.icns │ ├── AppIcon.ico │ └── Uwp_150.png ├── Unit_RMBroker.vlb ├── Unit_DMServer.dfm ├── Ollma_ClientResource.rc ├── OllmaClient_Defines.inc ├── LICENSE ├── Unit_AliveOllama.dfm ├── README.md ├── Unit_RequestDialog.dfm ├── Ollma_Client.dpr ├── Unit_RequestDialog.pas ├── Unit_Translator.dfm ├── Unit_Welcome.pas ├── Unit_DosCommander.dfm ├── Unit_RMBroker.dfm ├── Unit_AliveOllama.pas ├── Unit_SysInfo.pas ├── Unit_Translator.pas ├── Unit_DosCommander.pas └── Unit_ImageDropDown.pas /beep0.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/beep0.wav -------------------------------------------------------------------------------- /beep1.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/beep1.wav -------------------------------------------------------------------------------- /Ollama_Git.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Ollama_Git.png -------------------------------------------------------------------------------- /logollama.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/logollama.png -------------------------------------------------------------------------------- /ollamawin.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/ollamawin.gif -------------------------------------------------------------------------------- /O_chattings10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/O_chattings10.png -------------------------------------------------------------------------------- /Ollma_Client.dres: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Ollma_Client.dres -------------------------------------------------------------------------------- /Ollma_Client.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Ollma_Client.res -------------------------------------------------------------------------------- /SpeechLib_TLB.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/SpeechLib_TLB.pas -------------------------------------------------------------------------------- /Unit_Common.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Unit_Common.pas -------------------------------------------------------------------------------- /ollamawaiting.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/ollamawaiting.gif -------------------------------------------------------------------------------- /Android/ollama.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/ollama.png -------------------------------------------------------------------------------- /Images/O_about.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_about.png -------------------------------------------------------------------------------- /Unit_Jsonworks.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Unit_Jsonworks.pas -------------------------------------------------------------------------------- /Images/O_chattings.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings.png -------------------------------------------------------------------------------- /Images/O_welcome.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_welcome.png -------------------------------------------------------------------------------- /Images/android_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/android_1.png -------------------------------------------------------------------------------- /Images/android_2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/android_2.png -------------------------------------------------------------------------------- /Images/android_3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/android_3.png -------------------------------------------------------------------------------- /Android/OllamaClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.res -------------------------------------------------------------------------------- /Android/ollamallava.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/ollamallava.png -------------------------------------------------------------------------------- /Images/GitHub_Icon2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/GitHub_Icon2.png -------------------------------------------------------------------------------- /Images/GitHub_Icon3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/GitHub_Icon3.png -------------------------------------------------------------------------------- /Images/O_chattings10.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings10.png -------------------------------------------------------------------------------- /Images/O_chattings2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings2.png -------------------------------------------------------------------------------- /Images/O_chattings3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings3.png -------------------------------------------------------------------------------- /Images/O_chattings4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings4.png -------------------------------------------------------------------------------- /Images/O_chattings5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings5.png -------------------------------------------------------------------------------- /Images/O_chattings6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings6.png -------------------------------------------------------------------------------- /Images/O_chattings7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings7.png -------------------------------------------------------------------------------- /Images/O_chattings8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings8.png -------------------------------------------------------------------------------- /Images/O_chattings9.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_chattings9.png -------------------------------------------------------------------------------- /Images/O_skin_themes.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/O_skin_themes.png -------------------------------------------------------------------------------- /Include/VirtualTrees.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Include/VirtualTrees.res -------------------------------------------------------------------------------- /Android/OllamaClient.dres: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.dres -------------------------------------------------------------------------------- /Unit_ChattingBoxClass.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Unit_ChattingBoxClass.pas -------------------------------------------------------------------------------- /Images/sn_20240618_070418_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/sn_20240618_070418_1.png -------------------------------------------------------------------------------- /Images/sn_20240618_071403_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/sn_20240618_071403_1.png -------------------------------------------------------------------------------- /Images/sn_20240618_071425_1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Images/sn_20240618_071425_1.png -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncLines.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Include/NetCom7/Source/ncLines.pas -------------------------------------------------------------------------------- /Include/NetCom7/Source/_ncLines.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Include/NetCom7/Source/_ncLines.pas -------------------------------------------------------------------------------- /Ollma_Client.Artwork/Windows/Uwp_44.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Ollma_Client.Artwork/Windows/Uwp_44.png -------------------------------------------------------------------------------- /Include/NetCom7/Source/NetComRegister.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Include/NetCom7/Source/NetComRegister.dcr -------------------------------------------------------------------------------- /Include/NetCom7/Source/NetComRegister.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Include/NetCom7/Source/NetComRegister.pas -------------------------------------------------------------------------------- /Ollma_Client.Artwork/Windows/AppIcon.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Ollma_Client.Artwork/Windows/AppIcon.icns -------------------------------------------------------------------------------- /Ollma_Client.Artwork/Windows/AppIcon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Ollma_Client.Artwork/Windows/AppIcon.ico -------------------------------------------------------------------------------- /Ollma_Client.Artwork/Windows/Uwp_150.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Ollma_Client.Artwork/Windows/Uwp_150.png -------------------------------------------------------------------------------- /Android/OllamaClientResource.rc: -------------------------------------------------------------------------------- 1 | OLLAMA RCDATA "ollama.png" 2 | LLAVA RCDATA "ollamallava.png" 3 | MYSTYLE RCDATA "MaterialOxfordBlueSE_Android.style" 4 | -------------------------------------------------------------------------------- /Unit_RMBroker.vlb: -------------------------------------------------------------------------------- 1 | [RESTClient_RM] 2 | Visible=False 3 | 4 | [RESTRequest_RM] 5 | Visible=False 6 | 7 | [RESTResponse_RM] 8 | Visible=False 9 | 10 | -------------------------------------------------------------------------------- /Unit_DMServer.dfm: -------------------------------------------------------------------------------- 1 | object DM_Server: TDM_Server 2 | OnCreate = DataModuleCreate 3 | OnDestroy = DataModuleDestroy 4 | Height = 298 5 | Width = 245 6 | end 7 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_LauncherIcon_36x36.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_LauncherIcon_36x36.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_LauncherIcon_48x48.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_LauncherIcon_48x48.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_LauncherIcon_72x72.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_LauncherIcon_72x72.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_LauncherIcon_96x96.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_LauncherIcon_96x96.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_LauncherIcon_144x144.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_LauncherIcon_144x144.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_LauncherIcon_192x192.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_LauncherIcon_192x192.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_SplashImage_426x320.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_SplashImage_426x320.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_SplashImage_470x320.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_SplashImage_470x320.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_SplashImage_640x480.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_SplashImage_640x480.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_SplashImage_960x720.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_SplashImage_960x720.png -------------------------------------------------------------------------------- /Ollma_ClientResource.rc: -------------------------------------------------------------------------------- 1 | BEEP0 RCDATA "beep0.wav" 2 | BEEP1 RCDATA "beep1.wav" 3 | OLOGO RCDATA "logollama.png" 4 | OWAITTING RCDATA "ollamawaiting.gif" 5 | OWIN RCDATA "ollamawin.gif" 6 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_NotificationIcon_24x24.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_NotificationIcon_24x24.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_NotificationIcon_36x36.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_NotificationIcon_36x36.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_NotificationIcon_48x48.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_NotificationIcon_48x48.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_NotificationIcon_72x72.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_NotificationIcon_72x72.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_NotificationIcon_96x96.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_NotificationIcon_96x96.png -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_PlayStoreAppIcon_512x512.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/HuichanKIM/Ollama-Delphi-GUI/HEAD/Android/OllamaClient.Artwork/Android/FM_PlayStoreAppIcon_512x512.png -------------------------------------------------------------------------------- /Android/Unit_Main.vlb: -------------------------------------------------------------------------------- 1 | [SourceImage] 2 | Coordinates=190,386,79,51 3 | 4 | [StatusBar1] 5 | Coordinates=498,454,68,33 6 | 7 | [] 8 | Coordinates=132,522,58,33 9 | Visible=True 10 | 11 | [Button_Request] 12 | Coordinates=790,386,92,51 13 | 14 | [Layout_ModelUser] 15 | Coordinates=209,522,53,33 16 | 17 | [Layout_Request] 18 | Coordinates=665,454,53,33 19 | 20 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_AdaptiveIcon_Background.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Include/ReadMe.txt: -------------------------------------------------------------------------------- 1 | Original Source (by JAM-Software / Virtual-TreeView) 2 | Download at https://github.com/JAM-Software/Virtual-TreeView 3 | 4 | Modified parts ... 5 | - Partial modification (line number 14237) - procedure PrepareCell of VirtualTrees.BaseTree 6 | - Partial modification (line number 1469) - procedure DoTextDrawing of VirtualTrees.pas 7 | 8 | After Install JAM-Software/Virtual-TreeView 9 | 10 | Add ".\Include" to [Search path] in Project options. 11 | 12 | or work around other way ... -------------------------------------------------------------------------------- /Android/OllamaClient.dpr: -------------------------------------------------------------------------------- 1 | program OllamaClient; 2 | 3 | {$R *.dres} 4 | 5 | uses 6 | System.StartUpCopy, 7 | FMX.MobilePreview, 8 | FMX.Forms, 9 | FMX.Types, 10 | DW.Androidapi.JNI.Widget.Toast in 'DW.Androidapi.JNI.Widget.Toast.pas', 11 | DW.Toast.Android in 'DW.Toast.Android.pas', 12 | DW.JSON in 'DW.JSON.pas', 13 | Unit_Main in 'Unit_Main.pas' {MainForm}, 14 | Unit_Setting in 'Unit_Setting.pas' {Form_Setting}; 15 | 16 | {$R *.res} 17 | 18 | begin 19 | Application.Initialize; 20 | Application.CreateForm(TMainForm, MainForm); 21 | Application.CreateForm(TForm_Setting, Form_Setting); 22 | Application.Run; 23 | end. 24 | -------------------------------------------------------------------------------- /OllmaClient_Defines.inc: -------------------------------------------------------------------------------- 1 | {===================================================================================== 2 | Ollama-Delphi-GUI Compiler Directives. 3 | -Inspired from OllamaBox by tinyBigGAMES ( https://github.com/tinyBigGAMES/OllamaBox) 4 | ======================================================================================} 5 | 6 | {$WARN SYMBOL_DEPRECATED OFF} 7 | {$WARN SYMBOL_PLATFORM OFF} 8 | 9 | {$WARN UNIT_PLATFORM OFF} 10 | {$WARN UNIT_DEPRECATED OFF} 11 | 12 | {$WARN UNSUPPORTED_CONSTRUCT OFF} 13 | 14 | {$Z4} 15 | {$A8} 16 | {$INLINE AUTO} 17 | 18 | {$IF (CompilerVersion < 36.0)} 19 | {$MESSAGE Error 'Must use Delphi 12 or higher'} 20 | {$IFEND} 21 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_VectorizedNotificationIcon.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_AdaptiveIcon_Foreground.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_AdaptiveIcon_Monochrome.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_VectorizedSplash.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_VectorizedSplashDark.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_VectorizedSplashV31.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Android/OllamaClient.Artwork/Android/FM_VectorizedSplashV31Dark.xml: -------------------------------------------------------------------------------- 1 | 7 | 8 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncSerializeValue.pas: -------------------------------------------------------------------------------- 1 | unit ncSerializeValue; 2 | 3 | interface 4 | 5 | uses Rtti; 6 | 7 | implementation 8 | var 9 | RttiContext: TRttiContext; 10 | 11 | { Value ToBytes: 12 | if Data.IsEmpty then 13 | WriteString('nil') 14 | else 15 | begin 16 | // Write Data (TncValue) string name 17 | 18 | WriteString(RttiContext.GetType(Data.TypeInfo).QualifiedName); 19 | 20 | // Append Data (TncValue) contents 21 | Len := Length(Result); 22 | SetLength(Result, Len + Data.DataSize); 23 | Data.ExtractRawData(@Result[Len]); 24 | end; 25 | 26 | Value FromBytes: 27 | // Read Data (TncValue) string name 28 | TypeName := ReadString; 29 | 30 | // Read Data (TncValue) contents 31 | if TypeName = 'nil' then 32 | Data := nil 33 | else 34 | TValue.Make(@aBytes[Ofs], RttiContext.FindType(TypeName).Handle, Data); 35 | 36 | } 37 | 38 | initialization 39 | 40 | RttiContext := TRttiContext.Create; 41 | 42 | finalization 43 | 44 | RttiContext.Free; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2024 Huichan KIM 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncCompression.pas: -------------------------------------------------------------------------------- 1 | unit ncCompression; 2 | 3 | // To disable as much of RTTI as possible (Delphi 2009/2010), 4 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 5 | {$IF CompilerVersion >= 21.0} 6 | {$WEAKLINKRTTI ON} 7 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 8 | {$ENDIF} 9 | 10 | interface 11 | 12 | uses System.ZLib, System.Classes, System.SysUtils; 13 | 14 | type 15 | TncCompressionLevel = TZCompressionLevel; 16 | 17 | function CompressBytes(const aBytes: TBytes; aCompressionLevel: TncCompressionLevel = zcDefault): TBytes; 18 | function DecompressBytes(const aBytes: TBytes): TBytes; 19 | 20 | implementation 21 | 22 | function CompressBytes(const aBytes: TBytes; aCompressionLevel: TncCompressionLevel = zcDefault): TBytes; 23 | begin 24 | if Length(aBytes) > 0 then 25 | ZCompress(aBytes, Result, aCompressionLevel) 26 | else 27 | SetLength(Result, 0); 28 | end; 29 | 30 | function DecompressBytes(const aBytes: TBytes): TBytes; 31 | begin 32 | if Length(aBytes) > 0 then 33 | ZDecompress(aBytes, Result, Length(aBytes) * 128) 34 | else 35 | SetLength(Result, 0); 36 | end; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Unit_AliveOllama.dfm: -------------------------------------------------------------------------------- 1 | object Form_AliveOllama: TForm_AliveOllama 2 | Left = 0 3 | Top = 0 4 | ActiveControl = Button_OK 5 | BorderIcons = [biSystemMenu] 6 | BorderStyle = bsSingle 7 | Caption = ' Ollama Alive Checker' 8 | ClientHeight = 203 9 | ClientWidth = 224 10 | Color = clWindow 11 | Ctl3D = False 12 | Font.Charset = DEFAULT_CHARSET 13 | Font.Color = clSilver 14 | Font.Height = -12 15 | Font.Name = 'Segoe UI' 16 | Font.Style = [] 17 | FormStyle = fsStayOnTop 18 | KeyPreview = True 19 | Position = poDesigned 20 | OnCloseQuery = FormCloseQuery 21 | OnKeyPress = FormKeyPress 22 | OnShow = FormShow 23 | TextHeight = 15 24 | object GroupBox1: TGroupBox 25 | Left = 3 26 | Top = 8 27 | Width = 213 28 | Height = 65 29 | Caption = 'Ollama IP' 30 | TabOrder = 0 31 | object SpeedButton_Check: TSpeedButton 32 | Left = 155 33 | Top = 25 34 | Width = 47 35 | Height = 21 36 | Caption = 'Check' 37 | OnClick = SpeedButton_CheckClick 38 | end 39 | object Edit1: TEdit 40 | Left = 12 41 | Top = 25 42 | Width = 136 43 | Height = 21 44 | ReadOnly = True 45 | TabOrder = 0 46 | Text = 'http://localhost:11434' 47 | end 48 | end 49 | object Memo_Alive: TMemo 50 | Left = 3 51 | Top = 83 52 | Width = 213 53 | Height = 73 54 | TabOrder = 1 55 | StyleElements = [seClient, seBorder] 56 | end 57 | object Button_OK: TButton 58 | Left = 158 59 | Top = 168 60 | Width = 58 61 | Height = 25 62 | Caption = 'OK' 63 | ModalResult = 1 64 | TabOrder = 2 65 | end 66 | end 67 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Ollama-Delphi-GUI 2 | 3 | ### Latest Version 1.1.1 - 2025.05.06 4 | 5 | ### Features 6 | - Supports Request-History Manager, Chat with history 7 | - Supports Multimodal Image Analysis (Gemma3, Llava ... ) and Reasoning (Cogito, Deepseek ...) 8 | - Themes (Windows11 Impressive Dark, Windows10 SlateGray) according to user preferences of Windows Theme 9 | - Supports Windows 10 and 11 (for 64 bits). 10 | - If your computer has good performance, use it as a server/broker to connect your Android smartphone 11 | 12 | 13 | ### Prerequisites 14 | 15 | 1. Ollama Install 16 | 2. Pull Models to Ollama (Cogito, Gemma3, Phi4, llama3, DeepSeek, Llava ...) 17 | 3. Delphi Athens 12.0. over 18 | 19 | 20 | ### 3rd party Library (Open source for Delphi developers) 21 | 22 | - SVGIconImageList by EtheaDev 23 | - DOSCommand by TurboPack 24 | - Virtual-TreeView by JAM-Software 25 | - NetCom7 26 | - EasyJson 27 | 28 | 29 | ### About / Skin / Colors (Screenshot) 30 | 31 | ![About 1: Preview page](./Images/O_about.png) ![About 2: Preview page](./Images/O_skin_themes.png) 32 | 33 | ### Android (Screenshot) 34 | 35 | ![Android 1: Preview page](./Images/android_1.png) ![Android 2: Preview page](./Images/android_2.png) 36 | ![Android 3: Preview page](./Images/android_3.png) 37 | 38 | ### Chattings (Screenshot) 39 | 40 | ![Chattings 1: Preview page](./Images/O_chattings.png) 41 | 42 | ![Chattings 2: Preview page](./Images/O_chattings2.png) 43 | 44 | ![Chattings 3: Preview page](./Images/O_chattings3.png) 45 | 46 | ![Chattings 4: Preview page](./Images/O_chattings4.png) 47 | 48 | ![Chattings 5: Preview page](./Images/O_chattings5.png) 49 | 50 | ### Skin ( Windows10 SlateGray, Windows11 Impressive Dark, Windows11 Modern Dark ) 51 | ![Chattings 7: Preview page](./Images/O_chattings6.png) 52 | 53 | ![Chattings 8: Preview page](./Images/O_chattings7.png) 54 | 55 | ### Multimodal ( Gemma3, Llava ...) - Image Analysis 56 | ![Chattings 9: Preview page](./Images/O_chattings10.png) 57 | -------------------------------------------------------------------------------- /Android/DW.Androidapi.JNI.Widget.Toast.pas: -------------------------------------------------------------------------------- 1 | unit DW.Androidapi.JNI.Widget.Toast; 2 | 3 | {*******************************************************} 4 | { } 5 | { Kastri } 6 | { } 7 | { Delphi Worlds Cross-Platform Library } 8 | { } 9 | { Copyright 2020-2024 Dave Nottage under MIT license } 10 | { which is located in the root folder of this library } 11 | { } 12 | {*******************************************************} 13 | 14 | interface 15 | 16 | uses 17 | Androidapi.JNIBridge, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes; 18 | 19 | type 20 | JToast = interface; 21 | 22 | JToastClass = interface(JObjectClass) 23 | ['{68CA26BB-66F9-4253-B348-40D4A6841874}'] 24 | {class} function _GetLENGTH_LONG: Integer; cdecl; 25 | {class} function _GetLENGTH_SHORT: Integer; cdecl; 26 | {class} function init(context: JContext): JToast; cdecl; overload; 27 | {class} function makeText(context: JContext; text: JCharSequence; duration: Integer): JToast; cdecl; 28 | {class} property LENGTH_LONG: Integer read _GetLENGTH_LONG; 29 | {class} property LENGTH_SHORT: Integer read _GetLENGTH_SHORT; 30 | end; 31 | 32 | [JavaSignature('android/widget/Toast')] 33 | JToast = interface(JObject) 34 | ['{17E599B9-E074-4226-B5B7-BDCE114FDD6A}'] 35 | procedure cancel; cdecl; 36 | function getDuration: Integer; cdecl; 37 | function getGravity: Integer; cdecl; 38 | function getHorizontalMargin: Single; cdecl; 39 | function getVerticalMargin: Single; cdecl; 40 | function getView: JView; cdecl; 41 | function getXOffset: Integer; cdecl; 42 | function getYOffset: Integer; cdecl; 43 | procedure setDuration(value: Integer); cdecl; 44 | procedure setGravity(gravity, xOffset, yOffset: Integer); cdecl; 45 | procedure setMargin(horizontalMargin, verticalMargin: Single); cdecl; 46 | procedure setText(text: JCharSequence); cdecl; 47 | procedure setView(view: JView); cdecl; 48 | procedure show; cdecl; 49 | end; 50 | TJToast = class(TJavaGenericImport) end; 51 | 52 | implementation 53 | 54 | end. 55 | 56 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncDBCommands.pas: -------------------------------------------------------------------------------- 1 | unit ncDBCommands; 2 | 3 | interface 4 | 5 | uses Classes, SysUtils, DB, ADODB, ADOInt, ncCommandPacking, ncSources, ncSerializeADO; 6 | 7 | const 8 | ncDBOpenDataset = 0; // uses TDBDatasetData as param 9 | ncDBCloseDataset = 1; // uses no params 10 | ncDBUpdateDataset = 2; // uses TDBUpdateDatasetData as param 11 | ncDBExecDataset = 3; // uses TDBDatasetData as param 12 | 13 | type 14 | TDBDatasetData = class 15 | public 16 | SQL: string; 17 | Parameters: TBytes; 18 | 19 | constructor Create; 20 | destructor Destroy; override; 21 | 22 | function FromBytes(aBytes: TBytes): Integer; virtual; 23 | function ToBytes: TBytes; virtual; 24 | end; 25 | 26 | TDBUpdateDatasetData = class(TDBDatasetData) 27 | public 28 | RecordUpdates: _Recordset; 29 | 30 | constructor Create; 31 | destructor Destroy; override; 32 | 33 | function FromBytes(aBytes: TBytes): Integer; override; 34 | function ToBytes: TBytes; override; 35 | end; 36 | 37 | implementation 38 | 39 | { TDBOpenDatasetData } 40 | 41 | constructor TDBDatasetData.Create; 42 | begin 43 | inherited Create; 44 | SetLength(Parameters, 0); 45 | end; 46 | 47 | destructor TDBDatasetData.Destroy; 48 | begin 49 | inherited; 50 | end; 51 | 52 | function TDBDatasetData.FromBytes(aBytes: TBytes): Integer; 53 | begin 54 | Result := 0; 55 | 56 | SQL := ReadString(aBytes, Result); 57 | Parameters := ReadBytes(aBytes, Result); 58 | end; 59 | 60 | function TDBDatasetData.ToBytes: TBytes; 61 | var 62 | BufLen: Integer; 63 | begin 64 | // This is intended for the use of WriteMessageEmbeddedBufferLen 65 | SetLength(Result, 0); 66 | BufLen := 0; 67 | 68 | WriteString(SQL, Result, BufLen); 69 | WriteBytes(Parameters, Result, BufLen); 70 | end; 71 | 72 | { TDBUpdateDatasetData } 73 | 74 | constructor TDBUpdateDatasetData.Create; 75 | begin 76 | inherited Create; 77 | RecordUpdates := nil; 78 | end; 79 | 80 | destructor TDBUpdateDatasetData.Destroy; 81 | begin 82 | if Assigned(RecordUpdates) then 83 | RecordUpdates := nil; 84 | 85 | inherited; 86 | end; 87 | 88 | function TDBUpdateDatasetData.FromBytes(aBytes: TBytes): Integer; 89 | begin 90 | Result := inherited FromBytes(aBytes); 91 | 92 | RecordUpdates := BytesToRecordset(ReadBytes(aBytes, Result)); 93 | end; 94 | 95 | function TDBUpdateDatasetData.ToBytes: TBytes; 96 | var 97 | BufLen: Integer; 98 | begin 99 | Result := inherited ToBytes; 100 | BufLen := Length(Result); 101 | 102 | WriteBytes(RecordsetToBytes(RecordUpdates, pfADTG), Result, BufLen); 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /Android/AndroidManifest.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 9 | 10 | <%uses-permission%> 11 | 12 | 13 | <%queries-child-elements%> 14 | 15 | 26 | <%provider%> 27 | <%application-meta-data%> 28 | <%uses-libraries%> 29 | 30 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | <%services%> 42 | 44 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | <%activity%> 60 | <%receivers%> 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /Unit_RequestDialog.dfm: -------------------------------------------------------------------------------- 1 | object Form_RequestDialog: TForm_RequestDialog 2 | Left = 0 3 | Top = 0 4 | Cursor = crHandPoint 5 | ActiveControl = Memo_Request 6 | BorderStyle = bsDialog 7 | Caption = 'Chatting Dialog' 8 | ClientHeight = 230 9 | ClientWidth = 364 10 | Color = clBtnFace 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clWindowText 13 | Font.Height = -12 14 | Font.Name = 'Segoe UI' 15 | Font.Style = [] 16 | FormStyle = fsStayOnTop 17 | KeyPreview = True 18 | Position = poDefault 19 | OnCreate = FormCreate 20 | OnKeyPress = FormKeyPress 21 | OnShow = FormShow 22 | DesignSize = ( 23 | 364 24 | 230) 25 | TextHeight = 15 26 | object Label1: TLabel 27 | Left = 8 28 | Top = 8 29 | Width = 97 30 | Height = 15 31 | Caption = 'Prompt / Message' 32 | end 33 | object Label_Clear: TLabel 34 | Left = 334 35 | Top = 9 36 | Width = 26 37 | Height = 13 38 | Cursor = crHandPoint 39 | Anchors = [akTop, akRight] 40 | Caption = 'Clear' 41 | Font.Charset = DEFAULT_CHARSET 42 | Font.Color = clSilver 43 | Font.Height = -11 44 | Font.Name = 'Segoe UI' 45 | Font.Style = [] 46 | ParentFont = False 47 | StyleElements = [seClient, seBorder] 48 | OnClick = Label_ClearClick 49 | ExplicitLeft = 315 50 | end 51 | object SpeedButton_Trans: TSpeedButton 52 | Left = 260 53 | Top = 6 54 | Width = 67 55 | Height = 17 56 | Anchors = [akTop, akRight] 57 | Caption = 'Trans.' 58 | ImageIndex = 39 59 | ImageName = 'ic_format_size_48px' 60 | Images = Form_RestOllama.SVGIconVirtualImageList1 61 | OnClick = SpeedButton_TransClick 62 | ExplicitLeft = 241 63 | end 64 | object Label2: TLabel 65 | Left = 8 66 | Top = 196 67 | Width = 170 68 | Height = 15 69 | Caption = '* Invalid characters: ", {, }, [, ]' 70 | Font.Charset = DEFAULT_CHARSET 71 | Font.Color = clRed 72 | Font.Height = -12 73 | Font.Name = 'Segoe UI' 74 | Font.Style = [fsBold] 75 | ParentFont = False 76 | Visible = False 77 | StyleElements = [seClient, seBorder] 78 | end 79 | object Button_OK: TButton 80 | Left = 275 81 | Top = 192 82 | Width = 82 83 | Height = 25 84 | Anchors = [akRight, akBottom] 85 | Caption = 'Request' 86 | ImageIndex = 12 87 | ImageName = 'All\ic_send_48px' 88 | Images = Form_RestOllama.SVGIconVirtualImageList1 89 | ModalResult = 1 90 | TabOrder = 0 91 | ExplicitLeft = 256 92 | end 93 | object Memo_Request: TMemo 94 | AlignWithMargins = True 95 | Left = 5 96 | Top = 29 97 | Width = 354 98 | Height = 149 99 | Anchors = [akLeft, akTop, akRight, akBottom] 100 | Lines.Strings = ( 101 | 'Memo_Request') 102 | ScrollBars = ssVertical 103 | TabOrder = 1 104 | ExplicitWidth = 335 105 | end 106 | end 107 | -------------------------------------------------------------------------------- /Ollma_Client.dpr: -------------------------------------------------------------------------------- 1 | program Ollma_Client; 2 | 3 | {$R *.dres} 4 | 5 | uses 6 | FastMM4, 7 | System.SysUtils, 8 | WinApi.Windows, 9 | Vcl.Forms, 10 | Vcl.Themes, 11 | Vcl.Styles, 12 | System.Skia, 13 | Vcl.Skia, 14 | VirtualTrees.BaseTree in 'Include\VirtualTrees.BaseTree.pas', 15 | VirtualTrees in 'Include\VirtualTrees.pas', 16 | ncLines in 'Include\NetCom7\Source\ncLines.pas', 17 | EasyJson in 'Include\EasyJson.pas', 18 | DosCommand in 'Include\DosCommand\DosCommand.pas', 19 | Unit_Common in 'Unit_Common.pas', 20 | Unit_SysInfo in 'Unit_SysInfo.pas', 21 | Unit_MRUManager in 'Unit_MRUManager.pas', 22 | Unit_ImageDropDown in 'Unit_ImageDropDown.pas', 23 | SpeechLib_TLB in 'SpeechLib_TLB.pas', 24 | Unit_Jsonworks in 'Unit_Jsonworks.pas', 25 | Unit_HistoryManager in 'Unit_HistoryManager.pas', 26 | Unit_Welcome in 'Unit_Welcome.pas' {Frame_Welcome: TFrame}, 27 | Unit_Main in 'Unit_Main.pas' {Form_RestOllama: TForm}, 28 | Unit_AliveOllama in 'Unit_AliveOllama.pas' {TForm_AliveOllama}, 29 | Unit_Translator in 'Unit_Translator.pas' {TForm_Translator}, 30 | Unit_About in 'Unit_About.pas' {TForm_About}, 31 | Unit_RequestDialog in 'Unit_RequestDialog.pas' {Form_RequestDialog: TForm}, 32 | Unit_ChattingBoxClass in 'Unit_ChattingBoxClass.pas' {Frame_ChattingBoxClass: TFrame}, 33 | Unit_DosCommander in 'Unit_DosCommander.pas' {TForm_DosCommander}, 34 | Unit_DMServer in 'Unit_DMServer.pas' {DM_Server: TDataModule}, 35 | Unit_RMBroker in 'Unit_RMBroker.pas' {Form_RMBroker: TForm}; 36 | 37 | {$R *.res} 38 | 39 | {$IFDEF WIN64} 40 | {$SETPEOPTFLAGS $160} 41 | {$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE} 42 | {$ENDIF} 43 | 44 | const 45 | _AppTitle: string = 'Ollama Client GUI'; 46 | _AppWarning: string = 'Ollama Client GUI is already running...'; 47 | 48 | var 49 | _mxHandle: THandle = 0; 50 | begin 51 | var _RunTime := Application.MainForm = nil; 52 | if _RunTime then 53 | begin 54 | _mxHandle := CreateMutex(nil, False, PChar(_AppTitle)); 55 | if GetLastError = ERROR_ALREADY_EXISTS then 56 | begin 57 | var _dummy := MessageBox(0, PChar(_AppWarning), PChar(_AppTitle), MB_OK or MB_ICONINFORMATION); 58 | Halt(0); 59 | end; 60 | end 61 | else 62 | begin 63 | var _dummy := MessageBox(0, PChar(_AppWarning), PChar(_AppTitle), MB_OK or MB_ICONINFORMATION); 64 | Halt(0); 65 | end; 66 | 67 | if _mxHandle <> 0 then 68 | try 69 | Application.Initialize; 70 | Application.MainFormOnTaskbar := True; 71 | TStyleManager.TrySetStyle('Windows11 Impressive Dark'); 72 | //Uses System Style for border / shadow of Forms ... 73 | //TStyleManager.FormBorderStyle := TStyleManager.TFormBorderStyle.fbsSystemStyle; 74 | Application.Title := 'Ollama Client GUI'; 75 | Application.CreateForm(TForm_RestOllama, Form_RestOllama); 76 | Application.CreateForm(TForm_RequestDialog, Form_RequestDialog); 77 | Application.CreateForm(TDM_Server, DM_Server); 78 | Application.CreateForm(TForm_RMBroker, Form_RMBroker); 79 | Application.Run; 80 | finally 81 | CloseHandle(_mxHandle); 82 | end; 83 | end. 84 | -------------------------------------------------------------------------------- /Unit_RequestDialog.pas: -------------------------------------------------------------------------------- 1 | unit Unit_RequestDialog; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | Winapi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | Vcl.Graphics, 12 | Vcl.Controls, 13 | Vcl.Forms, 14 | Vcl.Dialogs, 15 | Vcl.StdCtrls, 16 | Vcl.Buttons; 17 | 18 | type 19 | TForm_RequestDialog = class(TForm) 20 | Memo_Request: TMemo; 21 | Button_OK: TButton; 22 | Label1: TLabel; 23 | Label_Clear: TLabel; 24 | SpeedButton_Trans: TSpeedButton; 25 | Label2: TLabel; 26 | procedure FormCreate(Sender: TObject); 27 | procedure FormShow(Sender: TObject); 28 | procedure FormKeyPress(Sender: TObject; var Key: Char); 29 | procedure Label_ClearClick(Sender: TObject); 30 | procedure SpeedButton_TransClick(Sender: TObject); 31 | private 32 | FPreLoader: string; 33 | FCode_From: Integer; 34 | FCode_to: Integer; 35 | procedure SetPreLoader(const Value: string); 36 | public 37 | // property ... 38 | property PreLoader: string read FPreLoader write SetPreLoader; 39 | property Code_From: Integer read FCode_From write FCode_From; 40 | property Code_to: Integer read FCode_to write FCode_To; 41 | end; 42 | 43 | var 44 | Form_RequestDialog: TForm_RequestDialog; 45 | 46 | implementation 47 | 48 | uses 49 | System.RegularExpressions, 50 | Unit_Translator, 51 | Unit_Main, 52 | Unit_Common; 53 | 54 | {$R *.dfm} 55 | 56 | procedure TForm_RequestDialog.FormCreate(Sender: TObject); 57 | begin 58 | Memo_Request.lines.clear; 59 | end; 60 | 61 | procedure TForm_RequestDialog.FormKeyPress(Sender: TObject; var Key: Char); 62 | begin 63 | if Key = #27 then 64 | begin 65 | Key := #0; 66 | ModalResult := mrCancel; 67 | end; 68 | end; 69 | 70 | procedure TForm_RequestDialog.FormShow(Sender: TObject); 71 | begin 72 | if Memo_Request.CanFocus then // Change Style Event ? 73 | begin 74 | Memo_Request.SetFocus; 75 | Memo_Request.SelectAll; 76 | end; 77 | end; 78 | 79 | procedure TForm_RequestDialog.Label_ClearClick(Sender: TObject); 80 | begin 81 | Memo_Request.Lines.Clear; 82 | end; 83 | 84 | procedure TForm_RequestDialog.SetPreLoader(const Value: string); 85 | begin 86 | FPreLoader := Value; 87 | Memo_Request.Lines.Text := Value; 88 | end; 89 | 90 | procedure TForm_RequestDialog.SpeedButton_TransClick(Sender: TObject); 91 | begin 92 | var _ItemStr := Trim(Memo_Request.Lines.Text); 93 | if _ItemStr = '' then 94 | begin 95 | ShowMessage('Can not translate for empty string'); 96 | Exit; 97 | end; 98 | 99 | var _codefrom := FCode_From; 100 | var _codeto := FCode_to; 101 | if Is_Hangul(_ItemStr) then 102 | begin 103 | _codefrom := 1; 104 | _codeto := 0; 105 | end; 106 | 107 | if _ItemStr <> '' then 108 | begin 109 | _ItemStr := Get_ReplaceSpecialChar4Trans(_ItemStr); 110 | Memo_Request.Lines.Text := Get_GoogleTranslatorEx(0, _codefrom, _codeto, _ItemStr); 111 | end; 112 | end; 113 | 114 | end. 115 | -------------------------------------------------------------------------------- /Unit_Translator.dfm: -------------------------------------------------------------------------------- 1 | object Form_Translator: TForm_Translator 2 | Left = 0 3 | Top = 0 4 | ActiveControl = Button_OK 5 | BorderStyle = bsDialog 6 | Caption = 'Translator - https://translate.googleapis.com' 7 | ClientHeight = 399 8 | ClientWidth = 514 9 | Color = clBtnFace 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -12 13 | Font.Name = 'Segoe UI' 14 | Font.Style = [] 15 | FormStyle = fsStayOnTop 16 | KeyPreview = True 17 | Position = poMainFormCenter 18 | RoundedCorners = rcOn 19 | OnClose = FormClose 20 | OnCreate = FormCreate 21 | OnKeyPress = FormKeyPress 22 | OnShow = FormShow 23 | TextHeight = 15 24 | object Panel_Buttons: TPanel 25 | AlignWithMargins = True 26 | Left = 3 27 | Top = 361 28 | Width = 508 29 | Height = 35 30 | Align = alBottom 31 | BevelOuter = bvNone 32 | TabOrder = 0 33 | DesignSize = ( 34 | 508 35 | 35) 36 | object Button_OK: TButton 37 | Left = 419 38 | Top = 8 39 | Width = 75 40 | Height = 25 41 | Anchors = [akTop, akRight] 42 | Caption = 'OK' 43 | ModalResult = 1 44 | TabOrder = 0 45 | end 46 | object CheckBox_Pushtochatbox: TCheckBox 47 | Left = 272 48 | Top = 12 49 | Width = 129 50 | Height = 17 51 | Alignment = taLeftJustify 52 | Caption = 'Push to chat box' 53 | Font.Charset = DEFAULT_CHARSET 54 | Font.Color = clSilver 55 | Font.Height = -13 56 | Font.Name = 'Segoe UI' 57 | Font.Style = [] 58 | ParentFont = False 59 | TabOrder = 1 60 | StyleElements = [seClient, seBorder] 61 | end 62 | end 63 | object Memo_Translates: TMemo 64 | AlignWithMargins = True 65 | Left = 3 66 | Top = 39 67 | Width = 508 68 | Height = 316 69 | Align = alClient 70 | BevelOuter = bvNone 71 | Font.Charset = DEFAULT_CHARSET 72 | Font.Color = clSilver 73 | Font.Height = -12 74 | Font.Name = 'Segoe UI' 75 | Font.Style = [] 76 | Lines.Strings = ( 77 | 'Memo_Translates') 78 | ParentFont = False 79 | ReadOnly = True 80 | ScrollBars = ssVertical 81 | TabOrder = 1 82 | StyleElements = [seClient, seBorder] 83 | end 84 | object Panel_Tollbar: TPanel 85 | AlignWithMargins = True 86 | Left = 3 87 | Top = 3 88 | Width = 508 89 | Height = 30 90 | Align = alTop 91 | Alignment = taLeftJustify 92 | BevelOuter = bvNone 93 | ShowCaption = False 94 | TabOrder = 2 95 | object Label_Prompt: TLabel 96 | AlignWithMargins = True 97 | Left = 3 98 | Top = 3 99 | Width = 495 100 | Height = 24 101 | Margins.Right = 10 102 | Align = alClient 103 | AutoSize = False 104 | Caption = 'Prompt ' 105 | EllipsisPosition = epEndEllipsis 106 | Font.Charset = DEFAULT_CHARSET 107 | Font.Color = clSilver 108 | Font.Height = -12 109 | Font.Name = 'Segoe UI' 110 | Font.Style = [] 111 | ParentFont = False 112 | ExplicitWidth = 49 113 | ExplicitHeight = 15 114 | end 115 | end 116 | end 117 | -------------------------------------------------------------------------------- /Unit_Welcome.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Welcome; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | Winapi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | System.Types, 12 | Vcl.Graphics, 13 | Vcl.Controls, 14 | Vcl.Forms, 15 | Vcl.Dialogs, 16 | System.Skia, 17 | Vcl.Skia, 18 | Vcl.ExtCtrls; 19 | 20 | type 21 | TFrame_Welcome = class(TFrame) 22 | SkSvg_ICon: TSkSvg; 23 | SkLabel_Clicktohome: TSkLabel; 24 | SkLabel_Intro: TSkLabel; 25 | SkAnimatedImage_Alive: TSkAnimatedImage; 26 | SkPaintBox_Intro: TSkPaintBox; 27 | procedure FrameResize(Sender: TObject); 28 | procedure SkPaintBox_IntroDraw(ASender: TObject; const ACanvas: ISkCanvas; const ADest: TRectF; const AOpacity: Single); 29 | private 30 | FAnimationFlag: Boolean; 31 | FVisibleBounds: Boolean; 32 | procedure SetAnimationFlag(const Value: Boolean); 33 | procedure SetVisibleBounds(const Value: Boolean); 34 | public 35 | property VisibleBounds: Boolean read FVisibleBounds write SetVisibleBounds; 36 | property AnimationFlag: Boolean read FAnimationFlag write SetAnimationFlag; 37 | end; 38 | 39 | implementation 40 | 41 | uses 42 | System.Math, 43 | System.UITypes, 44 | Unit_Common; 45 | 46 | {$R *.dfm} 47 | 48 | { TFrame_Welcome } 49 | 50 | procedure TFrame_Welcome.FrameResize(Sender: TObject); 51 | begin 52 | SkSvg_ICon.Left := (SkLabel_Intro.Width - SkSvg_ICon.Width) div 2; 53 | SkSvg_ICon.Top := (SkLabel_Intro.Height div 4)-10; 54 | SkAnimatedImage_Alive.Left := (SkLabel_Intro.Width - SkAnimatedImage_Alive.Width) div 2; 55 | SkAnimatedImage_Alive.Top := SkLabel_Intro.Height - SkLabel_Intro.Height div 6; 56 | SkPaintBox_Intro.Left := (SkLabel_Intro.Width - SkPaintBox_Intro.Width) div 2; 57 | SkPaintBox_Intro.Top := SkSvg_ICon.Top -20; 58 | end; 59 | 60 | procedure TFrame_Welcome.SetAnimationFlag(const Value: Boolean); 61 | begin 62 | FAnimationFlag := Value; 63 | SkAnimatedImage_Alive.Animation.Enabled := Value; 64 | SkAnimatedImage_Alive.Visible := Value; 65 | SkSvg_ICon.Opacity := IIF.CastBool(Value, 50, 200); 66 | end; 67 | 68 | procedure TFrame_Welcome.SetVisibleBounds(const Value: Boolean); 69 | begin 70 | FVisibleBounds := Value; 71 | Self.Visible := Value; 72 | if Value then 73 | begin 74 | Self.SetBounds(0, 0, TForm(Self.Parent).ClientWidth, TForm(Self.Parent).ClientHeight); 75 | FrameResize(Self); 76 | Self.BringToFront; 77 | end; 78 | end; 79 | 80 | procedure TFrame_Welcome.SkPaintBox_IntroDraw(ASender: TObject; 81 | const ACanvas: ISkCanvas; 82 | const ADest: TRectF; 83 | const AOpacity: Single); 84 | begin 85 | ACanvas.Save; 86 | try 87 | ACanvas.ClipRect(ADest); 88 | 89 | var _Radius := (Min(ADest.Width, ADest.Height) / 2) * 0.97; 90 | var _RoundRect := TRectF.Create(ADest.CenterPoint - PointF(_Radius, _Radius), ADest.CenterPoint + PointF(_Radius, _Radius)); 91 | ACanvas.ClipRoundRect(TSkRoundRect.Create(_RoundRect, _Radius, _Radius), TSkClipOp.Difference, True); 92 | 93 | var _Paint: ISkPaint := TSkPaint.Create; 94 | _Paint.AntiAlias := True; 95 | _Paint.Color := TAlphaColors.White; 96 | _Paint.AlphaF := 0.2; 97 | _Radius := Min(ADest.Width, ADest.Height) / 2; 98 | ACanvas.DrawCircle(ADest.CenterPoint, _Radius, _Paint); 99 | finally 100 | ACanvas.Restore; 101 | end; 102 | end; 103 | 104 | end. 105 | -------------------------------------------------------------------------------- /Unit_DosCommander.dfm: -------------------------------------------------------------------------------- 1 | object Form_DosCommander: TForm_DosCommander 2 | Left = 0 3 | Top = 0 4 | ActiveControl = Button_OK 5 | BorderStyle = bsDialog 6 | Caption = 'Dos Commander' 7 | ClientHeight = 140 8 | ClientWidth = 396 9 | Color = clWindow 10 | Ctl3D = False 11 | Font.Charset = DEFAULT_CHARSET 12 | Font.Color = clSilver 13 | Font.Height = -12 14 | Font.Name = 'Segoe UI' 15 | Font.Style = [] 16 | FormStyle = fsStayOnTop 17 | KeyPreview = True 18 | Position = poDesigned 19 | RoundedCorners = rcOn 20 | OnClick = Label_ListClick 21 | OnKeyPress = FormKeyPress 22 | OnShow = FormShow 23 | TextHeight = 15 24 | object GroupBox1: TGroupBox 25 | Left = 8 26 | Top = 8 27 | Width = 377 28 | Height = 81 29 | Caption = 'Command / Flag' 30 | TabOrder = 0 31 | object Label_Ollama: TLabel 32 | Left = 19 33 | Top = 28 34 | Width = 49 35 | Height = 15 36 | Caption = 'Ollama +' 37 | end 38 | object Label_Help: TLabel 39 | Tag = 2 40 | Left = 150 41 | Top = 53 42 | Width = 33 43 | Height = 15 44 | Cursor = crHandPoint 45 | Caption = '--help' 46 | OnClick = Label_ListClick 47 | end 48 | object Label_Version: TLabel 49 | Tag = 3 50 | Left = 191 51 | Top = 53 52 | Width = 48 53 | Height = 15 54 | Cursor = crHandPoint 55 | Caption = '--version' 56 | OnClick = Label_ListClick 57 | end 58 | object Label_List: TLabel 59 | Left = 94 60 | Top = 53 61 | Width = 15 62 | Height = 15 63 | Cursor = crHandPoint 64 | Caption = 'list' 65 | OnClick = Label_ListClick 66 | end 67 | object Label_Ps: TLabel 68 | Tag = 1 69 | Left = 124 70 | Top = 53 71 | Width = 12 72 | Height = 15 73 | Cursor = crHandPoint 74 | Caption = 'ps' 75 | OnClick = Label_ListClick 76 | end 77 | object Label_Reserved: TLabel 78 | Left = 24 79 | Top = 53 80 | Width = 58 81 | Height = 15 82 | Caption = '[ reserved ]' 83 | StyleElements = [seClient, seBorder] 84 | end 85 | object Label_Run: TLabel 86 | Tag = 4 87 | Left = 300 88 | Top = 53 89 | Width = 18 90 | Height = 15 91 | Cursor = crHandPoint 92 | Caption = 'run' 93 | StyleElements = [seClient, seBorder] 94 | OnClick = Label_ListClick 95 | end 96 | object Label_Pull: TLabel 97 | Tag = 6 98 | Left = 333 99 | Top = 53 100 | Width = 15 101 | Height = 15 102 | Cursor = crHandPoint 103 | Caption = 'rm' 104 | StyleElements = [seClient, seBorder] 105 | OnClick = Label_ListClick 106 | end 107 | object Label_Show: TLabel 108 | Tag = 3 109 | Left = 256 110 | Top = 53 111 | Width = 28 112 | Height = 15 113 | Cursor = crHandPoint 114 | Caption = 'show' 115 | OnClick = Label_ListClick 116 | end 117 | object Edit_CommandFlag: TEdit 118 | Left = 80 119 | Top = 26 120 | Width = 273 121 | Height = 21 122 | TabOrder = 0 123 | Text = '--help' 124 | OnKeyPress = Edit_CommandFlagKeyPress 125 | end 126 | end 127 | object Button_OK: TButton 128 | Left = 244 129 | Top = 102 130 | Width = 75 131 | Height = 25 132 | Caption = 'OK' 133 | ModalResult = 1 134 | TabOrder = 1 135 | end 136 | object Button_Cancel: TButton 137 | Left = 332 138 | Top = 102 139 | Width = 53 140 | Height = 25 141 | Caption = 'Cancel' 142 | ModalResult = 2 143 | TabOrder = 2 144 | end 145 | end 146 | -------------------------------------------------------------------------------- /Unit_RMBroker.dfm: -------------------------------------------------------------------------------- 1 | object Form_RMBroker: TForm_RMBroker 2 | Left = 0 3 | Top = 0 4 | ActiveControl = Memo_Log_Rm 5 | BorderStyle = bsDialog 6 | Caption = 'Ollama Broker / Server' 7 | ClientHeight = 369 8 | ClientWidth = 494 9 | Color = clBtnFace 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -12 13 | Font.Name = 'Segoe UI' 14 | Font.Style = [] 15 | FormStyle = fsStayOnTop 16 | KeyPreview = True 17 | Position = poMainFormCenter 18 | RoundedCorners = rcOn 19 | OnCreate = FormCreate 20 | OnDestroy = FormDestroy 21 | OnKeyPress = FormKeyPress 22 | TextHeight = 15 23 | object Panel1: TPanel 24 | Left = 0 25 | Top = 0 26 | Width = 494 27 | Height = 25 28 | Align = alTop 29 | BevelOuter = bvNone 30 | ShowCaption = False 31 | TabOrder = 0 32 | object Label1: TLabel 33 | AlignWithMargins = True 34 | Left = 33 35 | Top = 3 36 | Width = 40 37 | Height = 15 38 | Margins.Left = 5 39 | Align = alLeft 40 | Caption = 'Current' 41 | Layout = tlCenter 42 | end 43 | object Label_Connection: TLabel 44 | AlignWithMargins = True 45 | Left = 86 46 | Top = 3 47 | Width = 257 48 | Height = 19 49 | Margins.Left = 10 50 | Align = alClient 51 | AutoSize = False 52 | Caption = '...' 53 | EllipsisPosition = epEndEllipsis 54 | Font.Charset = DEFAULT_CHARSET 55 | Font.Color = clLime 56 | Font.Height = -12 57 | Font.Name = 'Segoe UI' 58 | Font.Style = [] 59 | ParentFont = False 60 | Layout = tlCenter 61 | StyleElements = [seClient, seBorder] 62 | ExplicitLeft = 63 63 | ExplicitWidth = 274 64 | end 65 | object SpeedButton_GetUsers: TSpeedButton 66 | AlignWithMargins = True 67 | Left = 349 68 | Top = 3 69 | Width = 40 70 | Height = 19 71 | Cursor = crHandPoint 72 | Align = alRight 73 | Caption = 'Users' 74 | ImageIndex = 68 75 | ImageName = 'logonicon' 76 | OnClick = SpeedButton_GetUsersClick 77 | ExplicitLeft = 352 78 | ExplicitTop = 0 79 | ExplicitHeight = 25 80 | end 81 | object SkSvg_RMBroker: TSkSvg 82 | AlignWithMargins = True 83 | Left = 3 84 | Top = 2 85 | Width = 22 86 | Height = 20 87 | Margins.Top = 2 88 | Align = alLeft 89 | ExplicitTop = -1 90 | end 91 | object CheckBox_Logoption: TCheckBox 92 | Left = 392 93 | Top = 0 94 | Width = 102 95 | Height = 25 96 | Margins.Right = 10 97 | Align = alRight 98 | Caption = 'Log Contents' 99 | TabOrder = 0 100 | end 101 | end 102 | object StatusBar_RM: TStatusBar 103 | Left = 0 104 | Top = 350 105 | Width = 494 106 | Height = 19 107 | Panels = <> 108 | SimplePanel = True 109 | end 110 | object Memo_Log_Rm: TMemo 111 | Left = 0 112 | Top = 25 113 | Width = 494 114 | Height = 325 115 | Align = alClient 116 | Lines.Strings = ( 117 | 'Memo_Log_Rm') 118 | ReadOnly = True 119 | ScrollBars = ssBoth 120 | TabOrder = 1 121 | WordWrap = False 122 | end 123 | object RESTClient_RM: TRESTClient 124 | Accept = 'application/json, text/plain; q=0.9, text/html;q=0.8,' 125 | AcceptCharset = 'utf-8, *;q=0.8' 126 | Params = <> 127 | ReadTimeout = 60000 128 | SynchronizedEvents = False 129 | BindSource.AutoActivate = False 130 | BindSource.AutoEdit = False 131 | BindSource.AutoPost = False 132 | OnSendData = RESTClient_RMSendData 133 | OnReceiveData = RESTClient_RMReceiveData 134 | Left = 160 135 | Top = 104 136 | end 137 | object RESTRequest_RM: TRESTRequest 138 | Client = RESTClient_RM 139 | Method = rmPOST 140 | Params = <> 141 | Response = RESTResponse_RM 142 | SynchronizedEvents = False 143 | BindSource.AutoActivate = False 144 | BindSource.AutoEdit = False 145 | BindSource.AutoPost = False 146 | Left = 264 147 | Top = 102 148 | end 149 | object RESTResponse_RM: TRESTResponse 150 | BindSource.AutoActivate = False 151 | BindSource.AutoEdit = False 152 | BindSource.AutoPost = False 153 | Left = 220 154 | Top = 151 155 | end 156 | end 157 | -------------------------------------------------------------------------------- /Android/Unit_Setting.LgXhdpiPh.fmx: -------------------------------------------------------------------------------- 1 | inherited Form_Setting_LgXhdpiPh: TForm_Setting_LgXhdpiPh 2 | ClientHeight = 695 3 | ClientWidth = 450 4 | DesignerMasterStyle = 0 5 | inherited ToolBar1: TToolBar 6 | Size.Width = 450.000000000000000000 7 | Size.Height = 48.000000000000000000 8 | inherited Label1: TLabel 9 | Position.X = 53.000000000000000000 10 | Size.Height = 38.000000000000000000 11 | TextSettings.Font.StyleExt = {00070000000000000004000000} 12 | end 13 | inherited Button_Return: TButton 14 | Size.Width = 48.000000000000000000 15 | Size.Height = 48.000000000000000000 16 | end 17 | end 18 | inherited Panel_SettingBase: TPanel 19 | Size.Width = 450.000000000000000000 20 | Size.Height = 647.000000000000000000 21 | inherited Panel_ServerHost: TPanel 22 | Size.Width = 440.000000000000000000 23 | inherited Label5: TLabel 24 | Size.Width = 440.000000000000000000 25 | end 26 | inherited Layout1: TLayout 27 | inherited Edit_Host: TEdit 28 | Size.Height = 32.000000000000000000 29 | end 30 | end 31 | inherited Layout2: TLayout 32 | inherited Edit_Port: TEdit 33 | Size.Height = 32.000000000000000000 34 | end 35 | end 36 | inherited Line1: TLine 37 | Size.Width = 440.000000000000000000 38 | end 39 | end 40 | inherited Panel2: TPanel 41 | Size.Width = 440.000000000000000000 42 | inherited Label6: TLabel 43 | Size.Width = 440.000000000000000000 44 | end 45 | inherited Layout3: TLayout 46 | inherited Edit_UserName: TEdit 47 | Size.Height = 32.000000000000000000 48 | end 49 | end 50 | inherited Line2: TLine 51 | Size.Width = 440.000000000000000000 52 | end 53 | end 54 | inherited Panel1: TPanel 55 | Size.Width = 440.000000000000000000 56 | inherited Label2: TLabel 57 | Size.Width = 440.000000000000000000 58 | inherited SpeedButton_DefaultColor: TSpeedButton 59 | Position.X = 380.000000000000000000 60 | Size.Height = 48.000000000000000000 61 | end 62 | end 63 | inherited Layout4: TLayout 64 | inherited ColorComboBox_Header: TColorComboBox 65 | Size.Height = 32.000000000000000000 66 | end 67 | end 68 | inherited Layout6: TLayout 69 | inherited ColorComboBox_Body: TColorComboBox 70 | Size.Height = 32.000000000000000000 71 | end 72 | end 73 | inherited Layout7: TLayout 74 | inherited ColorComboBox_Footer: TColorComboBox 75 | Size.Height = 32.000000000000000000 76 | end 77 | end 78 | inherited Line3: TLine 79 | Size.Width = 440.000000000000000000 80 | end 81 | end 82 | inherited Panel_Help: TPanel 83 | Size.Width = 440.000000000000000000 84 | inherited Label3: TLabel 85 | Size.Width = 440.000000000000000000 86 | end 87 | inherited SpeedButton6: TSpeedButton 88 | Size.Height = 48.000000000000000000 89 | end 90 | inherited SpeedButton4: TSpeedButton 91 | Size.Height = 48.000000000000000000 92 | end 93 | inherited SpeedButton3: TSpeedButton 94 | Size.Height = 48.000000000000000000 95 | end 96 | inherited SpeedButton2: TSpeedButton 97 | Size.Height = 48.000000000000000000 98 | end 99 | inherited SpeedButton1: TSpeedButton 100 | Size.Height = 48.000000000000000000 101 | end 102 | inherited Line4: TLine 103 | Size.Width = 440.000000000000000000 104 | end 105 | end 106 | inherited SkSvg1: TSkSvg 107 | Position.X = 385.000000000000000000 108 | Position.Y = 585.000000000000000000 109 | end 110 | inherited GroupBox1: TGroupBox 111 | Position.Y = 505.000000000000000000 112 | Size.Width = 440.000000000000000000 113 | inherited Text9: TText 114 | inherited Label_GiuServ: TLabel 115 | TextSettings.Font.StyleExt = {00040000000200000004000000} 116 | end 117 | end 118 | end 119 | end 120 | inherited GestureManager1: TGestureManager 121 | GestureData = < 122 | item 123 | Control = Panel_SettingBase 124 | Collection = < 125 | item 126 | GestureID = sgiRightLeft 127 | end 128 | item 129 | GestureID = sgiLeftRight 130 | end 131 | item 132 | GestureID = sgiLeft 133 | end 134 | item 135 | GestureID = sgiRight 136 | end> 137 | end> 138 | end 139 | end 140 | -------------------------------------------------------------------------------- /Android/Unit_Setting.NmXhdpiPh.fmx: -------------------------------------------------------------------------------- 1 | inherited Form_Setting_NmXhdpiPh: TForm_Setting_NmXhdpiPh 2 | ClientHeight = 615 3 | ClientWidth = 400 4 | DesignerMasterStyle = 0 5 | inherited ToolBar1: TToolBar 6 | Size.Width = 400.000000000000000000 7 | Size.Height = 48.000000000000000000 8 | inherited Label1: TLabel 9 | Position.X = 53.000000000000000000 10 | Size.Height = 38.000000000000000000 11 | TextSettings.Font.StyleExt = {00070000000000000004000000} 12 | end 13 | inherited Button_Return: TButton 14 | Size.Width = 48.000000000000000000 15 | Size.Height = 48.000000000000000000 16 | end 17 | end 18 | inherited Panel_SettingBase: TPanel 19 | Size.Width = 400.000000000000000000 20 | Size.Height = 567.000000000000000000 21 | inherited Panel_ServerHost: TPanel 22 | Size.Width = 390.000000000000000000 23 | inherited Label5: TLabel 24 | Size.Width = 390.000000000000000000 25 | end 26 | inherited Layout1: TLayout 27 | inherited Edit_Host: TEdit 28 | Size.Height = 32.000000000000000000 29 | end 30 | end 31 | inherited Layout2: TLayout 32 | inherited Edit_Port: TEdit 33 | Size.Height = 32.000000000000000000 34 | end 35 | end 36 | inherited Line1: TLine 37 | Size.Width = 390.000000000000000000 38 | end 39 | end 40 | inherited Panel2: TPanel 41 | Size.Width = 390.000000000000000000 42 | inherited Label6: TLabel 43 | Size.Width = 390.000000000000000000 44 | end 45 | inherited Layout3: TLayout 46 | inherited Edit_UserName: TEdit 47 | Size.Height = 32.000000000000000000 48 | end 49 | end 50 | inherited Line2: TLine 51 | Size.Width = 390.000000000000000000 52 | end 53 | end 54 | inherited Panel1: TPanel 55 | Size.Width = 390.000000000000000000 56 | inherited Label2: TLabel 57 | Size.Width = 390.000000000000000000 58 | inherited SpeedButton_DefaultColor: TSpeedButton 59 | Position.X = 330.000000000000000000 60 | Size.Height = 48.000000000000000000 61 | end 62 | end 63 | inherited Layout4: TLayout 64 | inherited ColorComboBox_Header: TColorComboBox 65 | Size.Height = 32.000000000000000000 66 | end 67 | end 68 | inherited Layout6: TLayout 69 | inherited ColorComboBox_Body: TColorComboBox 70 | Size.Height = 32.000000000000000000 71 | end 72 | end 73 | inherited Layout7: TLayout 74 | inherited ColorComboBox_Footer: TColorComboBox 75 | Size.Height = 32.000000000000000000 76 | end 77 | end 78 | inherited Line3: TLine 79 | Size.Width = 390.000000000000000000 80 | end 81 | end 82 | inherited Panel_Help: TPanel 83 | Size.Width = 390.000000000000000000 84 | inherited Label3: TLabel 85 | Size.Width = 390.000000000000000000 86 | end 87 | inherited SpeedButton6: TSpeedButton 88 | Size.Height = 48.000000000000000000 89 | end 90 | inherited SpeedButton4: TSpeedButton 91 | Size.Height = 48.000000000000000000 92 | end 93 | inherited SpeedButton3: TSpeedButton 94 | Size.Height = 48.000000000000000000 95 | end 96 | inherited SpeedButton2: TSpeedButton 97 | Size.Height = 48.000000000000000000 98 | end 99 | inherited SpeedButton1: TSpeedButton 100 | Size.Height = 48.000000000000000000 101 | end 102 | inherited Line4: TLine 103 | Size.Width = 390.000000000000000000 104 | end 105 | end 106 | inherited SkSvg1: TSkSvg 107 | Position.X = 335.000000000000000000 108 | Position.Y = 505.000000000000000000 109 | end 110 | inherited GroupBox1: TGroupBox 111 | Position.Y = 425.000000000000000000 112 | Size.Width = 390.000000000000000000 113 | inherited Text9: TText 114 | inherited Label_GiuServ: TLabel 115 | TextSettings.Font.StyleExt = {00040000000200000004000000} 116 | end 117 | end 118 | end 119 | end 120 | inherited GestureManager1: TGestureManager 121 | GestureData = < 122 | item 123 | Control = Panel_SettingBase 124 | Collection = < 125 | item 126 | GestureID = sgiRightLeft 127 | end 128 | item 129 | GestureID = sgiLeftRight 130 | end 131 | item 132 | GestureID = sgiLeft 133 | end 134 | item 135 | GestureID = sgiRight 136 | end> 137 | end> 138 | end 139 | end 140 | -------------------------------------------------------------------------------- /Android/Unit_Collections.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Collections; 2 | 3 | interface 4 | 5 | uses 6 | Classes, 7 | Generics.Collections, 8 | SysUtils, 9 | System.JSON; 10 | 11 | type 12 | 13 | TCollectionFactory = class 14 | public 15 | function DisplayName: string; virtual; 16 | function GetType: TClass; virtual; abstract; 17 | function GetExpression: string; virtual; abstract; 18 | function CreateCollection: TObject; virtual; abstract; 19 | end; 20 | 21 | TAnonCollectionFactory = class(TCollectionFactory) 22 | private 23 | FGetType: TFunc; 24 | FCreateCollection: TFunc; 25 | FExpression: string; 26 | public 27 | constructor Create(AGetType: TFunc; ACreateCollection: TFunc; const AExpression: string); 28 | function GetType: TClass; override; 29 | function CreateCollection: TObject; override; 30 | function GetExpression: string; override; 31 | end; 32 | 33 | 34 | TTestItem = class(TCollectionItem) 35 | private 36 | FStringField: string; 37 | FIntegerField: Integer; 38 | public 39 | destructor Destroy; override; 40 | property StringField: string read FStringField write FStringField; 41 | property IntegerField: Integer read FIntegerField write FIntegerField; 42 | end; 43 | 44 | TTestCollection = class(TCollection) 45 | end; 46 | 47 | TListObject = class 48 | private 49 | FStringField: string; 50 | FIntegerField: Integer; 51 | public 52 | constructor Create(const AString: string; AInteger: Integer); 53 | property StringField: string read FStringField write FStringField; 54 | property IntegerField: Integer read FIntegerField write FIntegerField; 55 | end; 56 | 57 | TTestRecord = record 58 | private 59 | FStringField: string; 60 | FIntegerField: Integer; 61 | public 62 | constructor Create(const AString: string; AInteger: Integer); 63 | property StringField: string read FStringField write FStringField; 64 | property IntegerField: Integer read FIntegerField write FIntegerField; 65 | end; 66 | 67 | function GetCollectionFactories: TArray; 68 | procedure RegisterCollectionFactory(ACollectionFactory: TCollectionFactory); 69 | 70 | implementation 71 | 72 | var 73 | FFactories: TList; 74 | 75 | function GetCollectionFactories: TArray; 76 | begin 77 | Result := FFactories.ToArray; 78 | end; 79 | 80 | procedure RegisterCollectionFactory(ACollectionFactory: TCollectionFactory); 81 | begin 82 | FFactories.Add(ACollectionFactory); 83 | end; 84 | 85 | { TAnonCollectionFactory } 86 | 87 | constructor TAnonCollectionFactory.Create(AGetType: TFunc; 88 | ACreateCollection: TFunc; const AExpression: string); 89 | begin 90 | FGetType := AGetType; 91 | FCreateCollection := ACreateCollection; 92 | FExpression := AExpression; 93 | end; 94 | 95 | function TAnonCollectionFactory.CreateCollection: TObject; 96 | begin 97 | Result := FCreateCollection; 98 | end; 99 | 100 | function TAnonCollectionFactory.GetExpression: string; 101 | begin 102 | Result := FExpression; 103 | end; 104 | 105 | function TAnonCollectionFactory.GetType: TClass; 106 | begin 107 | Result := FGetType; 108 | end; 109 | 110 | { TCollectionFactory } 111 | 112 | function TCollectionFactory.DisplayName: string; 113 | begin 114 | Result := GetType.ClassName; 115 | end; 116 | 117 | { TListObject } 118 | 119 | constructor TListObject.Create(const AString: string; AInteger: Integer); 120 | begin 121 | FStringField := AString; 122 | FIntegerField := AInteger; 123 | end; 124 | 125 | procedure EnumerateSampleData(ACallback: TProc); 126 | begin 127 | for var I := 1 to 100 do 128 | ACallback('Item' + IntToStr(I), I); 129 | end; 130 | 131 | { TTestItem } 132 | 133 | destructor TTestItem.Destroy; 134 | begin 135 | // 136 | inherited; 137 | end; 138 | 139 | { TTestRecord } 140 | 141 | constructor TTestRecord.Create(const AString: string; AInteger: Integer); 142 | begin 143 | FStringField := AString; 144 | FIntegerField := AInteger; 145 | end; 146 | 147 | const 148 | sQualifier = 'Current.'; 149 | sSelf = 'Current'; 150 | initialization 151 | FFactories := TObjectList.Create; 152 | RegisterCollectionFactory( 153 | TAnonCollectionFactory.Create( 154 | function: TClass 155 | begin 156 | Result := TTestCollection; 157 | end, 158 | function: TObject 159 | var 160 | LCollection: TTestCollection; 161 | begin 162 | LCollection := TTestCollection.Create(TTestItem); 163 | Result := LCollection; 164 | EnumerateSampleData( 165 | procedure(AString: string; AInteger: Integer) 166 | begin 167 | with LCollection.Add as TTestItem do 168 | begin 169 | StringField := AString; 170 | IntegerField := AInteger; 171 | end; 172 | end); 173 | end, 174 | Format('''(TTestItem) StringField: '' + %0:sStringField + ''; IntegerField: '' + ToStr(%0:sIntegerField)', [sQualifier]))); 175 | 176 | finalization 177 | FFactories.Free; 178 | 179 | end. 180 | -------------------------------------------------------------------------------- /Unit_AliveOllama.pas: -------------------------------------------------------------------------------- 1 | unit Unit_AliveOllama; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, 7 | Winapi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | Vcl.Graphics, 12 | Vcl.Controls, 13 | Vcl.Forms, 14 | Vcl.Dialogs, 15 | Vcl.StdCtrls, 16 | Vcl.Buttons; 17 | 18 | type 19 | TForm_AliveOllama = class(TForm) 20 | GroupBox1: TGroupBox; 21 | Edit1: TEdit; 22 | Memo_Alive: TMemo; 23 | Button_OK: TButton; 24 | SpeedButton_Check: TSpeedButton; 25 | procedure FormShow(Sender: TObject); 26 | procedure FormKeyPress(Sender: TObject; var Key: Char); 27 | procedure SpeedButton_CheckClick(Sender: TObject); 28 | procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 29 | private 30 | procedure LogReturn(const S: String); 31 | public 32 | IsCkeckedFlag: Boolean; 33 | end; 34 | 35 | procedure CheckAlive_Ollama(const AFlag: Integer = 0); 36 | function Get_ListModels_Ollama(const ARequestURI: string): string; 37 | 38 | implementation 39 | 40 | uses 41 | System.Threading, 42 | System.NetConsts, 43 | System.Net.HttpClient, 44 | System.Net.URLClient, 45 | Vcl.Themes, 46 | Unit_Common, 47 | Unit_Main; 48 | 49 | {$R *.dfm} 50 | 51 | const 52 | C_OllamaAddress = 'http://localhost:11434'; 53 | 54 | procedure CheckAlive_Ollama(const AFlag: Integer); 55 | begin 56 | TTask.Run( // Prevent Locking for Too Slow Response at First time ... 57 | procedure // When Ollama_server(ollama_llama_server.exe) not started, Yet. 58 | begin 59 | var _response: string := ''; 60 | var _HTTP := THTTPClient.Create; 61 | _HTTP.ProtocolVersion := THTTPProtocolVersion.HTTP_1_1; 62 | try 63 | var _HttpResponse := _HTTP.Get(C_OllamaAddress); 64 | if _HttpResponse.StatusCode = 200 then 65 | begin 66 | _response := LowerCase(_HttpResponse.ContentAsString()); 67 | GV_AliveOllamaFlag := (Pos('ollama', _response) > 0) and (Pos('running', _response) > 1); 68 | end; 69 | finally 70 | _HTTP.Free; 71 | end; 72 | 73 | PostMessage(Form_RestOllama.Handle, WM_NETHTTP_MESSAGE, WM_NETHTTP_MESSAGE_ALIVE, Ord(GV_AliveOllamaFlag)); 74 | end); 75 | end; 76 | 77 | function Get_ListModels_Ollama(const ARequestURI: string): string; 78 | begin 79 | Result := 'n/a'; 80 | if GV_AliveOllamaFlag then 81 | try 82 | var _HTTP := THTTPClient.Create; 83 | _HTTP.ProtocolVersion := THTTPProtocolVersion.HTTP_1_1; 84 | _HTTP.Accept := 'application/json, text/javascript, */*; q=0.01'; 85 | _HTTP.ContentType := 'application/json'; 86 | try 87 | var _HttpResponse := _HTTP.Get(ARequestURI); 88 | if _HttpResponse.StatusCode = 200 then 89 | begin 90 | Result := _HttpResponse.ContentAsString(); 91 | end; 92 | finally 93 | _HTTP.Free; 94 | end; 95 | except 96 | on E: Exception do 97 | ShowMessage(E.ClassName + ': ' + E.Message); 98 | end; 99 | end; 100 | 101 | procedure TForm_AliveOllama.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 102 | begin 103 | CanClose := IsCkeckedFlag; 104 | end; 105 | 106 | procedure TForm_AliveOllama.FormKeyPress(Sender: TObject; var Key: Char); 107 | begin 108 | if Key = #27 then 109 | begin 110 | ModalResult := mrCancel; 111 | end; 112 | end; 113 | 114 | procedure TForm_AliveOllama.FormShow(Sender: TObject); 115 | begin 116 | if TStyleManager.IsCustomStyleActive then 117 | begin 118 | Memo_Alive.StyleElements := [seBorder]; 119 | Memo_Alive.Color := StyleServices.GetStyleColor(scWindow); 120 | end; 121 | 122 | IsCkeckedFlag := True; 123 | Memo_Alive.Clear; 124 | end; 125 | 126 | procedure TForm_AliveOllama.LogReturn(const S: String); 127 | begin 128 | Memo_Alive.lines.Add(S); 129 | end; 130 | 131 | procedure TForm_AliveOllama.SpeedButton_CheckClick(Sender: TObject); 132 | const 133 | c_Warning = 'Check Ollama is installed and running on local computer.'; 134 | begin 135 | IsCkeckedFlag := False; 136 | Memo_Alive.lines.Clear; 137 | 138 | try 139 | var _response: string := ''; 140 | var _HTTP := THTTPClient.Create; 141 | _HTTP.ProtocolVersion := THTTPProtocolVersion.HTTP_1_1; 142 | try 143 | var _HttpResponse := _HTTP.Get(C_OllamaAddress); 144 | if _HttpResponse.StatusCode = 200 then 145 | begin 146 | _response := LowerCase(_HttpResponse.ContentAsString()); 147 | GV_AliveOllamaFlag := (Pos('ollama', _response) > 0) and (Pos('running', _response) > 1); 148 | end; 149 | finally 150 | _HTTP.Free; 151 | end; 152 | 153 | PostMessage(Form_RestOllama.Handle, WM_NETHTTP_MESSAGE, WM_NETHTTP_MESSAGE_ALIVE, Ord(GV_AliveOllamaFlag)); 154 | LogReturn(_response+GC_CRLF+ IIF.CastBool(GV_AliveOllamaFlag, 'Alive On', 'Not Alive')); 155 | if not GV_AliveOllamaFlag then 156 | begin 157 | Memo_Alive.lines.Add(c_Warning); 158 | Memo_Alive.lines.Add(GC_CRLF+'* On Restart, Checking Ollama Alive - On.'); 159 | end; 160 | except 161 | on E: Exception do 162 | LogReturn(E.ClassName + ': ' + E.Message); 163 | end; 164 | 165 | if Button_OK.CanFocus then 166 | Button_OK.SetFocus; 167 | 168 | IsCkeckedFlag := True; 169 | end; 170 | 171 | end. 172 | -------------------------------------------------------------------------------- /Unit_SysInfo.pas: -------------------------------------------------------------------------------- 1 | { 2 | From https://github.com/ddablib/sysinfo 3 | } 4 | 5 | unit Unit_SysInfo; 6 | 7 | {$I OllmaClient_Defines.inc} 8 | 9 | interface 10 | 11 | uses 12 | System.SysUtils, 13 | System.Classes, 14 | Winapi.Windows; 15 | 16 | type 17 | TPJProcessorArchitecture = ( 18 | paUnknown, // Unknown architecture 19 | paX64, // X64 (AMD or Intel) 20 | paIA64, // Intel Itanium processor family (IPF) 21 | paX86 // Intel 32 bit 22 | ); 23 | 24 | EPJSysInfo = class(Exception); 25 | 26 | type 27 | TPJComputerInfo = class(TObject) 28 | public 29 | class function ComputerName: string; 30 | class function UserName: string; 31 | class function Processor: TPJProcessorArchitecture; 32 | class function ProcessorCount: Cardinal; 33 | class function ProcessorIdentifier: string; 34 | class function ProcessorName: string; 35 | class function ProcessorSpeedMHz: Cardinal; 36 | end; 37 | 38 | implementation 39 | 40 | uses 41 | System.Win.Registry; 42 | 43 | resourcestring // Error messages 44 | r_BadRegType = 'Unsupported registry type'; 45 | r_BadRegIntType = 'Integer value expected in registry'; 46 | r_BadProcHandle = 'Bad process handle'; 47 | 48 | type 49 | TGetSystemInfo = procedure(var lpSystemInfo: TSystemInfo); stdcall; 50 | 51 | var 52 | V_GetSystemInfoFn: TGetSystemInfo; 53 | V_InternalProcessorArchitecture: Word = 0; 54 | 55 | const 56 | KEY_WOW64_64KEY = $0100; 57 | 58 | function LoadKernelFunc(const FuncName: string): Pointer; 59 | const 60 | c_Kernel = 'kernel32.dll'; 61 | begin 62 | Result := GetProcAddress(GetModuleHandle(c_Kernel), PChar(FuncName)); 63 | end; 64 | 65 | function RegCreate: TRegistry; 66 | begin 67 | Result := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY); 68 | end; 69 | 70 | function RegOpenKeyReadOnly(const Reg: TRegistry; const Key: string): Boolean; 71 | begin 72 | Result := Reg.OpenKey(Key, False); 73 | end; 74 | 75 | function GetRegistryString(const RootKey: HKEY; const SubKey, Name: string): string; 76 | begin 77 | Result := ''; 78 | var _Reg: TRegistry := RegCreate; 79 | try 80 | _Reg.RootKey := RootKey; 81 | if RegOpenKeyReadOnly(_Reg, SubKey) and _Reg.ValueExists(Name) then 82 | begin 83 | var _ValueInfo: TRegDataInfo; 84 | _Reg.GetDataInfo(Name, _ValueInfo); 85 | case _ValueInfo.RegData of 86 | rdString, rdExpandString: 87 | Result := _Reg.ReadString(Name); 88 | rdInteger: 89 | Result := IntToStr(_Reg.ReadInteger(Name)); 90 | else 91 | raise EPJSysInfo.Create(r_BadRegType); 92 | end; 93 | end; 94 | finally 95 | _Reg.CloseKey; 96 | _Reg.Free; 97 | end; 98 | end; 99 | 100 | function GetRegistryInt(const RootKey: HKEY; const SubKey, Name: string): Integer; 101 | begin 102 | Result := 0; 103 | var _Reg: TRegistry := RegCreate; 104 | try 105 | _Reg.RootKey := RootKey; 106 | if RegOpenKeyReadOnly(_Reg, SubKey) and _Reg.ValueExists(Name) then 107 | begin 108 | var _ValueInfo: TRegDataInfo; 109 | _Reg.GetDataInfo(Name, _ValueInfo); 110 | if _ValueInfo.RegData <> rdInteger then 111 | raise EPJSysInfo.Create(r_BadRegIntType); 112 | Result := _Reg.ReadInteger(Name); 113 | end; 114 | finally 115 | _Reg.CloseKey; 116 | _Reg.Free; 117 | end; 118 | end; 119 | 120 | procedure InitPlatformIdEx; 121 | var 122 | _SI: TSystemInfo; 123 | begin 124 | V_GetSystemInfoFn := LoadKernelFunc('GetNativeSystemInfo'); 125 | if not Assigned(V_GetSystemInfoFn) then 126 | V_GetSystemInfoFn := GetSystemInfo; 127 | V_GetSystemInfoFn(_SI); 128 | V_InternalProcessorArchitecture := _SI.wProcessorArchitecture; 129 | end; 130 | 131 | { TPJComputerInfo } 132 | 133 | class function TPJComputerInfo.ComputerName: string; 134 | var 135 | _PComputerName: array[0..MAX_COMPUTERNAME_LENGTH] of Char; 136 | begin 137 | var Size: DWORD := MAX_COMPUTERNAME_LENGTH; 138 | if GetComputerName(_PComputerName, Size) then 139 | Result := _PComputerName 140 | else 141 | Result := ''; 142 | end; 143 | 144 | class function TPJComputerInfo.Processor: TPJProcessorArchitecture; 145 | begin 146 | case V_InternalProcessorArchitecture of 147 | PROCESSOR_ARCHITECTURE_INTEL: Result := paX86; 148 | PROCESSOR_ARCHITECTURE_AMD64: Result := paX64; 149 | PROCESSOR_ARCHITECTURE_IA64: Result := paIA64; 150 | else Result := paUnknown; 151 | end; 152 | end; 153 | 154 | class function TPJComputerInfo.ProcessorCount: Cardinal; 155 | var 156 | _SI: TSystemInfo; 157 | begin 158 | V_GetSystemInfoFn(_SI); 159 | Result := _SI.dwNumberOfProcessors; 160 | end; 161 | 162 | class function TPJComputerInfo.ProcessorIdentifier: string; 163 | begin 164 | Result := GetRegistryString( 165 | HKEY_LOCAL_MACHINE, 166 | 'HARDWARE\DESCRIPTION\System\CentralProcessor\0\', 167 | 'Identifier' 168 | ); 169 | end; 170 | 171 | class function TPJComputerInfo.ProcessorName: string; 172 | begin 173 | Result := GetRegistryString( 174 | HKEY_LOCAL_MACHINE, 175 | 'HARDWARE\DESCRIPTION\System\CentralProcessor\0\', 176 | 'ProcessorNameString' 177 | ); 178 | end; 179 | 180 | class function TPJComputerInfo.ProcessorSpeedMHz: Cardinal; 181 | begin 182 | Result := Cardinal( 183 | GetRegistryInt( 184 | HKEY_LOCAL_MACHINE, 185 | 'HARDWARE\DESCRIPTION\System\CentralProcessor\0\', 186 | '~MHz' 187 | ) 188 | ); 189 | end; 190 | 191 | class function TPJComputerInfo.UserName: string; 192 | const 193 | c_UNLEN = 256; 194 | var 195 | _PUserName: array[0..c_UNLEN] of Char; 196 | begin 197 | var _Size: DWORD := c_UNLEN; 198 | if GetUserName(_PUserName, _Size) then 199 | Result := _PUserName 200 | else 201 | Result := ''; 202 | end; 203 | 204 | initialization 205 | InitPlatformIdEx; 206 | 207 | end. 208 | -------------------------------------------------------------------------------- /Android/DW.Toast.Android.pas: -------------------------------------------------------------------------------- 1 | unit DW.Toast.Android; 2 | 3 | {*******************************************************} 4 | { } 5 | { Kastri } 6 | { } 7 | { Delphi Worlds Cross-Platform Library } 8 | { } 9 | { Copyright 2020-2024 Dave Nottage under MIT license } 10 | { which is located in the root folder of this library } 11 | { } 12 | {*******************************************************} 13 | 14 | interface 15 | 16 | uses 17 | // Android 18 | Androidapi.JNI.Os, 19 | Androidapi.JNI.JavaTypes, 20 | Androidapi.JNIBridge; 21 | 22 | type 23 | TToast = class(TJavaLocal, JRunnable) 24 | private 25 | class var FToast: TToast; 26 | class destructor DestroyClass; 27 | private 28 | FHandler: JHandler; 29 | FIsCustom: Boolean; 30 | FIsShort: Boolean; 31 | FMsg: string; 32 | procedure DoRun(const AToastLength: Integer); 33 | procedure DoRunEx(const AToastLength: Integer); 34 | public 35 | { JRunnable } 36 | procedure run; cdecl; 37 | public 38 | /// 39 | /// Convenience equivalent of MakeToast 40 | /// 41 | class procedure Make(const AMsg: string; const AIsShort: Boolean = True); 42 | /// 43 | /// Convenience equivalent of MakeToastEx 44 | /// 45 | class procedure MakeEx(const AMsg: string; const AIsShort: Boolean = True); 46 | public 47 | constructor Create; 48 | /// 49 | /// Shows a toast with the message provided, for the length specified 50 | /// 51 | procedure MakeToast(const AMsg: string; const AIsShort: Boolean = True); 52 | /// 53 | /// Shows a custom toast with the message provided, for the length specified 54 | /// 55 | /// 56 | /// This method creates its own text view, so that more lines of text can be shown 57 | /// Note: Presently, the application icon is not shown in the toast 58 | /// 59 | procedure MakeToastEx(const AMsg: string; const AIsShort: Boolean = True); 60 | end; 61 | 62 | implementation 63 | 64 | uses 65 | // Android 66 | Androidapi.Helpers, 67 | Androidapi.JNI.Widget, 68 | Androidapi.JNI.GraphicsContentViewText, 69 | Androidapi.JNI.Support, 70 | // DW 71 | DW.Androidapi.JNI.Widget.Toast; 72 | 73 | function IsDarkTheme: Boolean; 74 | var 75 | LConfiguration: JConfiguration; 76 | LNightMode: Integer; 77 | begin 78 | LConfiguration := TAndroidHelper.Context.getResources.getConfiguration; 79 | LNightMode := LConfiguration.uiMode and TJConfiguration.JavaClass.UI_MODE_NIGHT_MASK; 80 | Result := LNightMode = TJConfiguration.JavaClass.UI_MODE_NIGHT_YES; 81 | end; 82 | 83 | { TToast } 84 | 85 | constructor TToast.Create; 86 | begin 87 | inherited; 88 | FHandler := TJHandler.JavaClass.init(TJLooper.JavaClass.getMainLooper); 89 | end; 90 | 91 | class destructor TToast.DestroyClass; 92 | begin 93 | FToast.Free; 94 | end; 95 | 96 | class procedure TToast.Make(const AMsg: string; const AIsShort: Boolean = True); 97 | begin 98 | if FToast = nil then 99 | FToast := TToast.Create; 100 | FToast.MakeToast(AMsg, AIsShort); 101 | end; 102 | 103 | class procedure TToast.MakeEx(const AMsg: string; const AIsShort: Boolean); 104 | begin 105 | if FToast = nil then 106 | FToast := TToast.Create; 107 | FToast.MakeToastEx(AMsg, AIsShort); 108 | end; 109 | 110 | procedure TToast.MakeToast(const AMsg: string; const AIsShort: Boolean = True); 111 | begin 112 | FMsg := AMsg; 113 | FIsShort := AIsShort; 114 | FIsCustom := False; 115 | FHandler.post(Self); 116 | end; 117 | 118 | procedure TToast.MakeToastEx(const AMsg: string; const AIsShort: Boolean); 119 | begin 120 | FMsg := AMsg; 121 | FIsShort := AIsShort; 122 | FIsCustom := True; 123 | FHandler.post(Self); 124 | end; 125 | 126 | procedure TToast.DoRun(const AToastLength: Integer); 127 | begin 128 | TJToast.JavaClass.makeText(TAndroidHelper.Context.getApplicationContext, StrToJCharSequence(FMsg), AToastLength).show; 129 | end; 130 | 131 | procedure TToast.DoRunEx(const AToastLength: Integer); 132 | const 133 | cResNameSuffix: array[Boolean] of string = ('light', 'dark'); 134 | var 135 | LToast: JToast; 136 | LView: JTextView; 137 | LBackground: JGradientDrawable; 138 | LResources: JResources; 139 | LIsDark: Boolean; 140 | LBackgroundColorID, LTextColorID: Integer; 141 | begin 142 | LIsDark := IsDarkTheme; 143 | LResources := TAndroidHelper.Context.getResources; 144 | LBackgroundColorID := LResources.getIdentifier(StringToJString('android:color/background_' + cResNameSuffix[LIsDark]), nil, nil); 145 | LTextColorID := LResources.getIdentifier(StringToJString('android:color/primary_text_' + cResNameSuffix[LIsDark]), nil, nil); 146 | LView := TJTextView.JavaClass.init(TAndroidHelper.Context.getApplicationContext); 147 | LView.setBackgroundColor(LResources.getColor(LBackgroundColorID)); 148 | LView.setTextColor(LResources.getColor(LTextColorID)); 149 | LView.setText(StrToJCharSequence(FMsg)); 150 | LView.setPadding(16, 16, 16, 16); 151 | LView.setGravity(TJGravity.JavaClass.CENTER); 152 | LBackground := TJGradientDrawable.JavaClass.init; 153 | LBackground.setCornerRadius(48); 154 | LBackground.setColor(LResources.getColor(LBackgroundColorID)); 155 | LView.setBackground(LBackground); 156 | LToast := TJToast.JavaClass.init(TAndroidHelper.Context.getApplicationContext); 157 | LToast.setView(LView); 158 | LToast.setDuration(AToastLength); 159 | LToast.show; 160 | end; 161 | 162 | procedure TToast.run; 163 | var 164 | LToastLength: Integer; 165 | begin 166 | if FIsShort then 167 | LToastLength := TJToast.JavaClass.LENGTH_SHORT 168 | else 169 | LToastLength := TJToast.JavaClass.LENGTH_LONG; 170 | if FIsCustom then 171 | DoRunEx(LToastLength) 172 | else 173 | DoRun(LToastLength); 174 | end; 175 | 176 | end. 177 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncSocketList.pas: -------------------------------------------------------------------------------- 1 | unit ncSocketList; 2 | 3 | /// //////////////////////////////////////////////////////////////////////////// 4 | // 5 | // TSocketList 6 | // Written by Demos Bill, Tue 21/10/2004 7 | // 8 | // SocketList, the equivalent of TStringList 9 | // but for the type of TSocket handles 10 | // 11 | /// //////////////////////////////////////////////////////////////////////////// 12 | 13 | interface 14 | 15 | uses System.Classes, System.SysUtils, System.RTLConsts, ncLines; 16 | 17 | type 18 | TSocketItem = record 19 | FSocketHandle: TSocketHandle; 20 | FLine: TncLine; 21 | end; 22 | 23 | PSocketItem = ^TSocketItem; 24 | 25 | TSocketItemList = array of TSocketItem; 26 | PSocketItemList = ^TSocketItemList; 27 | 28 | TSocketList = class(TPersistent) 29 | private 30 | FList: TSocketItemList; 31 | FCount: Integer; 32 | FCapacity: Integer; 33 | function GetSocketHandles(Index: Integer): TSocketHandle; register; 34 | function GetLines(Index: Integer): TncLine; register; 35 | procedure PutLines(Index: Integer; aLine: TncLine); 36 | procedure SetCapacity(aNewCapacity: Integer); 37 | protected 38 | procedure AssignTo(Dest: TPersistent); override; 39 | procedure Insert(aIndex: Integer; const aSocketHandle: TSocketHandle; aLine: TncLine); 40 | procedure Grow; 41 | public 42 | destructor Destroy; override; 43 | 44 | function Add(const aSocketHandle: TSocketHandle; aLine: TncLine): Integer; 45 | procedure Clear; 46 | procedure Delete(aIndex: Integer); register; 47 | function Find(const aSocketHandle: TSocketHandle; var aIndex: Integer): Boolean; register; 48 | function IndexOf(const aSocketHandle: TSocketHandle): Integer; register; 49 | 50 | property Count: Integer read FCount; 51 | property SocketHandles[index: Integer]: TSocketHandle read GetSocketHandles; default; 52 | property Lines[index: Integer]: TncLine read GetLines write PutLines; 53 | end; 54 | 55 | implementation 56 | 57 | resourcestring 58 | SDuplicateSocketHandle = 'Socket handle list does not allow duplicates'; 59 | 60 | { TSocketList } 61 | 62 | destructor TSocketList.Destroy; 63 | begin 64 | inherited Destroy; 65 | FCount := 0; 66 | SetCapacity(0); 67 | end; 68 | 69 | procedure TSocketList.AssignTo(Dest: TPersistent); 70 | var 71 | DestList: TSocketList; 72 | begin 73 | if Dest is TSocketList then 74 | begin 75 | DestList := TSocketList(Dest); 76 | DestList.FCapacity := FCapacity; 77 | DestList.FCount := FCount; 78 | DestList.FList := Copy(FList); 79 | end 80 | else 81 | raise EConvertError.CreateResFmt(@SAssignError, [ClassName, Dest.ClassName]); 82 | end; 83 | 84 | function TSocketList.Add(const aSocketHandle: TSocketHandle; aLine: TncLine): Integer; 85 | begin 86 | if Find(aSocketHandle, Result) then 87 | raise Exception.Create(SDuplicateSocketHandle); 88 | Insert(Result, aSocketHandle, aLine); 89 | end; 90 | 91 | procedure TSocketList.Clear; 92 | begin 93 | if FCount <> 0 then 94 | begin 95 | FCount := 0; 96 | SetCapacity(0); 97 | end; 98 | end; 99 | 100 | procedure TSocketList.Delete(aIndex: Integer); 101 | begin 102 | if (aIndex < 0) or (aIndex >= FCount) then 103 | raise Exception.Create(Format(SListIndexError, [aIndex])); 104 | 105 | Dec(FCount); 106 | if aIndex < FCount then 107 | System.Move(FList[aIndex + 1], FList[aIndex], (FCount - aIndex) * SizeOf(TSocketItem)); 108 | end; 109 | 110 | // Binary Searching 111 | 112 | function TSocketList.Find(const aSocketHandle: TSocketHandle; var aIndex: Integer): Boolean; 113 | var 114 | Low, High, Mid: Integer; 115 | begin 116 | Result := False; 117 | Low := 0; 118 | High := FCount - 1; 119 | while Low <= High do 120 | begin 121 | Mid := (Low + High) shr 1; 122 | if aSocketHandle > FList[Mid].FSocketHandle then 123 | Low := Mid + 1 124 | else 125 | begin 126 | High := Mid - 1; 127 | if aSocketHandle = FList[Mid].FSocketHandle then 128 | begin 129 | Result := True; 130 | Low := Mid; 131 | end; 132 | end; 133 | end; 134 | aIndex := Low; 135 | end; 136 | 137 | procedure TSocketList.Grow; 138 | var 139 | Delta: Integer; 140 | begin 141 | if FCapacity > 64 then 142 | Delta := FCapacity div 4 143 | else if FCapacity > 8 then 144 | Delta := 16 145 | else 146 | Delta := 4; 147 | SetCapacity(FCapacity + Delta); 148 | end; 149 | 150 | function TSocketList.IndexOf(const aSocketHandle: TSocketHandle): Integer; 151 | begin 152 | if not Find(aSocketHandle, Result) then 153 | Result := -1; 154 | end; 155 | 156 | procedure TSocketList.Insert(aIndex: Integer; const aSocketHandle: TSocketHandle; aLine: TncLine); 157 | begin 158 | if FCount = FCapacity then 159 | Grow; 160 | if aIndex < FCount then 161 | System.Move(FList[aIndex], FList[aIndex + 1], (FCount - aIndex) * SizeOf(TSocketItem)); 162 | with FList[aIndex] do 163 | begin 164 | FSocketHandle := aSocketHandle; 165 | FLine := aLine; 166 | end; 167 | Inc(FCount); 168 | end; 169 | 170 | function TSocketList.GetSocketHandles(Index: Integer): TSocketHandle; 171 | begin 172 | if (index < 0) or (index >= FCount) then 173 | raise Exception.Create(Format(SListIndexError, [index])); 174 | Result := FList[index].FSocketHandle; 175 | end; 176 | 177 | function TSocketList.GetLines(Index: Integer): TncLine; 178 | begin 179 | if (index < 0) or (index >= FCount) then 180 | raise Exception.Create(Format(SListIndexError, [index])); 181 | Result := FList[index].FLine; 182 | end; 183 | 184 | procedure TSocketList.PutLines(Index: Integer; aLine: TncLine); 185 | begin 186 | if (index < 0) or (index >= FCount) then 187 | raise Exception.Create(Format(SListIndexError, [index])); 188 | FList[index].FLine := aLine; 189 | end; 190 | 191 | procedure TSocketList.SetCapacity(aNewCapacity: Integer); 192 | begin 193 | if aNewCapacity < FCount then 194 | raise Exception.Create(Format(SListCapacityError, [aNewCapacity])); 195 | if aNewCapacity <> FCapacity then 196 | begin 197 | SetLength(FList, aNewCapacity); 198 | FCapacity := aNewCapacity; 199 | end; 200 | end; 201 | 202 | end. 203 | -------------------------------------------------------------------------------- /Android/DW.JSON.pas: -------------------------------------------------------------------------------- 1 | unit DW.JSON; 2 | 3 | {*******************************************************} 4 | { } 5 | { Kastri } 6 | { } 7 | { Delphi Worlds Cross-Platform Library } 8 | { } 9 | { Copyright 2020-2024 Dave Nottage under MIT license } 10 | { which is located in the root folder of this library } 11 | { } 12 | {*******************************************************} 13 | 14 | interface 15 | 16 | uses 17 | // RTL 18 | System.JSON; 19 | 20 | type 21 | TJSONHelper = record 22 | class function IsJSON(const AJSON: string): Boolean; static; 23 | class function JSONEncode(const AValue: TJSONValue): string; overload; static; 24 | class function JSONEncode(const AValue: string): string; overload; static; 25 | class function Tidy(const AValue: TJsonValue; const AIndentSize: Integer = 2): string; overload; static; 26 | class function Tidy(const AValue: string; const AIndentSize: Integer = 2): string; overload; static; 27 | class function ToJSON(const AValue: string; const AKey: string = ''): string; overload; static; 28 | class function ToJSON(const AValues: TArray): string; overload; static; 29 | class function ToJSON(const AValues: TArray; const AKey: string): string; overload; static; 30 | class function ToJSONValue(const AValues: TArray): TJSONValue; static; 31 | class function ToStringArray(const AValues: TJSONArray): TArray; static; 32 | end; 33 | 34 | TJSONValueHelper = class helper for TJSONValue 35 | function TryGetISO8601Date(const APath: string; out ADate: TDateTime; const AReturnUTC: Boolean = True): Boolean; 36 | end; 37 | 38 | implementation 39 | 40 | uses 41 | // RTL 42 | System.Character, System.SysUtils, System.DateUtils; 43 | 44 | class function TJSONHelper.IsJson(const AJson: string): Boolean; 45 | var 46 | LJsonValue: TJSONValue; 47 | begin 48 | Result := False; 49 | LJsonValue := TJSONObject.ParseJSONValue(AJson); 50 | if LJsonValue <> nil then 51 | try 52 | Result := True; 53 | finally 54 | LJsonValue.Free; 55 | end; 56 | end; 57 | 58 | class function TJSONHelper.JSONEncode(const AValue: TJSONValue): string; 59 | begin 60 | Result := AValue.ToJSON; 61 | end; 62 | 63 | class function TJSONHelper.JSONEncode(const AValue: string): string; 64 | var 65 | LValue: TJSONValue; 66 | LStr: string; 67 | begin 68 | LStr := AnsiQuotedStr(AValue, '\'); 69 | LStr := Copy(LStr, 2, Length(LStr) - 2); 70 | LValue := TJSONObject.ParseJSONValue(LStr, False, True); 71 | try 72 | Result := JSONEncode(LValue); 73 | finally 74 | LValue.Free; 75 | end; 76 | end; 77 | 78 | class function TJSONHelper.Tidy(const AValue: TJsonValue; const AIndentSize: Integer = 2): string; 79 | begin 80 | Result := Tidy(AValue.ToString, AIndentSize); 81 | end; 82 | 83 | // Now based on: https://pastebin.com/Juks92Y2 (if the link still exists), by Lars Fosdal 84 | class function TJSONHelper.Tidy(const AValue: string; const AIndentSize: Integer = 2): string; 85 | const 86 | cEOL = #13#10; 87 | var 88 | LChar: Char; 89 | LIsInString: boolean; 90 | LIsEscape: boolean; 91 | LIsHandled: boolean; 92 | LIndent: Integer; 93 | begin 94 | Result := ''; 95 | LIndent := 0; 96 | LIsInString := False; 97 | LIsEscape := False; 98 | for LChar in AValue do 99 | begin 100 | if not LIsInString then 101 | begin 102 | LIsHandled := False; 103 | if (LChar = '{') or (LChar = '[') then 104 | begin 105 | Inc(LIndent); 106 | Result := Result + LChar + cEOL + StringOfChar(' ', LIndent * AIndentSize); 107 | LIsHandled := True; 108 | end 109 | else if LChar = ',' then 110 | begin 111 | Result := Result + LChar + cEOL + StringOfChar(' ', LIndent * AIndentSize); 112 | LIsHandled := True; 113 | end 114 | else if (LChar = '}') or (LChar = ']') then 115 | begin 116 | Dec(LIndent); 117 | Result := Result + cEOL + StringOfChar(' ', LIndent * AIndentSize) + LChar; 118 | LIsHandled := True; 119 | end; 120 | if not LIsHandled and not LChar.IsWhiteSpace then 121 | Result := Result + LChar; 122 | end 123 | else 124 | Result := Result + LChar; 125 | if not LIsEscape and (LChar = '"') then 126 | LIsInString := not LIsInString; 127 | LIsEscape := (LChar = '\') and not LIsEscape; 128 | end; 129 | end; 130 | 131 | class function TJSONHelper.ToJSON(const AValues: TArray): string; 132 | var 133 | LJSON: TJSONValue; 134 | begin 135 | LJSON := ToJSONValue(AValues); 136 | try 137 | Result := LJSON.ToJSON; 138 | finally 139 | LJSON.Free; 140 | end; 141 | end; 142 | 143 | class function TJSONHelper.ToJSON(const AValues: TArray; const AKey: string): string; 144 | var 145 | LJSON: TJSONObject; 146 | begin 147 | LJSON := TJSONObject.Create; 148 | try 149 | LJSON.AddPair(AKey, ToJSONValue(AValues)); 150 | Result := LJSON.ToJSON; 151 | finally 152 | LJSON.Free; 153 | end; 154 | end; 155 | 156 | class function TJSONHelper.ToJSONValue(const AValues: TArray): TJSONValue; 157 | var 158 | LValues: TJSONArray; 159 | LValue: string; 160 | begin 161 | LValues := TJSONArray.Create; 162 | for LValue in AValues do 163 | LValues.AddElement(TJSONString.Create(LValue)); 164 | Result := LValues; 165 | end; 166 | 167 | class function TJSONHelper.ToJSON(const AValue: string; const AKey: string = ''): string; 168 | var 169 | LValue: TJSONObject; 170 | begin 171 | LValue := TJSONObject.Create; 172 | try 173 | if AKey.IsEmpty then 174 | LValue.AddPair('value', TJSONString.Create(AValue)) 175 | else 176 | LValue.AddPair(AKey, TJSONString.Create(AValue)); 177 | Result := LValue.ToJSON; 178 | finally 179 | LValue.Free; 180 | end; 181 | end; 182 | 183 | class function TJSONHelper.ToStringArray(const AValues: TJSONArray): TArray; 184 | var 185 | LValue: TJSONValue; 186 | begin 187 | for LValue in AValues do 188 | Result := Result + [LValue.Value]; 189 | end; 190 | 191 | { TJSONValueHelper } 192 | 193 | function TJSONValueHelper.TryGetISO8601Date(const APath: string; out ADate: TDateTime; const AReturnUTC: Boolean = True): Boolean; 194 | var 195 | LValue: string; 196 | begin 197 | Result := TryGetValue(APath, LValue); 198 | if Result then 199 | ADate := ISO8601ToDate(LValue, AReturnUTC) 200 | else 201 | ADate := 0; 202 | end; 203 | 204 | end. 205 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncCommandHandlers.pas: -------------------------------------------------------------------------------- 1 | unit ncCommandHandlers; 2 | 3 | // To disable as much of RTTI as possible (Delphi 2009/2010), 4 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 5 | {$IF CompilerVersion >= 21.0} 6 | {$WEAKLINKRTTI ON} 7 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 8 | {$ENDIF} 9 | 10 | interface 11 | 12 | uses 13 | System.Classes, System.SysUtils, System.SyncObjs, System.Rtti, ncSources; 14 | 15 | type 16 | TncCustomCommandHandler = class(TComponent, IncCommandHandler) 17 | private 18 | FSource: TncSourceBase; 19 | FPeerCommandHandler: string; 20 | FOnConnected: TncOnSourceConnectDisconnect; 21 | FOnDisconnected: TncOnSourceConnectDisconnect; 22 | FOnHandleCommand: TncOnSourceHandleCommand; 23 | FOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; 24 | procedure SetSource(const Value: TncSourceBase); 25 | function GetPeerCommandHandler: string; 26 | procedure SetPeerCommandHandler(const Value: string); 27 | function GetOnConnected: TncOnSourceConnectDisconnect; 28 | procedure SetOnConnected(const Value: TncOnSourceConnectDisconnect); 29 | function GetOnDisconnected: TncOnSourceConnectDisconnect; 30 | procedure SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); 31 | function GetOnHandleCommand: TncOnSourceHandleCommand; 32 | procedure SetOnHandleCommand(const Value: TncOnSourceHandleCommand); 33 | function GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; 34 | procedure SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); 35 | protected 36 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; 37 | function GetComponentName: string; 38 | 39 | property Source: TncSourceBase read FSource write SetSource; 40 | property PeerCommandHandler: string read GetPeerCommandHandler write SetPeerCommandHandler; 41 | property OnConnected: TncOnSourceConnectDisconnect read GetOnConnected write SetOnConnected; 42 | property OnDisconnected: TncOnSourceConnectDisconnect read GetOnDisconnected write SetOnDisconnected; 43 | property OnHandleCommand: TncOnSourceHandleCommand read GetOnHandleCommand write SetOnHandleCommand; 44 | property OnAsyncExecCommandResult: TncOnAsyncExecCommandResult read GetOnAsyncExecCommandResult write SetOnAsyncExecCommandResult; 45 | public 46 | constructor Create(AOwner: TComponent); override; 47 | destructor Destroy; override; 48 | 49 | function ExecCommand(aLine: TncSourceLine; const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; 50 | aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''): TBytes; 51 | published 52 | end; 53 | 54 | TncCommandHandler = class(TncCustomCommandHandler) 55 | published 56 | property Source; 57 | property PeerCommandHandler; 58 | 59 | property OnConnected; 60 | property OnDisconnected; 61 | property OnHandleCommand; 62 | end; 63 | 64 | implementation 65 | 66 | { TncCustomCommandHandler } 67 | 68 | constructor TncCustomCommandHandler.Create(AOwner: TComponent); 69 | begin 70 | inherited Create(AOwner); 71 | FSource := nil; 72 | FOnConnected := nil; 73 | FOnDisconnected := nil; 74 | FOnHandleCommand := nil; 75 | FOnAsyncExecCommandResult := nil; 76 | end; 77 | 78 | destructor TncCustomCommandHandler.Destroy; 79 | begin 80 | Source := nil; 81 | inherited Destroy; 82 | end; 83 | 84 | procedure TncCustomCommandHandler.Notification(AComponent: TComponent; Operation: TOperation); 85 | begin 86 | inherited Notification(AComponent, Operation); 87 | 88 | if Operation = opRemove then 89 | if AComponent = FSource then 90 | SetSource(nil); 91 | 92 | if not(csLoading in ComponentState) then 93 | begin 94 | if Operation = opInsert then 95 | if not Assigned(FSource) then 96 | if AComponent is TncSourceBase then 97 | SetSource(TncSourceBase(AComponent)); 98 | end; 99 | end; 100 | 101 | function TncCustomCommandHandler.ExecCommand(aLine: TncSourceLine; const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; 102 | aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''): TBytes; 103 | begin 104 | if not Assigned(Source) then 105 | raise Exception.Create('Cannot execute with no source object'); 106 | 107 | // If no override, we use the component's command handler (the property) 108 | if aPeerComponentHandler = '' then 109 | Result := Source.ExecCommand(aLine, aCmd, aData, aRequiresResult, aAsyncExecute, PeerCommandHandler) 110 | else 111 | Result := Source.ExecCommand(aLine, aCmd, aData, aRequiresResult, aAsyncExecute, aPeerComponentHandler); 112 | end; 113 | 114 | procedure TncCustomCommandHandler.SetSource(const Value: TncSourceBase); 115 | begin 116 | if FSource <> Value then 117 | begin 118 | if Assigned(FSource) then 119 | FSource.RemoveCommandHandler(Self); 120 | 121 | FSource := Value; 122 | 123 | if Assigned(FSource) then 124 | FSource.AddCommandHandler(Self); 125 | end; 126 | end; 127 | 128 | function TncCustomCommandHandler.GetPeerCommandHandler: string; 129 | begin 130 | Result := FPeerCommandHandler; 131 | end; 132 | 133 | procedure TncCustomCommandHandler.SetPeerCommandHandler(const Value: string); 134 | begin 135 | FPeerCommandHandler := Value; 136 | end; 137 | 138 | function TncCustomCommandHandler.GetComponentName: string; 139 | begin 140 | Result := Name; 141 | end; 142 | 143 | function TncCustomCommandHandler.GetOnConnected: TncOnSourceConnectDisconnect; 144 | begin 145 | Result := FOnConnected; 146 | end; 147 | 148 | procedure TncCustomCommandHandler.SetOnConnected(const Value: TncOnSourceConnectDisconnect); 149 | begin 150 | FOnConnected := Value; 151 | end; 152 | 153 | function TncCustomCommandHandler.GetOnDisconnected: TncOnSourceConnectDisconnect; 154 | begin 155 | Result := FOnDisconnected; 156 | end; 157 | 158 | procedure TncCustomCommandHandler.SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); 159 | begin 160 | FOnDisconnected := Value; 161 | end; 162 | 163 | function TncCustomCommandHandler.GetOnHandleCommand: TncOnSourceHandleCommand; 164 | begin 165 | Result := FOnHandleCommand; 166 | end; 167 | 168 | procedure TncCustomCommandHandler.SetOnHandleCommand(const Value: TncOnSourceHandleCommand); 169 | begin 170 | FOnHandleCommand := Value; 171 | end; 172 | 173 | function TncCustomCommandHandler.GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; 174 | begin 175 | Result := FOnAsyncExecCommandResult; 176 | end; 177 | 178 | procedure TncCustomCommandHandler.SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); 179 | begin 180 | FOnAsyncExecCommandResult := Value; 181 | end; 182 | 183 | end. 184 | -------------------------------------------------------------------------------- /Android/Unit_Setting.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Setting; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, 7 | System.Types, 8 | System.UITypes, 9 | System.Classes, 10 | System.Variants, 11 | FMX.Types, 12 | FMX.Controls, 13 | FMX.Forms, 14 | FMX.Graphics, 15 | FMX.Dialogs, 16 | FMX.ListBox, 17 | FMX.StdCtrls, 18 | FMX.Effects, 19 | FMX.Controls.Presentation, 20 | FMX.Edit, 21 | FMX.Objects, 22 | FMX.Layouts, 23 | FMX.Colors, 24 | FMX.Gestures; 25 | 26 | type 27 | TForm_Setting = class(TForm) 28 | ToolBar1: TToolBar; 29 | Label1: TLabel; 30 | Button_MROK: TButton; 31 | Panel_SettingBase: TPanel; 32 | Edit_Host: TEdit; 33 | Edit_Port: TEdit; 34 | Edit_UserName: TEdit; 35 | Panel_ServerHost: TPanel; 36 | Label5: TLabel; 37 | Panel2: TPanel; 38 | Label6: TLabel; 39 | Text1: TText; 40 | Text2: TText; 41 | Text3: TText; 42 | Layout1: TLayout; 43 | Layout2: TLayout; 44 | Layout3: TLayout; 45 | Panel1: TPanel; 46 | Label2: TLabel; 47 | Layout4: TLayout; 48 | Text4: TText; 49 | ColorComboBox_Header: TColorComboBox; 50 | Layout6: TLayout; 51 | Text6: TText; 52 | ColorComboBox_Body: TColorComboBox; 53 | Layout7: TLayout; 54 | Text7: TText; 55 | ColorComboBox_Footer: TColorComboBox; 56 | SpeedButton_DefaultColor: TSpeedButton; 57 | SpeedButton1: TSpeedButton; 58 | SpeedButton2: TSpeedButton; 59 | SpeedButton3: TSpeedButton; 60 | SpeedButton4: TSpeedButton; 61 | SpeedButton6: TSpeedButton; 62 | Panel_Help: TPanel; 63 | Label3: TLabel; 64 | Text5: TText; 65 | Text_Ollama: TText; 66 | GestureManager1: TGestureManager; 67 | GroupBox1: TGroupBox; 68 | Text_Version: TText; 69 | Label_GiuServ: TLabel; 70 | Line1: TLine; 71 | Line2: TLine; 72 | Line3: TLine; 73 | Line4: TLine; 74 | Rectangle_DesignTime: TRectangle; 75 | Layout5: TLayout; 76 | Text10: TText; 77 | ComboBox_FontSize: TComboBox; 78 | Image_Ollama: TImage; 79 | Layout8: TLayout; 80 | Text8: TText; 81 | ColorComboBox_Select: TColorComboBox; 82 | Circle_Connection2: TCircle; 83 | Text9: TText; 84 | SpeedButton_NewLogon: TSpeedButton; 85 | procedure FormShow(Sender: TObject); 86 | procedure Panel_SettingBaseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); 87 | procedure SpeedButton_DefaultColorClick(Sender: TObject); 88 | procedure Panel_SettingBaseGesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean); 89 | procedure Label_GiuServClick(Sender: TObject); 90 | procedure FormCreate(Sender: TObject); 91 | procedure Image_OllamaClick(Sender: TObject); 92 | procedure SpeedButton_NewLogonClick(Sender: TObject); 93 | procedure Edit_UserNameTyping(Sender: TObject); 94 | private 95 | FInitializeFlag: Boolean; 96 | FUserNameSaved: string; 97 | public 98 | end; 99 | 100 | {$IF Defined(ANDROID)} 101 | type 102 | TUrlOpen = class 103 | class procedure Open(URL: string); 104 | end; 105 | {$ENDIF} 106 | 107 | var 108 | Form_Setting: TForm_Setting; 109 | 110 | implementation 111 | 112 | {$R *.fmx} 113 | 114 | uses 115 | {$IF Defined(ANDROID)} 116 | Androidapi.JNI.GraphicsContentViewText, 117 | Androidapi.JNI.Net, 118 | Androidapi.JNI.App, 119 | Androidapi.Helpers, 120 | {$ENDIF} 121 | Unit_Main; 122 | 123 | { Class TUrlOpen ... } 124 | 125 | {$IF Defined(ANDROID)} 126 | class procedure TUrlOpen.Open(URL: string); 127 | begin 128 | var _Intent: JIntent := TJIntent.Create; 129 | _Intent.setAction(TJIntent.JavaClass.ACTION_VIEW); 130 | _Intent.setData(StrToJURI(URL)); 131 | Androidapi.Helpers.TAndroidHelper.Activity.startActivity(_Intent); 132 | end; 133 | {$ENDIF} 134 | 135 | procedure TForm_Setting.Edit_UserNameTyping(Sender: TObject); 136 | begin 137 | var _new: string := Edit_UserName.Text.Trim; 138 | SpeedButton_NewLogon.Visible := not SameText(FUserNameSaved, _new); 139 | end; 140 | 141 | procedure TForm_Setting.FormCreate(Sender: TObject); 142 | begin 143 | Rectangle_DesignTime.Free; 144 | ApplyStyleLookup; 145 | Text_Version.Text := 'Ver. 0.9.10 - 2024.06.21'; 146 | end; 147 | 148 | procedure TForm_Setting.FormShow(Sender: TObject); 149 | begin 150 | if not FInitializeFlag then 151 | begin 152 | FInitializeFlag := True; 153 | Edit_Host.Text := MainForm.ServerHost; 154 | Edit_Port.Text := MainForm.ServerPort.ToString; 155 | 156 | ColorComboBox_Header.Color := MainForm.ColorHeader; 157 | ColorComboBox_Body.Color := MainForm.ColorBody; 158 | ColorComboBox_Footer.Color := MainForm.ColorFooter; 159 | ColorComboBox_Select.Color := MainForm.ColorSelect; 160 | 161 | if MainForm.Font_Size = 12 then 162 | ComboBox_FontSize.ItemIndex := 0 else 163 | if MainForm.Font_Size = 14 then 164 | ComboBox_FontSize.ItemIndex := 1 else 165 | if MainForm.Font_Size = 16 then 166 | ComboBox_FontSize.ItemIndex := 2 167 | else 168 | ComboBox_FontSize.ItemIndex := 1; 169 | end; 170 | 171 | FUserNameSaved := MainForm.UserName; 172 | Edit_UserName.OnChange := nil; 173 | Edit_UserName.Text := MainForm.UserName; 174 | Edit_UserName.OnTyping := Edit_UserNameTyping; 175 | SpeedButton_NewLogon.Visible := False; 176 | Circle_Connection2.Fill.Color := MainForm.Circle_Connection.Fill.Color; 177 | end; 178 | 179 | procedure TForm_Setting.Image_OllamaClick(Sender: TObject); 180 | begin 181 | {$IF Defined(ANDROID)} 182 | TUrlOpen.Open(Text_Ollama.Text.Trim); 183 | {$ENDIF} 184 | end; 185 | 186 | procedure TForm_Setting.Label_GiuServClick(Sender: TObject); 187 | begin 188 | {$IF Defined(ANDROID)} 189 | TUrlOpen.Open(Label_GiuServ.Text.Trim); 190 | {$ENDIF} 191 | end; 192 | 193 | procedure TForm_Setting.Panel_SettingBaseGesture(Sender: TObject; const EventInfo: TGestureEventInfo; var Handled: Boolean); 194 | begin 195 | var _s: string := 'sgiRight'; 196 | if GestureToIdent(EventInfo.GestureID, _s) then 197 | if SameText(_s, 'sgiRightLeft') or SameText(_s, 'sgiRight') then 198 | Self.ModalResult := mrCancel; 199 | end; 200 | 201 | procedure TForm_Setting.Panel_SettingBaseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single); 202 | begin 203 | MainForm.Do_ShowHideVirtualKeyboard(False, nil); 204 | end; 205 | 206 | procedure TForm_Setting.SpeedButton_DefaultColorClick(Sender: TObject); 207 | begin 208 | ColorComboBox_Header.Color := TAlphaColorRec.Chartreuse; 209 | ColorComboBox_Body.Color := TAlphaColorRec.White; 210 | ColorComboBox_Footer.Color := TAlphaColorRec.Silver; 211 | ColorComboBox_Select.Color := TAlphaColorRec.Navy; 212 | ComboBox_FontSize.ItemIndex := 0; 213 | end; 214 | 215 | procedure TForm_Setting.SpeedButton_NewLogonClick(Sender: TObject); 216 | begin 217 | MainForm.UserName := Edit_UserName.Text.Trim; 218 | end; 219 | 220 | end. 221 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncPendingCommandsList.pas: -------------------------------------------------------------------------------- 1 | unit ncPendingCommandsList; 2 | 3 | /// //////////////////////////////////////////////////////////////////////////// 4 | // 5 | // TPendingCommandsList 6 | // Written by Demos Bill, Tue 11/08/2020 7 | // 8 | // PendingCommandsList, the equivalent of TStringList 9 | // but for the type of TncCommandUniqueID 10 | // 11 | /// //////////////////////////////////////////////////////////////////////////// 12 | 13 | interface 14 | 15 | uses System.Classes, System.SysUtils, System.RTLConsts, System.SyncObjs, ncCommandPacking; 16 | 17 | type 18 | TPendingCommandItem = record 19 | FUniqueID: TncCommandUniqueID; 20 | FReceivedResultEvent: TLightweightEvent; 21 | FResult: TncCommand; 22 | end; 23 | 24 | PPendingCommandItem = ^TPendingCommandItem; 25 | 26 | TPendingCommandItemsList = array of TPendingCommandItem; 27 | PPendingCommandItemsList = ^TPendingCommandItemsList; 28 | 29 | TPendingCommandsList = class(TPersistent) 30 | private 31 | FList: TPendingCommandItemsList; 32 | FCount: Integer; 33 | FCapacity: Integer; 34 | function GetUniqueIDs(Index: Integer): TncCommandUniqueID; register; 35 | function GetReceivedResultEvents(Index: Integer): TLightweightEvent; register; 36 | procedure PutReceivedResultEvents(Index: Integer; aReceivedResultEvent: TLightweightEvent); 37 | function GetResults(Index: Integer): TncCommand; 38 | procedure PutResults(Index: Integer; const aResult: TncCommand); 39 | procedure SetCapacity(aNewCapacity: Integer); 40 | protected 41 | procedure Insert(aIndex: Integer; const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent); 42 | procedure Grow; 43 | public 44 | destructor Destroy; override; 45 | 46 | function Add(const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent): Integer; 47 | procedure Clear; 48 | procedure Delete(aIndex: Integer); register; 49 | function Find(const aUniqueID: TncCommandUniqueID; var aIndex: Integer): Boolean; register; 50 | function IndexOf(const aUniqueID: TncCommandUniqueID): Integer; register; 51 | 52 | property Count: Integer read FCount; 53 | property UniqueIDs[index: Integer]: TncCommandUniqueID read GetUniqueIDs; default; 54 | property ReceivedResultEvents[index: Integer]: TLightweightEvent read GetReceivedResultEvents write PutReceivedResultEvents; 55 | property Results[index: Integer]: TncCommand read GetResults write PutResults; 56 | end; 57 | 58 | implementation 59 | 60 | resourcestring 61 | SDuplicateUniqueID = 'Command unique ID list does not allow duplicates'; 62 | 63 | { TPendingCommandList } 64 | 65 | destructor TPendingCommandsList.Destroy; 66 | begin 67 | inherited Destroy; 68 | FCount := 0; 69 | SetCapacity(0); 70 | end; 71 | 72 | function TPendingCommandsList.Add(const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent): Integer; 73 | begin 74 | if Find(aUniqueID, Result) then 75 | raise Exception.Create(SDuplicateUniqueID); 76 | Insert(Result, aUniqueID, aReceivedResultEvent); 77 | end; 78 | 79 | procedure TPendingCommandsList.Clear; 80 | begin 81 | if FCount <> 0 then 82 | begin 83 | FCount := 0; 84 | SetCapacity(0); 85 | end; 86 | end; 87 | 88 | procedure TPendingCommandsList.Delete(aIndex: Integer); 89 | begin 90 | if (aIndex < 0) or (aIndex >= FCount) then 91 | raise Exception.Create(Format(SListIndexError, [aIndex])); 92 | 93 | Dec(FCount); 94 | if aIndex < FCount then 95 | System.Move(FList[aIndex + 1], FList[aIndex], (FCount - aIndex) * SizeOf(TPendingCommandItem)); 96 | end; 97 | 98 | // Binary Searching 99 | 100 | function TPendingCommandsList.Find(const aUniqueID: TncCommandUniqueID; var aIndex: Integer): Boolean; 101 | var 102 | Low, High, Mid: Integer; 103 | begin 104 | Result := False; 105 | Low := 0; 106 | High := FCount - 1; 107 | while Low <= High do 108 | begin 109 | Mid := (Low + High) shr 1; 110 | if aUniqueID > FList[Mid].FUniqueID then 111 | Low := Mid + 1 112 | else 113 | begin 114 | High := Mid - 1; 115 | if aUniqueID = FList[Mid].FUniqueID then 116 | begin 117 | Result := True; 118 | Low := Mid; 119 | end; 120 | end; 121 | end; 122 | aIndex := Low; 123 | end; 124 | 125 | procedure TPendingCommandsList.Grow; 126 | var 127 | Delta: Integer; 128 | begin 129 | if FCapacity > 64 then 130 | Delta := FCapacity div 4 131 | else if FCapacity > 8 then 132 | Delta := 16 133 | else 134 | Delta := 4; 135 | SetCapacity(FCapacity + Delta); 136 | end; 137 | 138 | function TPendingCommandsList.IndexOf(const aUniqueID: TncCommandUniqueID): Integer; 139 | begin 140 | if not Find(aUniqueID, Result) then 141 | Result := -1; 142 | end; 143 | 144 | procedure TPendingCommandsList.Insert(aIndex: Integer; const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent); 145 | begin 146 | if FCount = FCapacity then 147 | Grow; 148 | if aIndex < FCount then 149 | System.Move(FList[aIndex], FList[aIndex + 1], (FCount - aIndex) * SizeOf(TPendingCommandItem)); 150 | with FList[aIndex] do 151 | begin 152 | FUniqueID := aUniqueID; 153 | FReceivedResultEvent := aReceivedResultEvent; 154 | end; 155 | Inc(FCount); 156 | end; 157 | 158 | function TPendingCommandsList.GetUniqueIDs(Index: Integer): TncCommandUniqueID; 159 | begin 160 | if (index < 0) or (index >= FCount) then 161 | raise Exception.Create(Format(SListIndexError, [index])); 162 | Result := FList[index].FUniqueID; 163 | end; 164 | 165 | function TPendingCommandsList.GetReceivedResultEvents(Index: Integer): TLightweightEvent; 166 | begin 167 | if (index < 0) or (index >= FCount) then 168 | raise Exception.Create(Format(SListIndexError, [index])); 169 | Result := FList[index].FReceivedResultEvent; 170 | end; 171 | 172 | procedure TPendingCommandsList.PutReceivedResultEvents(Index: Integer; aReceivedResultEvent: TLightweightEvent); 173 | begin 174 | if (index < 0) or (index >= FCount) then 175 | raise Exception.Create(Format(SListIndexError, [index])); 176 | FList[index].FReceivedResultEvent := aReceivedResultEvent; 177 | end; 178 | 179 | function TPendingCommandsList.GetResults(Index: Integer): TncCommand; 180 | begin 181 | if (index < 0) or (index >= FCount) then 182 | raise Exception.Create(Format(SListIndexError, [index])); 183 | Result := FList[index].FResult; 184 | end; 185 | 186 | procedure TPendingCommandsList.PutResults(Index: Integer; const aResult: TncCommand); 187 | begin 188 | if (index < 0) or (index >= FCount) then 189 | raise Exception.Create(Format(SListIndexError, [index])); 190 | FList[index].FResult := aResult; 191 | end; 192 | 193 | procedure TPendingCommandsList.SetCapacity(aNewCapacity: Integer); 194 | begin 195 | if aNewCapacity < FCount then 196 | raise Exception.Create(Format(SListCapacityError, [aNewCapacity])); 197 | if aNewCapacity <> FCapacity then 198 | begin 199 | SetLength(FList, aNewCapacity); 200 | FCapacity := aNewCapacity; 201 | end; 202 | end; 203 | 204 | end. 205 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/Encryption/ncEncTea.pas: -------------------------------------------------------------------------------- 1 | {$R-} 2 | {$Q-} 3 | unit ncEncTea; 4 | 5 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 6 | // 7 | // NetCom7 Package 8 | // 13 Dec 2010, 23/3/2024 9 | // 10 | // Written by Demos Bill 11 | // VasDemos@yahoo.co.uk 12 | // 13 | // This portion of NetCom adapts DCPCrypt into the library, 14 | // so that is does not depend on any DCP package the programmer may have installed. 15 | // The reason is because if there is an error in any encryption/decryption class, 16 | // That error should be maintained the same for any compilation of this library, 17 | // that is for any client using it. 18 | // To adapt DCPCrypt, a few changes had to be made: 19 | // 1. cosmetic changes (underscores were removed) 20 | // 2. performance changes 21 | // - const parameters when applicable 22 | // - inlined functions when necessary 23 | // 3. bug fixes: 24 | // - all ciphers do pointer walking arithmetic under only win32 25 | // For example, in DCPblowfish.pas, line 209, 210, you would find: 26 | // xL:= Pdword(@InData)^; 27 | // xR:= Pdword(longword(@InData)+4)^; 28 | // That would treat, wrongly, the address of @InData as a 32 bit unsigned int, 29 | // so all this type of pointer arithmetic has been replaced with the proper: 30 | // xL:= Pdword(@InData)^; 31 | // xR:= Pdword(NativeUInt(@InData)+4)^; 32 | // - All Pdword and dword references have been replaced with their appropriate 33 | // intrinsic types. 34 | // 35 | // Bellow is tribute to David Barton for supplying such a gem to the software community: 36 | // 37 | { ****************************************************************************** } 38 | { * Copyright (c) 1999-2002 David Barton * } 39 | { * Permission is hereby granted, free of charge, to any person obtaining a * } 40 | { * copy of this software and associated documentation files (the "Software"), * } 41 | { * to deal in the Software without restriction, including without limitation * } 42 | { * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } 43 | { * and/or sell copies of the Software, and to permit persons to whom the * } 44 | { * Software is furnished to do so, subject to the following conditions: * } 45 | { * * } 46 | { * The above copyright notice and this permission notice shall be included in * } 47 | { * all copies or substantial portions of the Software. * } 48 | { * * } 49 | { * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } 50 | { * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } 51 | { * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } 52 | { * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } 53 | { * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } 54 | { * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } 55 | { * DEALINGS IN THE SOFTWARE. * } 56 | { ****************************************************************************** } 57 | // 58 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 59 | 60 | // To disable as much of RTTI as possible (Delphi 2009/2010), 61 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 62 | {$IF CompilerVersion >= 21.0} 63 | {$WEAKLINKRTTI ON} 64 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 65 | {$ENDIF} 66 | 67 | interface 68 | 69 | uses 70 | System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; 71 | 72 | type 73 | TncEnc_tea = class(TncEnc_blockcipher64) 74 | protected 75 | KeyData: array [0 .. 3] of UInt32; 76 | procedure InitKey(const Key; Size: longword); override; 77 | public 78 | class function GetAlgorithm: string; override; 79 | class function GetMaxKeySize: Integer; override; 80 | class function SelfTest: Boolean; override; 81 | procedure Burn; override; 82 | procedure EncryptECB(const InData; var OutData); override; 83 | procedure DecryptECB(const InData; var OutData); override; 84 | end; 85 | 86 | { ****************************************************************************** } 87 | { ****************************************************************************** } 88 | implementation 89 | 90 | uses ncEncryption; 91 | 92 | const 93 | Delta = $9E3779B9; 94 | Rounds = 32; 95 | 96 | function SwapDword(const a: UInt32): UInt32; inline; 97 | begin 98 | Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); 99 | end; 100 | 101 | class function TncEnc_tea.GetAlgorithm: string; 102 | begin 103 | Result := 'Tea'; 104 | end; 105 | 106 | class function TncEnc_tea.GetMaxKeySize: Integer; 107 | begin 108 | Result := 128; 109 | end; 110 | 111 | class function TncEnc_tea.SelfTest: Boolean; 112 | const 113 | Key: array [0 .. 3] of UInt32 = ($12345678, $9ABCDEF0, $0FEDCBA9, $87654321); 114 | PT: array [0 .. 1] of UInt32 = ($12345678, $9ABCDEF0); 115 | var 116 | Data: array [0 .. 1] of UInt32; 117 | Cipher: TncEnc_tea; 118 | begin 119 | Cipher := TncEnc_tea.Create(nil); 120 | Cipher.Init(Key, Sizeof(Key) * 8, nil); 121 | Cipher.EncryptECB(PT, Data); 122 | Result := not CompareMem(@Data, @PT, Sizeof(PT)); 123 | Cipher.DecryptECB(Data, Data); 124 | Result := Result and CompareMem(@Data, @PT, Sizeof(PT)); 125 | Cipher.Burn; 126 | Cipher.Free; 127 | end; 128 | 129 | procedure TncEnc_tea.InitKey(const Key; Size: longword); 130 | begin 131 | FillChar(KeyData, Sizeof(KeyData), 0); 132 | Move(Key, KeyData, Size div 8); 133 | KeyData[0] := SwapDword(KeyData[0]); 134 | KeyData[1] := SwapDword(KeyData[1]); 135 | KeyData[2] := SwapDword(KeyData[2]); 136 | KeyData[3] := SwapDword(KeyData[3]); 137 | end; 138 | 139 | procedure TncEnc_tea.Burn; 140 | begin 141 | FillChar(KeyData, Sizeof(KeyData), 0); 142 | inherited Burn; 143 | end; 144 | 145 | procedure TncEnc_tea.EncryptECB(const InData; var OutData); 146 | var 147 | a, b, c, d, x, y, n, sum: UInt32; 148 | begin 149 | if not FInitialized then 150 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 151 | 152 | x := SwapDword(PUInt32(@InData)^); 153 | y := SwapDword(PUInt32(NativeUInt(@InData) + 4)^); 154 | sum := 0; 155 | a := KeyData[0]; 156 | b := KeyData[1]; 157 | c := KeyData[2]; 158 | d := KeyData[3]; 159 | for n := 1 to Rounds do 160 | begin 161 | Inc(sum, Delta); 162 | Inc(x, (y shl 4) + (a xor y) + (sum xor (y shr 5)) + b); 163 | Inc(y, (x shl 4) + (c xor x) + (sum xor (x shr 5)) + d); 164 | end; 165 | PUInt32(@OutData)^ := SwapDword(x); 166 | PUInt32(NativeUInt(@OutData) + 4)^ := SwapDword(y); 167 | end; 168 | 169 | procedure TncEnc_tea.DecryptECB(const InData; var OutData); 170 | var 171 | a, b, c, d, x, y, n, sum: UInt32; 172 | begin 173 | if not FInitialized then 174 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 175 | 176 | x := SwapDword(PUInt32(@InData)^); 177 | y := SwapDword(PUInt32(NativeUInt(@InData) + 4)^); 178 | sum := Delta shl 5; 179 | a := KeyData[0]; 180 | b := KeyData[1]; 181 | c := KeyData[2]; 182 | d := KeyData[3]; 183 | for n := 1 to Rounds do 184 | begin 185 | Dec(y, (x shl 4) + (c xor x) + (sum xor (x shr 5)) + d); 186 | Dec(x, (y shl 4) + (a xor y) + (sum xor (y shr 5)) + b); 187 | Dec(sum, Delta); 188 | end; 189 | PUInt32(@OutData)^ := SwapDword(x); 190 | PUInt32(NativeUInt(@OutData) + 4)^ := SwapDword(y); 191 | end; 192 | 193 | end. 194 | -------------------------------------------------------------------------------- /Unit_Translator.pas: -------------------------------------------------------------------------------- 1 | unit Unit_Translator; 2 | 3 | {$I OllmaClient_Defines.inc} 4 | 5 | interface 6 | 7 | uses 8 | Winapi.Windows, 9 | Winapi.Messages, 10 | System.SysUtils, 11 | System.Variants, 12 | System.Classes, 13 | Vcl.Graphics, 14 | Vcl.Controls, 15 | Vcl.Forms, 16 | Vcl.Dialogs, 17 | Vcl.StdCtrls, 18 | Vcl.ExtCtrls, 19 | Vcl.Buttons; 20 | 21 | type 22 | TForm_Translator = class(TForm) 23 | Panel_Buttons: TPanel; 24 | Button_OK: TButton; 25 | Memo_Translates: TMemo; 26 | Panel_Tollbar: TPanel; 27 | CheckBox_Pushtochatbox: TCheckBox; 28 | Label_Prompt: TLabel; 29 | procedure FormCreate(Sender: TObject); 30 | procedure FormKeyPress(Sender: TObject; var Key: Char); 31 | procedure FormShow(Sender: TObject); 32 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 33 | private 34 | FTransResult: string; 35 | FRequest: string; 36 | FPushFlag: Boolean; 37 | procedure SetFRequest(const Value: string); 38 | procedure SetPushFlag(const Value: Boolean); 39 | public 40 | procedure Get_GoogleTranslator(const AUser, ACodeFrom, ACodeTo: Integer; const AText: string); 41 | // property ... 42 | property TransResult: string read FTransResult write FTransResult; 43 | property Request: string read FRequest write SetFRequest; 44 | property PushFlag: Boolean read FPushFlag write SetPushFlag; 45 | end; 46 | 47 | var 48 | TV_AccessKey: string = ''; 49 | 50 | function Get_DetectLanguageCode(const AText: string): string; 51 | function Get_GoogleTranslatorEx(const AUser, ACodeFrom, ACodeTo: Integer; const AText: string): string; 52 | 53 | implementation 54 | 55 | uses 56 | System.Net.HttpClient, 57 | System.Net.URLClient, 58 | System.JSON, 59 | System.JSON.Readers, 60 | System.JSON.Writers, 61 | System.JSON.Types, 62 | Vcl.Themes, 63 | Unit_Common, 64 | Unit_Jsonworks; 65 | 66 | {$R *.dfm} 67 | 68 | { Google tanslate ... } 69 | 70 | function TranslateByGoogle(const ACodeFrom, ACodeTo: Integer; const AText: string): string; 71 | begin 72 | Result := ''; 73 | if AText.IsEmpty then Exit; 74 | if ACodeFrom = ACodeTo then { Same Language ... } 75 | begin 76 | Result := AText; 77 | Exit; 78 | end; 79 | 80 | var _LangSource := GC_LanguageCode[ ACodeFrom ]; 81 | var _LangTarget := GC_LanguageCode[ ACodeTo ]; 82 | var _Head := 'https://translate.googleapis.com/translate_a/single'; 83 | var _URI := TURI.Create(_Head); 84 | var _query := Trim(AText); 85 | with _URI do 86 | begin 87 | AddParameter('client', 'gtx'); 88 | AddParameter('sl', _LangSource); 89 | AddParameter('tl', _LangTarget); 90 | AddParameter('hl', _LangTarget); 91 | AddParameter('dt', 't'); 92 | AddParameter('dt', 'bd'); 93 | AddParameter('dj', '1'); 94 | AddParameter('ie', 'UTF-8'); 95 | AddParameter('source', 'icon'); 96 | AddParameter('tk', '467103.467103'); 97 | AddParameter('q', _query); 98 | end; 99 | 100 | var _Responses := TBytesStream.Create(); 101 | var _getflag: Boolean := False; 102 | var _HTTP := THTTPClient.Create; // To DO : Async - Case of Poor Networking Speed ... 103 | _HTTP.ProtocolVersion := THTTPProtocolVersion.HTTP_1_1; 104 | _HTTP.Accept := 'application/json'; 105 | _HTTP.ContentType := 'application/json; charset=UTF-8'; 106 | _HTTP.CustomHeaders['Authorization'] := ''; 107 | try 108 | _getflag := _HTTP.Get(_URI.Encode, _Responses).StatusCode = 200; 109 | _getflag := _getflag and (_Responses.Size > 1); 110 | if not _getflag then 111 | begin 112 | _Responses.Free; 113 | end; 114 | finally 115 | _HTTP.Free; 116 | end; 117 | 118 | if _getflag then 119 | try 120 | _Responses.Position := 0; 121 | var _rbs := TEncoding.UTF8.GetString(_Responses.Bytes, 0, _Responses.Size); 122 | Result := Get_DisplayJson(TDIsplay_Type.disp_Trans, _rbs); 123 | finally 124 | _Responses.Free; 125 | end; 126 | end; 127 | 128 | // Reference - https://blogs.embarcadero.com/what-you-need-to-add-language-detection-to-your-apps/ 129 | // Languagelayer - https://languagelayer.com/ 130 | // access_key - Get private API Access Key from Languagelayer 131 | // save filename at app path as "languagelayer_accesskey.key" (ex: accesskey=987654321) 132 | // Accurate ? 133 | function Get_DetectLanguageCode(const AText: string): string; 134 | begin 135 | Result := ''; 136 | var _Head := 'http://api.languagelayer.com/detect'; 137 | var _URI := TURI.Create(_Head); 138 | _URI.AddParameter('access_key', TV_AccessKey); 139 | _URI.AddParameter('query', AText); 140 | var _Responses := TBytesStream.Create(); 141 | var _getflag: Boolean := False; 142 | 143 | var _HTTP := THTTPClient.Create; 144 | _HTTP.ProtocolVersion := THTTPProtocolVersion.HTTP_1_1; 145 | _HTTP.Accept := 'application/json'; 146 | _HTTP.ContentType := 'application/json; charset=UTF-8'; 147 | _HTTP.CustomHeaders['Authorization'] := 'Bearer ' + TV_AccessKey; // ? 148 | try 149 | _getflag := _HTTP.Get(_URI.Encode, _Responses).StatusCode = 200; 150 | if not _getflag then 151 | begin 152 | Result := 'Failed ...'; 153 | _Responses.Free; 154 | end; 155 | finally 156 | _HTTP.Free; 157 | end; 158 | 159 | if _getflag then 160 | try 161 | var _RawResp := TEncoding.UTF8.GetString(_Responses.Bytes, 0, _Responses.Size); 162 | var _JsonResp := TJSONObject.ParseJSONValue(_RawResp) as TJSONObject; 163 | var _DataArr := _JsonResp.GetValue('results'); 164 | try 165 | Result := Format(' code - [ %s ]'+sLineBreak+' name - [ %s ]', [_DataArr.Items[0].GetValue('language_code'), 166 | _DataArr.Items[0].GetValue('language_name')]); 167 | finally 168 | _JsonResp.Free; 169 | end; 170 | finally 171 | _Responses.Free; 172 | end; 173 | end; 174 | 175 | // To Do : ASync Effects : [ TTask.Run -> PostMessage ] ? 176 | function Get_GoogleTranslatorEx(const AUser, ACodeFrom, ACodeTo: Integer; const AText: string): string; 177 | begin 178 | var _trans := TranslateByGoogle(ACodeFrom, ACodeTo, AText); 179 | if _trans <> '' then 180 | Result := _trans.Replace(GC_UTF8_LFA, GC_CRLF, [rfReplaceAll]); 181 | end; 182 | 183 | { TForm_Translator } 184 | 185 | procedure TForm_Translator.FormClose(Sender: TObject; var Action: TCloseAction); 186 | begin 187 | Action := caFree; 188 | end; 189 | 190 | procedure TForm_Translator.FormCreate(Sender: TObject); 191 | begin 192 | Memo_Translates.Clear; 193 | FRequest := ''; 194 | end; 195 | 196 | procedure TForm_Translator.FormKeyPress(Sender: TObject; var Key: Char); 197 | begin 198 | if Key = #27 then 199 | begin 200 | Key := #0; 201 | ModalResult := mrCancel; 202 | end; 203 | end; 204 | 205 | procedure TForm_Translator.FormShow(Sender: TObject); 206 | begin 207 | if TStyleManager.IsCustomStyleActive then 208 | begin 209 | Memo_Translates.StyleElements := [seBorder]; 210 | Memo_Translates.Color := StyleServices.GetStyleColor(scPanel); 211 | end; 212 | CheckBox_Pushtochatbox.Enabled := PushFlag; 213 | end; 214 | 215 | procedure TForm_Translator.Get_GoogleTranslator(const AUser, ACodeFrom, ACodeTo: Integer; const AText: string); 216 | const 217 | c_Type: array [0 .. 1 ] of string = ('Request', 'Prompt'); 218 | begin 219 | FTransResult := TranslateByGoogle(ACodeFrom, ACodeTo, AText); 220 | CheckBox_Pushtochatbox.Enabled := (AUser = 0) and PushFlag; 221 | if FTransResult <> '' then 222 | begin 223 | Label_Prompt.EllipsisPosition := epEndEllipsis; 224 | if FRequest = '' then 225 | Label_Prompt.Caption := 'Type: '+c_Type[AUser] 226 | else 227 | Label_Prompt.Caption := c_Type[AUser] + ' - '+FRequest; 228 | 229 | var _trans := FTransResult.Replace(GC_UTF8_LFA, GC_CRLF, [rfReplaceAll]); 230 | Memo_Translates.Lines.Add(_trans) 231 | end; 232 | end; 233 | 234 | procedure TForm_Translator.SetFRequest(const Value: string); 235 | begin 236 | FRequest := Value; 237 | end; 238 | 239 | procedure TForm_Translator.SetPushFlag(const Value: Boolean); 240 | begin 241 | FPushFlag := Value; 242 | CheckBox_Pushtochatbox.Enabled := Value; 243 | end; 244 | 245 | end. 246 | -------------------------------------------------------------------------------- /Unit_DosCommander.pas: -------------------------------------------------------------------------------- 1 | unit Unit_DosCommander; 2 | 3 | {$I OllmaClient_Defines.inc} 4 | 5 | interface 6 | 7 | uses 8 | Winapi.Windows, 9 | Winapi.Messages, 10 | System.SysUtils, 11 | System.Variants, 12 | System.Classes, 13 | Vcl.Graphics, 14 | Vcl.Controls, 15 | Vcl.Forms, 16 | Vcl.Dialogs, 17 | Vcl.StdCtrls, 18 | Vcl.Buttons, 19 | DosCommand; 20 | 21 | const 22 | DOS_MESSAGE = WM_USER + 1; 23 | DOS_MESSAGE_START = DOS_MESSAGE + 1; 24 | DOS_MESSAGE_STOP = DOS_MESSAGE + 2; 25 | DOS_MESSAGE_FINISH = DOS_MESSAGE + 3; 26 | DOS_MESSAGE_ERROR = DOS_MESSAGE + 4; 27 | 28 | type 29 | TG_DosCommand = class 30 | FDosCommand: TDosCommand; 31 | FDosTexts: TStrings; 32 | FCommand: string; 33 | FBatchMemo: TMemo; 34 | private 35 | FBatchRunning: Boolean; 36 | procedure DosCommandNewLine(ASender: TObject; const ANewLine: string; AOutputType: TOutputType); 37 | public 38 | constructor Create(); 39 | destructor Destroy; override; 40 | // 41 | procedure DosCommandTerminated(Sender: TObject); 42 | procedure DosCommandExecuteError(ASender: TObject; AE: Exception; var AHandled: Boolean); 43 | function Dos_Execute(const Acmd: string): Boolean; 44 | function Dos_Exit(): Boolean; 45 | procedure Dos_CommandBatch(ACmd: string); 46 | procedure Dos_CommandBatch2(ACmd: string); 47 | function Get_DosResult(AFlag: Integer = 0): string; 48 | { property ... } 49 | property DosCommand: TDosCommand read FDosCommand; 50 | property Command: string read FCommand; 51 | property BatchRunning: Boolean read FBatchRunning write FBatchRunning; 52 | property BatchMemo: TMemo read FBatchMemo write FBatchMemo; 53 | end; 54 | 55 | type 56 | TForm_DosCommander = class(TForm) 57 | GroupBox1: TGroupBox; 58 | Label_Ollama: TLabel; 59 | Edit_CommandFlag: TEdit; 60 | Button_OK: TButton; 61 | Button_Cancel: TButton; 62 | Label_Help: TLabel; 63 | Label_Version: TLabel; 64 | Label_List: TLabel; 65 | Label_Ps: TLabel; 66 | Label_Reserved: TLabel; 67 | Label_Run: TLabel; 68 | Label_Pull: TLabel; 69 | Label_Show: TLabel; 70 | procedure FormShow(Sender: TObject); 71 | procedure FormKeyPress(Sender: TObject; var Key: Char); 72 | procedure Label_ListClick(Sender: TObject); 73 | procedure Edit_CommandFlagKeyPress(Sender: TObject; var Key: Char); 74 | private 75 | FShowPosition: TPoint; 76 | public 77 | property ShowPositon: TPoint read FShowPosition write FShowPosition; 78 | end; 79 | 80 | var 81 | GV_DosCommand: TG_DosCommand; 82 | 83 | implementation 84 | 85 | uses 86 | WinAPi.ShellAPI, 87 | VCl.Themes, 88 | Unit_Common, 89 | Unit_Main; 90 | 91 | {$R *.dfm} 92 | 93 | { TG_DosCommand ... } 94 | 95 | constructor TG_DosCommand.Create; 96 | begin 97 | FDosTexts := TStringList.Create; 98 | FDosCommand := TDosCommand.Create(nil); 99 | FBatchRunning := False; 100 | with FDosCommand do 101 | begin 102 | InputToOutput := False; 103 | OutputLines := FDosTexts; 104 | MaxTimeAfterBeginning := 0; 105 | MaxTimeAfterLastOutput := 1000; 106 | OnExecuteError := DosCommandExecuteError; 107 | OnTerminated := DosCommandTerminated; 108 | end; 109 | end; 110 | 111 | destructor TG_DosCommand.Destroy; 112 | begin 113 | FDosCommand.OnExecuteError := nil; 114 | FDosCommand.OnTerminated := nil; 115 | if FDosCommand.IsRunning then 116 | FDosCommand.Stop; 117 | FreeAndNil(FDosCommand); 118 | FreeAndNil(FDosTexts); 119 | 120 | inherited; 121 | end; 122 | 123 | procedure TG_DosCommand.Dos_CommandBatch(ACmd: string); 124 | begin 125 | if Trim(Acmd) = '' then Exit; 126 | 127 | if FDosCommand.IsRunning then 128 | FDosCommand.Stop; 129 | var _batchfile := CV_AppPath+'ollamarun.bat'; 130 | var _commands := TStringList.Create; 131 | var _success: Boolean := False; 132 | with _commands do 133 | try 134 | Add('@echo off'); 135 | Add('rem Ollama Delphi GUI'); 136 | Add('cd "' + CV_AppPath+'"'); 137 | Add('@echo on'); 138 | Add(Acmd); 139 | Add('pause'); 140 | 141 | _success := IOUtils_WriteAllText(_batchfile, Text); 142 | finally 143 | Free; 144 | end; 145 | 146 | if _success then 147 | begin 148 | Sleep(10); 149 | ShellExecute(0, PChar('open'), PChar(_batchfile), nil, PChar(CV_AppPath), SW_SHOWNORMAL) ; 150 | end; 151 | end; 152 | 153 | procedure TG_DosCommand.Dos_CommandBatch2(ACmd: string); 154 | begin 155 | if Trim(Acmd) = '' then Exit; 156 | 157 | FBatchMemo.Lines.Clear; 158 | if FDosCommand.IsRunning then 159 | FDosCommand.Stop; 160 | 161 | var _batchfile := CV_AppPath+'ollamarun2.bat'; 162 | var _commands := TStringList.Create; 163 | var _success: Boolean := False; 164 | with _commands do 165 | try 166 | Add('@echo off'); 167 | Add('rem Ollama Delphi GUI'); 168 | Add('cd "' + CV_AppPath+'"'); 169 | Add('@echo on'); 170 | Add(Acmd); 171 | 172 | _success := IOUtils_WriteAllText(_batchfile, _commands.Text); 173 | finally 174 | Free; 175 | end; 176 | 177 | if _success then 178 | begin 179 | FBatchRunning := True; 180 | FCommand := Acmd; 181 | with FDosCommand do 182 | try 183 | OnNewLine := DosCommandNewLine; 184 | CommandLine := _batchfile; 185 | CurrentDir := CV_AppPath; 186 | OutputLines := FBatchMemo.Lines; 187 | 188 | Execute; 189 | except 190 | FBatchRunning := False; 191 | Abort; 192 | end; 193 | 194 | repeat 195 | Sleep(100); 196 | Application.ProcessMessages; 197 | until (FDosCommand.EndStatus <> esStill_Active); 198 | 199 | FBatchRunning := False; 200 | end; 201 | end; 202 | 203 | procedure TG_DosCommand.DosCommandNewLine(ASender: TObject; const ANewLine: string; AOutputType: TOutputType); 204 | begin 205 | if AOutputType = otEntireLine then 206 | begin 207 | FBatchMemo.Lines.Add(ANewLine); 208 | end; 209 | end; 210 | 211 | procedure TG_DosCommand.DosCommandExecuteError(ASender: TObject; AE: Exception; var AHandled: Boolean); 212 | begin 213 | if FBatchRunning then Exit; 214 | FDosTexts.Text := 'Error !!!'+GC_CRLF + AE.Message; 215 | PostMessage(Form_RestOllama.Handle, DOS_MESSAGE, DOS_MESSAGE_ERROR, 0); 216 | end; 217 | 218 | procedure TG_DosCommand.DosCommandTerminated(Sender: TObject); 219 | begin 220 | if FBatchRunning then Exit; 221 | // Finish ... 222 | PostMessage(Form_RestOllama.Handle, DOS_MESSAGE, DOS_MESSAGE_FINISH, 0); 223 | end; 224 | 225 | function TG_DosCommand.Dos_Execute(const Acmd: string): Boolean; 226 | begin 227 | if Trim(Acmd) = '' then Exit(False); 228 | 229 | Result := False; 230 | FBatchRunning := False; 231 | FDosCommand.OnTerminated := nil; 232 | if FDosCommand.IsRunning then 233 | FDosCommand.Stop; 234 | FDosCommand.OnTerminated := DosCommandTerminated; 235 | FDosTexts.Clear; 236 | FCommand := Acmd; 237 | 238 | with FDosCommand do 239 | try 240 | CommandLine := Acmd; 241 | CurrentDir := CV_AppPath; 242 | OutputLines := FDosTexts; 243 | 244 | Execute; 245 | except 246 | Abort; 247 | end; 248 | 249 | Result := True; 250 | PostMessage(Form_RestOllama.Handle, DOS_MESSAGE, DOS_MESSAGE_START, 0); 251 | end; 252 | 253 | function TG_DosCommand.Dos_Exit: Boolean; 254 | begin 255 | Result := False; 256 | if FDosCommand.IsRunning then 257 | FDosCommand.Stop; 258 | Result := not FDosCommand.IsRunning;; 259 | PostMessage(Form_RestOllama.Handle, DOS_MESSAGE, DOS_MESSAGE_STOP, 0); 260 | end; 261 | 262 | function TG_DosCommand.Get_DosResult(AFlag: Integer = 0): string; 263 | begin 264 | Result := FDosTexts.Text; 265 | end; 266 | 267 | { TForm_DosCommander } 268 | 269 | procedure TForm_DosCommander.FormKeyPress(Sender: TObject; var Key: Char); 270 | begin 271 | if Key = #27 then 272 | begin 273 | Key := #0; 274 | ModalResult := mrCancel; 275 | end; 276 | end; 277 | 278 | procedure TForm_DosCommander.FormShow(Sender: TObject); 279 | begin 280 | if FShowPosition.X = 0 then 281 | Self.Position := poScreenCenter 282 | else 283 | begin 284 | Self.Left := FShowPosition.X; 285 | Self.Top := FShowPosition.Y; 286 | end; 287 | end; 288 | 289 | procedure TForm_DosCommander.Edit_CommandFlagKeyPress(Sender: TObject; var Key: Char); 290 | begin 291 | if Key = #13 then 292 | begin 293 | Key := #0; 294 | ModalResult := mrOk; 295 | end; 296 | end; 297 | 298 | procedure TForm_DosCommander.Label_ListClick(Sender: TObject); 299 | var 300 | _selectlabel: TLabel absolute Sender; 301 | begin 302 | Edit_CommandFlag.Text := _selectlabel.Caption; 303 | Edit_CommandFlag.SetFocus; 304 | end; 305 | 306 | initialization 307 | GV_DosCommand := TG_DosCommand.Create; 308 | 309 | finalization 310 | FreeAndNil(GV_DosCommand); 311 | 312 | end. 313 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/ncCommandPacking.pas: -------------------------------------------------------------------------------- 1 | unit ncCommandPacking; 2 | 3 | /// //////////////////////////////////////////////////////////////////////////// 4 | // 5 | // TSocketList 6 | // 7 | // This unit declares a TncCommand which is used by ncSources to pass 8 | // information from peer to peer. 9 | // The TncCommand can be packed and unnpacked into and from a TBytes array 10 | // 11 | // This unit has been optimised to perform at maximum speed by checking the 12 | // assembly the compiler generates. 13 | // 14 | // Written by Demos Bill 15 | // 7/8/2020 16 | // - Optimised code by checking assembly. The performance of executing 100000 17 | // times a command with data: 'Hello from Client', and compression on, was 18 | // before optimisation: 57532 msec 19 | // after optimisation: 19383 msec 20 | // performance gain: 2,97 times faster. 21 | // With compression off we can execute 100000 command executions 22 | // in 5438 msec 23 | // This performance testing was made before ncSources were re-engineered. 24 | // Please check ncSources to see what the new performance is after 25 | // latest re-engineering. 26 | // - Initial Creation: Ported code from ncSources 27 | // 28 | /// //////////////////////////////////////////////////////////////////////////// 29 | 30 | interface 31 | 32 | uses SysUtils; 33 | 34 | type 35 | ENetComImproperMessageEncoding = class(Exception); 36 | 37 | TncCommandType = (ctInitiator, ctResponse); 38 | PncCommandType = ^TncCommandType; 39 | 40 | TncCommandUniqueID = UInt32; 41 | PncCommandUniqueID = ^TncCommandUniqueID; 42 | 43 | TncCommandCmd = UInt32; 44 | PncCommandCmd = ^TncCommandCmd; 45 | 46 | TncCommand = record 47 | public 48 | CommandType: TncCommandType; 49 | UniqueID: TncCommandUniqueID; 50 | Cmd: TncCommandCmd; 51 | Data: TBytes; 52 | RequiresResult: Boolean; 53 | AsyncExecute: Boolean; 54 | ResultIsErrorString: Boolean; 55 | SourceComponentHandler: string; 56 | PeerComponentHandler: string; 57 | 58 | procedure FromBytes(const aBytes: TBytes); 59 | function ToBytes: TBytes; 60 | end; 61 | 62 | resourcestring 63 | ENetComImproperMessageEncodingMessage = 'Improper message encoding'; 64 | 65 | implementation 66 | 67 | // ///////////////////////////////////////////////////////////////////////////// 68 | { TncCommand } 69 | // ///////////////////////////////////////////////////////////////////////////// 70 | 71 | procedure TncCommand.FromBytes(const aBytes: TBytes); 72 | type 73 | PBool = ^Boolean; 74 | PInt32 = ^Int32; 75 | PUInt64 = ^UInt64; 76 | 77 | const 78 | SigLen = SizeOf(Byte); 79 | BytesLen = SizeOf(UInt64); 80 | 81 | CommandTypeLen = SizeOf(TncCommandType); 82 | UniqueIDLen = SizeOf(TncCommandUniqueID); 83 | CmdLen = SizeOf(TncCommandCmd); 84 | AsyncExecuteLen = SizeOf(Boolean); 85 | RequiresResultLen = SizeOf(Boolean); 86 | ResultIsErrorStringLen = SizeOf(Boolean); 87 | 88 | var 89 | AddrPtr: PByte; 90 | DataBytesLen, SourceComponentBytesLen, PeerComponentBytesLen: UInt64; 91 | StrBytes: TBytes; 92 | 93 | begin 94 | // Point to beginning of aBytes 95 | AddrPtr := @aBytes[0]; 96 | 97 | // Read command type 98 | CommandType := PncCommandType(AddrPtr)^; 99 | inc(AddrPtr, CommandTypeLen); 100 | // Read UniqueID 101 | UniqueID := PncCommandUniqueID(AddrPtr)^; 102 | inc(AddrPtr, UniqueIDLen); 103 | // Read Cmd 104 | Cmd := PncCommandCmd(AddrPtr)^; 105 | inc(AddrPtr, CmdLen); 106 | // Read AsyncExecute 107 | AsyncExecute := PBool(AddrPtr)^; 108 | inc(AddrPtr, AsyncExecuteLen); 109 | // Read RequiresResult 110 | RequiresResult := PBool(AddrPtr)^; 111 | inc(AddrPtr, RequiresResultLen); 112 | // Read ResultIsErrorString 113 | ResultIsErrorString := PBool(AddrPtr)^; 114 | inc(AddrPtr, ResultIsErrorStringLen); 115 | 116 | // Read Signature 117 | if PByte(AddrPtr)^ <> $AA then // 10101010 bin 118 | raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); 119 | inc(AddrPtr, SigLen); 120 | // Read DataLen 121 | DataBytesLen := PUInt64(AddrPtr)^; 122 | inc(AddrPtr, BytesLen); 123 | 124 | // Read Signature 125 | if PByte(AddrPtr)^ <> $AA then // 10101010 bin 126 | raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); 127 | inc(AddrPtr, SigLen); 128 | // Read SourceComponentHandlerBytesLen 129 | SourceComponentBytesLen := PUInt64(AddrPtr)^; 130 | inc(AddrPtr, BytesLen); 131 | 132 | // Read Signature 133 | if PByte(AddrPtr)^ <> $AA then // 10101010 bin 134 | raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); 135 | inc(AddrPtr, SigLen); 136 | // Read PeerComponentHandlerBytesLen 137 | PeerComponentBytesLen := PUInt64(AddrPtr)^; 138 | inc(AddrPtr, BytesLen); 139 | 140 | // Read Data 141 | if DataBytesLen > 0 then 142 | begin 143 | SetLength(Data, DataBytesLen); 144 | move(AddrPtr^, Data[0], DataBytesLen); 145 | inc(AddrPtr, DataBytesLen); 146 | end; 147 | // Read SourceComponentHandlerBytes 148 | if SourceComponentBytesLen > 0 then 149 | begin 150 | SetLength(StrBytes, SourceComponentBytesLen); 151 | move(AddrPtr^, StrBytes[0], SourceComponentBytesLen); 152 | SourceComponentHandler := StringOf(StrBytes); 153 | inc(AddrPtr, SourceComponentBytesLen); 154 | end; 155 | // Read PeerComponentHandlerBytes 156 | if PeerComponentBytesLen > 0 then 157 | begin 158 | SetLength(StrBytes, PeerComponentBytesLen); 159 | move(AddrPtr^, StrBytes[0], PeerComponentBytesLen); 160 | PeerComponentHandler := StringOf(StrBytes); 161 | end; 162 | end; 163 | 164 | function TncCommand.ToBytes: TBytes; 165 | type 166 | PBool = ^Boolean; 167 | PInt32 = ^Int32; 168 | PUInt64 = ^UInt64; 169 | 170 | const 171 | SigLen = SizeOf(Byte); 172 | BytesLen = SizeOf(UInt64); 173 | 174 | CommandTypeLen = SizeOf(TncCommandType); 175 | UniqueIDLen = SizeOf(TncCommandUniqueID); 176 | CmdLen = SizeOf(TncCommandCmd); 177 | AsyncExecuteLen = SizeOf(Boolean); 178 | RequiresResultLen = SizeOf(Boolean); 179 | ResultIsErrorStringLen = SizeOf(Boolean); 180 | 181 | StaticBufferLen = 182 | 183 | UInt64(CommandTypeLen + UniqueIDLen + CmdLen + AsyncExecuteLen + RequiresResultLen + ResultIsErrorStringLen + 184 | 185 | SigLen + BytesLen + SigLen + BytesLen + SigLen + BytesLen); 186 | 187 | var 188 | AddrPtr: PByte; 189 | DataBytesLen, SourceComponentBytesLen, PeerComponentBytesLen: UInt64; 190 | SourceComponentHandlerBytes, PeerComponentHandlerBytes: TBytes; 191 | 192 | begin 193 | SourceComponentHandlerBytes := BytesOf(SourceComponentHandler); 194 | PeerComponentHandlerBytes := BytesOf(PeerComponentHandler); 195 | 196 | DataBytesLen := Length(Data); 197 | SourceComponentBytesLen := Length(SourceComponentHandlerBytes); 198 | PeerComponentBytesLen := Length(PeerComponentHandlerBytes); 199 | 200 | SetLength(Result, StaticBufferLen + DataBytesLen + SourceComponentBytesLen + PeerComponentBytesLen); 201 | 202 | // Point to beginning of result buffer 203 | AddrPtr := @Result[0]; 204 | 205 | // Write command type 206 | PncCommandType(AddrPtr)^ := CommandType; 207 | inc(AddrPtr, CommandTypeLen); 208 | // Write UniqueID 209 | PncCommandUniqueID(AddrPtr)^ := UniqueID; 210 | inc(AddrPtr, UniqueIDLen); 211 | // Write Cmd 212 | PncCommandCmd(AddrPtr)^ := Cmd; 213 | inc(AddrPtr, CmdLen); 214 | // Write AnyncExecute 215 | PBool(AddrPtr)^ := AsyncExecute; 216 | inc(AddrPtr, AsyncExecuteLen); 217 | // Write RequiresResult 218 | PBool(AddrPtr)^ := RequiresResult; 219 | inc(AddrPtr, RequiresResultLen); 220 | // Write ResultIsErrorString 221 | PBool(AddrPtr)^ := ResultIsErrorString; 222 | inc(AddrPtr, ResultIsErrorStringLen); 223 | 224 | // Write Signature 225 | PByte(AddrPtr)^ := $AA; // 10101010 bin 226 | inc(AddrPtr, SigLen); 227 | // Write DataLen 228 | PUInt64(AddrPtr)^ := DataBytesLen; 229 | inc(AddrPtr, BytesLen); 230 | 231 | // Write Signature 232 | PByte(AddrPtr)^ := $AA; // 10101010 bin 233 | inc(AddrPtr, SigLen); 234 | // Write SourceComponentHandlerBytesLen 235 | PUInt64(AddrPtr)^ := SourceComponentBytesLen; 236 | inc(AddrPtr, BytesLen); 237 | 238 | // Write Signature 239 | PByte(AddrPtr)^ := $AA; // 10101010 bin 240 | inc(AddrPtr, SigLen); 241 | // Write PeerComponentHandlerBytesLen 242 | PUInt64(AddrPtr)^ := PeerComponentBytesLen; 243 | inc(AddrPtr, BytesLen); 244 | 245 | // Write Data 246 | if DataBytesLen > 0 then 247 | begin 248 | move(Data[0], AddrPtr^, DataBytesLen); 249 | inc(AddrPtr, DataBytesLen); 250 | end; 251 | // Write SourceComponentHandlerBytes 252 | if SourceComponentBytesLen > 0 then 253 | begin 254 | move(SourceComponentHandlerBytes[0], AddrPtr^, SourceComponentBytesLen); 255 | inc(AddrPtr, SourceComponentBytesLen); 256 | end; 257 | // Write PeerComponentHandlerBytes 258 | if PeerComponentBytesLen > 0 then 259 | move(PeerComponentHandlerBytes[0], AddrPtr^, PeerComponentBytesLen); 260 | end; 261 | 262 | end. 263 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/Encryption/ncEncRc5.pas: -------------------------------------------------------------------------------- 1 | {$R-} 2 | {$Q-} 3 | unit ncEncRc5; 4 | 5 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 6 | // 7 | // NetCom7 Package 8 | // 13 Dec 2010, 23/3/2024 9 | // 10 | // Written by Demos Bill 11 | // VasDemos@yahoo.co.uk 12 | // 13 | // This portion of NetCom adapts DCPCrypt into the library, 14 | // so that is does not depend on any DCP package the programmer may have installed. 15 | // The reason is because if there is an error in any encryption/decryption class, 16 | // That error should be maintained the same for any compilation of this library, 17 | // that is for any client using it. 18 | // To adapt DCPCrypt, a few changes had to be made: 19 | // 1. cosmetic changes (underscores were removed) 20 | // 2. performance changes 21 | // - const parameters when applicable 22 | // - inlined functions when necessary 23 | // 3. bug fixes: 24 | // - all ciphers do pointer walking arithmetic under only win32 25 | // For example, in DCPblowfish.pas, line 209, 210, you would find: 26 | // xL:= Pdword(@InData)^; 27 | // xR:= Pdword(longword(@InData)+4)^; 28 | // That would treat, wrongly, the address of @InData as a 32 bit unsigned int, 29 | // so all this type of pointer arithmetic has been replaced with the proper: 30 | // xL:= Pdword(@InData)^; 31 | // xR:= Pdword(NativeUInt(@InData)+4)^; 32 | // - All Pdword and dword references have been replaced with their appropriate 33 | // intrinsic types. 34 | // 35 | // Bellow is tribute to David Barton for supplying such a gem to the software community: 36 | // 37 | { ****************************************************************************** } 38 | { * Copyright (c) 1999-2002 David Barton * } 39 | { * Permission is hereby granted, free of charge, to any person obtaining a * } 40 | { * copy of this software and associated documentation files (the "Software"), * } 41 | { * to deal in the Software without restriction, including without limitation * } 42 | { * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } 43 | { * and/or sell copies of the Software, and to permit persons to whom the * } 44 | { * Software is furnished to do so, subject to the following conditions: * } 45 | { * * } 46 | { * The above copyright notice and this permission notice shall be included in * } 47 | { * all copies or substantial portions of the Software. * } 48 | { * * } 49 | { * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } 50 | { * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } 51 | { * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } 52 | { * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } 53 | { * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } 54 | { * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } 55 | { * DEALINGS IN THE SOFTWARE. * } 56 | { ****************************************************************************** } 57 | // 58 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 59 | 60 | // To disable as much of RTTI as possible (Delphi 2009/2010), 61 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 62 | {$IF CompilerVersion >= 21.0} 63 | {$WEAKLINKRTTI ON} 64 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 65 | {$ENDIF} 66 | 67 | interface 68 | 69 | uses 70 | System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; 71 | 72 | const 73 | NUMROUNDS = 12; { number of rounds must be between 12-16 } 74 | 75 | type 76 | TncEnc_rc5 = class(TncEnc_blockcipher64) 77 | protected 78 | KeyData: array [0 .. ((NUMROUNDS * 2) + 1)] of UInt32; 79 | procedure InitKey(const Key; Size: longword); override; 80 | public 81 | class function GetAlgorithm: string; override; 82 | class function GetMaxKeySize: Integer; override; 83 | class function SelfTest: Boolean; override; 84 | procedure Burn; override; 85 | procedure EncryptECB(const InData; var OutData); override; 86 | procedure DecryptECB(const InData; var OutData); override; 87 | end; 88 | 89 | { ****************************************************************************** } 90 | { ****************************************************************************** } 91 | implementation 92 | 93 | uses ncEncryption; 94 | 95 | const 96 | sBox: array [0 .. 33] of UInt32 = ($B7E15163, $5618CB1C, $F45044D5, $9287BE8E, $30BF3847, $CEF6B200, $6D2E2BB9, $0B65A572, $A99D1F2B, $47D498E4, $E60C129D, $84438C56, $227B060F, $C0B27FC8, $5EE9F981, $FD21733A, $9B58ECF3, $399066AC, $D7C7E065, $75FF5A1E, $1436D3D7, $B26E4D90, $50A5C749, $EEDD4102, $8D14BABB, 97 | $2B4C3474, $C983AE2D, $67BB27E6, $05F2A19F, $A42A1B58, $42619511, $E0990ECA, $7ED08883, $1D08023C); 98 | 99 | function LRot32(const a, b: UInt32): UInt32; inline; 100 | begin 101 | Result := (a shl b) or (a shr (32 - b)); 102 | end; 103 | 104 | function RRot32(const a, b: UInt32): UInt32; inline; 105 | begin 106 | Result := (a shr b) or (a shl (32 - b)); 107 | end; 108 | 109 | class function TncEnc_rc5.GetAlgorithm: string; 110 | begin 111 | Result := 'RC5'; 112 | end; 113 | 114 | class function TncEnc_rc5.GetMaxKeySize: Integer; 115 | begin 116 | Result := 2048; 117 | end; 118 | 119 | class function TncEnc_rc5.SelfTest: Boolean; 120 | const 121 | Key1: array [0 .. 15] of byte = ($DC, $49, $DB, $13, $75, $A5, $58, $4F, $64, $85, $B4, $13, $B5, $F1, $2B, $AF); 122 | Plain1: array [0 .. 1] of UInt32 = ($B7B3422F, $92FC6903); 123 | Cipher1: array [0 .. 1] of UInt32 = ($B278C165, $CC97D184); 124 | Key2: array [0 .. 15] of byte = ($52, $69, $F1, $49, $D4, $1B, $A0, $15, $24, $97, $57, $4D, $7F, $15, $31, $25); 125 | Plain2: array [0 .. 1] of UInt32 = ($B278C165, $CC97D184); 126 | Cipher2: array [0 .. 1] of UInt32 = ($15E444EB, $249831DA); 127 | var 128 | Cipher: TncEnc_rc5; 129 | Data: array [0 .. 1] of UInt32; 130 | begin 131 | Cipher := TncEnc_rc5.Create(nil); 132 | Cipher.Init(Key1, Sizeof(Key1) * 8, nil); 133 | Cipher.EncryptECB(Plain1, Data); 134 | Result := Boolean(CompareMem(@Data, @Cipher1, Sizeof(Data))); 135 | Cipher.DecryptECB(Data, Data); 136 | Result := Result and Boolean(CompareMem(@Data, @Plain1, Sizeof(Data))); 137 | Cipher.Burn; 138 | Cipher.Init(Key2, Sizeof(Key2) * 8, nil); 139 | Cipher.EncryptECB(Plain2, Data); 140 | Result := Result and Boolean(CompareMem(@Data, @Cipher2, Sizeof(Data))); 141 | Cipher.DecryptECB(Data, Data); 142 | Result := Result and Boolean(CompareMem(@Data, @Plain2, Sizeof(Data))); 143 | Cipher.Burn; 144 | Cipher.Free; 145 | end; 146 | 147 | procedure TncEnc_rc5.InitKey(const Key; Size: longword); 148 | var 149 | xKeyD: array [0 .. 63] of UInt32; 150 | i, j, k, xKeyLen: longword; 151 | a, b: UInt32; 152 | begin 153 | FillChar(xKeyD, Sizeof(xKeyD), 0); 154 | Size := Size div 8; 155 | Move(Key, xKeyD, Size); 156 | xKeyLen := Size div 4; 157 | if (Size mod 4) <> 0 then 158 | Inc(xKeyLen); 159 | Move(sBox, KeyData, (NUMROUNDS + 1) * 8); 160 | i := 0; 161 | j := 0; 162 | a := 0; 163 | b := 0; 164 | if xKeyLen > ((NUMROUNDS + 1) * 2) then 165 | k := xKeyLen * 3 166 | else 167 | k := (NUMROUNDS + 1) * 6; 168 | for k := k downto 1 do 169 | begin 170 | a := LRot32(KeyData[i] + a + b, 3); 171 | KeyData[i] := a; 172 | b := LRot32(xKeyD[j] + a + b, a + b); 173 | xKeyD[j] := b; 174 | i := (i + 1) mod ((NUMROUNDS + 1) * 2); 175 | j := (j + 1) mod xKeyLen; 176 | end; 177 | FillChar(xKeyD, Sizeof(xKeyD), 0); 178 | end; 179 | 180 | procedure TncEnc_rc5.Burn; 181 | begin 182 | FillChar(KeyData, Sizeof(KeyData), $FF); 183 | inherited Burn; 184 | end; 185 | 186 | procedure TncEnc_rc5.EncryptECB(const InData; var OutData); 187 | var 188 | a, b: UInt32; 189 | i: longword; 190 | begin 191 | if not FInitialized then 192 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 193 | a := PUInt32(@InData)^ + KeyData[0]; 194 | b := PUInt32(NativeUInt(@InData) + 4)^ + KeyData[1]; 195 | for i := 1 to NUMROUNDS do 196 | begin 197 | a := a xor b; 198 | a := LRot32(a, b) + KeyData[2 * i]; 199 | b := b xor a; 200 | b := LRot32(b, a) + KeyData[(2 * i) + 1]; 201 | end; 202 | PUInt32(@OutData)^ := a; 203 | PUInt32(NativeUInt(@OutData) + 4)^ := b; 204 | end; 205 | 206 | procedure TncEnc_rc5.DecryptECB(const InData; var OutData); 207 | var 208 | a, b: UInt32; 209 | i: longword; 210 | begin 211 | if not FInitialized then 212 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 213 | a := PUInt32(@InData)^; 214 | b := PUInt32(NativeUInt(@InData) + 4)^; 215 | for i := NUMROUNDS downto 1 do 216 | begin 217 | b := RRot32(b - KeyData[(2 * i) + 1], a); 218 | b := b xor a; 219 | a := RRot32(a - KeyData[2 * i], b); 220 | a := a xor b; 221 | end; 222 | PUInt32(@OutData)^ := a - KeyData[0]; 223 | PUInt32(NativeUInt(@OutData) + 4)^ := b - KeyData[1]; 224 | end; 225 | 226 | end. 227 | -------------------------------------------------------------------------------- /Unit_ImageDropDown.pas: -------------------------------------------------------------------------------- 1 | Unit Unit_ImageDropDown; 2 | 3 | Interface 4 | 5 | Uses 6 | WinApi.Windows, 7 | WinApi.Messages, 8 | System.SysUtils, 9 | System.Variants, 10 | System.Classes, 11 | System.Skia, 12 | Vcl.Skia, 13 | Vcl.Graphics, 14 | Vcl.Controls, 15 | Vcl.ExtCtrls, 16 | Vcl.Forms, 17 | Vcl.Buttons, 18 | System.ImageList, 19 | Vcl.Imaging.jpeg, 20 | Vcl.Imaging.pngimage; 21 | 22 | type 23 | TLoadImageEvent = procedure(Sender: TObject; const ALoadFile: string) of object; 24 | TLoadIndexEvent = procedure(Sender: TObject; const AIndex: Integer) of object; 25 | 26 | type 27 | TImageDropDown = Class 28 | private 29 | FImage: TImage; 30 | FPanel: TPanel; 31 | FOriginalPanelWndProc: TWndMethod; 32 | FDropFlag: Integer; 33 | // 34 | FOnLoadImage: TLoadImageEvent; 35 | FOnLoadIndex: TLoadIndexEvent; 36 | FCurrentIndex: Integer; 37 | FImageSourceList: TStringList; 38 | FImagePrevButton: TSpeedButton; 39 | FImageNextButton: TSpeedButton; 40 | procedure WM_ImageDrop(var Msg: TWMDROPFILES); 41 | procedure PanelWindowProc(var Msg: TMessage); 42 | // 43 | procedure Do_UpdateButtons(); 44 | procedure SetCurrentIndex(const Value: Integer); 45 | procedure ImagePrevButtonClick(Sender: TObject); 46 | procedure ImageNextButtonClick(Sender: TObject); 47 | procedure SetImageNextButton(const Value: TSpeedButton); 48 | procedure SetImagePrevButton(const Value: TSpeedButton); 49 | function Load_IMG(const ASourceFile: string): Boolean; 50 | procedure Do_LoadIMG(const AIndex: Integer); 51 | public 52 | constructor Create(AImage: TImage; APanel: TPanel); 53 | destructor Destroy; override; 54 | procedure LoadIMG_Drop(const ADropedFile: string); 55 | // property ... 56 | property Image: TImage read FImage; 57 | property DropFlag: Integer read FDropFlag write FDropFlag; 58 | property OnLoadImage: TLoadImageEvent read FOnLoadImage write FOnLoadImage; 59 | property OnLoadIndex: TLoadIndexEvent read FOnLoadIndex write FOnLoadIndex; 60 | // 61 | property ImagePrevButton: TSpeedButton read FImagePrevButton write SetImagePrevButton; 62 | property ImageNextButton: TSpeedButton read FImageNextButton write SetImageNextButton; 63 | property CurrentIndex: Integer read FCurrentIndex write SetCurrentIndex; 64 | end; 65 | 66 | function GetResizedImage(const AImage: ISkImage; const ANewWidth, ANewHeight: Integer): ISkImage; 67 | 68 | implementation 69 | 70 | uses 71 | WinApi.ShellAPI, 72 | Vcl.Dialogs, 73 | System.Math, 74 | System.UITypes, 75 | Unit_Common, 76 | Unit_Main; 77 | 78 | function GetResizedImage(const AImage: ISkImage; const ANewWidth, ANewHeight: Integer): ISkImage; 79 | begin 80 | var _ScaleFactor: single := Min(ANewWidth / AImage.Width, ANewHeight / AImage.Height); 81 | var _NewWidth: single := AImage.Width * _ScaleFactor; 82 | var _NewHeight: single := AImage.Height * _ScaleFactor; 83 | var _OffsetX: single := (ANewWidth - _NewWidth) / 2; 84 | var _OffsetY: single := (ANewHeight - _NewHeight) / 2; 85 | 86 | var _Surface: ISkSurface := TSkSurface.MakeRaster(ANewWidth, ANewHeight); 87 | _Surface.Canvas.Clear(TAlphaColors.Null); 88 | _Surface.Canvas.Scale(_ScaleFactor, _ScaleFactor); 89 | _Surface.Canvas.DrawImage(AImage, _OffsetX / _ScaleFactor, _OffsetY / _ScaleFactor, TSkSamplingOptions.Medium); 90 | Result := _Surface.MakeImageSnapshot; 91 | 92 | // reserved ... 93 | // var _Bitmap := TBitmap.CreateFromSkImage(_Surface.MakeImageSnapshot) 94 | end; 95 | 96 | function TImageDropDown.Load_IMG(const ASourceFile: string): Boolean; 97 | begin 98 | Result := False; 99 | if FileExists(ASourceFile) then 100 | try 101 | var _ext := LowerCase(ExtractFileExt(ASourceFile)); 102 | if (_ext = '.webp') or (_ext = '.gif') then { Unsupported Image Format in Multimodel Image } 103 | begin 104 | var _BytesStreamJpg: TBytesStream := TBytesStream.Create(); 105 | try 106 | var _skImage: ISkImage := TSkImage.MakeFromEncodedFile(ASourceFile); 107 | if _skImage.EncodeToStream(_BytesStreamJpg, TSkEncodedImageFormat.jpeg) then 108 | begin 109 | _BytesStreamJpg.Position := 0; 110 | FImage.Picture.LoadFromStream(_BytesStreamJpg); 111 | end; 112 | finally 113 | _BytesStreamJpg.Free; 114 | end 115 | end 116 | else 117 | FImage.Picture.LoadFromFile(ASourceFile); 118 | 119 | Result := True; 120 | except 121 | Raise; 122 | end; 123 | end; 124 | 125 | procedure TImageDropDown.WM_ImageDrop(var Msg: TWMDROPFILES); 126 | begin 127 | inherited; 128 | var _DropH: HDROP := Msg.Drop; 129 | try 130 | var _numFiles := DragQueryFile(_DropH, $FFFFFFFF, nil, 0); 131 | if _numFiles >= 1 then 132 | begin 133 | var _FileNameLength := DragQueryFile(_DropH, 0, nil, 0); 134 | var _FileName: string := ''; 135 | SetLength(_FileName, _FileNameLength); 136 | DragQueryFile(_DropH, 0, PChar(_FileName), _FileNameLength + 1); 137 | LoadIMG_Drop(_FileName); 138 | end; 139 | finally 140 | DragFinish(_DropH); 141 | end; 142 | 143 | Msg.Result := 0; 144 | end; 145 | 146 | procedure TImageDropDown.LoadIMG_Drop(const ADropedFile: string); 147 | const 148 | c_VerifyImgFormat = '...*.jpg...*.jpeg...*.png...*.webp...*.gif'; 149 | begin 150 | FDropFlag := -1; 151 | var _ext := LowerCase(ExtractFileExt(ADropedFile)); 152 | if Pos(_ext, c_VerifyImgFormat) > 3 then 153 | try 154 | if (_ext = '.webp') or (_ext = '.gif') then { Unsupported Image Format in Multimodel Image } 155 | begin 156 | var _BytesStreamJpg: TBytesStream := TBytesStream.Create(); 157 | try 158 | var _skImage := TSkImage.MakeFromEncodedFile(ADropedFile); 159 | if _skImage.EncodeToStream(_BytesStreamJpg, TSkEncodedImageFormat.jpeg) then 160 | begin 161 | _BytesStreamJpg.Position := 0; 162 | FImage.Picture.LoadFromStream(_BytesStreamJpg); 163 | end; 164 | finally 165 | _BytesStreamJpg.Free; 166 | end 167 | end 168 | else 169 | FImage.Picture.LoadFromFile(ADropedFile); 170 | 171 | CurrentIndex := FImageSourceList.Add(ADropedFile); 172 | if Assigned(FOnLoadImage) then 173 | FOnLoadImage(Self, ADropedFile); 174 | except 175 | Raise; 176 | end 177 | else 178 | ShowMessage('Not Supported Image Format'#13#10' - supported format - (*.jpg, *.jpeg, *.png, *.webp, *.gif)'); 179 | 180 | FDropFlag := 0; 181 | end; 182 | 183 | constructor TImageDropDown.Create(AImage: TImage; APanel: TPanel); 184 | begin 185 | FImage := AImage; 186 | FPanel := APanel; 187 | 188 | FDropFlag := 0; 189 | FCurrentIndex := -1; 190 | FImageSourceList := TStringList.Create; 191 | FImage.Picture.Graphic.EnableScaledDrawer(TWICScaledGraphicDrawer); 192 | 193 | FOriginalPanelWndProc := APanel.WindowProc; 194 | APanel.WindowProc := PanelWindowProc; 195 | DragAcceptFiles(APanel.Handle, True); 196 | end; 197 | 198 | procedure TImageDropDown.PanelWindowProc(var Msg: TMessage); 199 | begin 200 | if Msg.Msg = WM_DROPFILES then 201 | WM_ImageDrop(TWMDROPFILES(Msg)) 202 | else 203 | FOriginalPanelWndProc(Msg); 204 | end; 205 | 206 | destructor TImageDropDown.Destroy; 207 | begin 208 | if Assigned(FPanel) then 209 | begin 210 | FPanel.WindowProc := FOriginalPanelWndProc; 211 | DragAcceptFiles(FPanel.Handle, False); 212 | end; 213 | FImageSourceList.Free; 214 | inherited; 215 | end; 216 | 217 | procedure TImageDropDown.Do_LoadIMG(const AIndex: Integer); 218 | begin 219 | if (AIndex >= 0) and (AIndex < FImageSourceList.Count) then 220 | begin 221 | var _source := FImageSourceList.Strings[AIndex]; 222 | if Load_IMG(_source) then 223 | begin 224 | CurrentIndex := AIndex; 225 | if Assigned(FOnLoadIndex) then 226 | FOnLoadIndex(Self, AIndex); 227 | end; 228 | end; 229 | end; 230 | 231 | procedure TImageDropDown.Do_UpdateButtons; 232 | begin 233 | if Assigned(FImagePrevButton) then 234 | FImagePrevButton.Enabled := (FImageSourceList.Count > 0) and (FCurrentIndex > 0); 235 | if Assigned(FImageNextButton) then 236 | FImageNextButton.Enabled := (FImageSourceList.Count > 0) and (FCurrentIndex < FImageSourceList.Count-1); 237 | end; 238 | 239 | procedure TImageDropDown.SetCurrentIndex(const Value: Integer); 240 | begin 241 | FCurrentIndex := Value; 242 | Do_UpdateButtons; 243 | end; 244 | 245 | procedure TImageDropDown.ImageNextButtonClick(Sender: TObject); 246 | begin 247 | var _nextindex: Integer := FCurrentIndex+1; 248 | Do_LoadIMG(_nextindex); 249 | end; 250 | 251 | procedure TImageDropDown.ImagePrevButtonClick(Sender: TObject); 252 | begin 253 | var _previndex: Integer := FCurrentIndex-1; 254 | Do_LoadIMG(_previndex); 255 | end; 256 | 257 | procedure TImageDropDown.SetImageNextButton(const Value: TSpeedButton); 258 | begin 259 | FImageNextButton := Value; 260 | FImageNextButton.onClick := ImageNextButtonClick; 261 | end; 262 | 263 | procedure TImageDropDown.SetImagePrevButton(const Value: TSpeedButton); 264 | begin 265 | FImagePrevButton := Value; 266 | FImagePrevButton.onClick := ImagePrevButtonClick; 267 | end; 268 | 269 | End. 270 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/Encryption/ncEncRc4.pas: -------------------------------------------------------------------------------- 1 | {$R-} 2 | {$Q-} 3 | unit ncEncRc4; 4 | 5 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 6 | // 7 | // NetCom7 Package 8 | // 13 Dec 2010, 23/3/2024 9 | // 10 | // Written by Demos Bill 11 | // VasDemos@yahoo.co.uk 12 | // 13 | // This portion of NetCom adapts DCPCrypt into the library, 14 | // so that is does not depend on any DCP package the programmer may have installed. 15 | // The reason is because if there is an error in any encryption/decryption class, 16 | // That error should be maintained the same for any compilation of this library, 17 | // that is for any client using it. 18 | // To adapt DCPCrypt, a few changes had to be made: 19 | // 1. cosmetic changes (underscores were removed) 20 | // 2. performance changes 21 | // - const parameters when applicable 22 | // - inlined functions when necessary 23 | // 3. bug fixes: 24 | // - all ciphers do pointer walking arithmetic under only win32 25 | // For example, in DCPblowfish.pas, line 209, 210, you would find: 26 | // xL:= Pdword(@InData)^; 27 | // xR:= Pdword(longword(@InData)+4)^; 28 | // That would treat, wrongly, the address of @InData as a 32 bit unsigned int, 29 | // so all this type of pointer arithmetic has been replaced with the proper: 30 | // xL:= Pdword(@InData)^; 31 | // xR:= Pdword(NativeUInt(@InData)+4)^; 32 | // - All Pdword and dword references have been replaced with their appropriate 33 | // intrinsic types. 34 | // 35 | // Bellow is tribute to David Barton for supplying such a gem to the software community: 36 | // 37 | { ****************************************************************************** } 38 | { * Copyright (c) 1999-2002 David Barton * } 39 | { * Permission is hereby granted, free of charge, to any person obtaining a * } 40 | { * copy of this software and associated documentation files (the "Software"), * } 41 | { * to deal in the Software without restriction, including without limitation * } 42 | { * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } 43 | { * and/or sell copies of the Software, and to permit persons to whom the * } 44 | { * Software is furnished to do so, subject to the following conditions: * } 45 | { * * } 46 | { * The above copyright notice and this permission notice shall be included in * } 47 | { * all copies or substantial portions of the Software. * } 48 | { * * } 49 | { * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } 50 | { * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } 51 | { * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } 52 | { * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } 53 | { * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } 54 | { * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } 55 | { * DEALINGS IN THE SOFTWARE. * } 56 | { ****************************************************************************** } 57 | // 58 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 59 | 60 | // To disable as much of RTTI as possible (Delphi 2009/2010), 61 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 62 | {$IF CompilerVersion >= 21.0} 63 | {$WEAKLINKRTTI ON} 64 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 65 | {$ENDIF} 66 | 67 | interface 68 | 69 | uses 70 | System.Classes, System.Sysutils, ncEnccrypt2; 71 | 72 | type 73 | TncEnc_rc4 = class(TncEncCipher) 74 | protected 75 | KeyData, KeyOrg: array [0 .. 255] of Byte; 76 | public 77 | class function GetAlgorithm: string; override; 78 | class function GetMaxKeySize: Integer; override; 79 | class function SelfTest: Boolean; override; 80 | procedure Init(const Key; Size: NativeUInt; InitVector: Pointer); override; 81 | procedure Reset; override; 82 | procedure Burn; override; 83 | procedure Encrypt(const InData; var OutData; Size: NativeUInt); override; 84 | procedure Decrypt(const InData; var OutData; Size: NativeUInt); override; 85 | end; 86 | 87 | { ****************************************************************************** } 88 | { ****************************************************************************** } 89 | implementation 90 | 91 | uses ncEncryption; 92 | 93 | class function TncEnc_rc4.GetAlgorithm: string; 94 | begin 95 | Result := 'RC4'; 96 | end; 97 | 98 | class function TncEnc_rc4.GetMaxKeySize: Integer; 99 | begin 100 | Result := 2048; 101 | end; 102 | 103 | class function TncEnc_rc4.SelfTest: Boolean; 104 | const 105 | Key1: array [0 .. 4] of Byte = ($61, $8A, $63, $D2, $FB); 106 | InData1: array [0 .. 4] of Byte = ($DC, $EE, $4C, $F9, $2C); 107 | OutData1: array [0 .. 4] of Byte = ($F1, $38, $29, $C9, $DE); 108 | var 109 | Cipher: TncEnc_rc4; 110 | Data: array [0 .. 4] of Byte; 111 | begin 112 | Cipher := TncEnc_rc4.Create(nil); 113 | Cipher.Init(Key1, Sizeof(Key1) * 8, nil); 114 | Cipher.Encrypt(InData1, Data, Sizeof(Data)); 115 | Result := Boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); 116 | Cipher.Reset; 117 | Cipher.Decrypt(Data, Data, Sizeof(Data)); 118 | Result := Boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; 119 | Cipher.Burn; 120 | Cipher.Free; 121 | end; 122 | 123 | procedure TncEnc_rc4.Init(const Key; Size: NativeUInt; InitVector: Pointer); 124 | var 125 | i, j, t: NativeUInt; 126 | xKey: array [0 .. 255] of Byte; 127 | begin 128 | if FInitialized then 129 | Burn; 130 | inherited Init(Key, Size, nil); 131 | Size := Size div 8; 132 | i := 0; 133 | while i < 255 do 134 | begin 135 | KeyData[i] := i; 136 | xKey[i] := PByte(NativeUInt(@Key) + (i mod Size))^; 137 | KeyData[i + 1] := i + 1; 138 | xKey[i + 1] := PByte(NativeUInt(@Key) + ((i + 1) mod Size))^; 139 | KeyData[i + 2] := i + 2; 140 | xKey[i + 2] := PByte(NativeUInt(@Key) + ((i + 2) mod Size))^; 141 | KeyData[i + 3] := i + 3; 142 | xKey[i + 3] := PByte(NativeUInt(@Key) + ((i + 3) mod Size))^; 143 | KeyData[i + 4] := i + 4; 144 | xKey[i + 4] := PByte(NativeUInt(@Key) + ((i + 4) mod Size))^; 145 | KeyData[i + 5] := i + 5; 146 | xKey[i + 5] := PByte(NativeUInt(@Key) + ((i + 5) mod Size))^; 147 | KeyData[i + 6] := i + 6; 148 | xKey[i + 6] := PByte(NativeUInt(@Key) + ((i + 6) mod Size))^; 149 | KeyData[i + 7] := i + 7; 150 | xKey[i + 7] := PByte(NativeUInt(@Key) + ((i + 7) mod Size))^; 151 | Inc(i, 8); 152 | end; 153 | j := 0; 154 | i := 0; 155 | while i < 255 do 156 | begin 157 | j := (j + KeyData[i] + xKey[i]) and $FF; 158 | t := KeyData[i]; 159 | KeyData[i] := KeyData[j]; 160 | KeyData[j] := t; 161 | j := (j + KeyData[i + 1] + xKey[i + 1]) and $FF; 162 | t := KeyData[i + 1]; 163 | KeyData[i + 1] := KeyData[j]; 164 | KeyData[j] := t; 165 | j := (j + KeyData[i + 2] + xKey[i + 2]) and $FF; 166 | t := KeyData[i + 2]; 167 | KeyData[i + 2] := KeyData[j]; 168 | KeyData[j] := t; 169 | j := (j + KeyData[i + 3] + xKey[i + 3]) and $FF; 170 | t := KeyData[i + 3]; 171 | KeyData[i + 3] := KeyData[j]; 172 | KeyData[j] := t; 173 | j := (j + KeyData[i + 4] + xKey[i + 4]) and $FF; 174 | t := KeyData[i + 4]; 175 | KeyData[i + 4] := KeyData[j]; 176 | KeyData[j] := t; 177 | j := (j + KeyData[i + 5] + xKey[i + 5]) and $FF; 178 | t := KeyData[i + 5]; 179 | KeyData[i + 5] := KeyData[j]; 180 | KeyData[j] := t; 181 | j := (j + KeyData[i + 6] + xKey[i + 6]) and $FF; 182 | t := KeyData[i + 6]; 183 | KeyData[i + 6] := KeyData[j]; 184 | KeyData[j] := t; 185 | j := (j + KeyData[i + 7] + xKey[i + 7]) and $FF; 186 | t := KeyData[i + 7]; 187 | KeyData[i + 7] := KeyData[j]; 188 | KeyData[j] := t; 189 | Inc(i, 8); 190 | end; 191 | Move(KeyData, KeyOrg, Sizeof(KeyOrg)); 192 | end; 193 | 194 | procedure TncEnc_rc4.Reset; 195 | begin 196 | Move(KeyOrg, KeyData, Sizeof(KeyData)); 197 | end; 198 | 199 | procedure TncEnc_rc4.Burn; 200 | begin 201 | FillChar(KeyOrg, Sizeof(KeyOrg), $FF); 202 | FillChar(KeyData, Sizeof(KeyData), $FF); 203 | inherited Burn; 204 | end; 205 | 206 | procedure TncEnc_rc4.Encrypt(const InData; var OutData; Size: NativeUInt); 207 | var 208 | i, j, t, k: longword; 209 | begin 210 | if not FInitialized then 211 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 212 | i := 0; 213 | j := 0; 214 | for k := 0 to Size - 1 do 215 | begin 216 | i := (i + 1) and $FF; 217 | t := KeyData[i]; 218 | j := (j + t) and $FF; 219 | KeyData[i] := KeyData[j]; 220 | KeyData[j] := t; 221 | t := (t + KeyData[i]) and $FF; 222 | Pbytearray(@OutData)^[k] := Pbytearray(@InData)^[k] xor KeyData[t]; 223 | end; 224 | end; 225 | 226 | procedure TncEnc_rc4.Decrypt(const InData; var OutData; Size: NativeUInt); 227 | var 228 | i, j, t, k: longword; 229 | begin 230 | if not FInitialized then 231 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 232 | i := 0; 233 | j := 0; 234 | for k := 0 to Size - 1 do 235 | begin 236 | i := (i + 1) and $FF; 237 | t := KeyData[i]; 238 | j := (j + t) and $FF; 239 | KeyData[i] := KeyData[j]; 240 | KeyData[j] := t; 241 | t := (t + KeyData[i]) and $FF; 242 | Pbytearray(@OutData)^[k] := Pbytearray(@InData)^[k] xor KeyData[t]; 243 | end; 244 | end; 245 | 246 | end. 247 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/Encryption/ncEncRc2.pas: -------------------------------------------------------------------------------- 1 | {$R-} 2 | {$Q-} 3 | unit ncEncRc2; 4 | 5 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 6 | // 7 | // NetCom7 Package 8 | // 13 Dec 2010, 23/3/2024 9 | // 10 | // Written by Demos Bill 11 | // VasDemos@yahoo.co.uk 12 | // 13 | // This portion of NetCom adapts DCPCrypt into the library, 14 | // so that is does not depend on any DCP package the programmer may have installed. 15 | // The reason is because if there is an error in any encryption/decryption class, 16 | // That error should be maintained the same for any compilation of this library, 17 | // that is for any client using it. 18 | // To adapt DCPCrypt, a few changes had to be made: 19 | // 1. cosmetic changes (underscores were removed) 20 | // 2. performance changes 21 | // - const parameters when applicable 22 | // - inlined functions when necessary 23 | // 3. bug fixes: 24 | // - all ciphers do pointer walking arithmetic under only win32 25 | // For example, in DCPblowfish.pas, line 209, 210, you would find: 26 | // xL:= Pdword(@InData)^; 27 | // xR:= Pdword(longword(@InData)+4)^; 28 | // That would treat, wrongly, the address of @InData as a 32 bit unsigned int, 29 | // so all this type of pointer arithmetic has been replaced with the proper: 30 | // xL:= Pdword(@InData)^; 31 | // xR:= Pdword(NativeUInt(@InData)+4)^; 32 | // - All Pdword and dword references have been replaced with their appropriate 33 | // intrinsic types. 34 | // 35 | // Bellow is tribute to David Barton for supplying such a gem to the software community: 36 | // 37 | { ****************************************************************************** } 38 | { * Copyright (c) 1999-2002 David Barton * } 39 | { * Permission is hereby granted, free of charge, to any person obtaining a * } 40 | { * copy of this software and associated documentation files (the "Software"), * } 41 | { * to deal in the Software without restriction, including without limitation * } 42 | { * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } 43 | { * and/or sell copies of the Software, and to permit persons to whom the * } 44 | { * Software is furnished to do so, subject to the following conditions: * } 45 | { * * } 46 | { * The above copyright notice and this permission notice shall be included in * } 47 | { * all copies or substantial portions of the Software. * } 48 | { * * } 49 | { * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } 50 | { * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } 51 | { * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } 52 | { * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } 53 | { * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } 54 | { * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } 55 | { * DEALINGS IN THE SOFTWARE. * } 56 | { ****************************************************************************** } 57 | // 58 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 59 | 60 | // To disable as much of RTTI as possible (Delphi 2009/2010), 61 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 62 | {$IF CompilerVersion >= 21.0} 63 | {$WEAKLINKRTTI ON} 64 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 65 | {$ENDIF} 66 | 67 | interface 68 | 69 | uses 70 | Classes, Sysutils, ncEnccrypt2, ncEncblockciphers; 71 | 72 | type 73 | TncEnc_rc2 = class(TncEnc_blockcipher64) 74 | protected 75 | KeyData: array [0 .. 63] of Word; 76 | procedure InitKey(const Key; Size: longword); override; 77 | public 78 | class function GetAlgorithm: string; override; 79 | class function GetMaxKeySize: integer; override; 80 | class function SelfTest: boolean; override; 81 | procedure Burn; override; 82 | procedure EncryptECB(const InData; var OutData); override; 83 | procedure DecryptECB(const InData; var OutData); override; 84 | end; 85 | 86 | { ****************************************************************************** } 87 | { ****************************************************************************** } 88 | implementation 89 | 90 | uses ncEncryption; 91 | 92 | const 93 | sBox: array [0 .. 255] of byte = ($D9, $78, $F9, $C4, $19, $DD, $B5, $ED, $28, $E9, $FD, $79, $4A, $A0, $D8, $9D, $C6, $7E, $37, $83, $2B, $76, $53, $8E, $62, $4C, $64, $88, $44, $8B, $FB, $A2, $17, $9A, $59, $F5, $87, $B3, $4F, $13, $61, $45, $6D, $8D, $09, $81, $7D, $32, $BD, $8F, $40, $EB, $86, $B7, $7B, $0B, $F0, 94 | $95, $21, $22, $5C, $6B, $4E, $82, $54, $D6, $65, $93, $CE, $60, $B2, $1C, $73, $56, $C0, $14, $A7, $8C, $F1, $DC, $12, $75, $CA, $1F, $3B, $BE, $E4, $D1, $42, $3D, $D4, $30, $A3, $3C, $B6, $26, $6F, $BF, $0E, $DA, $46, $69, $07, $57, $27, $F2, $1D, $9B, $BC, $94, $43, $03, $F8, $11, $C7, $F6, $90, $EF, $3E, $E7, 95 | $06, $C3, $D5, $2F, $C8, $66, $1E, $D7, $08, $E8, $EA, $DE, $80, $52, $EE, $F7, $84, $AA, $72, $AC, $35, $4D, $6A, $2A, $96, $1A, $D2, $71, $5A, $15, $49, $74, $4B, $9F, $D0, $5E, $04, $18, $A4, $EC, $C2, $E0, $41, $6E, $0F, $51, $CB, $CC, $24, $91, $AF, $50, $A1, $F4, $70, $39, $99, $7C, $3A, $85, $23, $B8, $B4, 96 | $7A, $FC, $02, $36, $5B, $25, $55, $97, $31, $2D, $5D, $FA, $98, $E3, $8A, $92, $AE, $05, $DF, $29, $10, $67, $6C, $BA, $C9, $D3, $00, $E6, $CF, $E1, $9E, $A8, $2C, $63, $16, $01, $3F, $58, $E2, $89, $A9, $0D, $38, $34, $1B, $AB, $33, $FF, $B0, $BB, $48, $0C, $5F, $B9, $B1, $CD, $2E, $C5, $F3, $DB, $47, $E5, $A5, 97 | $9C, $77, $0A, $A6, $20, $68, $FE, $7F, $C1, $AD); 98 | 99 | function LRot16(a, n: Word): Word; 100 | begin 101 | Result := (a shl n) or (a shr (16 - n)); 102 | end; 103 | 104 | function RRot16(a, n: Word): Word; 105 | begin 106 | Result := (a shr n) or (a shl (16 - n)); 107 | end; 108 | 109 | class function TncEnc_rc2.GetMaxKeySize: integer; 110 | begin 111 | Result := 1024; 112 | end; 113 | 114 | class function TncEnc_rc2.GetAlgorithm: string; 115 | begin 116 | Result := 'RC2'; 117 | end; 118 | 119 | class function TncEnc_rc2.SelfTest: boolean; 120 | const 121 | Key1: array [0 .. 15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E, $0F); 122 | InData1: array [0 .. 7] of byte = ($00, $00, $00, $00, $00, $00, $00, $00); 123 | OutData1: array [0 .. 7] of byte = ($50, $DC, $01, $62, $BD, $75, $7F, $31); 124 | Key2: array [0 .. 15] of byte = ($00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01); 125 | InData2: array [0 .. 7] of byte = ($00, $00, $00, $00, $00, $00, $00, $00); 126 | OutData2: array [0 .. 7] of byte = ($21, $82, $9C, $78, $A9, $F9, $C0, $74); 127 | var 128 | Cipher: TncEnc_rc2; 129 | Data: array [0 .. 7] of byte; 130 | begin 131 | Cipher := TncEnc_rc2.Create(nil); 132 | Cipher.Init(Key1, Sizeof(Key1) * 8, nil); 133 | Cipher.EncryptECB(InData1, Data); 134 | Result := boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); 135 | Cipher.DecryptECB(Data, Data); 136 | Result := boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; 137 | Cipher.Burn; 138 | Cipher.Init(Key2, Sizeof(Key2) * 8, nil); 139 | Cipher.EncryptECB(InData2, Data); 140 | Result := boolean(CompareMem(@Data, @OutData2, Sizeof(Data))) and Result; 141 | Cipher.DecryptECB(Data, Data); 142 | Result := boolean(CompareMem(@Data, @InData2, Sizeof(Data))) and Result; 143 | Cipher.Burn; 144 | Cipher.Free; 145 | end; 146 | 147 | procedure TncEnc_rc2.InitKey(const Key; Size: longword); 148 | var 149 | i: longword; 150 | KeyB: array [0 .. 127] of byte; 151 | begin 152 | Move(Key, KeyB, Size div 8); 153 | for i := (Size div 8) to 127 do 154 | KeyB[i] := sBox[(KeyB[i - (Size div 8)] + KeyB[i - 1]) and $FF]; 155 | KeyB[0] := sBox[KeyB[0]]; 156 | Move(KeyB, KeyData, Sizeof(KeyData)); 157 | end; 158 | 159 | procedure TncEnc_rc2.Burn; 160 | begin 161 | FillChar(KeyData, Sizeof(KeyData), 0); 162 | inherited Burn; 163 | end; 164 | 165 | procedure TncEnc_rc2.EncryptECB(const InData; var OutData); 166 | var 167 | i, j: longword; 168 | w: array [0 .. 3] of Word; 169 | begin 170 | if not FInitialized then 171 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 172 | PUInt32(@w[0])^ := PUInt32(@InData)^; 173 | PUInt32(@w[2])^ := PUInt32(NativeUInt(@InData) + 4)^; 174 | for i := 0 to 15 do 175 | begin 176 | j := i * 4; 177 | w[0] := LRot16((w[0] + (w[1] and (not w[3])) + (w[2] and w[3]) + KeyData[j + 0]), 1); 178 | w[1] := LRot16((w[1] + (w[2] and (not w[0])) + (w[3] and w[0]) + KeyData[j + 1]), 2); 179 | w[2] := LRot16((w[2] + (w[3] and (not w[1])) + (w[0] and w[1]) + KeyData[j + 2]), 3); 180 | w[3] := LRot16((w[3] + (w[0] and (not w[2])) + (w[1] and w[2]) + KeyData[j + 3]), 5); 181 | if (i = 4) or (i = 10) then 182 | begin 183 | w[0] := w[0] + KeyData[w[3] and 63]; 184 | w[1] := w[1] + KeyData[w[0] and 63]; 185 | w[2] := w[2] + KeyData[w[1] and 63]; 186 | w[3] := w[3] + KeyData[w[2] and 63]; 187 | end; 188 | end; 189 | PUInt32(@OutData)^ := PUInt32(@w[0])^; 190 | PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@w[2])^; 191 | end; 192 | 193 | procedure TncEnc_rc2.DecryptECB(const InData; var OutData); 194 | var 195 | i, j: longword; 196 | w: array [0 .. 3] of Word; 197 | begin 198 | if not FInitialized then 199 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 200 | PUInt32(@w[0])^ := PUInt32(@InData)^; 201 | PUInt32(@w[2])^ := PUInt32(NativeUInt(@InData) + 4)^; 202 | for i := 15 downto 0 do 203 | begin 204 | j := i * 4; 205 | w[3] := RRot16(w[3], 5) - (w[0] and (not w[2])) - (w[1] and w[2]) - KeyData[j + 3]; 206 | w[2] := RRot16(w[2], 3) - (w[3] and (not w[1])) - (w[0] and w[1]) - KeyData[j + 2]; 207 | w[1] := RRot16(w[1], 2) - (w[2] and (not w[0])) - (w[3] and w[0]) - KeyData[j + 1]; 208 | w[0] := RRot16(w[0], 1) - (w[1] and (not w[3])) - (w[2] and w[3]) - KeyData[j + 0]; 209 | if (i = 5) or (i = 11) then 210 | begin 211 | w[3] := w[3] - KeyData[w[2] and 63]; 212 | w[2] := w[2] - KeyData[w[1] and 63]; 213 | w[1] := w[1] - KeyData[w[0] and 63]; 214 | w[0] := w[0] - KeyData[w[3] and 63]; 215 | end; 216 | end; 217 | PUInt32(@OutData)^ := PUInt32(@w[0])^; 218 | PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@w[2])^; 219 | end; 220 | 221 | end. 222 | -------------------------------------------------------------------------------- /Include/NetCom7/Source/Encryption/ncEncRc6.pas: -------------------------------------------------------------------------------- 1 | {$R-} 2 | {$Q-} 3 | unit ncEncRc6; 4 | 5 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 6 | // 7 | // NetCom7 Package 8 | // 13 Dec 2010, 23/3/2024 9 | // 10 | // Written by Demos Bill 11 | // VasDemos@yahoo.co.uk 12 | // 13 | // This portion of NetCom adapts DCPCrypt into the library, 14 | // so that is does not depend on any DCP package the programmer may have installed. 15 | // The reason is because if there is an error in any encryption/decryption class, 16 | // That error should be maintained the same for any compilation of this library, 17 | // that is for any client using it. 18 | // To adapt DCPCrypt, a few changes had to be made: 19 | // 1. cosmetic changes (underscores were removed) 20 | // 2. performance changes 21 | // - const parameters when applicable 22 | // - inlined functions when necessary 23 | // 3. bug fixes: 24 | // - all ciphers do pointer walking arithmetic under only win32 25 | // For example, in DCPblowfish.pas, line 209, 210, you would find: 26 | // xL:= Pdword(@InData)^; 27 | // xR:= Pdword(longword(@InData)+4)^; 28 | // That would treat, wrongly, the address of @InData as a 32 bit unsigned int, 29 | // so all this type of pointer arithmetic has been replaced with the proper: 30 | // xL:= Pdword(@InData)^; 31 | // xR:= Pdword(NativeUInt(@InData)+4)^; 32 | // - All Pdword and dword references have been replaced with their appropriate 33 | // intrinsic types. 34 | // 35 | // Bellow is tribute to David Barton for supplying such a gem to the software community: 36 | // 37 | { ****************************************************************************** } 38 | { * Copyright (c) 1999-2002 David Barton * } 39 | { * Permission is hereby granted, free of charge, to any person obtaining a * } 40 | { * copy of this software and associated documentation files (the "Software"), * } 41 | { * to deal in the Software without restriction, including without limitation * } 42 | { * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } 43 | { * and/or sell copies of the Software, and to permit persons to whom the * } 44 | { * Software is furnished to do so, subject to the following conditions: * } 45 | { * * } 46 | { * The above copyright notice and this permission notice shall be included in * } 47 | { * all copies or substantial portions of the Software. * } 48 | { * * } 49 | { * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } 50 | { * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } 51 | { * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } 52 | { * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } 53 | { * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } 54 | { * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } 55 | { * DEALINGS IN THE SOFTWARE. * } 56 | { ****************************************************************************** } 57 | // 58 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 59 | 60 | // To disable as much of RTTI as possible (Delphi 2009/2010), 61 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 62 | {$IF CompilerVersion >= 21.0} 63 | {$WEAKLINKRTTI ON} 64 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 65 | {$ENDIF} 66 | 67 | interface 68 | 69 | uses 70 | System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; 71 | 72 | const 73 | NUMROUNDS = 20; { number of rounds must be between 16-24 } 74 | 75 | type 76 | TncEnc_rc6 = class(TncEnc_blockcipher128) 77 | protected 78 | KeyData: array [0 .. ((NUMROUNDS * 2) + 3)] of UInt32; 79 | procedure InitKey(const Key; Size: longword); override; 80 | public 81 | class function GetAlgorithm: string; override; 82 | class function GetMaxKeySize: integer; override; 83 | class function SelfTest: boolean; override; 84 | procedure Burn; override; 85 | procedure EncryptECB(const InData; var OutData); override; 86 | procedure DecryptECB(const InData; var OutData); override; 87 | end; 88 | 89 | { ****************************************************************************** } 90 | { ****************************************************************************** } 91 | implementation 92 | 93 | uses ncEncryption; 94 | 95 | const 96 | sBox: array [0 .. 51] of UInt32 = ($B7E15163, $5618CB1C, $F45044D5, $9287BE8E, $30BF3847, $CEF6B200, $6D2E2BB9, $0B65A572, $A99D1F2B, $47D498E4, $E60C129D, $84438C56, $227B060F, $C0B27FC8, $5EE9F981, $FD21733A, $9B58ECF3, $399066AC, $D7C7E065, $75FF5A1E, $1436D3D7, $B26E4D90, $50A5C749, $EEDD4102, $8D14BABB, 97 | $2B4C3474, $C983AE2D, $67BB27E6, $05F2A19F, $A42A1B58, $42619511, $E0990ECA, $7ED08883, $1D08023C, $BB3F7BF5, $5976F5AE, $F7AE6F67, $95E5E920, $341D62D9, $D254DC92, $708C564B, $0EC3D004, $ACFB49BD, $4B32C376, $E96A3D2F, $87A1B6E8, $25D930A1, $C410AA5A, $62482413, $007F9DCC, $9EB71785, $3CEE913E); 98 | 99 | function LRot32(const X: UInt32; const c: integer): UInt32; inline; 100 | begin 101 | LRot32 := (X shl c) or (X shr (32 - c)); 102 | end; 103 | 104 | function RRot32(const X: UInt32; const c: integer): UInt32; inline; 105 | begin 106 | RRot32 := (X shr c) or (X shl (32 - c)); 107 | end; 108 | 109 | class function TncEnc_rc6.GetAlgorithm: string; 110 | begin 111 | Result := 'RC6'; 112 | end; 113 | 114 | class function TncEnc_rc6.GetMaxKeySize: integer; 115 | begin 116 | Result := 2048; 117 | end; 118 | 119 | class function TncEnc_rc6.SelfTest: boolean; 120 | const 121 | Key1: array [0 .. 15] of byte = ($01, $23, $45, $67, $89, $AB, $CD, $EF, $01, $12, $23, $34, $45, $56, $67, $78); 122 | Plain1: array [0 .. 15] of byte = ($02, $13, $24, $35, $46, $57, $68, $79, $8A, $9B, $AC, $BD, $CE, $DF, $E0, $F1); 123 | Cipher1: array [0 .. 15] of byte = ($52, $4E, $19, $2F, $47, $15, $C6, $23, $1F, $51, $F6, $36, $7E, $A4, $3F, $18); 124 | Key2: array [0 .. 31] of byte = ($01, $23, $45, $67, $89, $AB, $CD, $EF, $01, $12, $23, $34, $45, $56, $67, $78, $89, $9A, $AB, $BC, $CD, $DE, $EF, $F0, $10, $32, $54, $76, $98, $BA, $DC, $FE); 125 | Plain2: array [0 .. 15] of byte = ($02, $13, $24, $35, $46, $57, $68, $79, $8A, $9B, $AC, $BD, $CE, $DF, $E0, $F1); 126 | Cipher2: array [0 .. 15] of byte = ($C8, $24, $18, $16, $F0, $D7, $E4, $89, $20, $AD, $16, $A1, $67, $4E, $5D, $48); 127 | var 128 | Cipher: TncEnc_rc6; 129 | Data: array [0 .. 15] of byte; 130 | begin 131 | Cipher := TncEnc_rc6.Create(nil); 132 | Cipher.Init(Key1, Sizeof(Key1) * 8, nil); 133 | Cipher.EncryptECB(Plain1, Data); 134 | Result := boolean(CompareMem(@Data, @Cipher1, Sizeof(Data))); 135 | Cipher.DecryptECB(Data, Data); 136 | Result := Result and boolean(CompareMem(@Data, @Plain1, Sizeof(Data))); 137 | Cipher.Burn; 138 | Cipher.Init(Key2, Sizeof(Key2) * 8, nil); 139 | Cipher.EncryptECB(Plain2, Data); 140 | Result := Result and boolean(CompareMem(@Data, @Cipher2, Sizeof(Data))); 141 | Cipher.DecryptECB(Data, Data); 142 | Result := Result and boolean(CompareMem(@Data, @Plain2, Sizeof(Data))); 143 | Cipher.Burn; 144 | Cipher.Free; 145 | end; 146 | 147 | procedure TncEnc_rc6.InitKey(const Key; Size: longword); 148 | var 149 | xKeyD: array [0 .. 63] of UInt32; 150 | i, j, k, xKeyLen: longword; 151 | A, B: UInt32; 152 | begin 153 | Size := Size div 8; 154 | FillChar(xKeyD, Sizeof(xKeyD), 0); 155 | Move(Key, xKeyD, Size); 156 | xKeyLen := Size div 4; 157 | if (Size mod 4) <> 0 then 158 | Inc(xKeyLen); 159 | Move(sBox, KeyData, ((NUMROUNDS * 2) + 4) * 4); 160 | i := 0; 161 | j := 0; 162 | A := 0; 163 | B := 0; 164 | if xKeyLen > ((NUMROUNDS * 2) + 4) then 165 | k := xKeyLen * 3 166 | else 167 | k := ((NUMROUNDS * 2) + 4) * 3; 168 | for k := 1 to k do 169 | begin 170 | A := LRot32(KeyData[i] + A + B, 3); 171 | KeyData[i] := A; 172 | B := LRot32(xKeyD[j] + A + B, A + B); 173 | xKeyD[j] := B; 174 | i := (i + 1) mod ((NUMROUNDS * 2) + 4); 175 | j := (j + 1) mod xKeyLen; 176 | end; 177 | FillChar(xKeyD, Sizeof(xKeyD), 0); 178 | end; 179 | 180 | procedure TncEnc_rc6.Burn; 181 | begin 182 | FillChar(KeyData, Sizeof(KeyData), $FF); 183 | inherited Burn; 184 | end; 185 | 186 | procedure TncEnc_rc6.EncryptECB(const InData; var OutData); 187 | var 188 | x0, x1, x2, x3: UInt32; 189 | u, t: UInt32; 190 | i: longword; 191 | begin 192 | if not FInitialized then 193 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 194 | x0 := PUInt32(@InData)^; 195 | x1 := PUInt32(NativeUInt(@InData) + 4)^; 196 | x2 := PUInt32(NativeUInt(@InData) + 8)^; 197 | x3 := PUInt32(NativeUInt(@InData) + 12)^; 198 | x1 := x1 + KeyData[0]; 199 | x3 := x3 + KeyData[1]; 200 | for i := 1 to NUMROUNDS do 201 | begin 202 | t := LRot32(x1 * (2 * x1 + 1), 5); 203 | u := LRot32(x3 * (2 * x3 + 1), 5); 204 | x0 := LRot32(x0 xor t, u) + KeyData[2 * i]; 205 | x2 := LRot32(x2 xor u, t) + KeyData[2 * i + 1]; 206 | t := x0; 207 | x0 := x1; 208 | x1 := x2; 209 | x2 := x3; 210 | x3 := t; 211 | end; 212 | x0 := x0 + KeyData[(2 * NUMROUNDS) + 2]; 213 | x2 := x2 + KeyData[(2 * NUMROUNDS) + 3]; 214 | PUInt32(@OutData)^ := x0; 215 | PUInt32(NativeUInt(@OutData) + 4)^ := x1; 216 | PUInt32(NativeUInt(@OutData) + 8)^ := x2; 217 | PUInt32(NativeUInt(@OutData) + 12)^ := x3; 218 | end; 219 | 220 | procedure TncEnc_rc6.DecryptECB(const InData; var OutData); 221 | var 222 | x0, x1, x2, x3: UInt32; 223 | u, t: UInt32; 224 | i: longword; 225 | begin 226 | if not FInitialized then 227 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 228 | x0 := PUInt32(@InData)^; 229 | x1 := PUInt32(NativeUInt(@InData) + 4)^; 230 | x2 := PUInt32(NativeUInt(@InData) + 8)^; 231 | x3 := PUInt32(NativeUInt(@InData) + 12)^; 232 | x2 := x2 - KeyData[(2 * NUMROUNDS) + 3]; 233 | x0 := x0 - KeyData[(2 * NUMROUNDS) + 2]; 234 | for i := NUMROUNDS downto 1 do 235 | begin 236 | t := x0; 237 | x0 := x3; 238 | x3 := x2; 239 | x2 := x1; 240 | x1 := t; 241 | u := LRot32(x3 * (2 * x3 + 1), 5); 242 | t := LRot32(x1 * (2 * x1 + 1), 5); 243 | x2 := RRot32(x2 - KeyData[2 * i + 1], t) xor u; 244 | x0 := RRot32(x0 - KeyData[2 * i], u) xor t; 245 | end; 246 | x3 := x3 - KeyData[1]; 247 | x1 := x1 - KeyData[0]; 248 | PUInt32(@OutData)^ := x0; 249 | PUInt32(NativeUInt(@OutData) + 4)^ := x1; 250 | PUInt32(NativeUInt(@OutData) + 8)^ := x2; 251 | PUInt32(NativeUInt(@OutData) + 12)^ := x3; 252 | end; 253 | 254 | end. 255 | --------------------------------------------------------------------------------