diff --git a/Demos/ChatDemo/Server/ChatServer.identcache b/Demos/ChatDemo/Server/ChatServer.identcache deleted file mode 100644 index 503e9b6..0000000 Binary files a/Demos/ChatDemo/Server/ChatServer.identcache and /dev/null differ diff --git a/Demos/ChatDemo/Server/ChatServer.res b/Demos/ChatDemo/Server/ChatServer.res deleted file mode 100644 index 2d1e943..0000000 Binary files a/Demos/ChatDemo/Server/ChatServer.res and /dev/null differ diff --git a/Demos/DB/ChatDemo/Client/ChatClient.identcache b/Demos/DB/ChatDemo/Client/ChatClient.identcache deleted file mode 100644 index 99d9dc7..0000000 Binary files a/Demos/DB/ChatDemo/Client/ChatClient.identcache and /dev/null differ diff --git a/Demos/DB/ChatDemo/Client/ChatClient.res b/Demos/DB/ChatDemo/Client/ChatClient.res deleted file mode 100644 index d543374..0000000 Binary files a/Demos/DB/ChatDemo/Client/ChatClient.res and /dev/null differ diff --git a/Demos/NetComVSIndy/Client/NetComVSIndyClient.identcache b/Demos/NetComVSIndy/Client/NetComVSIndyClient.identcache deleted file mode 100644 index c264ead..0000000 Binary files a/Demos/NetComVSIndy/Client/NetComVSIndyClient.identcache and /dev/null differ diff --git a/Demos/NetComVSIndy/Client/NetComVSIndyClient.res b/Demos/NetComVSIndy/Client/NetComVSIndyClient.res deleted file mode 100644 index 71b6a94..0000000 Binary files a/Demos/NetComVSIndy/Client/NetComVSIndyClient.res and /dev/null differ diff --git a/Demos/NetComVSIndy/Server/NetComVSIndyServer.identcache b/Demos/NetComVSIndy/Server/NetComVSIndyServer.identcache deleted file mode 100644 index 56929d7..0000000 Binary files a/Demos/NetComVSIndy/Server/NetComVSIndyServer.identcache and /dev/null differ diff --git a/Demos/NetComVSIndy/Server/NetComVSIndyServer.res b/Demos/NetComVSIndy/Server/NetComVSIndyServer.res deleted file mode 100644 index 9ed10ba..0000000 Binary files a/Demos/NetComVSIndy/Server/NetComVSIndyServer.res and /dev/null differ diff --git a/Demos/SimpleSockets/Client.dproj b/Demos/SimpleSockets/Client.dproj deleted file mode 100644 index 1273313..0000000 --- a/Demos/SimpleSockets/Client.dproj +++ /dev/null @@ -1,214 +0,0 @@ - - - {2F2F33BE-2A99-4B2A-A206-E1E4DE8915A3} - 18.8 - Client.dpr - Release - DCC32 - VCL - True - Win64 - 3 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - Client.exe - off - vclx;vcl;vclimg;dbrtl;Rave77VCL;bdertl;rtl;vclactnband;xmlrtl;vcldb;vcldbx;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dclOfficeXP;$(DCC_UsePackage) - $(BDSCOMMONDIR)\DCP - $(BDSCOMMONDIR)\DCU - x86 - 00400000 - Client - Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) - true - 1032 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - - - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\delphi_PROJECTICON.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - $(BDS)\bin\default_app.manifest - $(BDS)\bin\delphi_PROJECTICON.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - DEBUG;$(DCC_Define) - - - Debug - - - true - PerMonitorV2 - - - true - PerMonitorV2 - 1033 - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - - - - MainSource - - -
Form1
- - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - Delphi.Personality.12 - - - - - Client.dpr - - - False - True - False - - - True - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1032 - 1253 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - - - - False - True - True - - - 12 - - - diff --git a/Demos/SimpleSockets/Client.dproj.local b/Demos/SimpleSockets/Client.dproj.local deleted file mode 100644 index b4899b3..0000000 --- a/Demos/SimpleSockets/Client.dproj.local +++ /dev/null @@ -1,6 +0,0 @@ - - - - - - diff --git a/Demos/SimpleSockets/Client.identcache b/Demos/SimpleSockets/Client.identcache deleted file mode 100644 index 8b81f03..0000000 Binary files a/Demos/SimpleSockets/Client.identcache and /dev/null differ diff --git a/Demos/SimpleSockets/Client.res b/Demos/SimpleSockets/Client.res deleted file mode 100644 index 3e78508..0000000 Binary files a/Demos/SimpleSockets/Client.res and /dev/null differ diff --git a/Demos/SimpleSockets/Srv/Server.dproj b/Demos/SimpleSockets/Srv/Server.dproj deleted file mode 100644 index 4fcb55a..0000000 --- a/Demos/SimpleSockets/Srv/Server.dproj +++ /dev/null @@ -1,216 +0,0 @@ - - - {B76A70BC-BC2B-42B3-990D-FEC6939EAFD9} - 18.8 - Server.dpr - Release - DCC32 - VCL - True - Win64 - 3 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - Server.exe - off - vclx;vcl;vclimg;dbrtl;Rave77VCL;bdertl;rtl;vclactnband;xmlrtl;vcldb;vcldbx;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dclOfficeXP;$(DCC_UsePackage) - $(BDSCOMMONDIR)\DCP - $(BDSCOMMONDIR)\DCU - x86 - 00400000 - Server - Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) - true - 1032 - CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= - - - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\delphi_PROJECTICON.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - $(BDS)\bin\default_app.manifest - $(BDS)\bin\delphi_PROJECTICON.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - 1033 - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - $(BDS)\bin\delphi_PROJECTICON.ico - - - false - DEBUG;$(DCC_Define) - - - Debug - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - Delphi.Personality.12 - - - - - False - True - False - - - True - False - 1 - 0 - 0 - 0 - False - False - False - False - False - 1032 - 1253 - - - - - 1.0.0.0 - - - - - - 1.0.0.0 - - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - - - Server.dpr - - - - False - True - True - - - 12 - - - diff --git a/Demos/SimpleSockets/Srv/Server.dproj.local b/Demos/SimpleSockets/Srv/Server.dproj.local deleted file mode 100644 index b4899b3..0000000 --- a/Demos/SimpleSockets/Srv/Server.dproj.local +++ /dev/null @@ -1,6 +0,0 @@ - - - - - - diff --git a/Demos/SimpleSockets/Srv/Server.identcache b/Demos/SimpleSockets/Srv/Server.identcache deleted file mode 100644 index 764389c..0000000 Binary files a/Demos/SimpleSockets/Srv/Server.identcache and /dev/null differ diff --git a/Demos/SimpleSockets/Srv/Server.res b/Demos/SimpleSockets/Srv/Server.res deleted file mode 100644 index 8002f6e..0000000 Binary files a/Demos/SimpleSockets/Srv/Server.res and /dev/null differ diff --git a/Demos/SimpleSockets/Srv/ufrmMain.pas b/Demos/SimpleSockets/Srv/ufrmMain.pas deleted file mode 100644 index f2ff91e..0000000 --- a/Demos/SimpleSockets/Srv/ufrmMain.pas +++ /dev/null @@ -1,140 +0,0 @@ -unit ufrmMain; - -interface - -uses -{$IFDEF MSWINDOWS} - WinApi.Windows, WinApi.Winsock2, -{$ELSE} - Posix.SysSocket, Posix.Unistd, -{$ENDIF} - System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Samples.Spin, - System.Diagnostics, ncLines, ncSocketList, ncSockets; - -type - TfrmMain = class(TForm) - memLog: TMemo; - TCPServer: TncTCPServer; - pnlToolbar: TPanel; - btnActivate: TButton; - pblPort: TPanel; - edtPort: TSpinEdit; - btnShutdownAllClients: TButton; - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure TCPServerConnected(Sender: TObject; aLine: TncLine); - procedure TCPServerDisconnected(Sender: TObject; aLine: TncLine); - procedure TCPServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); - procedure btnActivateClick(Sender: TObject); - procedure edtPortChange(Sender: TObject); - procedure btnShutdownAllClientsClick(Sender: TObject); - private - public - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.dfm} - -procedure TfrmMain.FormCreate(Sender: TObject); -begin - try - TCPServer.Active := True; - memLog.Lines.Add('Server is active at port: ' + IntToStr(TCPServer.Port)); - btnActivate.Caption := 'Deactivate'; - except - on e: Exception do - memLog.Lines.Add('Server cannot activate. ' + e.Message); - end; -end; - -procedure TfrmMain.FormDestroy(Sender: TObject); -begin - TCPServer.Active := False; -end; - -procedure TfrmMain.btnActivateClick(Sender: TObject); -begin - try - TCPServer.Active := not TCPServer.Active; - finally - if TCPServer.Active then - begin - memLog.Lines.Add('Server is active at port: ' + IntToStr(TCPServer.Port)); - btnActivate.Caption := 'Deactivate'; - end - else - begin - memLog.Lines.Add('Server was deactivated'); - btnActivate.Caption := 'Activate'; - end; - end; -end; - -procedure TfrmMain.edtPortChange(Sender: TObject); -begin - try - TCPServer.Port := edtPort.Value; - except - // if it is active, it will not allow us to change the value, - // revert the edtPort value to its original - edtPort.Value := TCPServer.Port; - raise; // Reraise the exception so as the user sees the error - end; -end; - -procedure TfrmMain.btnShutdownAllClientsClick(Sender: TObject); -var - SocketList: TSocketList; - i: Integer; -begin - SocketList := TCPServer.Lines.LockList; - try - for i := 0 to SocketList.Count - 1 do - TCPServer.ShutDownLine(SocketList.Lines[i]); - finally - TCPServer.Lines.UnlockList; - end; -end; - - -procedure TfrmMain.TCPServerConnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add('Connected: ' + aLine.PeerIP); - end); - - TCPServer.Send(aLine, BytesOf('Hello mr. ' + IntToStr(aLine.Handle))); -end; - -procedure TfrmMain.TCPServerDisconnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add('Disconnected: ' + aLine.PeerIP); - end); -end; - -procedure TfrmMain.TCPServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); -var - BytesReceived: TBytes; -begin - BytesReceived := Copy(aBuf, 0, aBufCount); - - TThread.Queue(nil, - procedure - begin - memLog.Lines.Add('Received: "' + StringOf(BytesReceived) + '" from: ' + aLine.PeerIP); - end); - - // Send back the buffer received - TCPServer.Send(aLine, BytesReceived); -end; - -end. diff --git a/Demos/SimpleSockets/ufrmMain.pas b/Demos/SimpleSockets/ufrmMain.pas deleted file mode 100644 index 2c10902..0000000 --- a/Demos/SimpleSockets/ufrmMain.pas +++ /dev/null @@ -1,147 +0,0 @@ -unit ufrmMain; - -interface - -uses -{$IFDEF MSWINDOWS} - WinApi.Windows, WinApi.Winsock2, -{$ELSE} - Posix.SysSocket, Posix.Unistd, -{$ENDIF} - System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Samples.Spin, - System.Diagnostics, ncLines, ncSockets; - -type - TForm1 = class(TForm) - memLog: TMemo; - TCPClient: TncTCPClient; - pnlToolbar: TPanel; - btnActivate: TButton; - pnlAddress: TPanel; - edtHost: TEdit; - edtPort: TSpinEdit; - Panel1: TPanel; - btnSendData: TButton; - Panel2: TPanel; - edtDataToSend: TEdit; - procedure btnActivateClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure TCPClientConnected(Sender: TObject; aLine: TncLine); - procedure TCPClientDisconnected(Sender: TObject; aLine: TncLine); - procedure TCPClientReconnected(Sender: TObject; aLine: TncLine); - procedure TCPClientReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); - procedure edtHostChange(Sender: TObject); - procedure edtPortChange(Sender: TObject); - procedure btnSendDataClick(Sender: TObject); - procedure edtDataToSendEnter(Sender: TObject); - procedure edtDataToSendExit(Sender: TObject); - private - public - end; - -var - Form1: TForm1; - -implementation - -{$R *.dfm} - -procedure TForm1.FormDestroy(Sender: TObject); -begin - TCPClient.Active := False; -end; - -procedure TForm1.edtHostChange(Sender: TObject); -begin - try - TCPClient.Host := edtHost.Text; - except - edtHost.OnChange := nil; - try - edtHost.Text := TCPClient.Host; - finally - edtHost.OnChange := edtHostChange; - end; - raise; - end; -end; - -procedure TForm1.edtPortChange(Sender: TObject); -begin - try - TCPClient.Port := edtPort.Value; - except - edtPort.OnChange := nil; - try - edtPort.Value := TCPClient.Port; - finally - edtPort.OnChange := edtPortChange; - end; - raise; - end; -end; - -procedure TForm1.btnActivateClick(Sender: TObject); -begin - TCPClient.Active := not TCPClient.Active; -end; - -procedure TForm1.edtDataToSendEnter(Sender: TObject); -begin - btnSendData.Default := True; -end; - -procedure TForm1.edtDataToSendExit(Sender: TObject); -begin - btnSendData.Default := False; -end; - -procedure TForm1.TCPClientConnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add('Connected'); - btnActivate.Caption := 'Deactivate'; - end); -end; - -procedure TForm1.TCPClientDisconnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add('Disconnected'); - btnActivate.Caption := 'Activate'; - end); -end; - -procedure TForm1.TCPClientReconnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add('Reconnected'); - end); -end; - -procedure TForm1.TCPClientReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); -var - BytesReceived: TBytes; -begin - BytesReceived := Copy(aBuf, 0, aBufCount); - - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add('Received: ' + StringOf(BytesReceived)); - end); -end; - -procedure TForm1.btnSendDataClick(Sender: TObject); -begin - TCPClient.Send(edtDataToSend.Text); -end; - - -end. diff --git a/Demos/ChatDemo/Client/ChatClient.dpr b/Demos/TCP/ChatDemo/Client/ChatClient.dpr similarity index 94% rename from Demos/ChatDemo/Client/ChatClient.dpr rename to Demos/TCP/ChatDemo/Client/ChatClient.dpr index 8c41207..2f85b6a 100644 --- a/Demos/ChatDemo/Client/ChatClient.dpr +++ b/Demos/TCP/ChatDemo/Client/ChatClient.dpr @@ -1,17 +1,17 @@ -program ChatClient; - -uses - System.StartUpCopy, - FMX.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}; - -{$R *.res} - -begin - {$IFDEF DEBUG} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} - Application.Initialize; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program ChatClient; + +uses + System.StartUpCopy, + FMX.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/Demos/ChatDemo/Client/ChatClient.dproj b/Demos/TCP/ChatDemo/Client/ChatClient.dproj similarity index 98% rename from Demos/ChatDemo/Client/ChatClient.dproj rename to Demos/TCP/ChatDemo/Client/ChatClient.dproj index 79107f5..3d97885 100644 --- a/Demos/ChatDemo/Client/ChatClient.dproj +++ b/Demos/TCP/ChatDemo/Client/ChatClient.dproj @@ -1,1097 +1,1097 @@ - - - {E615DFF5-615F-4A51-B6AF-B5B187237486} - 18.8 - FMX - ChatClient.dpr - True - Debug - Win64 - 32787 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - true - true - true - true - true - true - true - true - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\delphi_PROJECTICNS.icns - ChatClient - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - 1 - #000000 - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - 1 - #000000 - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - - - true - PerMonitorV2 - true - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- fmx - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - ChatClient.dpr - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - - - - - - true - - - - - true - - - - - true - - - - - ChatClient.exe - true - - - - - ChatClient.exe - true - - - - - ChatClient.rsm - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - True - True - True - - - 12 - - - - - + + + {E615DFF5-615F-4A51-B6AF-B5B187237486} + 18.8 + FMX + ChatClient.dpr + True + Debug + Win64 + 32787 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + ChatClient + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + 1 + #000000 + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + 1 + #000000 + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + + + true + PerMonitorV2 + true + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ fmx + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + ChatClient.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + ChatClient.exe + true + + + + + ChatClient.exe + true + + + + + ChatClient.rsm + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + True + True + True + True + + + 12 + + + + + diff --git a/Demos/ChatDemo/Client/ChatClient.dproj.local b/Demos/TCP/ChatDemo/Client/ChatClient.dproj.local similarity index 99% rename from Demos/ChatDemo/Client/ChatClient.dproj.local rename to Demos/TCP/ChatDemo/Client/ChatClient.dproj.local index 653451a..aaa2336 100644 --- a/Demos/ChatDemo/Client/ChatClient.dproj.local +++ b/Demos/TCP/ChatDemo/Client/ChatClient.dproj.local @@ -1,38 +1,38 @@ - - - - 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas - 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/06/01 10:58:58.000.571,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx - 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/06/01 11:04:17.000.240,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ChatDemoClient.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj - 2020/08/10 16:11:38.000.249,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatDemoClient.dproj - - - - - + + + + 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas + 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/06/01 10:58:58.000.571,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx + 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/06/01 11:04:17.000.240,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ChatDemoClient.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj + 2020/08/10 16:11:38.000.249,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatDemoClient.dproj + + + + + diff --git a/Demos/ChatDemo/Client/ChatClient.dsk b/Demos/TCP/ChatDemo/Client/ChatClient.dsk similarity index 94% rename from Demos/ChatDemo/Client/ChatClient.dsk rename to Demos/TCP/ChatDemo/Client/ChatClient.dsk index da02916..49298f0 100644 --- a/Demos/ChatDemo/Client/ChatClient.dsk +++ b/Demos/TCP/ChatDemo/Client/ChatClient.dsk @@ -1,764 +1,764 @@ -[Closed Files] -File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,16018,1,16051,0,0,, -File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,629,1,644,0,0,, -File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,475,35,489,0,0,, -File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncThreads.pas',0,1,17,29,33,0,0,, -File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\Encryption\ncEncCast256.pas',0,1,401,1,417,0,0,, -File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.ScrollBox.pas',0,1,1479,17,1487,0,0,, -File_6=TSourceModule,'C:\Users\Programmer\Documents\Development\Workspace\AnimationPrototype\ufrmMain.pas',0,1,79,6,87,0,0,, -File_7=TSourceModule,'C:\Users\Programmer\Documents\Development\Projects\StarFieldSimulation\ufrmMain.pas',0,1,100,1,114,0,0,,{1 -File_8=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.UITypes.pas',0,1,88,15,109,0,0,, -File_9=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\ufrmMain.pas',0,1,145,1,1,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj] -ModuleType=TBaseProject - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr -CursorX=3 -CursorY=12 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas -CursorX=7 -CursorY=115 -TopLine=90 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=1 -Breakpoint0='C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',644,'',0,1,'',1,0,0,'',1,'','','',0,'' - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=28 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-318 -Top=-363 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,16018,1,16051,0,0,, +File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,629,1,644,0,0,, +File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,475,35,489,0,0,, +File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncThreads.pas',0,1,17,29,33,0,0,, +File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\Encryption\ncEncCast256.pas',0,1,401,1,417,0,0,, +File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.ScrollBox.pas',0,1,1479,17,1487,0,0,, +File_6=TSourceModule,'C:\Users\Programmer\Documents\Development\Workspace\AnimationPrototype\ufrmMain.pas',0,1,79,6,87,0,0,, +File_7=TSourceModule,'C:\Users\Programmer\Documents\Development\Projects\StarFieldSimulation\ufrmMain.pas',0,1,100,1,114,0,0,,{1 +File_8=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.UITypes.pas',0,1,88,15,109,0,0,, +File_9=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\ufrmMain.pas',0,1,145,1,1,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj] +ModuleType=TBaseProject + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr +CursorX=3 +CursorY=12 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas +CursorX=7 +CursorY=115 +TopLine=90 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=1 +Breakpoint0='C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',644,'',0,1,'',1,0,0,'',1,'','','',0,'' + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=28 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-318 +Top=-363 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/TCP/ChatDemo/Client/ChatClient.identcache b/Demos/TCP/ChatDemo/Client/ChatClient.identcache new file mode 100644 index 0000000..e4ca886 Binary files /dev/null and b/Demos/TCP/ChatDemo/Client/ChatClient.identcache differ diff --git a/Demos/TCP/ChatDemo/Client/ChatClient.res b/Demos/TCP/ChatDemo/Client/ChatClient.res new file mode 100644 index 0000000..2cc0378 Binary files /dev/null and b/Demos/TCP/ChatDemo/Client/ChatClient.res differ diff --git a/Demos/ChatDemo/Client/ufrmMain.fmx b/Demos/TCP/ChatDemo/Client/ufrmMain.fmx similarity index 96% rename from Demos/ChatDemo/Client/ufrmMain.fmx rename to Demos/TCP/ChatDemo/Client/ufrmMain.fmx index 07a75e0..d44cb92 100644 --- a/Demos/ChatDemo/Client/ufrmMain.fmx +++ b/Demos/TCP/ChatDemo/Client/ufrmMain.fmx @@ -1,126 +1,126 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - ActiveControl = edtText - Caption = 'Chat Client' - ClientHeight = 480 - ClientWidth = 640 - Position = ScreenCenter - FormFactor.Width = 320 - FormFactor.Height = 480 - FormFactor.Devices = [Desktop] - OnDestroy = FormDestroy - DesignerMasterStyle = 0 - object memLog: TMemo - Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] - DataDetectorTypes = [] - ReadOnly = True - TextSettings.WordWrap = True - Align = Client - Margins.Left = 5.000000000000000000 - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Size.Width = 630.000000000000000000 - Size.Height = 369.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Viewport.Width = 626.000000000000000000 - Viewport.Height = 365.000000000000000000 - end - object ltMain: TLayout - Align = Bottom - Margins.Left = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Position.X = 5.000000000000000000 - Position.Y = 446.000000000000000000 - Size.Width = 630.000000000000000000 - Size.Height = 29.000000000000000000 - Size.PlatformDefault = False - TabOrder = 3 - TabStop = False - object edtText: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Client - TabOrder = 0 - Margins.Right = 4.000000000000000000 - Size.Width = 546.000000000000000000 - Size.Height = 29.000000000000000000 - Size.PlatformDefault = False - OnEnter = edtTextEnter - OnExit = edtTextExit - end - object btnSend: TButton - Align = Right - Default = True - Position.X = 550.000000000000000000 - Size.Width = 80.000000000000000000 - Size.Height = 29.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Text = 'Send' - OnClick = btnSendClick - end - end - object edtClientName: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Bottom - TabOrder = 2 - Text = 'Happy texter' - Position.X = 5.000000000000000000 - Position.Y = 419.000000000000000000 - Margins.Left = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Size.Width = 630.000000000000000000 - Size.Height = 22.000000000000000000 - Size.PlatformDefault = False - TextPrompt = 'Enter your name' - end - object ToolBar1: TToolBar - Size.Width = 640.000000000000000000 - Size.Height = 40.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - TabStop = False - object btnActivateClient: TButton - Align = Left - Margins.Left = 5.000000000000000000 - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Position.X = 5.000000000000000000 - Position.Y = 5.000000000000000000 - Size.Width = 137.000000000000000000 - Size.Height = 30.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - Text = 'Activate Client' - OnClick = btnActivateClientClick - end - object edtHost: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Client - TabOrder = 1 - Text = 'LocalHost' - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Size.Width = 488.000000000000000000 - Size.Height = 30.000000000000000000 - Size.PlatformDefault = False - OnChange = edtHostChange - end - end - object Client: TncClientSource - EncryptionKey = 'SetEncryptionKey' - OnConnected = ClientConnected - OnDisconnected = ClientDisconnected - OnHandleCommand = ClientHandleCommand - Host = 'LocalHost' - OnReconnected = ClientReconnected - Left = 32 - Top = 32 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + ActiveControl = edtText + Caption = 'Chat Client' + ClientHeight = 480 + ClientWidth = 640 + Position = ScreenCenter + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnDestroy = FormDestroy + DesignerMasterStyle = 0 + object memLog: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + ReadOnly = True + TextSettings.WordWrap = True + Align = Client + Margins.Left = 5.000000000000000000 + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Size.Width = 630.000000000000000000 + Size.Height = 369.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Viewport.Width = 626.000000000000000000 + Viewport.Height = 365.000000000000000000 + end + object ltMain: TLayout + Align = Bottom + Margins.Left = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Position.X = 5.000000000000000000 + Position.Y = 446.000000000000000000 + Size.Width = 630.000000000000000000 + Size.Height = 29.000000000000000000 + Size.PlatformDefault = False + TabOrder = 3 + TabStop = False + object edtText: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Client + TabOrder = 0 + Margins.Right = 4.000000000000000000 + Size.Width = 546.000000000000000000 + Size.Height = 29.000000000000000000 + Size.PlatformDefault = False + OnEnter = edtTextEnter + OnExit = edtTextExit + end + object btnSend: TButton + Align = Right + Default = True + Position.X = 550.000000000000000000 + Size.Width = 80.000000000000000000 + Size.Height = 29.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Text = 'Send' + OnClick = btnSendClick + end + end + object edtClientName: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Bottom + TabOrder = 2 + Text = 'Happy texter' + Position.X = 5.000000000000000000 + Position.Y = 419.000000000000000000 + Margins.Left = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Size.Width = 630.000000000000000000 + Size.Height = 22.000000000000000000 + Size.PlatformDefault = False + TextPrompt = 'Enter your name' + end + object ToolBar1: TToolBar + Size.Width = 640.000000000000000000 + Size.Height = 40.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + TabStop = False + object btnActivateClient: TButton + Align = Left + Margins.Left = 5.000000000000000000 + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Position.X = 5.000000000000000000 + Position.Y = 5.000000000000000000 + Size.Width = 137.000000000000000000 + Size.Height = 30.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + Text = 'Activate Client' + OnClick = btnActivateClientClick + end + object edtHost: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Client + TabOrder = 1 + Text = 'LocalHost' + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Size.Width = 488.000000000000000000 + Size.Height = 30.000000000000000000 + Size.PlatformDefault = False + OnChange = edtHostChange + end + end + object Client: TncClientSource + EncryptionKey = 'SetEncryptionKey' + OnConnected = ClientConnected + OnDisconnected = ClientDisconnected + OnHandleCommand = ClientHandleCommand + Host = 'LocalHost' + OnReconnected = ClientReconnected + Left = 32 + Top = 32 + end +end diff --git a/Demos/ChatDemo/Client/ufrmMain.pas b/Demos/TCP/ChatDemo/Client/ufrmMain.pas similarity index 96% rename from Demos/ChatDemo/Client/ufrmMain.pas rename to Demos/TCP/ChatDemo/Client/ufrmMain.pas index fa15358..51ddb1f 100644 --- a/Demos/ChatDemo/Client/ufrmMain.pas +++ b/Demos/TCP/ChatDemo/Client/ufrmMain.pas @@ -1,118 +1,118 @@ -unit ufrmMain; - -interface - -uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, - FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, - FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, - FMX.Memo, System.SyncObjs, ncSources; - -type - TfrmMain = class(TForm) - memLog: TMemo; - ltMain: TLayout; - edtText: TEdit; - btnSend: TButton; - Client: TncClientSource; - edtClientName: TEdit; - ToolBar1: TToolBar; - btnActivateClient: TButton; - edtHost: TEdit; - procedure FormDestroy(Sender: TObject); - procedure btnSendClick(Sender: TObject); - function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; - const aSenderComponent, aReceiverComponent: string): TArray; - procedure edtTextEnter(Sender: TObject); - procedure edtTextExit(Sender: TObject); - procedure btnActivateClientClick(Sender: TObject); - procedure ClientConnected(Sender: TObject; aLine: TncLine); - procedure ClientDisconnected(Sender: TObject; aLine: TncLine); - procedure ClientReconnected(Sender: TObject; aLine: TncLine); - procedure edtHostChange(Sender: TObject); - private - public - procedure Log(aStr: string); - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.fmx} - -procedure TfrmMain.FormDestroy(Sender: TObject); -begin - Client.Active := False; -end; - -procedure TfrmMain.Log(aStr: string); -begin - // This is thread safe - TThread.Queue(nil, - procedure - begin - memLog.Lines.Add(aStr); - memLog.ScrollBy(0, 100); - end); -end; - -procedure TfrmMain.btnActivateClientClick(Sender: TObject); -begin - Client.Active := not Client.Active; -end; - -procedure TfrmMain.btnSendClick(Sender: TObject); -begin - Client.ExecCommand(0, BytesOf(edtClientName.Text + ': ' + edtText.Text)); - edtText.Text := ''; -end; - -procedure TfrmMain.edtHostChange(Sender: TObject); -begin - Client.Host := edtHost.Text; -end; - -procedure TfrmMain.edtTextEnter(Sender: TObject); -begin - btnSend.Default := True; -end; - -procedure TfrmMain.edtTextExit(Sender: TObject); -begin - btnSend.Default := False; -end; - -procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); -begin - Log('Client connected to peer: ' + aLine.PeerIP); - TThread.Queue(nil, - procedure - begin - btnActivateClient.Text := 'Deactivate client'; - end); -end; - -procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); -begin - Log('Client disconnected from peer: ' + aLine.PeerIP); - TThread.Queue(nil, - procedure - begin - btnActivateClient.Text := 'Activate client'; - end); -end; - -procedure TfrmMain.ClientReconnected(Sender: TObject; aLine: TncLine); -begin - Log('Client was reconnected to peer: ' + aLine.PeerIP); -end; - -function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; -const aSenderComponent, aReceiverComponent: string): TArray; -begin - Log(Stringof(aData)); -end; - -end. +unit ufrmMain; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, + FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, + FMX.Memo, System.SyncObjs, ncSources; + +type + TfrmMain = class(TForm) + memLog: TMemo; + ltMain: TLayout; + edtText: TEdit; + btnSend: TButton; + Client: TncClientSource; + edtClientName: TEdit; + ToolBar1: TToolBar; + btnActivateClient: TButton; + edtHost: TEdit; + procedure FormDestroy(Sender: TObject); + procedure btnSendClick(Sender: TObject); + function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TArray; + procedure edtTextEnter(Sender: TObject); + procedure edtTextExit(Sender: TObject); + procedure btnActivateClientClick(Sender: TObject); + procedure ClientConnected(Sender: TObject; aLine: TncLine); + procedure ClientDisconnected(Sender: TObject; aLine: TncLine); + procedure ClientReconnected(Sender: TObject; aLine: TncLine); + procedure edtHostChange(Sender: TObject); + private + public + procedure Log(aStr: string); + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.fmx} + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + Client.Active := False; +end; + +procedure TfrmMain.Log(aStr: string); +begin + // This is thread safe + TThread.Queue(nil, + procedure + begin + memLog.Lines.Add(aStr); + memLog.ScrollBy(0, 100); + end); +end; + +procedure TfrmMain.btnActivateClientClick(Sender: TObject); +begin + Client.Active := not Client.Active; +end; + +procedure TfrmMain.btnSendClick(Sender: TObject); +begin + Client.ExecCommand(0, BytesOf(edtClientName.Text + ': ' + edtText.Text)); + edtText.Text := ''; +end; + +procedure TfrmMain.edtHostChange(Sender: TObject); +begin + Client.Host := edtHost.Text; +end; + +procedure TfrmMain.edtTextEnter(Sender: TObject); +begin + btnSend.Default := True; +end; + +procedure TfrmMain.edtTextExit(Sender: TObject); +begin + btnSend.Default := False; +end; + +procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); +begin + Log('Client connected to peer: ' + aLine.PeerIP); + TThread.Queue(nil, + procedure + begin + btnActivateClient.Text := 'Deactivate client'; + end); +end; + +procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); +begin + Log('Client disconnected from peer: ' + aLine.PeerIP); + TThread.Queue(nil, + procedure + begin + btnActivateClient.Text := 'Activate client'; + end); +end; + +procedure TfrmMain.ClientReconnected(Sender: TObject; aLine: TncLine); +begin + Log('Client was reconnected to peer: ' + aLine.PeerIP); +end; + +function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; +const aSenderComponent, aReceiverComponent: string): TArray; +begin + Log(Stringof(aData)); +end; + +end. diff --git a/Demos/ChatDemo/Server/ChatServer.dpr b/Demos/TCP/ChatDemo/Server/ChatServer.dpr similarity index 94% rename from Demos/ChatDemo/Server/ChatServer.dpr rename to Demos/TCP/ChatDemo/Server/ChatServer.dpr index 8d643e1..4bd9fe0 100644 --- a/Demos/ChatDemo/Server/ChatServer.dpr +++ b/Demos/TCP/ChatDemo/Server/ChatServer.dpr @@ -1,17 +1,17 @@ -program ChatServer; - -uses - System.StartUpCopy, - FMX.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}; - -{$R *.res} - -begin - {$IFDEF DEBUG} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} - Application.Initialize; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program ChatServer; + +uses + System.StartUpCopy, + FMX.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/Demos/ChatDemo/Server/ChatServer.dproj b/Demos/TCP/ChatDemo/Server/ChatServer.dproj similarity index 98% rename from Demos/ChatDemo/Server/ChatServer.dproj rename to Demos/TCP/ChatDemo/Server/ChatServer.dproj index fa2d0cb..50ccec4 100644 --- a/Demos/ChatDemo/Server/ChatServer.dproj +++ b/Demos/TCP/ChatDemo/Server/ChatServer.dproj @@ -1,1081 +1,1081 @@ - - - {FEC7E51C-DA51-43D3-A01B-067E5466B16D} - 18.8 - FMX - ChatServer.dpr - True - Release - Win64 - 32787 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - true - true - true - true - true - true - true - true - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\delphi_PROJECTICNS.icns - ChatServer - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - - - true - PerMonitorV2 - true - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- fmx - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - ChatServer.dpr - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - - - - - - true - - - - - true - - - - - true - - - - - ChatServer.exe - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - True - True - True - - - 12 - - - - - + + + {FEC7E51C-DA51-43D3-A01B-067E5466B16D} + 18.8 + FMX + ChatServer.dpr + True + Release + Win64 + 32787 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + ChatServer + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + + + true + PerMonitorV2 + true + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ fmx + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + ChatServer.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + ChatServer.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + True + True + True + True + + + 12 + + + + + diff --git a/Demos/ChatDemo/Server/ChatServer.dproj.local b/Demos/TCP/ChatDemo/Server/ChatServer.dproj.local similarity index 99% rename from Demos/ChatDemo/Server/ChatServer.dproj.local rename to Demos/TCP/ChatDemo/Server/ChatServer.dproj.local index 3b18226..a02cd12 100644 --- a/Demos/ChatDemo/Server/ChatServer.dproj.local +++ b/Demos/TCP/ChatDemo/Server/ChatServer.dproj.local @@ -1,44 +1,44 @@ - - - - 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas - 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/10 12:55:10.000.953,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/10 12:57:08.000.980,C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.fmx - 2020/08/10 12:57:08.000.980,C:\Users\Programmer\Documents\Development\Projects\Unit3.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas - 2020/08/10 12:57:13.000.964,C:\Users\Programmer\Documents\Development\Projects\Project1.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dproj - - - - - + + + + 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas + 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/10 12:55:10.000.953,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/10 12:57:08.000.980,C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.fmx + 2020/08/10 12:57:08.000.980,C:\Users\Programmer\Documents\Development\Projects\Unit3.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas + 2020/08/10 12:57:13.000.964,C:\Users\Programmer\Documents\Development\Projects\Project1.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dproj + + + + + diff --git a/Demos/ChatDemo/Server/ChatServer.dsk b/Demos/TCP/ChatDemo/Server/ChatServer.dsk similarity index 94% rename from Demos/ChatDemo/Server/ChatServer.dsk rename to Demos/TCP/ChatDemo/Server/ChatServer.dsk index c484e80..44fd6e3 100644 --- a/Demos/ChatDemo/Server/ChatServer.dsk +++ b/Demos/TCP/ChatDemo/Server/ChatServer.dsk @@ -1,763 +1,763 @@ -[Closed Files] -File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,889,1,891,0,0,, -File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,1270,42,1296,0,0,,{1 -File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,104,64,117,0,0,, -File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncCommandHandlers.pas',0,1,22,38,37,0,0,, -File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncDBSrv.pas',0,1,121,71,132,0,0,, -File_5=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncDBCnt.pas',0,1,137,47,142,0,0,, -File_6=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSocketList.pas',0,1,286,41,301,0,0,, -File_7=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncCommandPacking.pas',0,1,1,7,14,0,0,, -File_8=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\NetComRegister.pas',0,1,5,1,37,0,0,, -File_9=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,2670,10,2686,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dproj -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dproj] -ModuleType=TBaseProject - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dpr -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dpr -CursorX=3 -CursorY=12 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas -CursorX=9 -CursorY=45 -TopLine=29 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=28 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-318 -Top=-363 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,889,1,891,0,0,, +File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,1270,42,1296,0,0,,{1 +File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,104,64,117,0,0,, +File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncCommandHandlers.pas',0,1,22,38,37,0,0,, +File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncDBSrv.pas',0,1,121,71,132,0,0,, +File_5=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncDBCnt.pas',0,1,137,47,142,0,0,, +File_6=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSocketList.pas',0,1,286,41,301,0,0,, +File_7=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncCommandPacking.pas',0,1,1,7,14,0,0,, +File_8=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\NetComRegister.pas',0,1,5,1,37,0,0,, +File_9=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,2670,10,2686,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dproj +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dproj] +ModuleType=TBaseProject + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dpr +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dpr +CursorX=3 +CursorY=12 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas +CursorX=9 +CursorY=45 +TopLine=29 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=28 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-318 +Top=-363 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/TCP/ChatDemo/Server/ChatServer.identcache b/Demos/TCP/ChatDemo/Server/ChatServer.identcache new file mode 100644 index 0000000..ada193f Binary files /dev/null and b/Demos/TCP/ChatDemo/Server/ChatServer.identcache differ diff --git a/Demos/TCP/ChatDemo/Server/ChatServer.res b/Demos/TCP/ChatDemo/Server/ChatServer.res new file mode 100644 index 0000000..f0a2763 Binary files /dev/null and b/Demos/TCP/ChatDemo/Server/ChatServer.res differ diff --git a/Demos/ChatDemo/Server/ufrmMain.fmx b/Demos/TCP/ChatDemo/Server/ufrmMain.fmx similarity index 96% rename from Demos/ChatDemo/Server/ufrmMain.fmx rename to Demos/TCP/ChatDemo/Server/ufrmMain.fmx index 35a8851..a1085ba 100644 --- a/Demos/ChatDemo/Server/ufrmMain.fmx +++ b/Demos/TCP/ChatDemo/Server/ufrmMain.fmx @@ -1,71 +1,71 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'Chat Server' - ClientHeight = 339 - ClientWidth = 583 - FormFactor.Width = 320 - FormFactor.Height = 480 - FormFactor.Devices = [Desktop] - OnDestroy = FormDestroy - DesignerMasterStyle = 0 - object memLog: TMemo - Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] - DataDetectorTypes = [] - ReadOnly = True - Align = Client - Margins.Left = 5.000000000000000000 - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Size.Width = 573.000000000000000000 - Size.Height = 289.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Viewport.Width = 569.000000000000000000 - Viewport.Height = 285.000000000000000000 - end - object ToolBar1: TToolBar - Size.Width = 583.000000000000000000 - Size.Height = 40.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - TabStop = False - object btnActivateServer: TButton - Align = Left - Margins.Left = 5.000000000000000000 - Margins.Top = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Position.X = 5.000000000000000000 - Position.Y = 5.000000000000000000 - Size.Width = 137.000000000000000000 - Size.Height = 30.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - Text = 'Activate Server' - OnClick = btnActivateServerClick - end - object btnShutDownClients: TButton - Align = Right - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Position.X = 424.000000000000000000 - Position.Y = 5.000000000000000000 - Size.Width = 154.000000000000000000 - Size.Height = 30.000000000000000000 - Size.PlatformDefault = False - TabOrder = 2 - Text = 'Shutdown Clients' - OnClick = btnShutDownClientsClick - end - end - object Server: TncServerSource - EncryptionKey = 'SetEncryptionKey' - OnConnected = ServerConnected - OnDisconnected = ServerDisconnected - OnHandleCommand = ServerHandleCommand - Left = 32 - Top = 32 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'Chat Server' + ClientHeight = 339 + ClientWidth = 583 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnDestroy = FormDestroy + DesignerMasterStyle = 0 + object memLog: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + ReadOnly = True + Align = Client + Margins.Left = 5.000000000000000000 + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Size.Width = 573.000000000000000000 + Size.Height = 289.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Viewport.Width = 569.000000000000000000 + Viewport.Height = 285.000000000000000000 + end + object ToolBar1: TToolBar + Size.Width = 583.000000000000000000 + Size.Height = 40.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + TabStop = False + object btnActivateServer: TButton + Align = Left + Margins.Left = 5.000000000000000000 + Margins.Top = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Position.X = 5.000000000000000000 + Position.Y = 5.000000000000000000 + Size.Width = 137.000000000000000000 + Size.Height = 30.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + Text = 'Activate Server' + OnClick = btnActivateServerClick + end + object btnShutDownClients: TButton + Align = Right + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Position.X = 424.000000000000000000 + Position.Y = 5.000000000000000000 + Size.Width = 154.000000000000000000 + Size.Height = 30.000000000000000000 + Size.PlatformDefault = False + TabOrder = 2 + Text = 'Shutdown Clients' + OnClick = btnShutDownClientsClick + end + end + object Server: TncServerSource + EncryptionKey = 'SetEncryptionKey' + OnConnected = ServerConnected + OnDisconnected = ServerDisconnected + OnHandleCommand = ServerHandleCommand + Left = 32 + Top = 32 + end +end diff --git a/Demos/ChatDemo/Server/ufrmMain.pas b/Demos/TCP/ChatDemo/Server/ufrmMain.pas similarity index 96% rename from Demos/ChatDemo/Server/ufrmMain.pas rename to Demos/TCP/ChatDemo/Server/ufrmMain.pas index aa2ed06..da4a6c8 100644 --- a/Demos/ChatDemo/Server/ufrmMain.pas +++ b/Demos/TCP/ChatDemo/Server/ufrmMain.pas @@ -1,118 +1,118 @@ -unit ufrmMain; - -interface - -uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, - FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, - FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, - System.SyncObjs, ncSocketList, ncSources; - -type - TfrmMain = class(TForm) - Server: TncServerSource; - memLog: TMemo; - ToolBar1: TToolBar; - btnActivateServer: TButton; - btnShutDownClients: TButton; - procedure FormDestroy(Sender: TObject); - function ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; - const aSenderComponent, aReceiverComponent: string): TArray; - procedure ServerConnected(Sender: TObject; aLine: TncLine); - procedure ServerDisconnected(Sender: TObject; aLine: TncLine); - procedure btnActivateServerClick(Sender: TObject); - procedure btnShutDownClientsClick(Sender: TObject); - private - public - procedure Log(aStr: string); - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.fmx} - -procedure TfrmMain.FormDestroy(Sender: TObject); -begin - Server.Active := False; -end; - -procedure TfrmMain.Log(aStr: string); -begin - // This is thread safe - TThread.Queue(nil, - procedure - begin - memLog.Lines.Add(aStr); - memLog.ScrollBy(0, 100); - end); -end; - -procedure TfrmMain.btnActivateServerClick(Sender: TObject); -begin - try - Server.Active := not Server.Active; - finally - if Server.Active then - begin - btnActivateServer.Text := 'Deactivate Server'; - Log('Server is activated'); - end - else - begin - btnActivateServer.Text := 'Activate Server'; - Log('Server was deactivated'); - end; - end; -end; - -procedure TfrmMain.ServerConnected(Sender: TObject; aLine: TncLine); -begin - Log('Client connected: ' + aLine.PeerIP); -end; - -procedure TfrmMain.ServerDisconnected(Sender: TObject; aLine: TncLine); -begin - Log('Client disconnected: ' + aLine.PeerIP); -end; - -function TfrmMain.ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; -const aSenderComponent, aReceiverComponent: string): TArray; -var - Clients: TSocketList; - i: Integer; -begin - Log('Received: "' + StringOf(aData) + '" from peer: ' + aLine.PeerIP); - - // Now send this to all clients - Clients := Server.Lines.LockList; - try - for i := 0 to Clients.Count - 1 do - // if Clients.Lines[i] <> aLine then // If you do not want to send text back to original client - Server.ExecCommand(Clients.Lines[i], 0, aData, False); - - // You can shutdown a line here by calling Server.ShutdownLine, - // see following procecure - finally - Server.Lines.UnlockList; - end; -end; - -procedure TfrmMain.btnShutDownClientsClick(Sender: TObject); -var - Clients: TSocketList; - i: Integer; -begin - Clients := Server.Lines.LockList; - try - for i := 0 to Clients.Count - 1 do - Server.ShutDownLine(Clients.Lines[i]); - finally - Server.Lines.UnlockList; - end; - -end; - -end. +unit ufrmMain; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, + FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, + System.SyncObjs, ncSocketList, ncSources; + +type + TfrmMain = class(TForm) + Server: TncServerSource; + memLog: TMemo; + ToolBar1: TToolBar; + btnActivateServer: TButton; + btnShutDownClients: TButton; + procedure FormDestroy(Sender: TObject); + function ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TArray; + procedure ServerConnected(Sender: TObject; aLine: TncLine); + procedure ServerDisconnected(Sender: TObject; aLine: TncLine); + procedure btnActivateServerClick(Sender: TObject); + procedure btnShutDownClientsClick(Sender: TObject); + private + public + procedure Log(aStr: string); + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.fmx} + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + Server.Active := False; +end; + +procedure TfrmMain.Log(aStr: string); +begin + // This is thread safe + TThread.Queue(nil, + procedure + begin + memLog.Lines.Add(aStr); + memLog.ScrollBy(0, 100); + end); +end; + +procedure TfrmMain.btnActivateServerClick(Sender: TObject); +begin + try + Server.Active := not Server.Active; + finally + if Server.Active then + begin + btnActivateServer.Text := 'Deactivate Server'; + Log('Server is activated'); + end + else + begin + btnActivateServer.Text := 'Activate Server'; + Log('Server was deactivated'); + end; + end; +end; + +procedure TfrmMain.ServerConnected(Sender: TObject; aLine: TncLine); +begin + Log('Client connected: ' + aLine.PeerIP); +end; + +procedure TfrmMain.ServerDisconnected(Sender: TObject; aLine: TncLine); +begin + Log('Client disconnected: ' + aLine.PeerIP); +end; + +function TfrmMain.ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; +const aSenderComponent, aReceiverComponent: string): TArray; +var + Clients: TSocketList; + i: Integer; +begin + Log('Received: "' + StringOf(aData) + '" from peer: ' + aLine.PeerIP); + + // Now send this to all clients + Clients := Server.Lines.LockList; + try + for i := 0 to Clients.Count - 1 do + // if Clients.Lines[i] <> aLine then // If you do not want to send text back to original client + Server.ExecCommand(Clients.Lines[i], 0, aData, False); + + // You can shutdown a line here by calling Server.ShutdownLine, + // see following procecure + finally + Server.Lines.UnlockList; + end; +end; + +procedure TfrmMain.btnShutDownClientsClick(Sender: TObject); +var + Clients: TSocketList; + i: Integer; +begin + Clients := Server.Lines.LockList; + try + for i := 0 to Clients.Count - 1 do + Server.ShutDownLine(Clients.Lines[i]); + finally + Server.Lines.UnlockList; + end; + +end; + +end. diff --git a/Demos/DB/ChatDemo/Client/ChatClient.dpr b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dpr similarity index 94% rename from Demos/DB/ChatDemo/Client/ChatClient.dpr rename to Demos/TCP/DB/ChatDemo/Client/ChatClient.dpr index 8c41207..2f85b6a 100644 --- a/Demos/DB/ChatDemo/Client/ChatClient.dpr +++ b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dpr @@ -1,17 +1,17 @@ -program ChatClient; - -uses - System.StartUpCopy, - FMX.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}; - -{$R *.res} - -begin - {$IFDEF DEBUG} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} - Application.Initialize; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program ChatClient; + +uses + System.StartUpCopy, + FMX.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/Demos/DB/ChatDemo/Client/ChatClient.dproj b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dproj similarity index 98% rename from Demos/DB/ChatDemo/Client/ChatClient.dproj rename to Demos/TCP/DB/ChatDemo/Client/ChatClient.dproj index 41b7fa4..e16bdba 100644 --- a/Demos/DB/ChatDemo/Client/ChatClient.dproj +++ b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dproj @@ -1,1097 +1,1097 @@ - - - {E615DFF5-615F-4A51-B6AF-B5B187237486} - 18.8 - FMX - ChatClient.dpr - True - Debug - Win64 - 32787 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - true - true - true - true - true - true - true - true - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\delphi_PROJECTICNS.icns - ChatClient - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - 1 - #000000 - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - 1 - #000000 - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - - - true - PerMonitorV2 - true - 1033 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- fmx - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - ChatClient.dpr - - - Microsoft Office 2000 Sample Automation Server Wrapper Components - - - - - - true - - - - - true - - - - - true - - - - - ChatClient.exe - true - - - - - ChatClient.exe - true - - - - - ChatClient.rsm - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - True - True - True - - - 12 - - - - - + + + {E615DFF5-615F-4A51-B6AF-B5B187237486} + 18.8 + FMX + ChatClient.dpr + True + Debug + Win64 + 32787 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + ChatClient + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + 1 + #000000 + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + 1 + #000000 + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + + + true + PerMonitorV2 + true + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ fmx + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + ChatClient.dpr + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + + + + + + true + + + + + true + + + + + true + + + + + ChatClient.exe + true + + + + + ChatClient.exe + true + + + + + ChatClient.rsm + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + True + True + True + True + + + 12 + + + + + diff --git a/Demos/DB/ChatDemo/Client/ChatClient.dproj.local b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dproj.local similarity index 99% rename from Demos/DB/ChatDemo/Client/ChatClient.dproj.local rename to Demos/TCP/DB/ChatDemo/Client/ChatClient.dproj.local index e8d19a3..a8cb9ab 100644 --- a/Demos/DB/ChatDemo/Client/ChatClient.dproj.local +++ b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dproj.local @@ -1,38 +1,38 @@ - - - - 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas - 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/06/01 10:58:58.000.571,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx - 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/06/01 11:04:17.000.240,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ChatDemoClient.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj - 2020/08/10 16:11:38.249,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatDemoClient.dproj - - - - - + + + + 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas + 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/06/01 10:58:58.000.571,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx + 2020/06/01 11:04:10.000.068,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/06/01 11:04:17.000.240,C:\Users\Programmer\Documents\Development\Projects\ChatDemo\Client\ChatDemoClient.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj + 2020/08/10 16:11:38.249,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatDemoClient.dproj + + + + + diff --git a/Demos/DB/ChatDemo/Client/ChatClient.dsk b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dsk similarity index 94% rename from Demos/DB/ChatDemo/Client/ChatClient.dsk rename to Demos/TCP/DB/ChatDemo/Client/ChatClient.dsk index a8a4502..182168d 100644 --- a/Demos/DB/ChatDemo/Client/ChatClient.dsk +++ b/Demos/TCP/DB/ChatDemo/Client/ChatClient.dsk @@ -1,762 +1,762 @@ -[Closed Files] -File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.ScrollBox.pas',0,1,1479,17,1487,0,0,, -File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Workspace\AnimationPrototype\ufrmMain.pas',0,1,79,6,87,0,0,, -File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Projects\StarFieldSimulation\ufrmMain.pas',0,1,100,1,114,0,0,,{1 -File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.UITypes.pas',0,1,88,15,109,0,0,, -File_4=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\ufrmMain.pas',0,1,145,1,1,0,0,, -File_5=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\udmResources.pas',0,1,1,1,1,0,0,, -File_6=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\udmMain.pas',0,1,46,1,1,0,0,, -File_7=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\uComponents.pas',0,1,1,1,1,0,0,, -File_8=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\u3DScene.pas',0,1,46,1,1,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas] -ModuleType=TSourceModule - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj] -ModuleType=TBaseProject - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr -CursorX=11 -CursorY=13 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatDemoClient.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas -CursorX=1 -CursorY=126 -TopLine=86 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-240 -Top=-285 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.ScrollBox.pas',0,1,1479,17,1487,0,0,, +File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Workspace\AnimationPrototype\ufrmMain.pas',0,1,79,6,87,0,0,, +File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Projects\StarFieldSimulation\ufrmMain.pas',0,1,100,1,114,0,0,,{1 +File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.UITypes.pas',0,1,88,15,109,0,0,, +File_4=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\ufrmMain.pas',0,1,145,1,1,0,0,, +File_5=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\udmResources.pas',0,1,1,1,1,0,0,, +File_6=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\udmMain.pas',0,1,46,1,1,0,0,, +File_7=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\uComponents.pas',0,1,1,1,1,0,0,, +File_8=TSourceModule,'E:\Users\Bill\Desktop\RAD Studio\Projects\Roulette\u3DScene.pas',0,1,46,1,1,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas] +ModuleType=TSourceModule + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dproj] +ModuleType=TBaseProject + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr +CursorX=11 +CursorY=13 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatDemoClient.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pas +CursorX=1 +CursorY=126 +TopLine=86 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-240 +Top=-285 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/ChatDemo/Client/ChatClient.identcache b/Demos/TCP/DB/ChatDemo/Client/ChatClient.identcache similarity index 100% rename from Demos/ChatDemo/Client/ChatClient.identcache rename to Demos/TCP/DB/ChatDemo/Client/ChatClient.identcache diff --git a/Demos/ChatDemo/Client/ChatClient.res b/Demos/TCP/DB/ChatDemo/Client/ChatClient.res similarity index 100% rename from Demos/ChatDemo/Client/ChatClient.res rename to Demos/TCP/DB/ChatDemo/Client/ChatClient.res diff --git a/Demos/DB/ChatDemo/Client/Initial.txt b/Demos/TCP/DB/ChatDemo/Client/Initial.txt similarity index 100% rename from Demos/DB/ChatDemo/Client/Initial.txt rename to Demos/TCP/DB/ChatDemo/Client/Initial.txt diff --git a/Demos/DB/ChatDemo/Client/ufrmMain.fmx b/Demos/TCP/DB/ChatDemo/Client/ufrmMain.fmx similarity index 96% rename from Demos/DB/ChatDemo/Client/ufrmMain.fmx rename to Demos/TCP/DB/ChatDemo/Client/ufrmMain.fmx index b12e2ad..7566752 100644 --- a/Demos/DB/ChatDemo/Client/ufrmMain.fmx +++ b/Demos/TCP/DB/ChatDemo/Client/ufrmMain.fmx @@ -1,133 +1,133 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - ActiveControl = edtText - Caption = 'Chat Client' - ClientHeight = 480 - ClientWidth = 640 - Position = ScreenCenter - FormFactor.Width = 320 - FormFactor.Height = 480 - FormFactor.Devices = [Desktop] - OnCreate = FormCreate - OnDestroy = FormDestroy - DesignerMasterStyle = 0 - object memLog: TMemo - Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] - DataDetectorTypes = [] - ReadOnly = True - TextSettings.WordWrap = True - Align = Client - Margins.Left = 5.000000000000000000 - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Size.Width = 630.000000000000000000 - Size.Height = 369.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Viewport.Width = 626.000000000000000000 - Viewport.Height = 365.000000000000000000 - end - object ltMain: TLayout - Align = Bottom - Margins.Left = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Position.X = 5.000000000000000000 - Position.Y = 446.000000000000000000 - Size.Width = 630.000000000000000000 - Size.Height = 29.000000000000000000 - Size.PlatformDefault = False - TabOrder = 3 - TabStop = False - object edtText: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Client - TabOrder = 0 - Margins.Right = 4.000000000000000000 - Size.Width = 546.000000000000000000 - Size.Height = 29.000000000000000000 - Size.PlatformDefault = False - OnEnter = edtTextEnter - OnExit = edtTextExit - end - object btnSend: TButton - Align = Right - Default = True - Position.X = 550.000000000000000000 - Size.Width = 80.000000000000000000 - Size.Height = 29.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Text = 'Send' - OnClick = btnSendClick - end - end - object edtClientName: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Bottom - TabOrder = 2 - Text = 'Happy texter' - Position.X = 5.000000000000000000 - Position.Y = 419.000000000000000000 - Margins.Left = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Size.Width = 630.000000000000000000 - Size.Height = 22.000000000000000000 - Size.PlatformDefault = False - TextPrompt = 'Enter your name' - end - object tmrUpdateLog: TTimer - Interval = 1 - OnTimer = tmrUpdateLogTimer - Left = 96 - Top = 32 - end - object ToolBar1: TToolBar - Size.Width = 640.000000000000000000 - Size.Height = 40.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - TabStop = False - object btnActivateClient: TButton - Align = Left - Margins.Left = 5.000000000000000000 - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Position.X = 5.000000000000000000 - Position.Y = 5.000000000000000000 - Size.Width = 137.000000000000000000 - Size.Height = 30.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - Text = 'Activate Client' - OnClick = btnActivateClientClick - end - object edtHost: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Client - TabOrder = 1 - Text = 'LocalHost' - Margins.Top = 5.000000000000000000 - Margins.Right = 5.000000000000000000 - Margins.Bottom = 5.000000000000000000 - Size.Width = 488.000000000000000000 - Size.Height = 30.000000000000000000 - Size.PlatformDefault = False - OnChange = edtHostChange - end - end - object Client: TncClientSource - EncryptionKey = 'SetEncryptionKey' - OnConnected = ClientConnected - OnDisconnected = ClientDisconnected - OnHandleCommand = ClientHandleCommand - Host = 'LocalHost' - OnReconnected = ClientReconnected - Left = 32 - Top = 32 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + ActiveControl = edtText + Caption = 'Chat Client' + ClientHeight = 480 + ClientWidth = 640 + Position = ScreenCenter + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + OnDestroy = FormDestroy + DesignerMasterStyle = 0 + object memLog: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + ReadOnly = True + TextSettings.WordWrap = True + Align = Client + Margins.Left = 5.000000000000000000 + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Size.Width = 630.000000000000000000 + Size.Height = 369.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Viewport.Width = 626.000000000000000000 + Viewport.Height = 365.000000000000000000 + end + object ltMain: TLayout + Align = Bottom + Margins.Left = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Position.X = 5.000000000000000000 + Position.Y = 446.000000000000000000 + Size.Width = 630.000000000000000000 + Size.Height = 29.000000000000000000 + Size.PlatformDefault = False + TabOrder = 3 + TabStop = False + object edtText: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Client + TabOrder = 0 + Margins.Right = 4.000000000000000000 + Size.Width = 546.000000000000000000 + Size.Height = 29.000000000000000000 + Size.PlatformDefault = False + OnEnter = edtTextEnter + OnExit = edtTextExit + end + object btnSend: TButton + Align = Right + Default = True + Position.X = 550.000000000000000000 + Size.Width = 80.000000000000000000 + Size.Height = 29.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Text = 'Send' + OnClick = btnSendClick + end + end + object edtClientName: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Bottom + TabOrder = 2 + Text = 'Happy texter' + Position.X = 5.000000000000000000 + Position.Y = 419.000000000000000000 + Margins.Left = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Size.Width = 630.000000000000000000 + Size.Height = 22.000000000000000000 + Size.PlatformDefault = False + TextPrompt = 'Enter your name' + end + object tmrUpdateLog: TTimer + Interval = 1 + OnTimer = tmrUpdateLogTimer + Left = 96 + Top = 32 + end + object ToolBar1: TToolBar + Size.Width = 640.000000000000000000 + Size.Height = 40.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + TabStop = False + object btnActivateClient: TButton + Align = Left + Margins.Left = 5.000000000000000000 + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Position.X = 5.000000000000000000 + Position.Y = 5.000000000000000000 + Size.Width = 137.000000000000000000 + Size.Height = 30.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + Text = 'Activate Client' + OnClick = btnActivateClientClick + end + object edtHost: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Client + TabOrder = 1 + Text = 'LocalHost' + Margins.Top = 5.000000000000000000 + Margins.Right = 5.000000000000000000 + Margins.Bottom = 5.000000000000000000 + Size.Width = 488.000000000000000000 + Size.Height = 30.000000000000000000 + Size.PlatformDefault = False + OnChange = edtHostChange + end + end + object Client: TncClientSource + EncryptionKey = 'SetEncryptionKey' + OnConnected = ClientConnected + OnDisconnected = ClientDisconnected + OnHandleCommand = ClientHandleCommand + Host = 'LocalHost' + OnReconnected = ClientReconnected + Left = 32 + Top = 32 + end +end diff --git a/Demos/DB/ChatDemo/Client/ufrmMain.pas b/Demos/TCP/DB/ChatDemo/Client/ufrmMain.pas similarity index 96% rename from Demos/DB/ChatDemo/Client/ufrmMain.pas rename to Demos/TCP/DB/ChatDemo/Client/ufrmMain.pas index 6536c2b..0bd12ea 100644 --- a/Demos/DB/ChatDemo/Client/ufrmMain.pas +++ b/Demos/TCP/DB/ChatDemo/Client/ufrmMain.pas @@ -1,158 +1,158 @@ -unit ufrmMain; - -interface - -uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, - FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, - FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, - FMX.Memo, System.SyncObjs, ncSources; - -type - TfrmMain = class(TForm) - memLog: TMemo; - ltMain: TLayout; - edtText: TEdit; - btnSend: TButton; - Client: TncClientSource; - tmrUpdateLog: TTimer; - edtClientName: TEdit; - ToolBar1: TToolBar; - btnActivateClient: TButton; - edtHost: TEdit; - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure btnSendClick(Sender: TObject); - procedure tmrUpdateLogTimer(Sender: TObject); - function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; - const aData: TArray; aRequiresResult: Boolean; - const aSenderComponent, aReceiverComponent: string): TArray; - procedure edtTextEnter(Sender: TObject); - procedure edtTextExit(Sender: TObject); - procedure btnActivateClientClick(Sender: TObject); - procedure ClientConnected(Sender: TObject; aLine: TncLine); - procedure ClientDisconnected(Sender: TObject; aLine: TncLine); - procedure ClientReconnected(Sender: TObject; aLine: TncLine); - procedure edtHostChange(Sender: TObject); - private - LogLock: TCriticalSection; - LogLines, LogLinesCopy: TStringList; - public - procedure Log(aStr: string); - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.fmx} - -procedure TfrmMain.FormCreate(Sender: TObject); -begin - LogLock := TCriticalSection.Create; - LogLines := TStringList.Create; - LogLinesCopy := TStringList.Create; -end; - -procedure TfrmMain.FormDestroy(Sender: TObject); -begin - Client.Active := False; - - LogLinesCopy.Free; - LogLines.Free; - LogLock.Free; -end; - -procedure TfrmMain.Log(aStr: string); -begin - // This is thread safe - LogLock.Acquire; - try - LogLines.Add (aStr); - finally - LogLock.Release; - end; -end; - -procedure TfrmMain.tmrUpdateLogTimer(Sender: TObject); -var - i: Integer; -begin - // Update the memLog from LogLines - LogLock.Acquire; - try - LogLinesCopy.Assign(LogLines); - LogLines.Clear; - finally - LogLock.Release; - end; - - for i := 0 to LogLinesCopy.Count - 1 do - begin - memLog.Lines.Add(LogLinesCopy.Strings[i]); - memLog.SelStart := Length(memLog.Text); - end; - LogLinesCopy.Clear; -end; - -procedure TfrmMain.btnActivateClientClick(Sender: TObject); -begin - Client.Active := not Client.Active; -end; - -procedure TfrmMain.btnSendClick(Sender: TObject); -begin - Client.ExecCommand(0, BytesOf (edtClientName.Text + ': ' + edtText.Text)); - edtText.Text := ''; -end; - -procedure TfrmMain.edtHostChange(Sender: TObject); -begin - if not Client.Active then - Client.Host := edtHost.Text; -end; - -procedure TfrmMain.edtTextEnter(Sender: TObject); -begin - btnSend.Default := True; -end; - -procedure TfrmMain.edtTextExit(Sender: TObject); -begin - btnSend.Default := False; -end; - -procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); -begin - Log ('Client connected to peer: ' + aLine.PeerIP); - TThread.Synchronize(nil, - procedure - begin - btnActivateClient.Text := 'Deactivate client'; - end); -end; - -procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); -begin - Log ('Client disconnected from peer: ' + aLine.PeerIP); - TThread.Synchronize(nil, - procedure - begin - btnActivateClient.Text := 'Activate client'; - end); -end; - -procedure TfrmMain.ClientReconnected(Sender: TObject; aLine: TncLine); -begin - Log ('Client was reconnected to peer: ' + aLine.PeerIP); -end; - -function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; - aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; - const aSenderComponent, aReceiverComponent: string): TArray; -begin - Log (Stringof (aData)); -end; - -end. +unit ufrmMain; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, + FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, + FMX.Memo, System.SyncObjs, ncSources; + +type + TfrmMain = class(TForm) + memLog: TMemo; + ltMain: TLayout; + edtText: TEdit; + btnSend: TButton; + Client: TncClientSource; + tmrUpdateLog: TTimer; + edtClientName: TEdit; + ToolBar1: TToolBar; + btnActivateClient: TButton; + edtHost: TEdit; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnSendClick(Sender: TObject); + procedure tmrUpdateLogTimer(Sender: TObject); + function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; + const aData: TArray; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TArray; + procedure edtTextEnter(Sender: TObject); + procedure edtTextExit(Sender: TObject); + procedure btnActivateClientClick(Sender: TObject); + procedure ClientConnected(Sender: TObject; aLine: TncLine); + procedure ClientDisconnected(Sender: TObject; aLine: TncLine); + procedure ClientReconnected(Sender: TObject; aLine: TncLine); + procedure edtHostChange(Sender: TObject); + private + LogLock: TCriticalSection; + LogLines, LogLinesCopy: TStringList; + public + procedure Log(aStr: string); + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.fmx} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + LogLock := TCriticalSection.Create; + LogLines := TStringList.Create; + LogLinesCopy := TStringList.Create; +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + Client.Active := False; + + LogLinesCopy.Free; + LogLines.Free; + LogLock.Free; +end; + +procedure TfrmMain.Log(aStr: string); +begin + // This is thread safe + LogLock.Acquire; + try + LogLines.Add (aStr); + finally + LogLock.Release; + end; +end; + +procedure TfrmMain.tmrUpdateLogTimer(Sender: TObject); +var + i: Integer; +begin + // Update the memLog from LogLines + LogLock.Acquire; + try + LogLinesCopy.Assign(LogLines); + LogLines.Clear; + finally + LogLock.Release; + end; + + for i := 0 to LogLinesCopy.Count - 1 do + begin + memLog.Lines.Add(LogLinesCopy.Strings[i]); + memLog.SelStart := Length(memLog.Text); + end; + LogLinesCopy.Clear; +end; + +procedure TfrmMain.btnActivateClientClick(Sender: TObject); +begin + Client.Active := not Client.Active; +end; + +procedure TfrmMain.btnSendClick(Sender: TObject); +begin + Client.ExecCommand(0, BytesOf (edtClientName.Text + ': ' + edtText.Text)); + edtText.Text := ''; +end; + +procedure TfrmMain.edtHostChange(Sender: TObject); +begin + if not Client.Active then + Client.Host := edtHost.Text; +end; + +procedure TfrmMain.edtTextEnter(Sender: TObject); +begin + btnSend.Default := True; +end; + +procedure TfrmMain.edtTextExit(Sender: TObject); +begin + btnSend.Default := False; +end; + +procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); +begin + Log ('Client connected to peer: ' + aLine.PeerIP); + TThread.Synchronize(nil, + procedure + begin + btnActivateClient.Text := 'Deactivate client'; + end); +end; + +procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); +begin + Log ('Client disconnected from peer: ' + aLine.PeerIP); + TThread.Synchronize(nil, + procedure + begin + btnActivateClient.Text := 'Activate client'; + end); +end; + +procedure TfrmMain.ClientReconnected(Sender: TObject; aLine: TncLine); +begin + Log ('Client was reconnected to peer: ' + aLine.PeerIP); +end; + +function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; + aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TArray; +begin + Log (Stringof (aData)); +end; + +end. diff --git a/Demos/DB/ChatDemo/Server/Initial.txt b/Demos/TCP/DB/ChatDemo/Server/Initial.txt similarity index 100% rename from Demos/DB/ChatDemo/Server/Initial.txt rename to Demos/TCP/DB/ChatDemo/Server/Initial.txt diff --git a/Demos/DB/ChatDemo/initial.txt b/Demos/TCP/DB/ChatDemo/initial.txt similarity index 100% rename from Demos/DB/ChatDemo/initial.txt rename to Demos/TCP/DB/ChatDemo/initial.txt diff --git a/Demos/DB/DBClient/DBClient.dpr b/Demos/TCP/DB/DBClient/DBClient.dpr similarity index 95% rename from Demos/DB/DBClient/DBClient.dpr rename to Demos/TCP/DB/DBClient/DBClient.dpr index b86a578..b071dcd 100644 --- a/Demos/DB/DBClient/DBClient.dpr +++ b/Demos/TCP/DB/DBClient/DBClient.dpr @@ -1,17 +1,17 @@ -program DBClient; - -uses - Vcl.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}, - udmMain in 'udmMain.pas' {dmMain: TDataModule}; - -{$R *.res} - -begin - ReportMemoryLeaksOnShutdown := True; - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.CreateForm(TfrmMain, frmMain); - Application.CreateForm(TdmMain, dmMain); - Application.Run; -end. +program DBClient; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}, + udmMain in 'udmMain.pas' {dmMain: TDataModule}; + +{$R *.res} + +begin + ReportMemoryLeaksOnShutdown := True; + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TfrmMain, frmMain); + Application.CreateForm(TdmMain, dmMain); + Application.Run; +end. diff --git a/Demos/DB/DBClient/DBClient.dproj b/Demos/TCP/DB/DBClient/DBClient.dproj similarity index 98% rename from Demos/DB/DBClient/DBClient.dproj rename to Demos/TCP/DB/DBClient/DBClient.dproj index e3466ad..5fe2cc3 100644 --- a/Demos/DB/DBClient/DBClient.dproj +++ b/Demos/TCP/DB/DBClient/DBClient.dproj @@ -1,209 +1,209 @@ - - - {5DC2BA92-67D1-464B-A6A6-59BD015406E5} - 18.8 - DBClient.dpr - Release - DCC32 - VCL - True - Win32 - 32769 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - DBClient.exe - $(BDSCOMMONDIR)\DCU - $(BDSCOMMONDIR)\DCP - vcl;rtl;vclx;vclactnband;xmlrtl;vclimg;dbrtl;vcldb;vcldbx;bdertl;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dxSkinscxPCPainterD14;cxPageControlD14;dxSkinsCoreD14;dxSkinsdxLCPainterD14;dxLayoutControlD14;dxSkinscxScheduler3PainterD14;cxSchedulerD14;dxSkinsdxNavBar2PainterD14;dxNavBarD14;dxSkinsdxDLPainterD14;dxDockingD14;dxSkinsdxRibbonPainterD14;dxRibbonD14;dxBarD14;dxSkinsdxBarPainterD14;dclOfficeXP;$(DCC_UsePackage) - 00400000 - x86 - true - DBClient - Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;Data.Win;$(DCC_Namespace) - true - 3 - 46 - true - 1033 - CompanyName=Developer Express Inc.;FileDescription=ExpressScheduler 3 connection to ExpressQuantumGrid;FileVersion=3.46.0.0;InternalName=;LegalCopyright=Copyright (c) 1998-2009 Developer Express Inc.;LegalTrademarks=;OriginalFilename=dclcxSchedulerGridD14.BPL;ProductName=;ProductVersion=3.4 - - - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - System.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) - 1033 - $(BDS)\bin\default_app.manifest - DBClient_Icon.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - $(BDS)\bin\default_app.manifest - DBClient_Icon.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - false - false - RELEASE;$(DCC_Define) - 0 - 0 - - - Debug - - - true - PerMonitorV2 - - - false - true - DEBUG;$(DCC_Define) - - - Debug - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- - -
dmMain
- TDataModule - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - Delphi.Personality.12 - - - - - DBClient.dpr - - - False - True - False - - - True - False - 3 - 46 - 0 - 0 - False - False - False - False - True - 1033 - 1200 - - - Developer Express Inc. - ExpressScheduler 3 connection to ExpressQuantumGrid - 3.46.0.0 - - Copyright (c) 1998-2009 Developer Express Inc. - - dclcxSchedulerGridD14.BPL - - 3.4 - - - Embarcadero C++Builder Office XP Servers Package - Embarcadero C++Builder Office 2000 Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - - - - True - True - False - - - 12 - - - + + + {5DC2BA92-67D1-464B-A6A6-59BD015406E5} + 18.8 + DBClient.dpr + Release + DCC32 + VCL + True + Win32 + 32769 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + DBClient.exe + $(BDSCOMMONDIR)\DCU + $(BDSCOMMONDIR)\DCP + vcl;rtl;vclx;vclactnband;xmlrtl;vclimg;dbrtl;vcldb;vcldbx;bdertl;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dxSkinscxPCPainterD14;cxPageControlD14;dxSkinsCoreD14;dxSkinsdxLCPainterD14;dxLayoutControlD14;dxSkinscxScheduler3PainterD14;cxSchedulerD14;dxSkinsdxNavBar2PainterD14;dxNavBarD14;dxSkinsdxDLPainterD14;dxDockingD14;dxSkinsdxRibbonPainterD14;dxRibbonD14;dxBarD14;dxSkinsdxBarPainterD14;dclOfficeXP;$(DCC_UsePackage) + 00400000 + x86 + true + DBClient + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;Data.Win;$(DCC_Namespace) + true + 3 + 46 + true + 1033 + CompanyName=Developer Express Inc.;FileDescription=ExpressScheduler 3 connection to ExpressQuantumGrid;FileVersion=3.46.0.0;InternalName=;LegalCopyright=Copyright (c) 1998-2009 Developer Express Inc.;LegalTrademarks=;OriginalFilename=dclcxSchedulerGridD14.BPL;ProductName=;ProductVersion=3.4 + + + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + System.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + DBClient_Icon.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\default_app.manifest + DBClient_Icon.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + false + false + RELEASE;$(DCC_Define) + 0 + 0 + + + Debug + + + true + PerMonitorV2 + + + false + true + DEBUG;$(DCC_Define) + + + Debug + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ + +
dmMain
+ TDataModule + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + Delphi.Personality.12 + + + + + DBClient.dpr + + + False + True + False + + + True + False + 3 + 46 + 0 + 0 + False + False + False + False + True + 1033 + 1200 + + + Developer Express Inc. + ExpressScheduler 3 connection to ExpressQuantumGrid + 3.46.0.0 + + Copyright (c) 1998-2009 Developer Express Inc. + + dclcxSchedulerGridD14.BPL + + 3.4 + + + Embarcadero C++Builder Office XP Servers Package + Embarcadero C++Builder Office 2000 Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + + + + True + True + False + + + 12 + + + diff --git a/Demos/DB/DBClient/DBClient.dproj.local b/Demos/TCP/DB/DBClient/DBClient.dproj.local similarity index 99% rename from Demos/DB/DBClient/DBClient.dproj.local rename to Demos/TCP/DB/DBClient/DBClient.dproj.local index c0b9684..0e0048f 100644 --- a/Demos/DB/DBClient/DBClient.dproj.local +++ b/Demos/TCP/DB/DBClient/DBClient.dproj.local @@ -1,11 +1,11 @@ - - - - 2011/03/28 11:31:42.844.dfm,C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.dfm=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\ufrmMain.dfm - 2011/03/28 11:31:42.844.pas,C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.pas=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas - 2011/03/28 11:31:46.702.dproj,C:\Users\BDemos\Documents\RAD Studio\Projects\Project1.dproj=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\DBClient.dproj - 2011/03/28 11:32:45.130.dfm,C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\Unit1.dfm=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\udmMain.dfm - 2011/03/28 11:32:45.130.pas,C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\Unit1.pas=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\udmMain.pas - - - + + + + 2011/03/28 11:31:42.844.dfm,C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.dfm=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\ufrmMain.dfm + 2011/03/28 11:31:42.844.pas,C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.pas=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas + 2011/03/28 11:31:46.702.dproj,C:\Users\BDemos\Documents\RAD Studio\Projects\Project1.dproj=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\DBClient.dproj + 2011/03/28 11:32:45.130.dfm,C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\Unit1.dfm=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\udmMain.dfm + 2011/03/28 11:32:45.130.pas,C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\Unit1.pas=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBClient\udmMain.pas + + + diff --git a/Demos/DB/DBClient/DBClient.dsk b/Demos/TCP/DB/DBClient/DBClient.dsk similarity index 94% rename from Demos/DB/DBClient/DBClient.dsk rename to Demos/TCP/DB/DBClient/DBClient.dsk index 8fedbb5..a84758c 100644 --- a/Demos/DB/DBClient/DBClient.dsk +++ b/Demos/TCP/DB/DBClient/DBClient.dsk @@ -1,785 +1,785 @@ -[Closed Files] -File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\data\ado\Data.Win.ADODB.pas',0,1,1,6,14,0,0,, -File_1=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\data\Data.DB.pas',0,1,1,6,10,0,0,, -File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,1,6,10,0,0,, -File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\RTL\SYS\System.SysUtils.pas',0,1,1,6,16,0,0,, -File_4=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.Forms.pas',0,1,1,6,10,0,0,{{1755,4},{1771,15},{'TScrollWindow'}}{{1858,4},{1959,15},{'TMainMenuBarStyleHook'}}, -File_5=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\ComObj.pas',0,1,783,30,786,0,0,, -File_6=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\db\DB.pas',0,1,11243,1,11262,0,0,, -File_7=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\db\ADODB.pas',0,1,5604,1,5623,0,0,, -File_8=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\RTL\SYS\System.pas',0,1,21903,1,21931,0,0,, -File_9=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Classes.pas',0,1,5252,1,5266,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dproj -Module2=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas -Count=3 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas] -ModuleType=TSourceModule - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dproj] -ModuleType=TBaseProject - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=3 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas -View0=0 -View1=1 -View2=2 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=00000800010100000000CC0E0000000000000166070000000000000100000000530E000009000000446F636B536974653301000000004D1A00001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=00000800010100000000CC0E00000000000001F50500000000000001000000004612000009000000446F636B536974653201000000004D1A000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=1622 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020100000009000000446F636B5369746531C0440000000000000256060000000000000100000000C04400000F0000004D65737361676556696577466F726DFFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dpr -CursorX=48 -CursorY=6 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas -CursorX=38 -CursorY=36 -TopLine=26 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[View2] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas -CursorX=1 -CursorY=6 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=1 -Breakpoint0='c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\db\ADODB.pas',4017,'',0,1,'',1,0,0,'',1,'','','',0,'' - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=9900 -Height=1372 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=1372 -TBDockHeight=1372 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=1826 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=1826 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=2884 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=2884 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[PropInspDesignerSelection] -ArrangeBy=Name -SelectedItem=Align,OnAsyncExecCommandResult -ExpandedItems=LiveBindings=0,"LiveBindings Designer=0",Margins=0,Border=0,BorderIcons=0,Fill=0,FormFactor=0,Constraints=0,Anchors=0,BevelEdges=0 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-240 -Top=-285 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=1826 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=1826 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\data\ado\Data.Win.ADODB.pas',0,1,1,6,14,0,0,, +File_1=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\data\Data.DB.pas',0,1,1,6,10,0,0,, +File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,1,6,10,0,0,, +File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\RTL\SYS\System.SysUtils.pas',0,1,1,6,16,0,0,, +File_4=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.Forms.pas',0,1,1,6,10,0,0,{{1755,4},{1771,15},{'TScrollWindow'}}{{1858,4},{1959,15},{'TMainMenuBarStyleHook'}}, +File_5=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\ComObj.pas',0,1,783,30,786,0,0,, +File_6=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\db\DB.pas',0,1,11243,1,11262,0,0,, +File_7=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\db\ADODB.pas',0,1,5604,1,5623,0,0,, +File_8=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\RTL\SYS\System.pas',0,1,21903,1,21931,0,0,, +File_9=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Classes.pas',0,1,5252,1,5266,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dproj +Module2=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas +Count=3 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas] +ModuleType=TSourceModule + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dproj] +ModuleType=TBaseProject + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=3 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas +View0=0 +View1=1 +View2=2 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=00000800010100000000CC0E0000000000000166070000000000000100000000530E000009000000446F636B536974653301000000004D1A00001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=00000800010100000000CC0E00000000000001F50500000000000001000000004612000009000000446F636B536974653201000000004D1A000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=1622 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020100000009000000446F636B5369746531C0440000000000000256060000000000000100000000C04400000F0000004D65737361676556696577466F726DFFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dpr +CursorX=48 +CursorY=6 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pas +CursorX=38 +CursorY=36 +TopLine=26 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[View2] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas +CursorX=1 +CursorY=6 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pas + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=1 +Breakpoint0='c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\db\ADODB.pas',4017,'',0,1,'',1,0,0,'',1,'','','',0,'' + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=9900 +Height=1372 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=1372 +TBDockHeight=1372 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=1826 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=1826 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=2884 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=2884 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[PropInspDesignerSelection] +ArrangeBy=Name +SelectedItem=Align,OnAsyncExecCommandResult +ExpandedItems=LiveBindings=0,"LiveBindings Designer=0",Margins=0,Border=0,BorderIcons=0,Fill=0,FormFactor=0,Constraints=0,Anchors=0,BevelEdges=0 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-240 +Top=-285 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=1826 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=1826 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/DB/DBClient/DBClient.identcache b/Demos/TCP/DB/DBClient/DBClient.identcache similarity index 100% rename from Demos/DB/DBClient/DBClient.identcache rename to Demos/TCP/DB/DBClient/DBClient.identcache diff --git a/Demos/DB/DBClient/DBClient.res b/Demos/TCP/DB/DBClient/DBClient.res similarity index 100% rename from Demos/DB/DBClient/DBClient.res rename to Demos/TCP/DB/DBClient/DBClient.res diff --git a/Demos/DB/DBClient/DBClient.skincfg b/Demos/TCP/DB/DBClient/DBClient.skincfg similarity index 94% rename from Demos/DB/DBClient/DBClient.skincfg rename to Demos/TCP/DB/DBClient/DBClient.skincfg index 6870d73..d58e821 100644 --- a/Demos/DB/DBClient/DBClient.skincfg +++ b/Demos/TCP/DB/DBClient/DBClient.skincfg @@ -1,33 +1,33 @@ -[ExpressSkins] -Default=1 -ShowNotifications=1 -Enabled=1 -dxSkinBlack=0 -dxSkinBlue=0 -dxSkinCaramel=0 -dxSkinCoffee=0 -dxSkinDarkRoom=0 -dxSkinDarkSide=0 -dxSkinFoggy=0 -dxSkinGlassOceans=0 -dxSkiniMaginary=0 -dxSkinLilian=0 -dxSkinLiquidSky=0 -dxSkinLondonLiquidSky=0 -dxSkinMcSkin=0 -dxSkinMoneyTwins=0 -dxSkinOffice2007Black=0 -dxSkinOffice2007Blue=0 -dxSkinOffice2007Green=0 -dxSkinOffice2007Pink=0 -dxSkinOffice2007Silver=0 -dxSkinPumpkin=0 -dxSkinSeven=0 -dxSkinSharp=0 -dxSkinSilver=0 -dxSkinSpringTime=0 -dxSkinStardust=0 -dxSkinSummer2008=0 -dxSkinsDefaultPainters=0 -dxSkinValentine=0 -dxSkinXmas2008Blue=0 +[ExpressSkins] +Default=1 +ShowNotifications=1 +Enabled=1 +dxSkinBlack=0 +dxSkinBlue=0 +dxSkinCaramel=0 +dxSkinCoffee=0 +dxSkinDarkRoom=0 +dxSkinDarkSide=0 +dxSkinFoggy=0 +dxSkinGlassOceans=0 +dxSkiniMaginary=0 +dxSkinLilian=0 +dxSkinLiquidSky=0 +dxSkinLondonLiquidSky=0 +dxSkinMcSkin=0 +dxSkinMoneyTwins=0 +dxSkinOffice2007Black=0 +dxSkinOffice2007Blue=0 +dxSkinOffice2007Green=0 +dxSkinOffice2007Pink=0 +dxSkinOffice2007Silver=0 +dxSkinPumpkin=0 +dxSkinSeven=0 +dxSkinSharp=0 +dxSkinSilver=0 +dxSkinSpringTime=0 +dxSkinStardust=0 +dxSkinSummer2008=0 +dxSkinsDefaultPainters=0 +dxSkinValentine=0 +dxSkinXmas2008Blue=0 diff --git a/Demos/DB/DBClient/DBClient_Icon.ico b/Demos/TCP/DB/DBClient/DBClient_Icon.ico similarity index 100% rename from Demos/DB/DBClient/DBClient_Icon.ico rename to Demos/TCP/DB/DBClient/DBClient_Icon.ico diff --git a/Demos/DB/DBClient/udmMain.dfm b/Demos/TCP/DB/DBClient/udmMain.dfm similarity index 95% rename from Demos/DB/DBClient/udmMain.dfm rename to Demos/TCP/DB/DBClient/udmMain.dfm index fc78ad6..900b2d1 100644 --- a/Demos/DB/DBClient/udmMain.dfm +++ b/Demos/TCP/DB/DBClient/udmMain.dfm @@ -1,58 +1,58 @@ -object dmMain: TdmMain - OldCreateOrder = False - OnCreate = DataModuleCreate - Height = 351 - Width = 376 - object ncClientSource: TncClientSource - Port = 18753 - EncryptionKey = 'SetEncryptionKey' - Host = 'localhost' - Left = 56 - Top = 36 - end - object ncDBDataset1: TncDBDataset - CursorType = ctStatic - LockType = ltBatchOptimistic - Source = ncClientSource - PeerCommandHandler = 'DBServer' - SQL.Strings = ( - 'select * from Customers') - Parameters = <> - Left = 112 - Top = 116 - end - object DataSource1: TDataSource - DataSet = ncDBDataset1 - Left = 196 - Top = 116 - end - object ncDBDataset2: TncDBDataset - CursorType = ctStatic - LockType = ltBatchOptimistic - Source = ncClientSource - PeerCommandHandler = 'DBServer' - SQL.Strings = ( - 'select * from Orders' - 'where FKCustomersID=:ID') - DataSource = DataSource1 - IndexFieldNames = 'FKCustomersID' - Parameters = < - item - Name = 'ID' - Size = -1 - Value = Null - end> - Left = 112 - Top = 184 - end - object DataSource2: TDataSource - DataSet = ncDBDataset2 - Left = 196 - Top = 184 - end - object ADOQuery1: TADOQuery - Parameters = <> - Left = 56 - Top = 276 - end -end +object dmMain: TdmMain + OldCreateOrder = False + OnCreate = DataModuleCreate + Height = 351 + Width = 376 + object ncClientSource: TncClientSource + Port = 18753 + EncryptionKey = 'SetEncryptionKey' + Host = 'localhost' + Left = 56 + Top = 36 + end + object ncDBDataset1: TncDBDataset + CursorType = ctStatic + LockType = ltBatchOptimistic + Source = ncClientSource + PeerCommandHandler = 'DBServer' + SQL.Strings = ( + 'select * from Customers') + Parameters = <> + Left = 112 + Top = 116 + end + object DataSource1: TDataSource + DataSet = ncDBDataset1 + Left = 196 + Top = 116 + end + object ncDBDataset2: TncDBDataset + CursorType = ctStatic + LockType = ltBatchOptimistic + Source = ncClientSource + PeerCommandHandler = 'DBServer' + SQL.Strings = ( + 'select * from Orders' + 'where FKCustomersID=:ID') + DataSource = DataSource1 + IndexFieldNames = 'FKCustomersID' + Parameters = < + item + Name = 'ID' + Size = -1 + Value = Null + end> + Left = 112 + Top = 184 + end + object DataSource2: TDataSource + DataSet = ncDBDataset2 + Left = 196 + Top = 184 + end + object ADOQuery1: TADOQuery + Parameters = <> + Left = 56 + Top = 276 + end +end diff --git a/Demos/DB/DBClient/udmMain.pas b/Demos/TCP/DB/DBClient/udmMain.pas similarity index 94% rename from Demos/DB/DBClient/udmMain.pas rename to Demos/TCP/DB/DBClient/udmMain.pas index 79d5884..54692f0 100644 --- a/Demos/DB/DBClient/udmMain.pas +++ b/Demos/TCP/DB/DBClient/udmMain.pas @@ -1,38 +1,38 @@ -unit udmMain; - -interface - -uses - System.Classes, System.SysUtils, Data.DB, Data.Win.ADODB, ncSockets, ncSources, ncDBCnt; - -type - TdmMain = class(TDataModule) - ncClientSource: TncClientSource; - ncDBDataset1: TncDBDataset; - DataSource1: TDataSource; - ncDBDataset2: TncDBDataset; - DataSource2: TDataSource; - ADOQuery1: TADOQuery; - procedure DataModuleCreate(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - dmMain: TdmMain; - -implementation - -uses ufrmMain; - -{$R *.dfm} - -procedure TdmMain.DataModuleCreate(Sender: TObject); -begin - ncDBDataset1.Active := True; - ncDBDataset2.Active := True; -end; - -end. +unit udmMain; + +interface + +uses + System.Classes, System.SysUtils, Data.DB, Data.Win.ADODB, ncSockets, ncSources, ncDBCnt; + +type + TdmMain = class(TDataModule) + ncClientSource: TncClientSource; + ncDBDataset1: TncDBDataset; + DataSource1: TDataSource; + ncDBDataset2: TncDBDataset; + DataSource2: TDataSource; + ADOQuery1: TADOQuery; + procedure DataModuleCreate(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + dmMain: TdmMain; + +implementation + +uses ufrmMain; + +{$R *.dfm} + +procedure TdmMain.DataModuleCreate(Sender: TObject); +begin + ncDBDataset1.Active := True; + ncDBDataset2.Active := True; +end; + +end. diff --git a/Demos/DB/DBClient/ufrmMain.dfm b/Demos/TCP/DB/DBClient/ufrmMain.dfm similarity index 95% rename from Demos/DB/DBClient/ufrmMain.dfm rename to Demos/TCP/DB/DBClient/ufrmMain.dfm index 8de34cb..5bd6af1 100644 --- a/Demos/DB/DBClient/ufrmMain.dfm +++ b/Demos/TCP/DB/DBClient/ufrmMain.dfm @@ -1,144 +1,144 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'Client DB Tester' - ClientHeight = 392 - ClientWidth = 945 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - PixelsPerInch = 96 - TextHeight = 13 - object Panel2: TPanel - Left = 245 - Top = 0 - Width = 700 - Height = 373 - Align = alClient - TabOrder = 2 - object dbGrid1: TDBGrid - AlignWithMargins = True - Left = 4 - Top = 4 - Width = 692 - Height = 150 - Align = alTop - DataSource = dmMain.DataSource1 - TabOrder = 0 - TitleFont.Charset = DEFAULT_CHARSET - TitleFont.Color = clWindowText - TitleFont.Height = -11 - TitleFont.Name = 'Tahoma' - TitleFont.Style = [] - end - object DBNavigator1: TDBNavigator - AlignWithMargins = True - Left = 4 - Top = 160 - Width = 692 - Height = 35 - DataSource = dmMain.DataSource1 - Align = alTop - TabOrder = 1 - end - object DBGrid2: TDBGrid - AlignWithMargins = True - Left = 4 - Top = 201 - Width = 692 - Height = 130 - Align = alClient - DataSource = dmMain.DataSource2 - TabOrder = 2 - TitleFont.Charset = DEFAULT_CHARSET - TitleFont.Color = clWindowText - TitleFont.Height = -11 - TitleFont.Name = 'Tahoma' - TitleFont.Style = [] - end - object DBNavigator2: TDBNavigator - AlignWithMargins = True - Left = 4 - Top = 337 - Width = 692 - Height = 32 - DataSource = dmMain.DataSource2 - Align = alBottom - TabOrder = 3 - end - end - object StatusBar: TStatusBar - Left = 0 - Top = 373 - Width = 945 - Height = 19 - Panels = <> - SimplePanel = True - end - object Panel1: TPanel - Left = 0 - Top = 0 - Width = 245 - Height = 373 - Align = alLeft - TabOrder = 0 - object Button1: TButton - Left = 6 - Top = 52 - Width = 219 - Height = 25 - Caption = 'Test Activate/Deactivate Recordset Cycle' - TabOrder = 0 - OnClick = Button1Click - end - object Button2: TButton - Left = 6 - Top = 111 - Width = 219 - Height = 25 - Caption = 'Test Requery' - TabOrder = 1 - OnClick = Button2Click - end - object cbShowOpenClose: TCheckBox - Left = 12 - Top = 83 - Width = 213 - Height = 17 - Caption = 'Show Open/Close' - TabOrder = 2 - end - object Button4: TButton - Left = 6 - Top = 230 - Width = 161 - Height = 45 - Caption = 'Filter Pending' - TabOrder = 3 - OnClick = Button4Click - end - object edtHost: TEdit - Left = 6 - Top = 10 - Width = 121 - Height = 21 - TabOrder = 4 - Text = 'LocalHost' - TextHint = 'Host' - OnChange = edtHostChange - end - object btnApplyUpdates: TButton - Left = 6 - Top = 281 - Width = 161 - Height = 45 - Caption = 'Apply Updates' - TabOrder = 5 - OnClick = btnApplyUpdatesClick - end - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'Client DB Tester' + ClientHeight = 392 + ClientWidth = 945 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + PixelsPerInch = 96 + TextHeight = 13 + object Panel2: TPanel + Left = 245 + Top = 0 + Width = 700 + Height = 373 + Align = alClient + TabOrder = 2 + object dbGrid1: TDBGrid + AlignWithMargins = True + Left = 4 + Top = 4 + Width = 692 + Height = 150 + Align = alTop + DataSource = dmMain.DataSource1 + TabOrder = 0 + TitleFont.Charset = DEFAULT_CHARSET + TitleFont.Color = clWindowText + TitleFont.Height = -11 + TitleFont.Name = 'Tahoma' + TitleFont.Style = [] + end + object DBNavigator1: TDBNavigator + AlignWithMargins = True + Left = 4 + Top = 160 + Width = 692 + Height = 35 + DataSource = dmMain.DataSource1 + Align = alTop + TabOrder = 1 + end + object DBGrid2: TDBGrid + AlignWithMargins = True + Left = 4 + Top = 201 + Width = 692 + Height = 130 + Align = alClient + DataSource = dmMain.DataSource2 + TabOrder = 2 + TitleFont.Charset = DEFAULT_CHARSET + TitleFont.Color = clWindowText + TitleFont.Height = -11 + TitleFont.Name = 'Tahoma' + TitleFont.Style = [] + end + object DBNavigator2: TDBNavigator + AlignWithMargins = True + Left = 4 + Top = 337 + Width = 692 + Height = 32 + DataSource = dmMain.DataSource2 + Align = alBottom + TabOrder = 3 + end + end + object StatusBar: TStatusBar + Left = 0 + Top = 373 + Width = 945 + Height = 19 + Panels = <> + SimplePanel = True + end + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 245 + Height = 373 + Align = alLeft + TabOrder = 0 + object Button1: TButton + Left = 6 + Top = 52 + Width = 219 + Height = 25 + Caption = 'Test Activate/Deactivate Recordset Cycle' + TabOrder = 0 + OnClick = Button1Click + end + object Button2: TButton + Left = 6 + Top = 111 + Width = 219 + Height = 25 + Caption = 'Test Requery' + TabOrder = 1 + OnClick = Button2Click + end + object cbShowOpenClose: TCheckBox + Left = 12 + Top = 83 + Width = 213 + Height = 17 + Caption = 'Show Open/Close' + TabOrder = 2 + end + object Button4: TButton + Left = 6 + Top = 230 + Width = 161 + Height = 45 + Caption = 'Filter Pending' + TabOrder = 3 + OnClick = Button4Click + end + object edtHost: TEdit + Left = 6 + Top = 10 + Width = 121 + Height = 21 + TabOrder = 4 + Text = 'LocalHost' + TextHint = 'Host' + OnChange = edtHostChange + end + object btnApplyUpdates: TButton + Left = 6 + Top = 281 + Width = 161 + Height = 45 + Caption = 'Apply Updates' + TabOrder = 5 + OnClick = btnApplyUpdatesClick + end + end +end diff --git a/Demos/DB/DBClient/ufrmMain.pas b/Demos/TCP/DB/DBClient/ufrmMain.pas similarity index 96% rename from Demos/DB/DBClient/ufrmMain.pas rename to Demos/TCP/DB/DBClient/ufrmMain.pas index 6723e20..679a6d0 100644 --- a/Demos/DB/DBClient/ufrmMain.pas +++ b/Demos/TCP/DB/DBClient/ufrmMain.pas @@ -1,128 +1,128 @@ -unit ufrmMain; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, udmMain, DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ncSockets, ncDBCnt, - ComCtrls, ADOInt, ADODB, Data.DB; - -type - TfrmMain = class(TForm) - StatusBar: TStatusBar; - Panel1: TPanel; - Panel2: TPanel; - dbGrid1: TDBGrid; - DBNavigator1: TDBNavigator; - DBGrid2: TDBGrid; - DBNavigator2: TDBNavigator; - Button1: TButton; - Button2: TButton; - cbShowOpenClose: TCheckBox; - Button4: TButton; - edtHost: TEdit; - btnApplyUpdates: TButton; - procedure Button1Click(Sender: TObject); - procedure Button2Click(Sender: TObject); - procedure Button4Click(Sender: TObject); - procedure edtHostChange(Sender: TObject); - procedure btnApplyUpdatesClick(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.dfm} - -var - InButton1: Boolean = False; - PrevBtn1Cap: string; - -procedure TfrmMain.Button1Click(Sender: TObject); -var - TimeStart, TimeEnd: Int64; - - Freq: Int64; - i: Integer; -begin - if InButton1 then - begin - Button1.Caption := PrevBtn1Cap; - - InButton1 := False; - Exit; - end; - - // Test n alive queries - InButton1 := True; - try - PrevBtn1Cap := Button1.Caption; - Button1.Caption := 'Stop'; - - if not cbShowOpenClose.Checked then - begin - dmMain.DataSource1.DataSet := nil; - dmMain.DataSource2.DataSet := nil; - end; - try - QueryPerformanceFrequency(Freq); - QueryPerformanceCounter(TimeStart); - i := 0; - while InButton1 and not Application.Terminated do - begin - i := i + 1; - if i mod 100 = 0 then - begin - StatusBar.SimpleText := Format('Iteration: %4.4d, Mean Open/Close Time: %f (ms)', [i, 1000 * (TimeEnd - TimeStart) / (i * Freq)]); - Application.ProcessMessages; - end; - // Test open/close time - dmMain.ncDBDataset1.Active := False; - dmMain.ncDBDataset1.Active := True; - // Test ExecSQL time - // dmMain.ncDBDataset1.SQL.Text := 'UPDATE Customers SET CustomerName = ''Bill'' where ID = 1'; - // dmMain.ncDBDataset1.ExecSQL; - QueryPerformanceCounter(TimeEnd); - end; - finally - if dmMain.DataSource1.DataSet = nil then - begin - dmMain.DataSource1.DataSet := dmMain.ncDBDataset1; - dmMain.DataSource2.DataSet := dmMain.ncDBDataset2; - end; - end; - finally - InButton1 := False; - end; -end; - -procedure TfrmMain.Button2Click(Sender: TObject); -begin - dmMain.ncDBDataset2.Requery; -end; - -procedure TfrmMain.Button4Click(Sender: TObject); -begin - dmMain.ncDBDataset1.FilterGroup := fgPendingRecords; - dmMain.ncDBDataset1.Filtered := not dmMain.ncDBDataset1.Filtered; -end; - -procedure TfrmMain.btnApplyUpdatesClick(Sender: TObject); -begin - dmMain.ncDBDataset1.ApplyUpdates; - dmMain.ncDBDataset2.ApplyUpdates; -end; - -procedure TfrmMain.edtHostChange(Sender: TObject); -begin - dmMain.ncClientSource.Active := False; - dmMain.ncClientSource.Host := edtHost.Text; -end; - -end. +unit ufrmMain; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, udmMain, DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ncSockets, ncDBCnt, + ComCtrls, ADOInt, ADODB, Data.DB; + +type + TfrmMain = class(TForm) + StatusBar: TStatusBar; + Panel1: TPanel; + Panel2: TPanel; + dbGrid1: TDBGrid; + DBNavigator1: TDBNavigator; + DBGrid2: TDBGrid; + DBNavigator2: TDBNavigator; + Button1: TButton; + Button2: TButton; + cbShowOpenClose: TCheckBox; + Button4: TButton; + edtHost: TEdit; + btnApplyUpdates: TButton; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure Button4Click(Sender: TObject); + procedure edtHostChange(Sender: TObject); + procedure btnApplyUpdatesClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.dfm} + +var + InButton1: Boolean = False; + PrevBtn1Cap: string; + +procedure TfrmMain.Button1Click(Sender: TObject); +var + TimeStart, TimeEnd: Int64; + + Freq: Int64; + i: Integer; +begin + if InButton1 then + begin + Button1.Caption := PrevBtn1Cap; + + InButton1 := False; + Exit; + end; + + // Test n alive queries + InButton1 := True; + try + PrevBtn1Cap := Button1.Caption; + Button1.Caption := 'Stop'; + + if not cbShowOpenClose.Checked then + begin + dmMain.DataSource1.DataSet := nil; + dmMain.DataSource2.DataSet := nil; + end; + try + QueryPerformanceFrequency(Freq); + QueryPerformanceCounter(TimeStart); + i := 0; + while InButton1 and not Application.Terminated do + begin + i := i + 1; + if i mod 100 = 0 then + begin + StatusBar.SimpleText := Format('Iteration: %4.4d, Mean Open/Close Time: %f (ms)', [i, 1000 * (TimeEnd - TimeStart) / (i * Freq)]); + Application.ProcessMessages; + end; + // Test open/close time + dmMain.ncDBDataset1.Active := False; + dmMain.ncDBDataset1.Active := True; + // Test ExecSQL time + // dmMain.ncDBDataset1.SQL.Text := 'UPDATE Customers SET CustomerName = ''Bill'' where ID = 1'; + // dmMain.ncDBDataset1.ExecSQL; + QueryPerformanceCounter(TimeEnd); + end; + finally + if dmMain.DataSource1.DataSet = nil then + begin + dmMain.DataSource1.DataSet := dmMain.ncDBDataset1; + dmMain.DataSource2.DataSet := dmMain.ncDBDataset2; + end; + end; + finally + InButton1 := False; + end; +end; + +procedure TfrmMain.Button2Click(Sender: TObject); +begin + dmMain.ncDBDataset2.Requery; +end; + +procedure TfrmMain.Button4Click(Sender: TObject); +begin + dmMain.ncDBDataset1.FilterGroup := fgPendingRecords; + dmMain.ncDBDataset1.Filtered := not dmMain.ncDBDataset1.Filtered; +end; + +procedure TfrmMain.btnApplyUpdatesClick(Sender: TObject); +begin + dmMain.ncDBDataset1.ApplyUpdates; + dmMain.ncDBDataset2.ApplyUpdates; +end; + +procedure TfrmMain.edtHostChange(Sender: TObject); +begin + dmMain.ncClientSource.Active := False; + dmMain.ncClientSource.Host := edtHost.Text; +end; + +end. diff --git a/Demos/DB/DBServer/Service/DBServerService.dpr b/Demos/TCP/DB/DBServer/Service/DBServerService.dpr similarity index 97% rename from Demos/DB/DBServer/Service/DBServerService.dpr rename to Demos/TCP/DB/DBServer/Service/DBServerService.dpr index ebb50fa..3a1582c 100644 --- a/Demos/DB/DBServer/Service/DBServerService.dpr +++ b/Demos/TCP/DB/DBServer/Service/DBServerService.dpr @@ -1,32 +1,32 @@ -program DBServerService; - -uses - Windows, - SysUtils, - SvcMgr, - usvcMain in 'usvcMain.pas' {NetcomDataServer: TService}, - uscvServiceCommands in 'uscvServiceCommands.pas'; - -{$R *.RES} - -begin - // Windows 2003 Server requires StartServiceCtrlDispatcher to be - // called before CoRegisterClassObject, which can be called indirectly - // by Application.Initialize. TServiceApplication.DelayInitialize allows - // Application.Initialize to be called from TService.Main (after - // StartServiceCtrlDispatcher has been called). - // - // Delayed initialization of the Application object may affect - // events which then occur prior to initialization, such as - // TService.OnCreate. It is only recommended if the ServiceApplication - // registers a class object with OLE and is intended for use with - // Windows 2003 Server. - // - // Application.DelayInitialize := True; - // - SetCurrentDirectory(PChar (ExtractFilePath (ParamStr (0)))); - if not Application.DelayInitialize or Application.Installing then - Application.Initialize; - Application.CreateForm(TNetcomDataServer, Service); - Application.Run; -end. +program DBServerService; + +uses + Windows, + SysUtils, + SvcMgr, + usvcMain in 'usvcMain.pas' {NetcomDataServer: TService}, + uscvServiceCommands in 'uscvServiceCommands.pas'; + +{$R *.RES} + +begin + // Windows 2003 Server requires StartServiceCtrlDispatcher to be + // called before CoRegisterClassObject, which can be called indirectly + // by Application.Initialize. TServiceApplication.DelayInitialize allows + // Application.Initialize to be called from TService.Main (after + // StartServiceCtrlDispatcher has been called). + // + // Delayed initialization of the Application object may affect + // events which then occur prior to initialization, such as + // TService.OnCreate. It is only recommended if the ServiceApplication + // registers a class object with OLE and is intended for use with + // Windows 2003 Server. + // + // Application.DelayInitialize := True; + // + SetCurrentDirectory(PChar (ExtractFilePath (ParamStr (0)))); + if not Application.DelayInitialize or Application.Installing then + Application.Initialize; + Application.CreateForm(TNetcomDataServer, Service); + Application.Run; +end. diff --git a/Demos/DB/DBServer/Service/DBServerService.dproj b/Demos/TCP/DB/DBServer/Service/DBServerService.dproj similarity index 98% rename from Demos/DB/DBServer/Service/DBServerService.dproj rename to Demos/TCP/DB/DBServer/Service/DBServerService.dproj index 9701749..757d357 100644 --- a/Demos/DB/DBServer/Service/DBServerService.dproj +++ b/Demos/TCP/DB/DBServer/Service/DBServerService.dproj @@ -1,115 +1,115 @@ - - - {1CE60A32-3682-445E-BC9A-10E419519CEC} - 12.0 - DBServerService.dpr - Debug - DCC32 - - - true - - - true - Base - true - - - true - Base - true - - - DBServerService.exe - $(BDSCOMMONDIR)\DCU - $(BDSCOMMONDIR)\DCP - vcl;rtl;vclx;vclactnband;xmlrtl;vclimg;dbrtl;vcldb;vcldbx;bdertl;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dxSkinscxPCPainterD14;cxPageControlD14;dxSkinsCoreD14;dxSkinsdxLCPainterD14;dxLayoutControlD14;dxSkinscxScheduler3PainterD14;cxSchedulerD14;dxSkinsdxNavBar2PainterD14;dxNavBarD14;dxSkinsdxDLPainterD14;dxDockingD14;dxSkinsdxRibbonPainterD14;dxRibbonD14;dxBarD14;dxSkinsdxBarPainterD14;dclOfficeXP - 00400000 - x86 - WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) - true - - - false - false - RELEASE;$(DCC_Define) - 0 - false - - - true - DEBUG;$(DCC_Define) - - - - MainSource - - -
NetcomDataServer
- TService - - - - Base - - - Cfg_2 - Base - - - Cfg_1 - Base - - - - - Delphi.Personality.12 - - - - - DBServerService.dpr - - - False - True - False - /install - - - True - False - 1 - 0 - 0 - 0 - False - False - False - False - True - 1033 - 1200 - - - - Service Prototype - 1.0.0.0 - - - - - - 1.0.0.0 - - - Embarcadero C++Builder Office XP Servers Package - Embarcadero C++Builder Office 2000 Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - ExpressPivotGrid 2 OLAP by Developer Express Inc. - - - - 12 - - + + + {1CE60A32-3682-445E-BC9A-10E419519CEC} + 12.0 + DBServerService.dpr + Debug + DCC32 + + + true + + + true + Base + true + + + true + Base + true + + + DBServerService.exe + $(BDSCOMMONDIR)\DCU + $(BDSCOMMONDIR)\DCP + vcl;rtl;vclx;vclactnband;xmlrtl;vclimg;dbrtl;vcldb;vcldbx;bdertl;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dxSkinscxPCPainterD14;cxPageControlD14;dxSkinsCoreD14;dxSkinsdxLCPainterD14;dxLayoutControlD14;dxSkinscxScheduler3PainterD14;cxSchedulerD14;dxSkinsdxNavBar2PainterD14;dxNavBarD14;dxSkinsdxDLPainterD14;dxDockingD14;dxSkinsdxRibbonPainterD14;dxRibbonD14;dxBarD14;dxSkinsdxBarPainterD14;dclOfficeXP + 00400000 + x86 + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) + true + + + false + false + RELEASE;$(DCC_Define) + 0 + false + + + true + DEBUG;$(DCC_Define) + + + + MainSource + + +
NetcomDataServer
+ TService + + + + Base + + + Cfg_2 + Base + + + Cfg_1 + Base + + + + + Delphi.Personality.12 + + + + + DBServerService.dpr + + + False + True + False + /install + + + True + False + 1 + 0 + 0 + 0 + False + False + False + False + True + 1033 + 1200 + + + + Service Prototype + 1.0.0.0 + + + + + + 1.0.0.0 + + + Embarcadero C++Builder Office XP Servers Package + Embarcadero C++Builder Office 2000 Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + ExpressPivotGrid 2 OLAP by Developer Express Inc. + + + + 12 + + diff --git a/Demos/DB/DBServer/Service/DBServerService.dproj.local b/Demos/TCP/DB/DBServer/Service/DBServerService.dproj.local similarity index 96% rename from Demos/DB/DBServer/Service/DBServerService.dproj.local rename to Demos/TCP/DB/DBServer/Service/DBServerService.dproj.local index d576f03..b3811b7 100644 --- a/Demos/DB/DBServer/Service/DBServerService.dproj.local +++ b/Demos/TCP/DB/DBServer/Service/DBServerService.dproj.local @@ -1,2 +1,2 @@ - - + + diff --git a/Demos/DB/DBServer/Service/DBServerService.dsk b/Demos/TCP/DB/DBServer/Service/DBServerService.dsk similarity index 94% rename from Demos/DB/DBServer/Service/DBServerService.dsk rename to Demos/TCP/DB/DBServer/Service/DBServerService.dsk index ea49d38..da4604d 100644 --- a/Demos/DB/DBServer/Service/DBServerService.dsk +++ b/Demos/TCP/DB/DBServer/Service/DBServerService.dsk @@ -1,653 +1,653 @@ -[Closed Files] -File_0=TSourceModule,'\\CODE\Backup\Code Snippets\udpEnvComponents.pas',0,1,15,1,52,0,0,, -File_1=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDirectPanel.pas',0,1,751,1,762,0,0,, -File_2=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectX9\uDirect3D9.pas',0,1,2855,5,2866,0,0,,{1,3058,17}{2,3021,11} -File_3=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPIControls.pas',0,1,67,40,91,0,0,, -File_4=TSourceModule,'\\CODE\Backup\Code Snippets\udpEnvironment.pas',0,1,76,39,14,0,0,, -File_5=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Workspace\DirectPanelMultiTexture\ufrmMain.pas',0,1,1,1,13,0,0,, -File_6=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7.zip',0,1,1,1,1,0,0,, -File_7=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Classes.pas',0,1,12189,3,12208,0,0,, -File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameServer\Service\ufrmEngineEdit.pas',0,1,1,1,1,0,0,, -File_9=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameEngine\ufrmEditor.pas',0,1,1,12,12,0,0,, -File_10=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameEngine\ufmSpline.pas',0,1,1,1,1,0,0,, -File_11=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameEngine\ufmWaveDrawer.pas',0,1,1,1,1,0,0,, -File_12=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\Netcom7\Source\ncSources.pas',0,1,406,1,423,0,0,, -File_13=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameServer\Service\uReelGameEngine.pas',0,1,162,11,193,0,0,, -File_14=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameServer\Service\usvcMain.pas',0,1,165,22,187,0,0,, - -[Modules] -Module0=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dproj -Module1=default.htm -Count=2 -EditWindowCount=1 - -[C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dproj] -ModuleType=TBaseProject - -[default.htm] -ModuleType=TURLModule - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dpr -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=10000 -Height=9269 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=10000 -ClientHeight=9269 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1896 -LeftPanelClients=DockSite3,PropertyInspector -LeftPanelData=000008000101000000002D100000000000000168070000000000000100000000A11500001100000050726F7065727479496E73706563746F720100000000C11C000009000000446F636B5369746533FFFFFFFF -RightPanelSize=2000 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000002D1000000000000001D00700000000000001000000004412000009000000446F636B53697465320100000000C11C000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=1537 -BottomPanelClients=DockSite1,MessageView,DockSite0 -BottomPanelData=0000080001020100000009000000446F636B536974653172450000000000000201060000000000000100000000B922000009000000446F636B53697465300100000000724500000F0000004D65737361676556696577466F726DFFFFFFFF -BottomMiddlePanelSize=0 - -[View0] -CustomEditViewType=TWelcomePageView -WelcomePageURL=bds:/default.htm - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dpr -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dpr - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3823 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3823 -ClientHeight=1135 -TBDockHeight=212 -LRDockWidth=13599 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=1068 -Top=0 -Width=8932 -Height=8519 -MaxLeft=-5 -MaxTop=-10 -MaxWidth=10083 -MaxHeight=10154 -ClientWidth=10000 -ClientHeight=9788 -BottomPanelSize=8926 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2000 -Height=4356 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2000 -ClientHeight=4356 -TBDockHeight=5894 -LRDockWidth=2349 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=960 -Top=23 -Width=5000 -Height=1375 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=5000 -ClientHeight=1375 -TBDockHeight=1375 -LRDockWidth=2771 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2000 -Height=2567 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2000 -ClientHeight=2567 -TBDockHeight=7154 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-1728 -Top=270 -Width=276 -Height=356 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=276 -ClientHeight=356 -TBDockHeight=356 -LRDockWidth=276 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3823 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3823 -ClientHeight=1135 -TBDockHeight=404 -LRDockWidth=4948 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3823 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3823 -ClientHeight=1135 -TBDockHeight=212 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=250 -Column4Width=250 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3823 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3823 -ClientHeight=1135 -TBDockHeight=1538 -LRDockWidth=3479 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3823 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3823 -ClientHeight=1135 -TBDockHeight=2058 -LRDockWidth=3479 -Dockable=1 -StayOnTop=0 - -[TFileExplorerForm] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-1418 -Top=-11 -Width=2844 -Height=6212 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2844 -ClientHeight=6212 -TBDockHeight=6212 -LRDockWidth=2844 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=5000 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=5000 -ClientHeight=1135 -TBDockHeight=2317 -LRDockWidth=2823 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=5000 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=5000 -ClientHeight=1135 -TBDockHeight=3212 -LRDockWidth=2823 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=4979 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=4979 -ClientHeight=1135 -TBDockHeight=1154 -LRDockWidth=3677 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2000 -Height=6788 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2000 -ClientHeight=6788 -TBDockHeight=4885 -LRDockWidth=7151 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2000 -Height=6788 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2000 -ClientHeight=6788 -TBDockHeight=4885 -LRDockWidth=5307 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=-99 -Width=1844 -Height=3144 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1844 -ClientHeight=3144 -TBDockHeight=3144 -LRDockWidth=1844 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=23 -Width=1896 -Height=5490 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1896 -ClientHeight=5490 -TBDockHeight=9029 -LRDockWidth=1896 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3823 -Height=1135 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3823 -ClientHeight=1135 -TBDockHeight=1548 -LRDockWidth=8745 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1896 -Height=1673 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1896 -ClientHeight=1673 -TBDockHeight=3673 -LRDockWidth=1896 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=4260 -Top=2654 -Width=3474 -Height=6779 -MaxLeft=-5 -MaxTop=-10 -ClientWidth=3391 -ClientHeight=6452 -TBDockHeight=6779 -LRDockWidth=3474 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1823 -Height=6173 -MaxLeft=-5 -MaxTop=-10 -ClientWidth=1740 -ClientHeight=5846 -TBDockHeight=6173 -LRDockWidth=1823 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=23 -Width=4979 -Height=1375 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=4979 -ClientHeight=1375 -TBDockHeight=1375 -LRDockWidth=2339 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToDo List -TabDockClients=RefactoringForm,FindReferencsForm,ToDo List - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=23 -Width=3823 -Height=1375 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3823 -ClientHeight=1375 -TBDockHeight=1375 -LRDockWidth=3823 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=23 -Width=2000 -Height=4596 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2000 -ClientHeight=4596 -TBDockHeight=9029 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorer,TFileExplorerForm - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=621 -Width=1896 -Height=1673 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1896 -ClientHeight=1673 -TBDockHeight=9029 -LRDockWidth=1896 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=528 -Width=2000 -Height=2567 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2000 -ClientHeight=2567 -TBDockHeight=7029 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'\\CODE\Backup\Code Snippets\udpEnvComponents.pas',0,1,15,1,52,0,0,, +File_1=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDirectPanel.pas',0,1,751,1,762,0,0,, +File_2=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectX9\uDirect3D9.pas',0,1,2855,5,2866,0,0,,{1,3058,17}{2,3021,11} +File_3=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPIControls.pas',0,1,67,40,91,0,0,, +File_4=TSourceModule,'\\CODE\Backup\Code Snippets\udpEnvironment.pas',0,1,76,39,14,0,0,, +File_5=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Workspace\DirectPanelMultiTexture\ufrmMain.pas',0,1,1,1,13,0,0,, +File_6=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7.zip',0,1,1,1,1,0,0,, +File_7=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Classes.pas',0,1,12189,3,12208,0,0,, +File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameServer\Service\ufrmEngineEdit.pas',0,1,1,1,1,0,0,, +File_9=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameEngine\ufrmEditor.pas',0,1,1,12,12,0,0,, +File_10=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameEngine\ufmSpline.pas',0,1,1,1,1,0,0,, +File_11=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameEngine\ufmWaveDrawer.pas',0,1,1,1,1,0,0,, +File_12=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\Netcom7\Source\ncSources.pas',0,1,406,1,423,0,0,, +File_13=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameServer\Service\uReelGameEngine.pas',0,1,162,11,193,0,0,, +File_14=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Projects\GameServer\Service\usvcMain.pas',0,1,165,22,187,0,0,, + +[Modules] +Module0=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dproj +Module1=default.htm +Count=2 +EditWindowCount=1 + +[C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dproj] +ModuleType=TBaseProject + +[default.htm] +ModuleType=TURLModule + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dpr +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=10000 +Height=9269 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=10000 +ClientHeight=9269 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1896 +LeftPanelClients=DockSite3,PropertyInspector +LeftPanelData=000008000101000000002D100000000000000168070000000000000100000000A11500001100000050726F7065727479496E73706563746F720100000000C11C000009000000446F636B5369746533FFFFFFFF +RightPanelSize=2000 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000002D1000000000000001D00700000000000001000000004412000009000000446F636B53697465320100000000C11C000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=1537 +BottomPanelClients=DockSite1,MessageView,DockSite0 +BottomPanelData=0000080001020100000009000000446F636B536974653172450000000000000201060000000000000100000000B922000009000000446F636B53697465300100000000724500000F0000004D65737361676556696577466F726DFFFFFFFF +BottomMiddlePanelSize=0 + +[View0] +CustomEditViewType=TWelcomePageView +WelcomePageURL=bds:/default.htm + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dpr +CursorX=1 +CursorY=1 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dpr + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3823 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3823 +ClientHeight=1135 +TBDockHeight=212 +LRDockWidth=13599 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=1068 +Top=0 +Width=8932 +Height=8519 +MaxLeft=-5 +MaxTop=-10 +MaxWidth=10083 +MaxHeight=10154 +ClientWidth=10000 +ClientHeight=9788 +BottomPanelSize=8926 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2000 +Height=4356 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2000 +ClientHeight=4356 +TBDockHeight=5894 +LRDockWidth=2349 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=960 +Top=23 +Width=5000 +Height=1375 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=5000 +ClientHeight=1375 +TBDockHeight=1375 +LRDockWidth=2771 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2000 +Height=2567 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2000 +ClientHeight=2567 +TBDockHeight=7154 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-1728 +Top=270 +Width=276 +Height=356 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=276 +ClientHeight=356 +TBDockHeight=356 +LRDockWidth=276 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3823 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3823 +ClientHeight=1135 +TBDockHeight=404 +LRDockWidth=4948 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3823 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3823 +ClientHeight=1135 +TBDockHeight=212 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=250 +Column4Width=250 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3823 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3823 +ClientHeight=1135 +TBDockHeight=1538 +LRDockWidth=3479 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3823 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3823 +ClientHeight=1135 +TBDockHeight=2058 +LRDockWidth=3479 +Dockable=1 +StayOnTop=0 + +[TFileExplorerForm] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-1418 +Top=-11 +Width=2844 +Height=6212 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2844 +ClientHeight=6212 +TBDockHeight=6212 +LRDockWidth=2844 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=5000 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=5000 +ClientHeight=1135 +TBDockHeight=2317 +LRDockWidth=2823 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=5000 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=5000 +ClientHeight=1135 +TBDockHeight=3212 +LRDockWidth=2823 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=4979 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=4979 +ClientHeight=1135 +TBDockHeight=1154 +LRDockWidth=3677 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2000 +Height=6788 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2000 +ClientHeight=6788 +TBDockHeight=4885 +LRDockWidth=7151 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2000 +Height=6788 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2000 +ClientHeight=6788 +TBDockHeight=4885 +LRDockWidth=5307 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=-99 +Width=1844 +Height=3144 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1844 +ClientHeight=3144 +TBDockHeight=3144 +LRDockWidth=1844 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=23 +Width=1896 +Height=5490 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1896 +ClientHeight=5490 +TBDockHeight=9029 +LRDockWidth=1896 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3823 +Height=1135 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3823 +ClientHeight=1135 +TBDockHeight=1548 +LRDockWidth=8745 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1896 +Height=1673 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1896 +ClientHeight=1673 +TBDockHeight=3673 +LRDockWidth=1896 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=4260 +Top=2654 +Width=3474 +Height=6779 +MaxLeft=-5 +MaxTop=-10 +ClientWidth=3391 +ClientHeight=6452 +TBDockHeight=6779 +LRDockWidth=3474 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1823 +Height=6173 +MaxLeft=-5 +MaxTop=-10 +ClientWidth=1740 +ClientHeight=5846 +TBDockHeight=6173 +LRDockWidth=1823 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=23 +Width=4979 +Height=1375 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=4979 +ClientHeight=1375 +TBDockHeight=1375 +LRDockWidth=2339 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToDo List +TabDockClients=RefactoringForm,FindReferencsForm,ToDo List + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=23 +Width=3823 +Height=1375 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3823 +ClientHeight=1375 +TBDockHeight=1375 +LRDockWidth=3823 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=23 +Width=2000 +Height=4596 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2000 +ClientHeight=4596 +TBDockHeight=9029 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorer,TFileExplorerForm + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=621 +Width=1896 +Height=1673 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1896 +ClientHeight=1673 +TBDockHeight=9029 +LRDockWidth=1896 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=528 +Width=2000 +Height=2567 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2000 +ClientHeight=2567 +TBDockHeight=7029 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/DB/DBServer/Service/DBServerService.identcache b/Demos/TCP/DB/DBServer/Service/DBServerService.identcache similarity index 100% rename from Demos/DB/DBServer/Service/DBServerService.identcache rename to Demos/TCP/DB/DBServer/Service/DBServerService.identcache diff --git a/Demos/DB/DBServer/Service/DBServerService.res b/Demos/TCP/DB/DBServer/Service/DBServerService.res similarity index 100% rename from Demos/DB/DBServer/Service/DBServerService.res rename to Demos/TCP/DB/DBServer/Service/DBServerService.res diff --git a/Demos/DB/DBServer/Service/DBServerService.skincfg b/Demos/TCP/DB/DBServer/Service/DBServerService.skincfg similarity index 94% rename from Demos/DB/DBServer/Service/DBServerService.skincfg rename to Demos/TCP/DB/DBServer/Service/DBServerService.skincfg index 6870d73..d58e821 100644 --- a/Demos/DB/DBServer/Service/DBServerService.skincfg +++ b/Demos/TCP/DB/DBServer/Service/DBServerService.skincfg @@ -1,33 +1,33 @@ -[ExpressSkins] -Default=1 -ShowNotifications=1 -Enabled=1 -dxSkinBlack=0 -dxSkinBlue=0 -dxSkinCaramel=0 -dxSkinCoffee=0 -dxSkinDarkRoom=0 -dxSkinDarkSide=0 -dxSkinFoggy=0 -dxSkinGlassOceans=0 -dxSkiniMaginary=0 -dxSkinLilian=0 -dxSkinLiquidSky=0 -dxSkinLondonLiquidSky=0 -dxSkinMcSkin=0 -dxSkinMoneyTwins=0 -dxSkinOffice2007Black=0 -dxSkinOffice2007Blue=0 -dxSkinOffice2007Green=0 -dxSkinOffice2007Pink=0 -dxSkinOffice2007Silver=0 -dxSkinPumpkin=0 -dxSkinSeven=0 -dxSkinSharp=0 -dxSkinSilver=0 -dxSkinSpringTime=0 -dxSkinStardust=0 -dxSkinSummer2008=0 -dxSkinsDefaultPainters=0 -dxSkinValentine=0 -dxSkinXmas2008Blue=0 +[ExpressSkins] +Default=1 +ShowNotifications=1 +Enabled=1 +dxSkinBlack=0 +dxSkinBlue=0 +dxSkinCaramel=0 +dxSkinCoffee=0 +dxSkinDarkRoom=0 +dxSkinDarkSide=0 +dxSkinFoggy=0 +dxSkinGlassOceans=0 +dxSkiniMaginary=0 +dxSkinLilian=0 +dxSkinLiquidSky=0 +dxSkinLondonLiquidSky=0 +dxSkinMcSkin=0 +dxSkinMoneyTwins=0 +dxSkinOffice2007Black=0 +dxSkinOffice2007Blue=0 +dxSkinOffice2007Green=0 +dxSkinOffice2007Pink=0 +dxSkinOffice2007Silver=0 +dxSkinPumpkin=0 +dxSkinSeven=0 +dxSkinSharp=0 +dxSkinSilver=0 +dxSkinSpringTime=0 +dxSkinStardust=0 +dxSkinSummer2008=0 +dxSkinsDefaultPainters=0 +dxSkinValentine=0 +dxSkinXmas2008Blue=0 diff --git a/Demos/DB/DBServer/Service/DBServerService_Icon.ico b/Demos/TCP/DB/DBServer/Service/DBServerService_Icon.ico similarity index 100% rename from Demos/DB/DBServer/Service/DBServerService_Icon.ico rename to Demos/TCP/DB/DBServer/Service/DBServerService_Icon.ico diff --git a/Demos/DB/DBServer/Service/uscvServiceCommands.pas b/Demos/TCP/DB/DBServer/Service/uscvServiceCommands.pas similarity index 89% rename from Demos/DB/DBServer/Service/uscvServiceCommands.pas rename to Demos/TCP/DB/DBServer/Service/uscvServiceCommands.pas index b118f32..0cf3444 100644 --- a/Demos/DB/DBServer/Service/uscvServiceCommands.pas +++ b/Demos/TCP/DB/DBServer/Service/uscvServiceCommands.pas @@ -1,7 +1,7 @@ -unit uscvServiceCommands; - -interface - -implementation - -end. +unit uscvServiceCommands; + +interface + +implementation + +end. diff --git a/Demos/DB/DBServer/Service/usvcMain.dfm b/Demos/TCP/DB/DBServer/Service/usvcMain.dfm similarity index 96% rename from Demos/DB/DBServer/Service/usvcMain.dfm rename to Demos/TCP/DB/DBServer/Service/usvcMain.dfm index e20e9aa..6bf834e 100644 --- a/Demos/DB/DBServer/Service/usvcMain.dfm +++ b/Demos/TCP/DB/DBServer/Service/usvcMain.dfm @@ -1,33 +1,33 @@ -object NetcomDataServer: TNetcomDataServer - OldCreateOrder = False - OnCreate = ServiceCreate - OnDestroy = ServiceDestroy - DisplayName = 'Netcom7 Database Server' - OnShutdown = ServiceShutdown - OnStart = ServiceStart - OnStop = ServiceStop - Height = 254 - Width = 270 - object srvController: TncServerSource - Port = 18753 - EncryptionKey = 'SetEncryptionKey' - Left = 40 - Top = 32 - end - object DBServer: TncDBServer - ADOConnection = ADOConnection - Source = srvController - Left = 40 - Top = 92 - end - object ADOConnection: TADOConnection - ConnectionString = - 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\..\TestData\Custo' + - 'mers.mdb;Persist Security Info=False;' - LoginPrompt = False - Mode = cmShareDenyNone - Provider = 'Microsoft.Jet.OLEDB.4.0' - Left = 128 - Top = 92 - end -end +object NetcomDataServer: TNetcomDataServer + OldCreateOrder = False + OnCreate = ServiceCreate + OnDestroy = ServiceDestroy + DisplayName = 'Netcom7 Database Server' + OnShutdown = ServiceShutdown + OnStart = ServiceStart + OnStop = ServiceStop + Height = 254 + Width = 270 + object srvController: TncServerSource + Port = 18753 + EncryptionKey = 'SetEncryptionKey' + Left = 40 + Top = 32 + end + object DBServer: TncDBServer + ADOConnection = ADOConnection + Source = srvController + Left = 40 + Top = 92 + end + object ADOConnection: TADOConnection + ConnectionString = + 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\..\TestData\Custo' + + 'mers.mdb;Persist Security Info=False;' + LoginPrompt = False + Mode = cmShareDenyNone + Provider = 'Microsoft.Jet.OLEDB.4.0' + Left = 128 + Top = 92 + end +end diff --git a/Demos/DB/DBServer/Service/usvcMain.pas b/Demos/TCP/DB/DBServer/Service/usvcMain.pas similarity index 96% rename from Demos/DB/DBServer/Service/usvcMain.pas rename to Demos/TCP/DB/DBServer/Service/usvcMain.pas index 5d1b42b..3f7d228 100644 --- a/Demos/DB/DBServer/Service/usvcMain.pas +++ b/Demos/TCP/DB/DBServer/Service/usvcMain.pas @@ -1,184 +1,184 @@ -unit usvcMain; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, - ncSources, ncSockets, Registry, DB, ADODB, ncCommandHandlers, ncDBSrv, ActiveX; - -type - TsvcOnLogMessage = procedure(Sender: TObject; aMessage: string; aError: Boolean = False) of object; - - // Name property is the name we are going to use to uniquelly identify our service - TNetcomDataServer = class(TService) - srvController: TncServerSource; - DBServer: TncDBServer; - ADOConnection: TADOConnection; - procedure ServiceCreate(Sender: TObject); - procedure ServiceDestroy(Sender: TObject); - procedure ServiceStart(Sender: TService; var Started: Boolean); - procedure ServiceStop(Sender: TService; var Stopped: Boolean); - procedure ServiceShutdown(Sender: TService); - private - FOnLogMessage: TsvcOnLogMessage; - function GetServicePort: Integer; - procedure SetServicePort(const Value: Integer); - function GetDBConnectionString: string; - procedure SetDBConnectionString(const Value: string); - procedure StopAndShutdown; - function GetCacheResponses: Boolean; - procedure SetCacheResponses(const Value: Boolean); - public - Settings: TRegistry; - procedure Log(aStr: string; aError: Boolean = False); - function GetServiceController: TServiceController; override; - property OnLogMessage: TsvcOnLogMessage read FOnLogMessage write FOnLogMessage; - property ServicePort: Integer read GetServicePort write SetServicePort; - property DBConnectionString: string read GetDBConnectionString write SetDBConnectionString; - property CacheResponses: Boolean read GetCacheResponses write SetCacheResponses; - end; - -var - Service: TNetcomDataServer; - -implementation - -uses uscvServiceCommands; -{$R *.DFM} - -procedure ServiceController(CtrlCode: DWord); stdcall; -begin - Service.Controller(CtrlCode); -end; - -function TNetcomDataServer.GetServiceController: TServiceController; -begin - Result := ServiceController; -end; - -procedure TNetcomDataServer.ServiceCreate(Sender: TObject); -begin - FOnLogMessage := nil; - Settings := TRegistry.Create(KEY_READ or KEY_WRITE); - Settings.LazyWrite := False; - Settings.RootKey := HKEY_CURRENT_USER; - if not Settings.OpenKey('\HKEY_CURRENT_USER\Software\' + Name, True) then - Log('Cannot open settings key: \HKEY_CURRENT_USER\Software\' + Name); -end; - -procedure TNetcomDataServer.ServiceDestroy(Sender: TObject); -begin - Settings.CloseKey; - Settings.Free; -end; - -procedure TNetcomDataServer.Log(aStr: string; aError: Boolean = False); -var - ErrType: DWord; -begin - if Assigned(FOnLogMessage) then - // Call custom handler - FOnLogMessage(Self, aStr, aError) - else - begin - // Write to windows log system - if aError then - ErrType := EVENTLOG_AUDIT_FAILURE - else - ErrType := EVENTLOG_AUDIT_SUCCESS; - Self.LogMessage(aStr, ErrType); - end; -end; - -procedure TNetcomDataServer.ServiceStart(Sender: TService; var Started: Boolean); -begin - try - CoInitialize(nil); - // Put critical startup code here - srvController.Port := ServicePort; - ADOConnection.ConnectionString := DBConnectionString; - DBServer.CacheResponses := CacheResponses; - - ADOConnection.Connected := True; - srvController.Active := True; - - Log('"' + DisplayName + '" (' + Name + ') service started successfully, on port: ' + IntTostr(srvController.Port)); - except - on E: Exception do - begin - Log('"' + DisplayName + '" (' + Name + ') service failed to start. ' + E.Message, True); - Started := False; - end; - end; -end; - -procedure TNetcomDataServer.ServiceStop(Sender: TService; var Stopped: Boolean); -begin - StopAndShutdown; - - Log('"' + DisplayName + '" service stopped successfully'); -end; - -procedure TNetcomDataServer.ServiceShutdown(Sender: TService); -begin - StopAndShutdown; - - Log('"' + DisplayName + '" service stopped successfully'); -end; - -procedure TNetcomDataServer.StopAndShutdown; -begin - srvController.Active := False; - ADOConnection.Connected := False; - CoUninitialize; -end; - -function TNetcomDataServer.GetServicePort: Integer; -begin - try - if not Settings.ValueExists('ServicePort') then - Abort; - Result := Settings.ReadInteger('ServicePort'); - except - Result := srvController.Port; - end; -end; - -procedure TNetcomDataServer.SetServicePort(const Value: Integer); -begin - Settings.WriteInteger('ServicePort', Value); -end; - -function TNetcomDataServer.GetDBConnectionString: string; -begin - try - if not Settings.ValueExists('DBConnection') then - Abort; - Result := Settings.ReadString('DBConnection'); - except - Result := ADOConnection.ConnectionString; - end; -end; - -procedure TNetcomDataServer.SetDBConnectionString(const Value: string); -begin - Settings.WriteString('DBConnection', Value); -end; - -function TNetcomDataServer.GetCacheResponses: Boolean; -begin - try - if not Settings.ValueExists('CacheResponses') then - Abort; - Result := Settings.ReadBool('CacheResponses'); - except - Result := DBServer.CacheResponses; - end; -end; - -procedure TNetcomDataServer.SetCacheResponses(const Value: Boolean); -begin - Settings.WriteBool('CacheResponses', Value); -end; - -end. +unit usvcMain; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, + ncSources, ncSockets, Registry, DB, ADODB, ncCommandHandlers, ncDBSrv, ActiveX; + +type + TsvcOnLogMessage = procedure(Sender: TObject; aMessage: string; aError: Boolean = False) of object; + + // Name property is the name we are going to use to uniquelly identify our service + TNetcomDataServer = class(TService) + srvController: TncServerSource; + DBServer: TncDBServer; + ADOConnection: TADOConnection; + procedure ServiceCreate(Sender: TObject); + procedure ServiceDestroy(Sender: TObject); + procedure ServiceStart(Sender: TService; var Started: Boolean); + procedure ServiceStop(Sender: TService; var Stopped: Boolean); + procedure ServiceShutdown(Sender: TService); + private + FOnLogMessage: TsvcOnLogMessage; + function GetServicePort: Integer; + procedure SetServicePort(const Value: Integer); + function GetDBConnectionString: string; + procedure SetDBConnectionString(const Value: string); + procedure StopAndShutdown; + function GetCacheResponses: Boolean; + procedure SetCacheResponses(const Value: Boolean); + public + Settings: TRegistry; + procedure Log(aStr: string; aError: Boolean = False); + function GetServiceController: TServiceController; override; + property OnLogMessage: TsvcOnLogMessage read FOnLogMessage write FOnLogMessage; + property ServicePort: Integer read GetServicePort write SetServicePort; + property DBConnectionString: string read GetDBConnectionString write SetDBConnectionString; + property CacheResponses: Boolean read GetCacheResponses write SetCacheResponses; + end; + +var + Service: TNetcomDataServer; + +implementation + +uses uscvServiceCommands; +{$R *.DFM} + +procedure ServiceController(CtrlCode: DWord); stdcall; +begin + Service.Controller(CtrlCode); +end; + +function TNetcomDataServer.GetServiceController: TServiceController; +begin + Result := ServiceController; +end; + +procedure TNetcomDataServer.ServiceCreate(Sender: TObject); +begin + FOnLogMessage := nil; + Settings := TRegistry.Create(KEY_READ or KEY_WRITE); + Settings.LazyWrite := False; + Settings.RootKey := HKEY_CURRENT_USER; + if not Settings.OpenKey('\HKEY_CURRENT_USER\Software\' + Name, True) then + Log('Cannot open settings key: \HKEY_CURRENT_USER\Software\' + Name); +end; + +procedure TNetcomDataServer.ServiceDestroy(Sender: TObject); +begin + Settings.CloseKey; + Settings.Free; +end; + +procedure TNetcomDataServer.Log(aStr: string; aError: Boolean = False); +var + ErrType: DWord; +begin + if Assigned(FOnLogMessage) then + // Call custom handler + FOnLogMessage(Self, aStr, aError) + else + begin + // Write to windows log system + if aError then + ErrType := EVENTLOG_AUDIT_FAILURE + else + ErrType := EVENTLOG_AUDIT_SUCCESS; + Self.LogMessage(aStr, ErrType); + end; +end; + +procedure TNetcomDataServer.ServiceStart(Sender: TService; var Started: Boolean); +begin + try + CoInitialize(nil); + // Put critical startup code here + srvController.Port := ServicePort; + ADOConnection.ConnectionString := DBConnectionString; + DBServer.CacheResponses := CacheResponses; + + ADOConnection.Connected := True; + srvController.Active := True; + + Log('"' + DisplayName + '" (' + Name + ') service started successfully, on port: ' + IntTostr(srvController.Port)); + except + on E: Exception do + begin + Log('"' + DisplayName + '" (' + Name + ') service failed to start. ' + E.Message, True); + Started := False; + end; + end; +end; + +procedure TNetcomDataServer.ServiceStop(Sender: TService; var Stopped: Boolean); +begin + StopAndShutdown; + + Log('"' + DisplayName + '" service stopped successfully'); +end; + +procedure TNetcomDataServer.ServiceShutdown(Sender: TService); +begin + StopAndShutdown; + + Log('"' + DisplayName + '" service stopped successfully'); +end; + +procedure TNetcomDataServer.StopAndShutdown; +begin + srvController.Active := False; + ADOConnection.Connected := False; + CoUninitialize; +end; + +function TNetcomDataServer.GetServicePort: Integer; +begin + try + if not Settings.ValueExists('ServicePort') then + Abort; + Result := Settings.ReadInteger('ServicePort'); + except + Result := srvController.Port; + end; +end; + +procedure TNetcomDataServer.SetServicePort(const Value: Integer); +begin + Settings.WriteInteger('ServicePort', Value); +end; + +function TNetcomDataServer.GetDBConnectionString: string; +begin + try + if not Settings.ValueExists('DBConnection') then + Abort; + Result := Settings.ReadString('DBConnection'); + except + Result := ADOConnection.ConnectionString; + end; +end; + +procedure TNetcomDataServer.SetDBConnectionString(const Value: string); +begin + Settings.WriteString('DBConnection', Value); +end; + +function TNetcomDataServer.GetCacheResponses: Boolean; +begin + try + if not Settings.ValueExists('CacheResponses') then + Abort; + Result := Settings.ReadBool('CacheResponses'); + except + Result := DBServer.CacheResponses; + end; +end; + +procedure TNetcomDataServer.SetCacheResponses(const Value: Boolean); +begin + Settings.WriteBool('CacheResponses', Value); +end; + +end. diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dpr b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dpr similarity index 96% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication.dpr rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dpr index b3628dc..ecaa008 100644 --- a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dpr +++ b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dpr @@ -1,24 +1,24 @@ -program DBServerApplication; - -uses - Forms, - ufrmMain in 'ufrmMain.pas' { frmMain } , - uscvServiceCommands in '..\Service\uscvServiceCommands.pas', - usvcMain in '..\Service\usvcMain.pas' { svcMain: TService } ; -{$R *.res} - -begin - ReportMemoryLeaksOnShutdown := True; - - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.ShowMainForm := False; - Service := TNetcomDataServer.Create(nil); - try - Application.Title := Service.DisplayName; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; - finally - Service.Free; - end; -end. +program DBServerApplication; + +uses + Forms, + ufrmMain in 'ufrmMain.pas' { frmMain } , + uscvServiceCommands in '..\Service\uscvServiceCommands.pas', + usvcMain in '..\Service\usvcMain.pas' { svcMain: TService } ; +{$R *.res} + +begin + ReportMemoryLeaksOnShutdown := True; + + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.ShowMainForm := False; + Service := TNetcomDataServer.Create(nil); + try + Application.Title := Service.DisplayName; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; + finally + Service.Free; + end; +end. diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dproj b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dproj similarity index 98% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication.dproj rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dproj index 6cfbacf..d5c8e07 100644 --- a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dproj +++ b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dproj @@ -1,220 +1,220 @@ - - - {7EC35961-3AF1-4464-AC69-01EF47AFB21B} - 18.8 - DBServerApplication.dpr - Release - DCC32 - VCL - True - Win32 - 37889 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - DBServerApplication.exe - $(BDSCOMMONDIR)\DCU - $(BDSCOMMONDIR)\DCP - vcl;rtl;vclx;vclactnband;xmlrtl;vclimg;dbrtl;vcldb;vcldbx;bdertl;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dxSkinscxPCPainterD14;cxPageControlD14;dxSkinsCoreD14;dxSkinsdxLCPainterD14;dxLayoutControlD14;dxSkinscxScheduler3PainterD14;cxSchedulerD14;dxSkinsdxNavBar2PainterD14;dxNavBarD14;dxSkinsdxDLPainterD14;dxDockingD14;dxSkinsdxRibbonPainterD14;dxRibbonD14;dxBarD14;dxSkinsdxBarPainterD14;dclOfficeXP;$(DCC_UsePackage) - 00400000 - x86 - true - DBServerApplication - Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Data.Win;Winapi;System.Win;$(DCC_Namespace) - true - true - 175 - 1033 - CompanyName=Simetron Informatics;FileDescription=Netcom7 DBServer Application;FileVersion=1.0.0.175;InternalName=;LegalCopyright=Copyright (c) 1998-2011 Simetron;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0 - - - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) - 1033 - $(BDS)\bin\default_app.manifest - DBServerApplication_Icon.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - $(BDS)\bin\default_app.manifest - DBServerApplication_Icon.ico - true - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - false - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - DEBUG;$(DCC_Define) - - - Debug - - - Debug - - - Debug - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- - - -
svcMain
- TService - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - - Delphi.Personality.12 - - - - - DBServerApplication.dpr - - - False - True - False - - - True - True - 1 - 0 - 0 - 175 - False - False - False - False - False - 1033 - 1200 - - - Simetron Informatics - Netcom7 DBServer Application - 1.0.0.175 - - Copyright (c) 1998-2011 Simetron - - - - 1.0.0.0 - - - Embarcadero C++Builder Office XP Servers Package - Embarcadero C++Builder Office 2000 Servers Package - Microsoft Office 2000 Sample Automation Server Wrapper Components - ExpressPivotGrid 2 OLAP by Developer Express Inc. - - - - True - True - True - True - False - - - 12 - - - + + + {7EC35961-3AF1-4464-AC69-01EF47AFB21B} + 18.8 + DBServerApplication.dpr + Release + DCC32 + VCL + True + Win32 + 37889 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + DBServerApplication.exe + $(BDSCOMMONDIR)\DCU + $(BDSCOMMONDIR)\DCP + vcl;rtl;vclx;vclactnband;xmlrtl;vclimg;dbrtl;vcldb;vcldbx;bdertl;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dxSkinscxPCPainterD14;cxPageControlD14;dxSkinsCoreD14;dxSkinsdxLCPainterD14;dxLayoutControlD14;dxSkinscxScheduler3PainterD14;cxSchedulerD14;dxSkinsdxNavBar2PainterD14;dxNavBarD14;dxSkinsdxDLPainterD14;dxDockingD14;dxSkinsdxRibbonPainterD14;dxRibbonD14;dxBarD14;dxSkinsdxBarPainterD14;dclOfficeXP;$(DCC_UsePackage) + 00400000 + x86 + true + DBServerApplication + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Data.Win;Winapi;System.Win;$(DCC_Namespace) + true + true + 175 + 1033 + CompanyName=Simetron Informatics;FileDescription=Netcom7 DBServer Application;FileVersion=1.0.0.175;InternalName=;LegalCopyright=Copyright (c) 1998-2011 Simetron;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0 + + + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + DBServerApplication_Icon.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\default_app.manifest + DBServerApplication_Icon.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + false + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + DEBUG;$(DCC_Define) + + + Debug + + + Debug + + + Debug + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ + + +
svcMain
+ TService + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + Delphi.Personality.12 + + + + + DBServerApplication.dpr + + + False + True + False + + + True + True + 1 + 0 + 0 + 175 + False + False + False + False + False + 1033 + 1200 + + + Simetron Informatics + Netcom7 DBServer Application + 1.0.0.175 + + Copyright (c) 1998-2011 Simetron + + + + 1.0.0.0 + + + Embarcadero C++Builder Office XP Servers Package + Embarcadero C++Builder Office 2000 Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + ExpressPivotGrid 2 OLAP by Developer Express Inc. + + + + True + True + True + True + False + + + 12 + + + diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dproj.local b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dproj.local similarity index 99% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication.dproj.local rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dproj.local index 1a86a44..86b675f 100644 --- a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dproj.local +++ b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dproj.local @@ -1,11 +1,11 @@ - - - - 2011/04/04 13:08:58.034.dfm,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ufrmMain.dfm=C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.dfm - 2011/04/04 13:08:58.034.pas,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ufrmMain.pas=C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.pas - 2011/04/04 13:09:06.196.dproj,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ServiceConsole.dproj=C:\Users\BDemos\Documents\RAD Studio\Projects\Project1.dproj - 2011/04/05 09:14:37.644.dproj,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ServiceApplication.dproj=C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ServiceConsole.dproj - 2011/04/06 10:27:07.382.dproj,C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\DBServerApplication.dproj=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ServiceApplication.dproj - - - + + + + 2011/04/04 13:08:58.034.dfm,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ufrmMain.dfm=C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.dfm + 2011/04/04 13:08:58.034.pas,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ufrmMain.pas=C:\Users\BDemos\Documents\RAD Studio\Projects\Unit1.pas + 2011/04/04 13:09:06.196.dproj,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ServiceConsole.dproj=C:\Users\BDemos\Documents\RAD Studio\Projects\Project1.dproj + 2011/04/05 09:14:37.644.dproj,C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ServiceApplication.dproj=C:\Users\BDemos\Documents\RAD Studio\Workspace\TrayLogServiceModule\ServiceConsole\ServiceConsole.dproj + 2011/04/06 10:27:07.382.dproj,C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\DBServerApplication.dproj=C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ServiceApplication.dproj + + + diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dsk b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dsk similarity index 94% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication.dsk rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dsk index 8faeb9d..af4c73c 100644 --- a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.dsk +++ b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.dsk @@ -1,768 +1,768 @@ -[Closed Files] -File_0=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\RTL\SYS\System.pas',0,1,4091,1,4109,0,0,, -File_1=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Classes.pas',0,1,5241,8,5266,0,0,, -File_2=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\Netcom7\Source\ncSockets.pas',0,1,1547,1,1565,0,0,, -File_3=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Registry.pas',0,1,711,1,729,0,0,, -File_4=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\RTL\SYS\SysUtils.pas',0,1,15677,5,15519,0,0,, -File_5=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\Forms.pas',0,1,1259,1,1279,0,0,, -File_6=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\ExtCtrls.pas',0,1,1894,3,1856,0,0,, -File_7=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\Controls.pas',0,1,2514,1,2533,0,0,, -File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncDBCnt.pas',0,1,250,30,259,0,0,, -File_9=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\Netcom7\Source\ncDBCommands.pas',0,1,1,23,11,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ufrmMain.pas -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas] -ModuleType=TSourceModule - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ufrmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1844 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000134070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=762 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001FA0200000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ufrmMain.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas -CursorX=1 -CursorY=1 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=762 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=762 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1844 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1844 -ClientHeight=4674 -TBDockHeight=4674 -LRDockWidth=1844 -Dockable=1 -StayOnTop=0 -SplitPos=110 - -[PropInspDesignerSelection] -ArrangeBy=Name -SelectedItem=Name,ADOConnection -ExpandedItems=ADOConnection=0,"LiveBindings Designer=0",Source=0 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3488 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3488 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=0 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=0 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-344 -Top=-389 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1844 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1844 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=0 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=0 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=762 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=762 -ClientHeight=4477 -TBDockHeight=4477 -LRDockWidth=762 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1844 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1844 -ClientHeight=3419 -TBDockHeight=3419 -LRDockWidth=1844 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=762 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=762 -ClientHeight=3616 -TBDockHeight=3616 -LRDockWidth=762 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\RTL\SYS\System.pas',0,1,4091,1,4109,0,0,, +File_1=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Classes.pas',0,1,5241,8,5266,0,0,, +File_2=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\Netcom7\Source\ncSockets.pas',0,1,1547,1,1565,0,0,, +File_3=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\source\Win32\rtl\common\Registry.pas',0,1,711,1,729,0,0,, +File_4=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\RTL\SYS\SysUtils.pas',0,1,15677,5,15519,0,0,, +File_5=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\Forms.pas',0,1,1259,1,1279,0,0,, +File_6=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\ExtCtrls.pas',0,1,1894,3,1856,0,0,, +File_7=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\Controls.pas',0,1,2514,1,2533,0,0,, +File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncDBCnt.pas',0,1,250,30,259,0,0,, +File_9=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\Netcom7\Source\ncDBCommands.pas',0,1,1,23,11,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ufrmMain.pas +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas] +ModuleType=TSourceModule + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ufrmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1844 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000134070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=762 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001FA0200000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ufrmMain.pas +CursorX=1 +CursorY=1 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas +CursorX=1 +CursorY=1 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=762 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=762 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1844 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1844 +ClientHeight=4674 +TBDockHeight=4674 +LRDockWidth=1844 +Dockable=1 +StayOnTop=0 +SplitPos=110 + +[PropInspDesignerSelection] +ArrangeBy=Name +SelectedItem=Name,ADOConnection +ExpandedItems=ADOConnection=0,"LiveBindings Designer=0",Source=0 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3488 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3488 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=0 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=0 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-344 +Top=-389 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1844 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1844 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=0 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=0 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=762 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=762 +ClientHeight=4477 +TBDockHeight=4477 +LRDockWidth=762 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1844 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1844 +ClientHeight=3419 +TBDockHeight=3419 +LRDockWidth=1844 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=762 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=762 +ClientHeight=3616 +TBDockHeight=3616 +LRDockWidth=762 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.identcache b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.identcache similarity index 100% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication.identcache rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.identcache diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.res b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.res similarity index 100% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication.res rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.res diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.skincfg b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.skincfg similarity index 94% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication.skincfg rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.skincfg index 6870d73..d58e821 100644 --- a/Demos/DB/DBServer/ServiceApplication/DBServerApplication.skincfg +++ b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication.skincfg @@ -1,33 +1,33 @@ -[ExpressSkins] -Default=1 -ShowNotifications=1 -Enabled=1 -dxSkinBlack=0 -dxSkinBlue=0 -dxSkinCaramel=0 -dxSkinCoffee=0 -dxSkinDarkRoom=0 -dxSkinDarkSide=0 -dxSkinFoggy=0 -dxSkinGlassOceans=0 -dxSkiniMaginary=0 -dxSkinLilian=0 -dxSkinLiquidSky=0 -dxSkinLondonLiquidSky=0 -dxSkinMcSkin=0 -dxSkinMoneyTwins=0 -dxSkinOffice2007Black=0 -dxSkinOffice2007Blue=0 -dxSkinOffice2007Green=0 -dxSkinOffice2007Pink=0 -dxSkinOffice2007Silver=0 -dxSkinPumpkin=0 -dxSkinSeven=0 -dxSkinSharp=0 -dxSkinSilver=0 -dxSkinSpringTime=0 -dxSkinStardust=0 -dxSkinSummer2008=0 -dxSkinsDefaultPainters=0 -dxSkinValentine=0 -dxSkinXmas2008Blue=0 +[ExpressSkins] +Default=1 +ShowNotifications=1 +Enabled=1 +dxSkinBlack=0 +dxSkinBlue=0 +dxSkinCaramel=0 +dxSkinCoffee=0 +dxSkinDarkRoom=0 +dxSkinDarkSide=0 +dxSkinFoggy=0 +dxSkinGlassOceans=0 +dxSkiniMaginary=0 +dxSkinLilian=0 +dxSkinLiquidSky=0 +dxSkinLondonLiquidSky=0 +dxSkinMcSkin=0 +dxSkinMoneyTwins=0 +dxSkinOffice2007Black=0 +dxSkinOffice2007Blue=0 +dxSkinOffice2007Green=0 +dxSkinOffice2007Pink=0 +dxSkinOffice2007Silver=0 +dxSkinPumpkin=0 +dxSkinSeven=0 +dxSkinSharp=0 +dxSkinSilver=0 +dxSkinSpringTime=0 +dxSkinStardust=0 +dxSkinSummer2008=0 +dxSkinsDefaultPainters=0 +dxSkinValentine=0 +dxSkinXmas2008Blue=0 diff --git a/Demos/DB/DBServer/ServiceApplication/DBServerApplication_Icon.ico b/Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication_Icon.ico similarity index 100% rename from Demos/DB/DBServer/ServiceApplication/DBServerApplication_Icon.ico rename to Demos/TCP/DB/DBServer/ServiceApplication/DBServerApplication_Icon.ico diff --git a/Demos/DB/DBServer/ServiceApplication/ufrmMain.dfm b/Demos/TCP/DB/DBServer/ServiceApplication/ufrmMain.dfm similarity index 96% rename from Demos/DB/DBServer/ServiceApplication/ufrmMain.dfm rename to Demos/TCP/DB/DBServer/ServiceApplication/ufrmMain.dfm index 688129e..1bba110 100644 --- a/Demos/DB/DBServer/ServiceApplication/ufrmMain.dfm +++ b/Demos/TCP/DB/DBServer/ServiceApplication/ufrmMain.dfm @@ -1,316 +1,316 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - ActiveControl = memLog - Caption = 'Netcom7 Database Server Management' - ClientHeight = 388 - ClientWidth = 1030 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - ScreenSnap = True - ShowHint = True - OnClose = FormClose - OnCreate = FormCreate - OnDestroy = FormDestroy - PixelsPerInch = 96 - TextHeight = 13 - object Splitter1: TSplitter - Left = 257 - Top = 50 - Height = 338 - ExplicitLeft = 308 - ExplicitTop = 276 - ExplicitHeight = 100 - end - object pnlCaption: TPanel - Left = 0 - Top = 0 - Width = 1030 - Height = 50 - Align = alTop - BevelOuter = bvNone - Caption = 'In-memory service - stopped' - Color = clBlack - Font.Charset = DEFAULT_CHARSET - Font.Color = clWhite - Font.Height = -27 - Font.Name = 'Tahoma' - Font.Style = [] - ParentBackground = False - ParentFont = False - TabOrder = 0 - end - object memLog: TMemo - Left = 260 - Top = 50 - Width = 770 - Height = 338 - Align = alClient - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Courier New' - Font.Style = [] - ParentFont = False - ReadOnly = True - ScrollBars = ssBoth - TabOrder = 2 - WordWrap = False - end - object CategoryPanelGroup1: TCategoryPanelGroup - Left = 0 - Top = 50 - Width = 257 - Height = 338 - VertScrollBar.Tracking = True - BevelInner = bvNone - BevelOuter = bvNone - ChevronAlignment = taRightJustify - Color = clGradientActiveCaption - HeaderAlignment = taRightJustify - HeaderFont.Charset = DEFAULT_CHARSET - HeaderFont.Color = clWindowText - HeaderFont.Height = -11 - HeaderFont.Name = 'Tahoma' - HeaderFont.Style = [] - Padding.Left = 3 - Padding.Top = 3 - Padding.Right = 3 - Padding.Bottom = 3 - TabOrder = 1 - object CategoryPanel3: TCategoryPanel - AlignWithMargins = True - Top = 204 - Height = 65 - Caption = 'Startup' - TabOrder = 2 - object cbAutorunLogon: TCheckBox - AlignWithMargins = True - Left = 7 - Top = 3 - Width = 163 - Height = 33 - Hint = - 'Check this if you want to run this program instead of the servic' + - 'e for testing over time. This application will launch with windo' + - 'ws logon.' - Margins.Left = 7 - Margins.Right = 7 - Align = alLeft - Caption = 'Autorun with Windows logon' - TabOrder = 0 - OnClick = cbAutorunLogonClick - end - end - object cpConnection: TCategoryPanel - AlignWithMargins = True - Top = 77 - Height = 121 - Caption = 'Engine Settings' - TabOrder = 1 - object GridPanel1: TGridPanel - AlignWithMargins = True - Left = 7 - Top = 7 - Width = 227 - Height = 81 - Margins.Left = 7 - Margins.Top = 7 - Margins.Right = 7 - Margins.Bottom = 7 - Align = alClient - BevelOuter = bvNone - ColumnCollection = < - item - Value = 100.000000000000000000 - end> - ControlCollection = < - item - Column = 0 - Control = Panel1 - Row = 0 - end - item - Column = 0 - Control = Panel2 - Row = 1 - end - item - Column = 0 - Control = Panel3 - Row = 2 - end> - RowCollection = < - item - Value = 33.333333333333330000 - end - item - Value = 33.333333333333330000 - end - item - Value = 33.333333333333330000 - end> - TabOrder = 0 - object Panel1: TPanel - Left = 0 - Top = 0 - Width = 227 - Height = 26 - Align = alClient - BevelOuter = bvNone - Caption = 'Panel1' - TabOrder = 0 - object edtConnectionString: TEdit - AlignWithMargins = True - Left = 0 - Top = 2 - Width = 202 - Height = 22 - Margins.Left = 0 - Margins.Top = 2 - Margins.Right = 1 - Margins.Bottom = 2 - Align = alClient - TabOrder = 0 - TextHint = 'ADO Connection String' - OnChange = edtConnectionStringChange - ExplicitHeight = 21 - end - object btnEditConnectionString: TButton - AlignWithMargins = True - Left = 204 - Top = 2 - Width = 23 - Height = 22 - Hint = 'Edit connection string...' - Margins.Left = 1 - Margins.Top = 2 - Margins.Right = 0 - Margins.Bottom = 2 - Align = alRight - Caption = '...' - TabOrder = 1 - OnClick = btnEditConnectionStringClick - end - end - object Panel2: TPanel - Left = 0 - Top = 26 - Width = 227 - Height = 26 - Align = alClient - BevelOuter = bvNone - TabOrder = 1 - object lblPort: TLabel - Left = 71 - Top = 5 - Width = 64 - Height = 13 - Caption = '(TCP/IP Port)' - end - object edtPort: TSpinEdit - Left = 0 - Top = 2 - Width = 65 - Height = 22 - MaxValue = 0 - MinValue = 0 - TabOrder = 0 - Value = 0 - OnChange = edtPortChange - end - end - object Panel3: TPanel - Left = 0 - Top = 52 - Width = 227 - Height = 29 - Align = alClient - BevelOuter = bvNone - TabOrder = 2 - object cbEnableCachedResults: TCheckBox - Left = 0 - Top = 0 - Width = 227 - Height = 29 - Align = alClient - Caption = 'Enable cached query responses' - Checked = True - Color = clWindow - ParentColor = False - State = cbChecked - TabOrder = 0 - OnClick = cbEnableCachedResultsClick - end - end - end - end - object CategoryPanel1: TCategoryPanel - AlignWithMargins = True - Top = 6 - Height = 65 - Caption = 'In-memory Server Activation' - TabOrder = 0 - object btnStartService: TButton - AlignWithMargins = True - Left = 7 - Top = 7 - Width = 102 - Height = 25 - Margins.Left = 7 - Margins.Top = 7 - Margins.Bottom = 7 - Align = alLeft - Caption = 'Start Engine' - TabOrder = 0 - OnClick = btnStartServiceClick - end - object cbAutostartServer: TCheckBox - AlignWithMargins = True - Left = 168 - Top = 3 - Width = 66 - Height = 33 - Hint = 'Start Engine when this program starts' - Margins.Right = 7 - Align = alRight - Caption = 'Autostart' - TabOrder = 1 - OnClick = cbAutostartServerClick - end - end - end - object TrayIcon: TTrayIcon - PopupMenu = popTray - Visible = True - OnClick = miShowHideServerClick - Left = 316 - Top = 68 - end - object popTray: TPopupMenu - Left = 368 - Top = 68 - object miShowHideServer: TMenuItem - Caption = 'Show/Hide Server' - OnClick = miShowHideServerClick - end - object miN1: TMenuItem - Caption = '-' - end - object miShutdown: TMenuItem - Caption = 'Shutdown' - OnClick = miShutdownClick - end - end - object tmrUpdateLog: TTimer - Interval = 10 - OnTimer = tmrUpdateLogTimer - Left = 316 - Top = 116 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + ActiveControl = memLog + Caption = 'Netcom7 Database Server Management' + ClientHeight = 388 + ClientWidth = 1030 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + ScreenSnap = True + ShowHint = True + OnClose = FormClose + OnCreate = FormCreate + OnDestroy = FormDestroy + PixelsPerInch = 96 + TextHeight = 13 + object Splitter1: TSplitter + Left = 257 + Top = 50 + Height = 338 + ExplicitLeft = 308 + ExplicitTop = 276 + ExplicitHeight = 100 + end + object pnlCaption: TPanel + Left = 0 + Top = 0 + Width = 1030 + Height = 50 + Align = alTop + BevelOuter = bvNone + Caption = 'In-memory service - stopped' + Color = clBlack + Font.Charset = DEFAULT_CHARSET + Font.Color = clWhite + Font.Height = -27 + Font.Name = 'Tahoma' + Font.Style = [] + ParentBackground = False + ParentFont = False + TabOrder = 0 + end + object memLog: TMemo + Left = 260 + Top = 50 + Width = 770 + Height = 338 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Courier New' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssBoth + TabOrder = 2 + WordWrap = False + end + object CategoryPanelGroup1: TCategoryPanelGroup + Left = 0 + Top = 50 + Width = 257 + Height = 338 + VertScrollBar.Tracking = True + BevelInner = bvNone + BevelOuter = bvNone + ChevronAlignment = taRightJustify + Color = clGradientActiveCaption + HeaderAlignment = taRightJustify + HeaderFont.Charset = DEFAULT_CHARSET + HeaderFont.Color = clWindowText + HeaderFont.Height = -11 + HeaderFont.Name = 'Tahoma' + HeaderFont.Style = [] + Padding.Left = 3 + Padding.Top = 3 + Padding.Right = 3 + Padding.Bottom = 3 + TabOrder = 1 + object CategoryPanel3: TCategoryPanel + AlignWithMargins = True + Top = 204 + Height = 65 + Caption = 'Startup' + TabOrder = 2 + object cbAutorunLogon: TCheckBox + AlignWithMargins = True + Left = 7 + Top = 3 + Width = 163 + Height = 33 + Hint = + 'Check this if you want to run this program instead of the servic' + + 'e for testing over time. This application will launch with windo' + + 'ws logon.' + Margins.Left = 7 + Margins.Right = 7 + Align = alLeft + Caption = 'Autorun with Windows logon' + TabOrder = 0 + OnClick = cbAutorunLogonClick + end + end + object cpConnection: TCategoryPanel + AlignWithMargins = True + Top = 77 + Height = 121 + Caption = 'Engine Settings' + TabOrder = 1 + object GridPanel1: TGridPanel + AlignWithMargins = True + Left = 7 + Top = 7 + Width = 227 + Height = 81 + Margins.Left = 7 + Margins.Top = 7 + Margins.Right = 7 + Margins.Bottom = 7 + Align = alClient + BevelOuter = bvNone + ColumnCollection = < + item + Value = 100.000000000000000000 + end> + ControlCollection = < + item + Column = 0 + Control = Panel1 + Row = 0 + end + item + Column = 0 + Control = Panel2 + Row = 1 + end + item + Column = 0 + Control = Panel3 + Row = 2 + end> + RowCollection = < + item + Value = 33.333333333333330000 + end + item + Value = 33.333333333333330000 + end + item + Value = 33.333333333333330000 + end> + TabOrder = 0 + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 227 + Height = 26 + Align = alClient + BevelOuter = bvNone + Caption = 'Panel1' + TabOrder = 0 + object edtConnectionString: TEdit + AlignWithMargins = True + Left = 0 + Top = 2 + Width = 202 + Height = 22 + Margins.Left = 0 + Margins.Top = 2 + Margins.Right = 1 + Margins.Bottom = 2 + Align = alClient + TabOrder = 0 + TextHint = 'ADO Connection String' + OnChange = edtConnectionStringChange + ExplicitHeight = 21 + end + object btnEditConnectionString: TButton + AlignWithMargins = True + Left = 204 + Top = 2 + Width = 23 + Height = 22 + Hint = 'Edit connection string...' + Margins.Left = 1 + Margins.Top = 2 + Margins.Right = 0 + Margins.Bottom = 2 + Align = alRight + Caption = '...' + TabOrder = 1 + OnClick = btnEditConnectionStringClick + end + end + object Panel2: TPanel + Left = 0 + Top = 26 + Width = 227 + Height = 26 + Align = alClient + BevelOuter = bvNone + TabOrder = 1 + object lblPort: TLabel + Left = 71 + Top = 5 + Width = 64 + Height = 13 + Caption = '(TCP/IP Port)' + end + object edtPort: TSpinEdit + Left = 0 + Top = 2 + Width = 65 + Height = 22 + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 0 + OnChange = edtPortChange + end + end + object Panel3: TPanel + Left = 0 + Top = 52 + Width = 227 + Height = 29 + Align = alClient + BevelOuter = bvNone + TabOrder = 2 + object cbEnableCachedResults: TCheckBox + Left = 0 + Top = 0 + Width = 227 + Height = 29 + Align = alClient + Caption = 'Enable cached query responses' + Checked = True + Color = clWindow + ParentColor = False + State = cbChecked + TabOrder = 0 + OnClick = cbEnableCachedResultsClick + end + end + end + end + object CategoryPanel1: TCategoryPanel + AlignWithMargins = True + Top = 6 + Height = 65 + Caption = 'In-memory Server Activation' + TabOrder = 0 + object btnStartService: TButton + AlignWithMargins = True + Left = 7 + Top = 7 + Width = 102 + Height = 25 + Margins.Left = 7 + Margins.Top = 7 + Margins.Bottom = 7 + Align = alLeft + Caption = 'Start Engine' + TabOrder = 0 + OnClick = btnStartServiceClick + end + object cbAutostartServer: TCheckBox + AlignWithMargins = True + Left = 168 + Top = 3 + Width = 66 + Height = 33 + Hint = 'Start Engine when this program starts' + Margins.Right = 7 + Align = alRight + Caption = 'Autostart' + TabOrder = 1 + OnClick = cbAutostartServerClick + end + end + end + object TrayIcon: TTrayIcon + PopupMenu = popTray + Visible = True + OnClick = miShowHideServerClick + Left = 316 + Top = 68 + end + object popTray: TPopupMenu + Left = 368 + Top = 68 + object miShowHideServer: TMenuItem + Caption = 'Show/Hide Server' + OnClick = miShowHideServerClick + end + object miN1: TMenuItem + Caption = '-' + end + object miShutdown: TMenuItem + Caption = 'Shutdown' + OnClick = miShutdownClick + end + end + object tmrUpdateLog: TTimer + Interval = 10 + OnTimer = tmrUpdateLogTimer + Left = 316 + Top = 116 + end +end diff --git a/Demos/DB/DBServer/ServiceApplication/ufrmMain.pas b/Demos/TCP/DB/DBServer/ServiceApplication/ufrmMain.pas similarity index 96% rename from Demos/DB/DBServer/ServiceApplication/ufrmMain.pas rename to Demos/TCP/DB/DBServer/ServiceApplication/ufrmMain.pas index e3ece21..03e80e5 100644 --- a/Demos/DB/DBServer/ServiceApplication/ufrmMain.pas +++ b/Demos/TCP/DB/DBServer/ServiceApplication/ufrmMain.pas @@ -1,318 +1,318 @@ -unit ufrmMain; - -interface - -uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ExtCtrls, StdCtrls, Registry, Menus, SyncObjs, ComCtrls, ADOConEd, - Spin; - -type - TStringArray = array of string; - TBooleanArray = array of Boolean; - - TfrmMain = class(TForm) - pnlCaption: TPanel; - memLog: TMemo; - TrayIcon: TTrayIcon; - popTray: TPopupMenu; - miShowHideServer: TMenuItem; - miN1: TMenuItem; - miShutdown: TMenuItem; - tmrUpdateLog: TTimer; - CategoryPanelGroup1: TCategoryPanelGroup; - CategoryPanel1: TCategoryPanel; - cpConnection: TCategoryPanel; - btnStartService: TButton; - cbAutostartServer: TCheckBox; - CategoryPanel3: TCategoryPanel; - cbAutorunLogon: TCheckBox; - Splitter1: TSplitter; - GridPanel1: TGridPanel; - Panel1: TPanel; - edtConnectionString: TEdit; - btnEditConnectionString: TButton; - Panel2: TPanel; - edtPort: TSpinEdit; - lblPort: TLabel; - Panel3: TPanel; - cbEnableCachedResults: TCheckBox; - procedure FormCreate(Sender: TObject); - procedure btnStartServiceClick(Sender: TObject); - procedure cbAutostartServerClick(Sender: TObject); - procedure cbAutorunLogonClick(Sender: TObject); - procedure miShowHideServerClick(Sender: TObject); - procedure FormClose(Sender: TObject; var Action: TCloseAction); - procedure miShutdownClick(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure tmrUpdateLogTimer(Sender: TObject); - procedure btnEditConnectionStringClick(Sender: TObject); - procedure edtConnectionStringChange(Sender: TObject); - procedure edtPortChange(Sender: TObject); - procedure cbEnableCachedResultsClick(Sender: TObject); - private - svcStarted: Boolean; - LogLock: TCriticalSection; - LogStrs: TStringArray; - LogErrs: TBooleanArray; - btnStartServiceCaption: string; - procedure RefreshGUI; - procedure ServiceLogMessage(Sender: TObject; aMessage: string; aError: Boolean = False); - procedure ApplicationException(Sender: TObject; E: Exception); - public - function IsAutoRun: Boolean; - procedure SetAutoRun(aAutoRun: Boolean); - end; - -var - frmMain: TfrmMain; - -implementation - -uses usvcMain; -{$R *.dfm} - -procedure TfrmMain.FormCreate(Sender: TObject); -begin - svcStarted := False; - - btnStartServiceCaption := btnStartService.Caption; - - LogLock := TCriticalSection.Create; - SetLength(LogStrs, 0); - SetLength(LogErrs, 0); - - Application.OnException := ApplicationException; - Service.OnLogMessage := ServiceLogMessage; - - if Service.Settings.ValueExists('AppAutostart') then - cbAutostartServer.Checked := Service.Settings.ReadBool('AppAutostart'); - cbAutorunLogon.Checked := IsAutoRun; - - edtConnectionString.Text := Service.DBConnectionString; - edtPort.Value := Service.ServicePort; - cbEnableCachedResults.Checked := Service.CacheResponses; - - RefreshGUI; - - if cbAutostartServer.Checked then - btnStartService.Click; -end; - -procedure TfrmMain.FormDestroy(Sender: TObject); -begin - LogLock.Free; -end; - -procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); -begin - Action := caNone; - Visible := False; -end; - -procedure TfrmMain.ApplicationException(Sender: TObject; E: Exception); -begin - memLog.Lines.Add('*** APPLICATION EXCEPTION (' + E.ClassName + ')! ' + DateTimeToStr(Now) + ': ' + E.Message); -end; - -procedure TfrmMain.ServiceLogMessage(Sender: TObject; aMessage: string; aError: Boolean = False); -begin - // This must be thread safe, a log can be called all over the place - - LogLock.Acquire; - try - SetLength(LogStrs, Length(LogStrs) + 1); - LogStrs[ High(LogStrs)] := aMessage; - SetLength(LogErrs, Length(LogErrs) + 1); - LogErrs[ High(LogErrs)] := aError; - finally - LogLock.Release; - end; -end; - -procedure TfrmMain.tmrUpdateLogTimer(Sender: TObject); -var - Strs: TStringArray; - Errs: TBooleanArray; - - MsgStr: string; - i: Integer; -begin - // Get thread critical data as fast as possible onto local copies - LogLock.Acquire; - try - Strs := LogStrs; - Errs := LogErrs; - SetLength(LogStrs, 0); - SetLength(LogErrs, 0); - finally - LogLock.Release; - end; - - // And begin showing the messages/errors in the log area - if Length(Strs) > 0 then - begin - memLog.Lines.BeginUpdate; - try - for i := 0 to High(Strs) do - begin - MsgStr := ''; - if Errs[i] then - begin - Visible := True; - MsgStr := MsgStr + '*** Error! '; - end; - - MsgStr := MsgStr + '[' + DateTimeToStr(Now) + ']: ' + Strs[i]; - if memLog.Lines.Count > 10000 then - memLog.Lines.Text := 'Log cleared - reached 10000 lines'; - memLog.Lines.Add(MsgStr); - end; - finally - memLog.Lines.EndUpdate; - end; - end; -end; - -procedure TfrmMain.RefreshGUI; -var - Caption: string; -begin - Caption := Service.DisplayName; - if svcStarted then - Caption := Caption + ' - started' - else - Caption := Caption + ' - stopped'; - pnlCaption.Caption := Caption; -end; - -procedure TfrmMain.btnStartServiceClick(Sender: TObject); -var - svcStopped: Boolean; -begin - if svcStarted then - begin - svcStarted := False; - btnStartService.Caption := btnStartServiceCaption; - cpConnection.Enabled := True; - Service.ServiceStop(nil, svcStopped); - end - else - begin - svcStarted := True; - try - Service.ServiceStart(nil, svcStarted); - if svcStarted then - begin - btnStartService.Caption := 'Stop service'; - cpConnection.Enabled := False; - end; - except - svcStarted := False; - raise ; - end; - end; - RefreshGUI; -end; - -procedure TfrmMain.cbAutostartServerClick(Sender: TObject); -begin - Service.Settings.WriteBool('AppAutostart', cbAutostartServer.Checked); -end; - -procedure TfrmMain.edtConnectionStringChange(Sender: TObject); -begin - edtConnectionString.Hint := edtConnectionString.Text; - Service.DBConnectionString := edtConnectionString.Text; -end; - -procedure TfrmMain.edtPortChange(Sender: TObject); -begin - Service.ServicePort := edtPort.Value; -end; - -procedure TfrmMain.cbEnableCachedResultsClick(Sender: TObject); -begin - Service.CacheResponses := cbEnableCachedResults.Checked; -end; - -procedure TfrmMain.cbAutorunLogonClick(Sender: TObject); -begin - if cbAutorunLogon.Checked then - cbAutoStartServer.Checked := True; - SetAutoRun(cbAutorunLogon.Checked); -end; - -procedure TfrmMain.btnEditConnectionStringClick(Sender: TObject); -begin - if EditConnectionString(Service.ADOConnection) then - begin - edtConnectionString.Text := Service.ADOConnection.ConnectionString; - end; -end; - -function TfrmMain.IsAutoRun: Boolean; -var - Reg: TRegistry; - AppName: string; -begin - Result := False; - - Reg := TRegistry.Create; - try - Reg.RootKey := HKEY_LOCAL_MACHINE; - if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then - try - AppName := ExtractFileName(ParamStr(0)); - AppName := Copy(AppName, 1, Length(AppName) - Length(ExtractFileExt(AppName))); - AppName := AppName + '.' + Service.Name; - - Result := SameText(Reg.ReadString(AppName), ParamStr(0)); - finally - Reg.CloseKey; - end; - finally - Reg.Free; - end; -end; - -procedure TfrmMain.SetAutoRun(aAutoRun: Boolean); -var - Reg: TRegistry; - AppName: string; -begin - Reg := TRegistry.Create; - try - Reg.RootKey := HKEY_LOCAL_MACHINE; - Reg.LazyWrite := False; - if not Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then - raise Exception.Create('Cannot open registry key.'); - try - AppName := ExtractFileName(ParamStr(0)); - AppName := Copy(AppName, 1, Length(AppName) - Length(ExtractFileExt(AppName))); - AppName := AppName + '.' + Service.Name; - - if cbAutorunLogon.Checked then - Reg.WriteString(AppName, ParamStr(0)) - else - Reg.DeleteValue(AppName); - finally - Reg.CloseKey; - end; - finally - Reg.Free; - end; -end; - -procedure TfrmMain.miShowHideServerClick(Sender: TObject); -begin - Application.BringToFront; - frmMain.Visible := not frmMain.Visible; -end; - -procedure TfrmMain.miShutdownClick(Sender: TObject); -begin - Application.Terminate; -end; - -end. +unit ufrmMain; + +interface + +uses + Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ExtCtrls, StdCtrls, Registry, Menus, SyncObjs, ComCtrls, ADOConEd, + Spin; + +type + TStringArray = array of string; + TBooleanArray = array of Boolean; + + TfrmMain = class(TForm) + pnlCaption: TPanel; + memLog: TMemo; + TrayIcon: TTrayIcon; + popTray: TPopupMenu; + miShowHideServer: TMenuItem; + miN1: TMenuItem; + miShutdown: TMenuItem; + tmrUpdateLog: TTimer; + CategoryPanelGroup1: TCategoryPanelGroup; + CategoryPanel1: TCategoryPanel; + cpConnection: TCategoryPanel; + btnStartService: TButton; + cbAutostartServer: TCheckBox; + CategoryPanel3: TCategoryPanel; + cbAutorunLogon: TCheckBox; + Splitter1: TSplitter; + GridPanel1: TGridPanel; + Panel1: TPanel; + edtConnectionString: TEdit; + btnEditConnectionString: TButton; + Panel2: TPanel; + edtPort: TSpinEdit; + lblPort: TLabel; + Panel3: TPanel; + cbEnableCachedResults: TCheckBox; + procedure FormCreate(Sender: TObject); + procedure btnStartServiceClick(Sender: TObject); + procedure cbAutostartServerClick(Sender: TObject); + procedure cbAutorunLogonClick(Sender: TObject); + procedure miShowHideServerClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + procedure miShutdownClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure tmrUpdateLogTimer(Sender: TObject); + procedure btnEditConnectionStringClick(Sender: TObject); + procedure edtConnectionStringChange(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure cbEnableCachedResultsClick(Sender: TObject); + private + svcStarted: Boolean; + LogLock: TCriticalSection; + LogStrs: TStringArray; + LogErrs: TBooleanArray; + btnStartServiceCaption: string; + procedure RefreshGUI; + procedure ServiceLogMessage(Sender: TObject; aMessage: string; aError: Boolean = False); + procedure ApplicationException(Sender: TObject; E: Exception); + public + function IsAutoRun: Boolean; + procedure SetAutoRun(aAutoRun: Boolean); + end; + +var + frmMain: TfrmMain; + +implementation + +uses usvcMain; +{$R *.dfm} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + svcStarted := False; + + btnStartServiceCaption := btnStartService.Caption; + + LogLock := TCriticalSection.Create; + SetLength(LogStrs, 0); + SetLength(LogErrs, 0); + + Application.OnException := ApplicationException; + Service.OnLogMessage := ServiceLogMessage; + + if Service.Settings.ValueExists('AppAutostart') then + cbAutostartServer.Checked := Service.Settings.ReadBool('AppAutostart'); + cbAutorunLogon.Checked := IsAutoRun; + + edtConnectionString.Text := Service.DBConnectionString; + edtPort.Value := Service.ServicePort; + cbEnableCachedResults.Checked := Service.CacheResponses; + + RefreshGUI; + + if cbAutostartServer.Checked then + btnStartService.Click; +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + LogLock.Free; +end; + +procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); +begin + Action := caNone; + Visible := False; +end; + +procedure TfrmMain.ApplicationException(Sender: TObject; E: Exception); +begin + memLog.Lines.Add('*** APPLICATION EXCEPTION (' + E.ClassName + ')! ' + DateTimeToStr(Now) + ': ' + E.Message); +end; + +procedure TfrmMain.ServiceLogMessage(Sender: TObject; aMessage: string; aError: Boolean = False); +begin + // This must be thread safe, a log can be called all over the place + + LogLock.Acquire; + try + SetLength(LogStrs, Length(LogStrs) + 1); + LogStrs[ High(LogStrs)] := aMessage; + SetLength(LogErrs, Length(LogErrs) + 1); + LogErrs[ High(LogErrs)] := aError; + finally + LogLock.Release; + end; +end; + +procedure TfrmMain.tmrUpdateLogTimer(Sender: TObject); +var + Strs: TStringArray; + Errs: TBooleanArray; + + MsgStr: string; + i: Integer; +begin + // Get thread critical data as fast as possible onto local copies + LogLock.Acquire; + try + Strs := LogStrs; + Errs := LogErrs; + SetLength(LogStrs, 0); + SetLength(LogErrs, 0); + finally + LogLock.Release; + end; + + // And begin showing the messages/errors in the log area + if Length(Strs) > 0 then + begin + memLog.Lines.BeginUpdate; + try + for i := 0 to High(Strs) do + begin + MsgStr := ''; + if Errs[i] then + begin + Visible := True; + MsgStr := MsgStr + '*** Error! '; + end; + + MsgStr := MsgStr + '[' + DateTimeToStr(Now) + ']: ' + Strs[i]; + if memLog.Lines.Count > 10000 then + memLog.Lines.Text := 'Log cleared - reached 10000 lines'; + memLog.Lines.Add(MsgStr); + end; + finally + memLog.Lines.EndUpdate; + end; + end; +end; + +procedure TfrmMain.RefreshGUI; +var + Caption: string; +begin + Caption := Service.DisplayName; + if svcStarted then + Caption := Caption + ' - started' + else + Caption := Caption + ' - stopped'; + pnlCaption.Caption := Caption; +end; + +procedure TfrmMain.btnStartServiceClick(Sender: TObject); +var + svcStopped: Boolean; +begin + if svcStarted then + begin + svcStarted := False; + btnStartService.Caption := btnStartServiceCaption; + cpConnection.Enabled := True; + Service.ServiceStop(nil, svcStopped); + end + else + begin + svcStarted := True; + try + Service.ServiceStart(nil, svcStarted); + if svcStarted then + begin + btnStartService.Caption := 'Stop service'; + cpConnection.Enabled := False; + end; + except + svcStarted := False; + raise ; + end; + end; + RefreshGUI; +end; + +procedure TfrmMain.cbAutostartServerClick(Sender: TObject); +begin + Service.Settings.WriteBool('AppAutostart', cbAutostartServer.Checked); +end; + +procedure TfrmMain.edtConnectionStringChange(Sender: TObject); +begin + edtConnectionString.Hint := edtConnectionString.Text; + Service.DBConnectionString := edtConnectionString.Text; +end; + +procedure TfrmMain.edtPortChange(Sender: TObject); +begin + Service.ServicePort := edtPort.Value; +end; + +procedure TfrmMain.cbEnableCachedResultsClick(Sender: TObject); +begin + Service.CacheResponses := cbEnableCachedResults.Checked; +end; + +procedure TfrmMain.cbAutorunLogonClick(Sender: TObject); +begin + if cbAutorunLogon.Checked then + cbAutoStartServer.Checked := True; + SetAutoRun(cbAutorunLogon.Checked); +end; + +procedure TfrmMain.btnEditConnectionStringClick(Sender: TObject); +begin + if EditConnectionString(Service.ADOConnection) then + begin + edtConnectionString.Text := Service.ADOConnection.ConnectionString; + end; +end; + +function TfrmMain.IsAutoRun: Boolean; +var + Reg: TRegistry; + AppName: string; +begin + Result := False; + + Reg := TRegistry.Create; + try + Reg.RootKey := HKEY_LOCAL_MACHINE; + if Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then + try + AppName := ExtractFileName(ParamStr(0)); + AppName := Copy(AppName, 1, Length(AppName) - Length(ExtractFileExt(AppName))); + AppName := AppName + '.' + Service.Name; + + Result := SameText(Reg.ReadString(AppName), ParamStr(0)); + finally + Reg.CloseKey; + end; + finally + Reg.Free; + end; +end; + +procedure TfrmMain.SetAutoRun(aAutoRun: Boolean); +var + Reg: TRegistry; + AppName: string; +begin + Reg := TRegistry.Create; + try + Reg.RootKey := HKEY_LOCAL_MACHINE; + Reg.LazyWrite := False; + if not Reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run', True) then + raise Exception.Create('Cannot open registry key.'); + try + AppName := ExtractFileName(ParamStr(0)); + AppName := Copy(AppName, 1, Length(AppName) - Length(ExtractFileExt(AppName))); + AppName := AppName + '.' + Service.Name; + + if cbAutorunLogon.Checked then + Reg.WriteString(AppName, ParamStr(0)) + else + Reg.DeleteValue(AppName); + finally + Reg.CloseKey; + end; + finally + Reg.Free; + end; +end; + +procedure TfrmMain.miShowHideServerClick(Sender: TObject); +begin + Application.BringToFront; + frmMain.Visible := not frmMain.Visible; +end; + +procedure TfrmMain.miShutdownClick(Sender: TObject); +begin + Application.Terminate; +end; + +end. diff --git a/Demos/DB/DBServer/TestData/Customers.mdb b/Demos/TCP/DB/DBServer/TestData/Customers.mdb similarity index 100% rename from Demos/DB/DBServer/TestData/Customers.mdb rename to Demos/TCP/DB/DBServer/TestData/Customers.mdb diff --git a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dpr b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dpr similarity index 94% rename from Demos/NetComVSIndy/Client/NetComVSIndyClient.dpr rename to Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dpr index aacd074..ecb956c 100644 --- a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dpr +++ b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dpr @@ -1,14 +1,14 @@ -program NetComVSIndyClient; - -uses - Vcl.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}; - -{$R *.res} - -begin - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program NetComVSIndyClient; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dproj b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dproj similarity index 76% rename from Demos/NetComVSIndy/Client/NetComVSIndyClient.dproj rename to Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dproj index 9b3fd67..f12bdd1 100644 --- a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dproj +++ b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dproj @@ -1,1002 +1,1108 @@ - - - {87A44595-5F1F-4CE4-8F52-2D9AF02CFC5C} - 18.8 - VCL - NetComVSIndyClient.dpr - True - Release - Win64 - 3 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - NetComVSIndyClient - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - - - true - PerMonitorV2 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- dfm - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - NetComVSIndyClient.dpr - - - - - - NetComVSIndyClient.exe - true - - - - - NetComVSIndyClient.exe - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - True - - - 12 - - - - - + + + {87A44595-5F1F-4CE4-8F52-2D9AF02CFC5C} + 20.2 + VCL + NetComVSIndyClient.dpr + True + Release + Win32 + 3 + Application + NetComVSIndyClient + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + NetComVSIndyClient + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + NetComVSIndyClient.dpr + + + + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + + True + True + + + 12 + + + + + diff --git a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dproj.local b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dproj.local similarity index 89% rename from Demos/NetComVSIndy/Client/NetComVSIndyClient.dproj.local rename to Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dproj.local index dcb08ed..3a0c17e 100644 --- a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dproj.local +++ b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dproj.local @@ -1,45 +1,45 @@ - - - - 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas - 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/11 06:18:58.000.380,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/11 06:47:57.000.575,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.dfm=C:\Users\Programmer\Documents\Development\Projects\Unit3.dfm - 2020/08/11 06:47:57.000.575,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/11 06:48:06.000.793,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\NetComVSIndyClient.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj - - - - - + + + + 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas + 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/11 06:18:58.000.380,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/11 06:47:57.000.575,C:\Users\Programmer\Documents\Development\Projects\Unit3.dfm=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.dfm + 2020/08/11 06:47:57.000.575,C:\Users\Programmer\Documents\Development\Projects\Unit3.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas + 2020/08/11 06:48:06.000.793,C:\Users\Programmer\Documents\Development\Projects\Project1.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\NetComVSIndyClient.dproj + + + + + diff --git a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dsk b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dsk similarity index 94% rename from Demos/NetComVSIndy/Client/NetComVSIndyClient.dsk rename to Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dsk index c835053..f6b9598 100644 --- a/Demos/NetComVSIndy/Client/NetComVSIndyClient.dsk +++ b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.dsk @@ -1,755 +1,755 @@ -[Closed Files] -File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,520,1,923,0,0,,{1,910,1} -File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,499,5,475,0,0,, -File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdIOHandler.pas',0,1,1837,3,1853,0,0,, -File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackBSDBase.pas',0,1,498,1,513,0,0,, -File_4=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackConsts.pas',0,1,128,1,144,0,0,, -File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdSocketHandle.pas',0,1,362,11,378,0,0,, -File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdIOHandlerStack.pas',0,1,366,1,368,0,0,, -File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdGlobal.pas',0,1,2735,10,2524,0,0,, -File_8=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,3264,1,3279,0,0,, -File_9=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackWindows.pas',0,1,1054,1,1070,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas -Count=1 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=1 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas -View0=0 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas -CursorX=1 -CursorY=14 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=3 -Breakpoint0='c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdSocketHandle.pas',340,'',0,1,'',1,0,0,'',1,'','','',0,'' -Breakpoint1='c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackBSDBase.pas',448,'',0,1,'',1,0,0,'',1,'','','',0,'' -Breakpoint2='c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackBSDBase.pas',513,'',0,1,'',1,0,0,'',1,'','','',0,'' - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[PropInspDesignerSelection] -ArrangeBy=Name -SelectedItem=Caption, -ExpandedItems=Anchors=0,BorderIcons=0,Constraints=0 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-214 -Top=-259 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,520,1,923,0,0,,{1,910,1} +File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,499,5,475,0,0,, +File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdIOHandler.pas',0,1,1837,3,1853,0,0,, +File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackBSDBase.pas',0,1,498,1,513,0,0,, +File_4=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackConsts.pas',0,1,128,1,144,0,0,, +File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdSocketHandle.pas',0,1,362,11,378,0,0,, +File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdIOHandlerStack.pas',0,1,366,1,368,0,0,, +File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdGlobal.pas',0,1,2735,10,2524,0,0,, +File_8=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,3264,1,3279,0,0,, +File_9=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackWindows.pas',0,1,1054,1,1070,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas +Count=1 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=1 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas +View0=0 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas +CursorX=1 +CursorY=14 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=3 +Breakpoint0='c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdSocketHandle.pas',340,'',0,1,'',1,0,0,'',1,'','','',0,'' +Breakpoint1='c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackBSDBase.pas',448,'',0,1,'',1,0,0,'',1,'','','',0,'' +Breakpoint2='c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\System\IdStackBSDBase.pas',513,'',0,1,'',1,0,0,'',1,'','','',0,'' + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[PropInspDesignerSelection] +ArrangeBy=Name +SelectedItem=Caption, +ExpandedItems=Anchors=0,BorderIcons=0,Constraints=0 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-214 +Top=-259 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.res b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.res new file mode 100644 index 0000000..7cb3dbd Binary files /dev/null and b/Demos/TCP/NetComVSIndy/Client/NetComVSIndyClient.res differ diff --git a/Demos/NetComVSIndy/Client/ufrmMain.dfm b/Demos/TCP/NetComVSIndy/Client/ufrmMain.dfm similarity index 90% rename from Demos/NetComVSIndy/Client/ufrmMain.dfm rename to Demos/TCP/NetComVSIndy/Client/ufrmMain.dfm index a50f87b..5d97777 100644 --- a/Demos/NetComVSIndy/Client/ufrmMain.dfm +++ b/Demos/TCP/NetComVSIndy/Client/ufrmMain.dfm @@ -1,98 +1,95 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'NetCom vs Indy speed testing' - ClientHeight = 358 - ClientWidth = 802 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - OnCreate = FormCreate - PixelsPerInch = 96 - TextHeight = 13 - object pnlToolbar: TPanel - Left = 0 - Top = 0 - Width = 802 - Height = 41 - Align = alTop - BevelOuter = bvNone - FullRepaint = False - TabOrder = 0 - object Label1: TLabel - Left = 328 - Top = 14 - Width = 51 - Height = 13 - Caption = 'Iterations:' - end - object btnTestSpeed: TButton - Left = 0 - Top = 0 - Width = 121 - Height = 41 - Align = alLeft - Caption = 'Test Speed' - TabOrder = 0 - OnClick = btnTestSpeedClick - end - object edtIterations: TSpinEdit - Left = 385 - Top = 11 - Width = 81 - Height = 22 - MaxValue = 0 - MinValue = 0 - TabOrder = 1 - Value = 10000 - end - object rbTestNetCom: TRadioButton - Left = 145 - Top = 12 - Width = 80 - Height = 17 - Caption = 'Test NetCom' - Checked = True - TabOrder = 2 - TabStop = True - end - object rbTestIndy: TRadioButton - Left = 231 - Top = 12 - Width = 82 - Height = 17 - Caption = 'Test Indy' - TabOrder = 3 - end - end - object memLog: TMemo - Left = 0 - Top = 41 - Width = 802 - Height = 317 - Align = alClient - TabOrder = 1 - end - object ncClient: TncTCPClient - Host = 'LocalHost' - UseReaderThread = False - NoDelay = True - KeepAlive = False - Reconnect = False - Left = 304 - Top = 32 - end - object idClient: TIdTCPClient - ConnectTimeout = 0 - Host = 'LocalHost' - IPVersion = Id_IPv4 - Port = 16234 - ReadTimeout = -1 - Left = 304 - Top = 88 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'NetCom vs Indy speed testing' + ClientHeight = 358 + ClientWidth = 802 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OnCreate = FormCreate + TextHeight = 13 + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 802 + Height = 41 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + object Label1: TLabel + Left = 328 + Top = 14 + Width = 51 + Height = 13 + Caption = 'Iterations:' + end + object btnTestSpeed: TButton + Left = 0 + Top = 0 + Width = 121 + Height = 41 + Align = alLeft + Caption = 'Test Speed' + TabOrder = 0 + OnClick = btnTestSpeedClick + end + object edtIterations: TSpinEdit + Left = 385 + Top = 11 + Width = 81 + Height = 22 + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 10000 + end + object rbTestNetCom: TRadioButton + Left = 145 + Top = 12 + Width = 80 + Height = 17 + Caption = 'Test NetCom' + Checked = True + TabOrder = 2 + TabStop = True + end + object rbTestIndy: TRadioButton + Left = 231 + Top = 12 + Width = 82 + Height = 17 + Caption = 'Test Indy' + TabOrder = 3 + end + end + object memLog: TMemo + Left = 0 + Top = 41 + Width = 802 + Height = 317 + Align = alClient + TabOrder = 1 + end + object ncClient: TncTCPClient + Host = 'LocalHost' + UseReaderThread = False + NoDelay = True + KeepAlive = False + Reconnect = False + Left = 224 + Top = 88 + end + object idClient: TIdTCPClient + ConnectTimeout = 0 + Host = 'LocalHost' + Port = 16234 + ReadTimeout = -1 + Left = 304 + Top = 88 + end +end diff --git a/Demos/NetComVSIndy/Client/ufrmMain.pas b/Demos/TCP/NetComVSIndy/Client/ufrmMain.pas similarity index 96% rename from Demos/NetComVSIndy/Client/ufrmMain.pas rename to Demos/TCP/NetComVSIndy/Client/ufrmMain.pas index 307a1e7..ca6dee8 100644 --- a/Demos/NetComVSIndy/Client/ufrmMain.pas +++ b/Demos/TCP/NetComVSIndy/Client/ufrmMain.pas @@ -1,94 +1,95 @@ -unit ufrmMain; - -interface - -uses - Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, - Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Samples.Spin, - IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdCustomTCPServer, - IdTCPServer, IdContext, IdGlobal, - Winapi.Winsock2, System.Diagnostics, ncSockets, ncLines; - -const - // We are testing the socket mechanisms here and not how fast tcp/ip is, - // therefore the buffer sent back and forth is kept at a fairly minimal size - BuffSize = 256; - -type - TfrmMain = class(TForm) - ncClient: TncTCPClient; - idClient: TIdTCPClient; - pnlToolbar: TPanel; - memLog: TMemo; - btnTestSpeed: TButton; - edtIterations: TSpinEdit; - Label1: TLabel; - rbTestNetCom: TRadioButton; - rbTestIndy: TRadioButton; - procedure FormCreate(Sender: TObject); - procedure btnTestSpeedClick(Sender: TObject); - private - BufferSend, BufferRead: TBytes; - idBufferSend, idBufferRead: TidBytes; - public - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.dfm} - -procedure TfrmMain.FormCreate(Sender: TObject); -begin - SetLength(BufferSend, BuffSize); - SetLength(BufferRead, BuffSize); - SetLength(idBufferSend, BuffSize); - SetLength(idBufferRead, BuffSize); -end; - -procedure TfrmMain.btnTestSpeedClick(Sender: TObject); -var - i: Integer; - TimeSt: Cardinal; - TimeTaken: Cardinal; -begin - if rbTestNetCom.Checked then - ncClient.Active := True; - if rbTestIndy.Checked then - idClient.Connect; - - if rbTestNetCom.Checked then - begin - memLog.Lines.Add('Testing NetCom...'); - TimeSt := GetTickCount; - for i := 1 to edtIterations.Value do - begin - ncClient.Send(BufferSend); - ncClient.ReceiveRaw(BufferRead); - end; - TimeTaken := GetTickCount - TimeSt; - memLog.Lines.Add('Time taken: ' + IntToStr(TimeTaken) + ' msec'); - end; - - if rbTestIndy.Checked then - begin - memLog.Lines.Add('Testing Indy...'); - TimeSt := GetTickCount; - for i := 1 to edtIterations.Value do - begin - idClient.Socket.Write(idBufferSend); - idClient.Socket.ReadBytes(idBufferRead, BuffSize, False); - end; - TimeTaken := GetTickCount - TimeSt; - memLog.Lines.Add('Time taken: ' + IntToStr(TimeTaken) + ' msec'); - end; - - if rbTestNetCom.Checked then - ncClient.Active := False; - if rbTestIndy.Checked then - idClient.Disconnect; -end; - -end. +unit ufrmMain; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Samples.Spin, + IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdCustomTCPServer, + IdTCPServer, IdContext, IdGlobal, + Winapi.Winsock2, System.Diagnostics, ncSockets, ncLines; + +const + // We are testing the socket mechanisms here and not how fast tcp/ip is, + // therefore the buffer sent back and forth is kept at a fairly minimal size + BuffSize = 256; + +type + TfrmMain = class(TForm) + ncClient: TncTCPClient; + idClient: TIdTCPClient; + pnlToolbar: TPanel; + memLog: TMemo; + btnTestSpeed: TButton; + edtIterations: TSpinEdit; + Label1: TLabel; + rbTestNetCom: TRadioButton; + rbTestIndy: TRadioButton; + procedure FormCreate(Sender: TObject); + procedure btnTestSpeedClick(Sender: TObject); + private + BufferSend, BufferRead: TBytes; + idBufferSend, idBufferRead: TidBytes; + public + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.dfm} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + SetLength(BufferSend, BuffSize); + SetLength(BufferRead, BuffSize); + SetLength(idBufferSend, BuffSize); + SetLength(idBufferRead, BuffSize); +end; + +procedure TfrmMain.btnTestSpeedClick(Sender: TObject); +var + i: Integer; + TimeSt: Cardinal; + TimeTaken: Cardinal; +begin + if rbTestNetCom.Checked then + ncClient.Active := True; + if rbTestIndy.Checked then + idClient.Connect; + + if rbTestNetCom.Checked then + begin + memLog.Lines.Add('Testing NetCom...'); + TimeSt := GetTickCount; + for i := 1 to edtIterations.Value do + begin + ncClient.Send(BufferSend); + ncClient.ReceiveRaw(BufferRead); + end; + TimeTaken := GetTickCount - TimeSt; + memLog.Lines.Add('Time taken: ' + IntToStr(TimeTaken) + ' msec'); + end; + + if rbTestIndy.Checked then + begin + memLog.Lines.Add('Testing Indy...'); + TimeSt := GetTickCount; + for i := 1 to edtIterations.Value do + begin + idClient.Socket.Write(idBufferSend); + idClient.Socket.ReadBytes(idBufferRead, BuffSize, False); + end; + TimeTaken := GetTickCount - TimeSt; + memLog.Lines.Add('Time taken: ' + IntToStr(TimeTaken) + ' msec'); + end; + + if rbTestNetCom.Checked then + ncClient.Active := False; + if rbTestIndy.Checked then + idClient.Disconnect; +end; + +end. + diff --git a/Demos/TCP/NetComVSIndy/NetComVSIndy.groupproj b/Demos/TCP/NetComVSIndy/NetComVSIndy.groupproj new file mode 100644 index 0000000..5a20ee2 --- /dev/null +++ b/Demos/TCP/NetComVSIndy/NetComVSIndy.groupproj @@ -0,0 +1,48 @@ + + + {BAC706C1-FD83-4697-8BAD-8B892870DBDE} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Demos/TCP/NetComVSIndy/NetComVSIndy.groupproj.local b/Demos/TCP/NetComVSIndy/NetComVSIndy.groupproj.local new file mode 100644 index 0000000..64d433f --- /dev/null +++ b/Demos/TCP/NetComVSIndy/NetComVSIndy.groupproj.local @@ -0,0 +1,9 @@ + + + + 2025/07/19 21:15:44.000.829,C:\Users\leet\Documents\Embarcadero\Studio\Projects\ProjectGroup1.groupproj=D:\_Delphi\_Library\Netcom7\Demos\NetComVSIndy\NetComVSIndy.groupproj + + + + + diff --git a/Demos/TCP/NetComVSIndy/NetComVSIndy_prjgroup.tvsconfig b/Demos/TCP/NetComVSIndy/NetComVSIndy_prjgroup.tvsconfig new file mode 100644 index 0000000..d430780 --- /dev/null +++ b/Demos/TCP/NetComVSIndy/NetComVSIndy_prjgroup.tvsconfig @@ -0,0 +1,2 @@ + + \ No newline at end of file diff --git a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dpr b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dpr similarity index 94% rename from Demos/NetComVSIndy/Server/NetComVSIndyServer.dpr rename to Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dpr index fc14422..3a60130 100644 --- a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dpr +++ b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dpr @@ -1,14 +1,14 @@ -program NetComVSIndyServer; - -uses - Vcl.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}; - -{$R *.res} - -begin - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program NetComVSIndyServer; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dproj b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dproj similarity index 76% rename from Demos/NetComVSIndy/Server/NetComVSIndyServer.dproj rename to Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dproj index 761da63..7eaa6ff 100644 --- a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dproj +++ b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dproj @@ -1,996 +1,1107 @@ - - - {DB8AA72F-75BF-4D63-A09D-AB194FD815B9} - 18.8 - VCL - NetComVSIndyServer.dpr - True - Release - Win64 - 3 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - NetComVSIndyServer - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - - - true - PerMonitorV2 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- dfm - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - NetComVSIndyServer.dpr - - - - - - NetComVSIndyServer.exe - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - True - - - 12 - - - - - + + + {DB8AA72F-75BF-4D63-A09D-AB194FD815B9} + 20.2 + VCL + NetComVSIndyServer.dpr + True + Release + Win32 + 3 + Application + NetComVSIndyServer + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + NetComVSIndyServer + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + NetComVSIndyServer.dpr + + + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + + True + True + + + 12 + + + + + diff --git a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dproj.local b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dproj.local similarity index 89% rename from Demos/NetComVSIndy/Server/NetComVSIndyServer.dproj.local rename to Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dproj.local index 76c5145..5cefd78 100644 --- a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dproj.local +++ b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dproj.local @@ -1,45 +1,45 @@ - - - - 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas - 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/11 06:48:47.000.137,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/11 06:50:30.000.325,C:\Users\Programmer\Documents\Development\Projects\Unit3.dfm=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.dfm - 2020/08/11 06:50:30.000.325,C:\Users\Programmer\Documents\Development\Projects\Unit3.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas - 2020/08/11 06:50:45.000.950,C:\Users\Programmer\Documents\Development\Projects\Project1.dproj=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\NetComVSIndyServer.dproj - - - - - + + + + 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas + 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/11 06:48:47.000.137,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/11 06:50:30.000.325,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.dfm=C:\Users\Programmer\Documents\Development\Projects\Unit3.dfm + 2020/08/11 06:50:30.000.325,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/11 06:50:45.000.950,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\NetComVSIndyServer.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj + + + + + diff --git a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dsk b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dsk similarity index 94% rename from Demos/NetComVSIndy/Server/NetComVSIndyServer.dsk rename to Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dsk index 0bf34f0..311dc9e 100644 --- a/Demos/NetComVSIndy/Server/NetComVSIndyServer.dsk +++ b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.dsk @@ -1,752 +1,752 @@ -[Closed Files] -File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,319,27,327,0,0,,{1 -File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,58,28,74,0,0,, -File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdIOHandler.pas',0,1,2262,1,2239,0,0,, -File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\NetComRegister.pas',0,1,79,1,95,0,0,, -File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,420,19,436,0,0,, -File_5=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\NetCom7.vrc',0,1,65,1,65,0,0,, -File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\ToolsAPI\DesignEditors.pas',0,1,1,1,1,0,0,, -File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\ToolsAPI\DesignIntf.pas',0,1,1,1,1,0,0,, -File_8=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\ToolsAPI\ToolsAPI.pas',0,1,1,1,11,0,0,, -File_9=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncCommandHandlers.pas',0,1,22,38,37,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas -Count=1 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=1 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas -View0=0 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas -CursorX=25 -CursorY=9 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[PropInspDesignerSelection] -ArrangeBy=Name -SelectedItem=Action, -ExpandedItems=Anchors=0,BorderIcons=0 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-214 -Top=-259 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,319,27,327,0,0,,{1 +File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,58,28,74,0,0,, +File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\Indy10\Core\IdIOHandler.pas',0,1,2262,1,2239,0,0,, +File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\NetComRegister.pas',0,1,79,1,95,0,0,, +File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,420,19,436,0,0,, +File_5=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\NetCom7.vrc',0,1,65,1,65,0,0,, +File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\ToolsAPI\DesignEditors.pas',0,1,1,1,1,0,0,, +File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\ToolsAPI\DesignIntf.pas',0,1,1,1,1,0,0,, +File_8=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\ToolsAPI\ToolsAPI.pas',0,1,1,1,11,0,0,, +File_9=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncCommandHandlers.pas',0,1,22,38,37,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas +Count=1 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=1 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas +View0=0 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pas +CursorX=25 +CursorY=9 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[PropInspDesignerSelection] +ArrangeBy=Name +SelectedItem=Action, +ExpandedItems=Anchors=0,BorderIcons=0 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-214 +Top=-259 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.res b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.res new file mode 100644 index 0000000..a141ec6 Binary files /dev/null and b/Demos/TCP/NetComVSIndy/Server/NetComVSIndyServer.res differ diff --git a/Demos/NetComVSIndy/Server/ufrmMain.dfm b/Demos/TCP/NetComVSIndy/Server/ufrmMain.dfm similarity index 95% rename from Demos/NetComVSIndy/Server/ufrmMain.dfm rename to Demos/TCP/NetComVSIndy/Server/ufrmMain.dfm index 072e13f..3a6b1d0 100644 --- a/Demos/NetComVSIndy/Server/ufrmMain.dfm +++ b/Demos/TCP/NetComVSIndy/Server/ufrmMain.dfm @@ -1,39 +1,39 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'NetCom VS Indy Server' - ClientHeight = 57 - ClientWidth = 601 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - OnCreate = FormCreate - PixelsPerInch = 96 - TextHeight = 13 - object Label1: TLabel - Left = 24 - Top = 24 - Width = 555 - Height = 13 - Caption = - 'Servers activate on creation (except if there was an error). You' + - ' can now run the client while this program is running' - end - object ncServer: TncTCPServer - NoDelay = True - OnReadData = ncServerReadData - Left = 456 - Top = 8 - end - object idServer: TIdTCPServer - Bindings = <> - DefaultPort = 16234 - OnExecute = idServerExecute - Left = 504 - Top = 8 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'NetCom VS Indy Server' + ClientHeight = 57 + ClientWidth = 601 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + OnCreate = FormCreate + PixelsPerInch = 96 + TextHeight = 13 + object Label1: TLabel + Left = 24 + Top = 24 + Width = 555 + Height = 13 + Caption = + 'Servers activate on creation (except if there was an error). You' + + ' can now run the client while this program is running' + end + object ncServer: TncTCPServer + NoDelay = True + OnReadData = ncServerReadData + Left = 456 + Top = 8 + end + object idServer: TIdTCPServer + Bindings = <> + DefaultPort = 16234 + OnExecute = idServerExecute + Left = 504 + Top = 8 + end +end diff --git a/Demos/NetComVSIndy/Server/ufrmMain.pas b/Demos/TCP/NetComVSIndy/Server/ufrmMain.pas similarity index 96% rename from Demos/NetComVSIndy/Server/ufrmMain.pas rename to Demos/TCP/NetComVSIndy/Server/ufrmMain.pas index 95ff4ef..3b60ed0 100644 --- a/Demos/NetComVSIndy/Server/ufrmMain.pas +++ b/Demos/TCP/NetComVSIndy/Server/ufrmMain.pas @@ -1,61 +1,61 @@ -unit ufrmMain; - -interface - -uses - Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, - Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.Winsock2, - IdContext, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdGlobal, - System.Diagnostics, ncLines, ncSockets, Vcl.StdCtrls; - -type - TfrmMain = class(TForm) - ncServer: TncTCPServer; - idServer: TIdTCPServer; - Label1: TLabel; - procedure FormCreate(Sender: TObject); - procedure ncServerReadData(Sender: TObject; aLine: TncLine; - const aBuf: TArray; aBufCount: Integer); - procedure idServerExecute(AContext: TIdContext); - private - { Private declarations } - public - { Public declarations } - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.dfm} - -procedure TfrmMain.FormCreate(Sender: TObject); -begin - ncServer.Active := True; - idServer.Active := True; -end; - -procedure TfrmMain.idServerExecute(AContext: TIdContext); -var - Data: TIdBytes; -begin - // Reply with data received - if not aContext.Connection.IOHandler.InputBufferIsEmpty then - begin - aContext.Connection.IOHandler.InputBuffer.ExtractToBytes(Data); - aContext.Binding.Send(Data); - end; -end; - -procedure TfrmMain.ncServerReadData(Sender: TObject; aLine: TncLine; - const aBuf: TArray; aBufCount: Integer); -var - Data: TBytes; -begin - // Reply with data received - Data := Copy (aBuf, 0, aBufCount); - ncServer.Send(aLine, Data); -end; - -end. +unit ufrmMain; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.Winsock2, + IdContext, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdGlobal, + System.Diagnostics, ncLines, ncSockets, Vcl.StdCtrls; + +type + TfrmMain = class(TForm) + ncServer: TncTCPServer; + idServer: TIdTCPServer; + Label1: TLabel; + procedure FormCreate(Sender: TObject); + procedure ncServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TArray; aBufCount: Integer); + procedure idServerExecute(AContext: TIdContext); + private + { Private declarations } + public + { Public declarations } + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.dfm} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + ncServer.Active := True; + idServer.Active := True; +end; + +procedure TfrmMain.idServerExecute(AContext: TIdContext); +var + Data: TIdBytes; +begin + // Reply with data received + if not aContext.Connection.IOHandler.InputBufferIsEmpty then + begin + aContext.Connection.IOHandler.InputBuffer.ExtractToBytes(Data); + aContext.Binding.Send(Data); + end; +end; + +procedure TfrmMain.ncServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TArray; aBufCount: Integer); +var + Data: TBytes; +begin + // Reply with data received + Data := Copy (aBuf, 0, aBufCount); + ncServer.Send(aLine, Data); +end; + +end. diff --git a/Demos/SimpleSockets/Client.dpr b/Demos/TCP/SimpleSockets/Client/Client.dpr similarity index 94% rename from Demos/SimpleSockets/Client.dpr rename to Demos/TCP/SimpleSockets/Client/Client.dpr index 028c5c1..aa89c08 100644 --- a/Demos/SimpleSockets/Client.dpr +++ b/Demos/TCP/SimpleSockets/Client/Client.dpr @@ -1,17 +1,17 @@ -program Client; - -uses - Vcl.Forms, - ufrmMain in 'ufrmMain.pas' {Form1}; - -{$R *.res} - -begin - {$IFDEF DEBUG} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.CreateForm(TForm1, Form1); - Application.Run; -end. +program Client; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/TCP/SimpleSockets/Client/Client.dproj b/Demos/TCP/SimpleSockets/Client/Client.dproj new file mode 100644 index 0000000..4a0ef54 --- /dev/null +++ b/Demos/TCP/SimpleSockets/Client/Client.dproj @@ -0,0 +1,200 @@ + + + {A7946007-4A7F-492A-BC3D-79264B590A5A} + Client.dpr + True + Debug + Client + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + Client + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + $(BDS)\bin\delphi_PROJECTICON.ico + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + Client.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/TCP/SimpleSockets/Client/Client.identcache b/Demos/TCP/SimpleSockets/Client/Client.identcache new file mode 100644 index 0000000..86daade Binary files /dev/null and b/Demos/TCP/SimpleSockets/Client/Client.identcache differ diff --git a/Demos/TCP/SimpleSockets/Client/Client.res b/Demos/TCP/SimpleSockets/Client/Client.res new file mode 100644 index 0000000..e16426e Binary files /dev/null and b/Demos/TCP/SimpleSockets/Client/Client.res differ diff --git a/Demos/TCP/SimpleSockets/Client/ufrmMain.dcu b/Demos/TCP/SimpleSockets/Client/ufrmMain.dcu new file mode 100644 index 0000000..af14704 Binary files /dev/null and b/Demos/TCP/SimpleSockets/Client/ufrmMain.dcu differ diff --git a/Demos/SimpleSockets/ufrmMain.dfm b/Demos/TCP/SimpleSockets/Client/ufrmMain.dfm similarity index 91% rename from Demos/SimpleSockets/ufrmMain.dfm rename to Demos/TCP/SimpleSockets/Client/ufrmMain.dfm index adf35a8..b7cad98 100644 --- a/Demos/SimpleSockets/ufrmMain.dfm +++ b/Demos/TCP/SimpleSockets/Client/ufrmMain.dfm @@ -1,174 +1,173 @@ -object Form1: TForm1 - Left = 0 - Top = 0 - ActiveControl = edtDataToSend - Caption = 'TCPClient' - ClientHeight = 243 - ClientWidth = 527 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - Position = poScreenCenter - OnDestroy = FormDestroy - PixelsPerInch = 96 - TextHeight = 13 - object memLog: TMemo - AlignWithMargins = True - Left = 5 - Top = 37 - Width = 517 - Height = 169 - Margins.Left = 5 - Margins.Top = 0 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alClient - ReadOnly = True - ScrollBars = ssVertical - TabOrder = 1 - end - object pnlToolbar: TPanel - Left = 0 - Top = 0 - Width = 527 - Height = 37 - Align = alTop - BevelOuter = bvNone - FullRepaint = False - TabOrder = 0 - object btnActivate: TButton - AlignWithMargins = True - Left = 5 - Top = 5 - Width = 105 - Height = 27 - Margins.Left = 5 - Margins.Top = 5 - Margins.Right = 0 - Margins.Bottom = 5 - Align = alLeft - Caption = 'Activate' - TabOrder = 0 - OnClick = btnActivateClick - end - object pnlAddress: TPanel - AlignWithMargins = True - Left = 110 - Top = 3 - Width = 417 - Height = 31 - Margins.Left = 0 - Margins.Right = 0 - Align = alClient - BevelOuter = bvNone - FullRepaint = False - TabOrder = 1 - object edtHost: TEdit - AlignWithMargins = True - Left = 5 - Top = 5 - Width = 281 - Height = 21 - Margins.Left = 5 - Margins.Top = 5 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alClient - TabOrder = 0 - Text = 'LocalHost' - TextHint = 'Enter host address' - OnChange = edtHostChange - end - object edtPort: TSpinEdit - AlignWithMargins = True - Left = 291 - Top = 5 - Width = 121 - Height = 22 - Margins.Left = 0 - Margins.Top = 5 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alRight - MaxValue = 0 - MinValue = 0 - TabOrder = 1 - Value = 16233 - OnChange = edtPortChange - end - end - end - object Panel1: TPanel - Left = 0 - Top = 211 - Width = 527 - Height = 32 - Margins.Left = 5 - Margins.Top = 0 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alBottom - BevelOuter = bvNone - FullRepaint = False - TabOrder = 2 - object btnSendData: TButton - AlignWithMargins = True - Left = 5 - Top = 0 - Width = 105 - Height = 27 - Margins.Left = 5 - Margins.Top = 0 - Margins.Right = 0 - Margins.Bottom = 5 - Align = alLeft - Caption = 'Send' - Default = True - TabOrder = 0 - OnClick = btnSendDataClick - end - object Panel2: TPanel - AlignWithMargins = True - Left = 110 - Top = 3 - Width = 417 - Height = 26 - Margins.Left = 0 - Margins.Right = 0 - Align = alClient - BevelOuter = bvNone - FullRepaint = False - TabOrder = 1 - object edtDataToSend: TEdit - AlignWithMargins = True - Left = 5 - Top = 0 - Width = 407 - Height = 21 - Margins.Left = 5 - Margins.Top = 0 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alClient - TabOrder = 0 - Text = 'This is some text data' - TextHint = 'Enter data to send here' - OnEnter = edtDataToSendEnter - OnExit = edtDataToSendExit - end - end - end - object TCPClient: TncTCPClient - Host = 'localhost' - OnConnected = TCPClientConnected - OnDisconnected = TCPClientDisconnected - OnReadData = TCPClientReadData - OnReconnected = TCPClientReconnected - Left = 92 - Top = 52 - end -end +object Form1: TForm1 + Left = 0 + Top = 0 + ActiveControl = edtDataToSend + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'TCPClient' + ClientHeight = 243 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 169 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start TCP Client' + TabOrder = 0 + OnClick = btnActivateClick + end + object pnlAddress: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtHost: TEdit + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 281 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + TextHint = 'Enter host address' + OnChange = edtHostChange + end + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 291 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 211 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object btnSendData: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send' + Default = True + TabOrder = 0 + OnClick = btnSendDataClick + end + object Panel2: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtDataToSend: TEdit + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 407 + Height = 21 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = 'This is some text data' + TextHint = 'Enter data to send here' + OnEnter = edtDataToSendEnter + OnExit = edtDataToSendExit + end + end + end + object TCPClient: TncTCPClient + OnConnected = TCPClientConnected + OnDisconnected = TCPClientDisconnected + OnReadData = TCPClientReadData + OnReconnected = TCPClientReconnected + Left = 208 + Top = 80 + end +end diff --git a/Demos/TCP/SimpleSockets/Client/ufrmMain.pas b/Demos/TCP/SimpleSockets/Client/ufrmMain.pas new file mode 100644 index 0000000..b032383 --- /dev/null +++ b/Demos/TCP/SimpleSockets/Client/ufrmMain.pas @@ -0,0 +1,234 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, + System.Diagnostics, ncLines, ncSockets; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pnlAddress: TPanel; + edtHost: TEdit; + edtPort: TSpinEdit; + Panel1: TPanel; + btnSendData: TButton; + Panel2: TPanel; + edtDataToSend: TEdit; + TCPClient: TncTCPClient; + procedure btnActivateClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure TCPClientConnected(Sender: TObject; aLine: TncLine); + procedure TCPClientDisconnected(Sender: TObject; aLine: TncLine); + procedure TCPClientReconnected(Sender: TObject; aLine: TncLine); + procedure edtHostChange(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure btnSendDataClick(Sender: TObject); + procedure edtDataToSendEnter(Sender: TObject); + procedure edtDataToSendExit(Sender: TObject); + procedure TCPClientReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormCreate(Sender: TObject); + private + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin +// +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + TCPClient.Active := False; +end; + +// ***************************************************************************** +// Start/Stop Main CLient +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if TCPClient.Active then + begin + // Deactivate the TCP client + TCPClient.Active := False; + btnActivate.Caption := 'Start TCP Client'; + Log('TCP Client Deactivated'); + end + else + begin + // Check if the host field is blank + if Trim(edtHost.Text) = '' then + begin + Log('Host field cannot be blank.'); + Exit; // Exit the procedure if the host field is blank + end; + + try + // Set the host from the text field + TCPClient.Host := edtHost.Text; + + // Activate the TCP client + TCPClient.Port := edtPort.Value; + TCPClient.Active := True; + btnActivate.Caption := 'Stop TCP Client'; + Log('TCP Client Activated'); + except + on E: Exception do + Log('Failed to activate TCP Client: ' + E.Message); + end; + end; +end; + +// ***************************************************************************** +// Change host (server) +// ***************************************************************************** +procedure TForm1.edtHostChange(Sender: TObject); +begin + try + TCPClient.Host := edtHost.Text; + except + edtHost.OnChange := nil; + try + edtHost.Text := TCPClient.Host; + finally + edtHost.OnChange := edtHostChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Change Main Client port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + TCPClient.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := TCPClient.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Data to send +// ***************************************************************************** +procedure TForm1.edtDataToSendEnter(Sender: TObject); +begin + btnSendData.Default := True; +end; + +procedure TForm1.edtDataToSendExit(Sender: TObject); +begin + btnSendData.Default := False; +end; + +procedure TForm1.btnSendDataClick(Sender: TObject); +begin + // Check if the data field is blank + if Trim(edtDataToSend.Text) = '' then + begin + Log('Cannot send - Data field cannot be blank.'); + Exit; // Exit the procedure if the data field is blank + end; + + try + // Send the data + TCPClient.Send(edtDataToSend.Text); + Log('Data sent: ' + edtDataToSend.Text); + except + on E: Exception do + Log('Failed to send data: ' + E.Message); + end; +end; + +// ***************************************************************************** +// TCPClientConnected +// ***************************************************************************** +procedure TForm1.TCPClientConnected(Sender: TObject; aLine: TncLine); +begin + Log('Connected'); + btnActivate.Caption := 'Deactivate'; +end; + +// ***************************************************************************** +// TCPClientDisconnected +// ***************************************************************************** +procedure TForm1.TCPClientDisconnected(Sender: TObject; aLine: TncLine); +begin + Log('Disconnected'); + btnActivate.Caption := 'Activate'; +end; + +// ***************************************************************************** +// TCPClientReconnected +// ***************************************************************************** +procedure TForm1.TCPClientReconnected(Sender: TObject; aLine: TncLine); +begin + Log('Reconnected'); +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.TCPClientReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + BytesReceived: TBytes; +begin + BytesReceived := Copy(aBuf, 0, aBufCount); + + Log('Received: ' + StringOf(BytesReceived)); + +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/TCP/SimpleSockets/Server/Server.dpr b/Demos/TCP/SimpleSockets/Server/Server.dpr new file mode 100644 index 0000000..63d6f38 --- /dev/null +++ b/Demos/TCP/SimpleSockets/Server/Server.dpr @@ -0,0 +1,17 @@ +program Server; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/TCP/SimpleSockets/Server/Server.dproj b/Demos/TCP/SimpleSockets/Server/Server.dproj new file mode 100644 index 0000000..f45ef2f --- /dev/null +++ b/Demos/TCP/SimpleSockets/Server/Server.dproj @@ -0,0 +1,200 @@ + + + {0B2EB3CC-F54E-41A8-A712-8771BC0FC4AD} + Server.dpr + True + Debug + Server + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + Server + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + $(BDS)\bin\delphi_PROJECTICON.ico + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + Server.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/TCP/SimpleSockets/Server/Server.dproj.local b/Demos/TCP/SimpleSockets/Server/Server.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/SimpleSockets/Server/Server.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/SimpleSockets/Server/Server.res b/Demos/TCP/SimpleSockets/Server/Server.res new file mode 100644 index 0000000..ac78dad Binary files /dev/null and b/Demos/TCP/SimpleSockets/Server/Server.res differ diff --git a/Demos/TCP/SimpleSockets/Server/ufrmMain.dcu b/Demos/TCP/SimpleSockets/Server/ufrmMain.dcu new file mode 100644 index 0000000..51543a2 Binary files /dev/null and b/Demos/TCP/SimpleSockets/Server/ufrmMain.dcu differ diff --git a/Demos/SimpleSockets/Srv/ufrmMain.dfm b/Demos/TCP/SimpleSockets/Server/ufrmMain.dfm similarity index 87% rename from Demos/SimpleSockets/Srv/ufrmMain.dfm rename to Demos/TCP/SimpleSockets/Server/ufrmMain.dfm index 0e1ff11..7719392 100644 --- a/Demos/SimpleSockets/Srv/ufrmMain.dfm +++ b/Demos/TCP/SimpleSockets/Server/ufrmMain.dfm @@ -1,113 +1,122 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'TCPServer' - ClientHeight = 243 - ClientWidth = 527 - Color = clBtnFace - Font.Charset = DEFAULT_CHARSET - Font.Color = clWindowText - Font.Height = -11 - Font.Name = 'Tahoma' - Font.Style = [] - OldCreateOrder = False - OnCreate = FormCreate - OnDestroy = FormDestroy - PixelsPerInch = 96 - TextHeight = 13 - object memLog: TMemo - AlignWithMargins = True - Left = 5 - Top = 37 - Width = 517 - Height = 201 - Margins.Left = 5 - Margins.Top = 0 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alClient - ReadOnly = True - ScrollBars = ssVertical - TabOrder = 0 - end - object pnlToolbar: TPanel - Left = 0 - Top = 0 - Width = 527 - Height = 37 - Align = alTop - BevelOuter = bvNone - FullRepaint = False - TabOrder = 1 - object btnActivate: TButton - AlignWithMargins = True - Left = 5 - Top = 5 - Width = 105 - Height = 27 - Margins.Left = 5 - Margins.Top = 5 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alLeft - Caption = 'Activate' - TabOrder = 0 - OnClick = btnActivateClick - end - object pblPort: TPanel - AlignWithMargins = True - Left = 115 - Top = 3 - Width = 412 - Height = 31 - Margins.Left = 0 - Margins.Right = 0 - Align = alClient - BevelOuter = bvNone - FullRepaint = False - TabOrder = 1 - ExplicitLeft = 110 - ExplicitWidth = 417 - object edtPort: TSpinEdit - AlignWithMargins = True - Left = 0 - Top = 5 - Width = 121 - Height = 22 - Margins.Left = 0 - Margins.Top = 5 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alLeft - MaxValue = 0 - MinValue = 0 - TabOrder = 0 - Value = 16233 - OnChange = edtPortChange - ExplicitLeft = 291 - end - object btnShutdownAllClients: TButton - AlignWithMargins = True - Left = 256 - Top = 5 - Width = 151 - Height = 21 - Margins.Left = 5 - Margins.Top = 5 - Margins.Right = 5 - Margins.Bottom = 5 - Align = alRight - Caption = 'Shutdown all clients' - TabOrder = 1 - OnClick = btnShutdownAllClientsClick - end - end - end - object TCPServer: TncTCPServer - OnConnected = TCPServerConnected - OnDisconnected = TCPServerDisconnected - OnReadData = TCPServerReadData - Left = 92 - Top = 52 - end -end +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'TCPServer' + ClientHeight = 243 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 182 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Activate' + TabOrder = 0 + OnClick = btnActivateClick + end + object pblPort: TPanel + AlignWithMargins = True + Left = 115 + Top = 3 + Width = 412 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 0 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 16233 + OnChange = edtPortChange + end + object btnShutdownAllClients: TButton + AlignWithMargins = True + Left = 256 + Top = 5 + Width = 151 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + Caption = 'Shutdown all clients' + TabOrder = 1 + OnClick = btnShutdownAllClientsClick + end + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 224 + Width = 527 + Height = 19 + Panels = < + item + Text = 'Connections: 0' + Width = 150 + end> + end + object TCPServer: TncTCPServer + OnConnected = TCPServerConnected + OnDisconnected = TCPServerDisconnected + OnReadData = TCPServerReadData + Left = 92 + Top = 52 + end +end diff --git a/Demos/TCP/SimpleSockets/Server/ufrmMain.pas b/Demos/TCP/SimpleSockets/Server/ufrmMain.pas new file mode 100644 index 0000000..036aaa5 --- /dev/null +++ b/Demos/TCP/SimpleSockets/Server/ufrmMain.pas @@ -0,0 +1,197 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, Vcl.ComCtrls, + System.Diagnostics, ncLines, ncSocketList, ncSockets; + +type + TForm1 = class(TForm) + memLog: TMemo; + TCPServer: TncTCPServer; + pnlToolbar: TPanel; + btnActivate: TButton; + pblPort: TPanel; + edtPort: TSpinEdit; + btnShutdownAllClients: TButton; + StatusBar1: TStatusBar; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure TCPServerConnected(Sender: TObject; aLine: TncLine); + procedure TCPServerDisconnected(Sender: TObject; aLine: TncLine); + procedure btnActivateClick(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure btnShutdownAllClientsClick(Sender: TObject); + procedure TCPServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + private + FConnectionCount: Integer; + procedure UpdateConnectionCount; + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + FConnectionCount := 0; + UpdateConnectionCount; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + TCPServer.Active := False; +end; + +// ***************************************************************************** +// Start/Stop Main Server +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if TCPServer.Active then + begin + // Deactivate the TCP Server + TCPServer.Active := False; + btnActivate.Caption := 'Start TCP Server'; + Log('TCP Server Deactivated'); + end + else + begin + try + // Activate the TCP Server + TCPServer.Port := edtPort.Value; + TCPServer.Active := True; + btnActivate.Caption := 'Stop TCP Server'; + Log('TCP Server Activated at port: ' + IntToStr(TCPServer.Port)); + + except + on E: Exception do + Log('Failed to activate TCP Server: ' + E.Message); + end; + end; +end; + +// ***************************************************************************** +// Change Main Client port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + TCPServer.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := TCPServer.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Shutdown all Clients +// ***************************************************************************** +procedure TForm1.btnShutdownAllClientsClick(Sender: TObject); +var + SocketList: TSocketList; + i: Integer; +begin + SocketList := TCPServer.Lines.LockList; + try + for i := 0 to SocketList.Count - 1 do + TCPServer.ShutDownLine(SocketList.Lines[i]); + finally + TCPServer.Lines.UnlockList; + end; +end; + +procedure TForm1.UpdateConnectionCount; +begin + StatusBar1.Panels[0].Text := 'Connections: ' + IntToStr(FConnectionCount); +end; + +// ***************************************************************************** +// TCPServerConnected +// ***************************************************************************** +procedure TForm1.TCPServerConnected(Sender: TObject; aLine: TncLine); +begin + Inc(FConnectionCount); + UpdateConnectionCount; + + Log('Connected: ' + aLine.PeerIP); + + TCPServer.Send(aLine, BytesOf('Hello mr. ' + IntToStr(aLine.Handle))); +end; + +// ***************************************************************************** +// TCPServerDisconnected +// ***************************************************************************** +procedure TForm1.TCPServerDisconnected(Sender: TObject; aLine: TncLine); +begin + Dec(FConnectionCount); + UpdateConnectionCount; + + Log('Disconnected: ' + aLine.PeerIP); + +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.TCPServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + BytesReceived: TBytes; +begin + BytesReceived := Copy(aBuf, 0, aBufCount); + + Log('Received: "' + StringOf(BytesReceived) + '" from: ' + aLine.PeerIP); + + // Send back the buffer received + TCPServer.Send(aLine, BytesReceived); + + Log('Data sent: ' + StringOf(BytesReceived)); + +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/TCP/SimpleSockets/SimpleSockets.groupproj b/Demos/TCP/SimpleSockets/SimpleSockets.groupproj new file mode 100644 index 0000000..3122a45 --- /dev/null +++ b/Demos/TCP/SimpleSockets/SimpleSockets.groupproj @@ -0,0 +1,48 @@ + + + {A9A55D39-6A58-48E9-AA5F-4DED5B38E8A8} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Demos/TCP/SimpleSockets/SimpleSockets.groupproj.local b/Demos/TCP/SimpleSockets/SimpleSockets.groupproj.local new file mode 100644 index 0000000..e31bd9b --- /dev/null +++ b/Demos/TCP/SimpleSockets/SimpleSockets.groupproj.local @@ -0,0 +1,7 @@ + + + + + + + diff --git a/Demos/TCP/SimpleSockets/SimpleSockets_TCPv4.PNG b/Demos/TCP/SimpleSockets/SimpleSockets_TCPv4.PNG new file mode 100644 index 0000000..95f8d5d Binary files /dev/null and b/Demos/TCP/SimpleSockets/SimpleSockets_TCPv4.PNG differ diff --git a/Demos/TCP/SimpleSockets/SimpleSockets_TCPv6.PNG b/Demos/TCP/SimpleSockets/SimpleSockets_TCPv6.PNG new file mode 100644 index 0000000..9549054 Binary files /dev/null and b/Demos/TCP/SimpleSockets/SimpleSockets_TCPv6.PNG differ diff --git a/Demos/TCP/SimpleSockets/SimpleSockets_prjgroup.tvsconfig b/Demos/TCP/SimpleSockets/SimpleSockets_prjgroup.tvsconfig new file mode 100644 index 0000000..d430780 --- /dev/null +++ b/Demos/TCP/SimpleSockets/SimpleSockets_prjgroup.tvsconfig @@ -0,0 +1,2 @@ + + \ No newline at end of file diff --git a/Demos/TCP/SimpleSockets_TLS/Client/Client.dpr b/Demos/TCP/SimpleSockets_TLS/Client/Client.dpr new file mode 100644 index 0000000..8992c4c --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Client/Client.dpr @@ -0,0 +1,19 @@ +program Client; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + + diff --git a/Demos/TCP/SimpleSockets_TLS/Client/Client.dproj b/Demos/TCP/SimpleSockets_TLS/Client/Client.dproj new file mode 100644 index 0000000..5b50ed4 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Client/Client.dproj @@ -0,0 +1,262 @@ + + + {A7946007-4A7F-492A-BC3D-79264B590A5A} + Client.dpr + True + Debug + Client + 3 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + Client + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + RELEASE;$(DCC_Define) + false + 0 + true + 3 + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + 3 + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + $(BDS)\bin\delphi_PROJECTICON.ico + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + Client.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + False + False + False + False + False + False + True + True + + + 12 + + + + diff --git a/Demos/TCP/SimpleSockets_TLS/Client/Client.dproj.local b/Demos/TCP/SimpleSockets_TLS/Client/Client.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Client/Client.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/SimpleSockets_TLS/Client/Client.drc b/Demos/TCP/SimpleSockets_TLS/Client/Client.drc new file mode 100644 index 0000000..1a550dd --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Client/Client.drc @@ -0,0 +1,773 @@ +/* VER360 + Generated by the Embarcadero Delphi Pascal Compiler + because -GD or --drc was supplied to the compiler. + + This file contains compiler-generated resources that + were bound to the executable. + If this file is empty, then no compiler-generated + resources were bound to the produced executable. +*/ + +#define System_Win_ComConst_SVarNotObject 65152 +#define System_Win_ComConst_STooManyParams 65153 +#define ncSockets_ECannotSetPortWhileConnectionIsActiveStr 65154 +#define ncSockets_ECannotSetHostWhileConnectionIsActiveStr 65155 +#define ncSockets_ECannotSendWhileSocketInactiveStr 65156 +#define ncSockets_ECannotSetUseReaderThreadWhileActiveStr 65157 +#define ncSockets_ECannotSetFamilyWhileConnectionIsActiveStr 65158 +#define ncSockets_EOpenSSLNotAvailableStr 65159 +#define Vcl_Consts_SStyleRegisterError 65168 +#define Vcl_Consts_SStyleClassRegisterError 65169 +#define Vcl_Consts_SStyleNotFound 65170 +#define Vcl_Consts_SStyleClassNotFound 65171 +#define Vcl_Consts_SStyleInvalidHandle 65172 +#define Vcl_Consts_SStyleFormatError 65173 +#define Vcl_Consts_SStyleHookClassRegistered 65174 +#define Vcl_Consts_SStyleHookClassNotRegistered 65175 +#define Vcl_Consts_SStyleInvalidParameter 65176 +#define Vcl_Consts_SStyleFeatureNotSupported 65177 +#define Vcl_Consts_SStyleNotRegistered 65178 +#define Vcl_Consts_SStyleUnregisterError 65179 +#define Vcl_Consts_SStyleNotRegisteredNoName 65180 +#define Vcl_Consts_sBeginInvokeNoHandle 65181 +#define System_Win_ComConst_SOleError 65182 +#define System_Win_ComConst_SNoMethod 65183 +#define Vcl_Consts_SDockZoneNotFound 65184 +#define Vcl_Consts_SDockZoneHasNoCtl 65185 +#define Vcl_Consts_SDockZoneVersionConflict 65186 +#define Vcl_Consts_SPromptArrayTooShort 65187 +#define Vcl_Consts_SPromptArrayEmpty 65188 +#define Vcl_Consts_SUsername 65189 +#define Vcl_Consts_SPassword 65190 +#define Vcl_Consts_SDomain 65191 +#define Vcl_Consts_SLogin 65192 +#define Vcl_Consts_STrayIconRemoveError 65193 +#define Vcl_Consts_SWindowsVistaRequired 65194 +#define Vcl_Consts_STaskDlgButtonCaption 65195 +#define Vcl_Consts_STaskDlgRadioButtonCaption 65196 +#define Vcl_Consts_SInvalidTaskDlgButtonCaption 65197 +#define Vcl_Consts_SStyleLoadError 65198 +#define Vcl_Consts_SStyleLoadErrors 65199 +#define Vcl_Consts_SmkcDown 65200 +#define Vcl_Consts_SmkcIns 65201 +#define Vcl_Consts_SmkcDel 65202 +#define Vcl_Consts_SmkcShift 65203 +#define Vcl_Consts_SmkcCtrl 65204 +#define Vcl_Consts_SmkcAlt 65205 +#define Vcl_Consts_SOutOfRange 65206 +#define Vcl_Consts_sAllFilter 65207 +#define Vcl_Consts_SIconToClipboard 65208 +#define Vcl_Consts_SCannotOpenClipboard 65209 +#define Vcl_Consts_SInvalidMemoSize 65210 +#define Vcl_Consts_SInvalidPrinterOp 65211 +#define Vcl_Consts_SNoDefaultPrinter 65212 +#define Vcl_Consts_SDuplicateMenus 65213 +#define Vcl_Consts_SDockedCtlNeedsName 65214 +#define Vcl_Consts_SDockTreeRemoveError 65215 +#define Vcl_Consts_SMsgDlgAll 65216 +#define Vcl_Consts_SMsgDlgNoToAll 65217 +#define Vcl_Consts_SMsgDlgYesToAll 65218 +#define Vcl_Consts_SMsgDlgClose 65219 +#define Vcl_Consts_SmkcBkSp 65220 +#define Vcl_Consts_SmkcTab 65221 +#define Vcl_Consts_SmkcEsc 65222 +#define Vcl_Consts_SmkcEnter 65223 +#define Vcl_Consts_SmkcSpace 65224 +#define Vcl_Consts_SmkcPgUp 65225 +#define Vcl_Consts_SmkcPgDn 65226 +#define Vcl_Consts_SmkcEnd 65227 +#define Vcl_Consts_SmkcHome 65228 +#define Vcl_Consts_SmkcLeft 65229 +#define Vcl_Consts_SmkcUp 65230 +#define Vcl_Consts_SmkcRight 65231 +#define Vcl_Consts_SVEnhMetafiles 65232 +#define Vcl_Consts_SVIcons 65233 +#define Vcl_Consts_SVBitmaps 65234 +#define Vcl_Consts_SVTIFFImages 65235 +#define Vcl_Consts_SMsgDlgWarning 65236 +#define Vcl_Consts_SMsgDlgError 65237 +#define Vcl_Consts_SMsgDlgInformation 65238 +#define Vcl_Consts_SMsgDlgConfirm 65239 +#define Vcl_Consts_SMsgDlgYes 65240 +#define Vcl_Consts_SMsgDlgNo 65241 +#define Vcl_Consts_SMsgDlgOK 65242 +#define Vcl_Consts_SMsgDlgCancel 65243 +#define Vcl_Consts_SMsgDlgHelp 65244 +#define Vcl_Consts_SMsgDlgAbort 65245 +#define Vcl_Consts_SMsgDlgRetry 65246 +#define Vcl_Consts_SMsgDlgIgnore 65247 +#define Vcl_Consts_SNoMDIForm 65248 +#define Vcl_Consts_SImageCanvasNeedsBitmap 65249 +#define Vcl_Consts_SControlParentSetToSelf 65250 +#define Vcl_Consts_SControlNonMainThreadUsage 65251 +#define Vcl_Consts_SOKButton 65252 +#define Vcl_Consts_SCancelButton 65253 +#define Vcl_Consts_SYesButton 65254 +#define Vcl_Consts_SNoButton 65255 +#define Vcl_Consts_SHelpButton 65256 +#define Vcl_Consts_SCloseButton 65257 +#define Vcl_Consts_SIgnoreButton 65258 +#define Vcl_Consts_SRetryButton 65259 +#define Vcl_Consts_SAbortButton 65260 +#define Vcl_Consts_SAllButton 65261 +#define Vcl_Consts_SCannotDragForm 65262 +#define Vcl_Consts_SVMetafiles 65263 +#define Vcl_Consts_SParentGivenNotAParent 65264 +#define Vcl_Consts_SMDIChildNotVisible 65265 +#define Vcl_Consts_SVisibleChanged 65266 +#define Vcl_Consts_SCannotShowModal 65267 +#define Vcl_Consts_SScrollBarRange 65268 +#define Vcl_Consts_SPropertyOutOfRange 65269 +#define Vcl_Consts_SMenuIndexError 65270 +#define Vcl_Consts_SMenuReinserted 65271 +#define Vcl_Consts_SMenuNotFound 65272 +#define Vcl_Consts_SNoTimers 65273 +#define Vcl_Consts_SNotPrinting 65274 +#define Vcl_Consts_SPrinting 65275 +#define Vcl_Consts_SPrinterIndexError 65276 +#define Vcl_Consts_SInvalidPrinter 65277 +#define Vcl_Consts_SDeviceOnPort 65278 +#define Vcl_Consts_SGroupIndexTooLow 65279 +#define Vcl_Consts_SOutOfResources 65280 +#define Vcl_Consts_SNoCanvasHandle 65281 +#define Vcl_Consts_SInvalidTextFormatFlag 65282 +#define Vcl_Consts_SInvalidFrameIndex 65283 +#define Vcl_Consts_SInvalidImageSize 65284 +#define Vcl_Consts_SInvalidImageList 65285 +#define Vcl_Consts_SReplaceImage 65286 +#define Vcl_Consts_SInsertImage 65287 +#define Vcl_Consts_SImageIndexError 65288 +#define Vcl_Consts_SImageReadFail 65289 +#define Vcl_Consts_SImageWriteFail 65290 +#define Vcl_Consts_SWindowDCError 65291 +#define Vcl_Consts_SWindowClass 65292 +#define Vcl_Consts_SCannotFocus 65293 +#define Vcl_Consts_SParentRequired 65294 +#define Vcl_Consts_SControlPath 65295 +#define System_RTLConsts_sObserverNoSinglecastFound 65296 +#define System_RTLConsts_sObserverNoMulticastFound 65297 +#define System_RTLConsts_sObserverNotAvailable 65298 +#define System_RTLConsts_sMustWaitOnOneEvent 65299 +#define System_RTLConsts_sBeginInvokeDestroying 65300 +#define Vcl_Consts_SInvalidBitmap 65301 +#define Vcl_Consts_SInvalidIcon 65302 +#define Vcl_Consts_SInvalidMetafile 65303 +#define Vcl_Consts_SInvalidPixelFormat 65304 +#define Vcl_Consts_SInvalidImage 65305 +#define Vcl_Consts_SScanLine 65306 +#define Vcl_Consts_SChangeIconSize 65307 +#define Vcl_Consts_SChangeWicSize 65308 +#define Vcl_Consts_SUnknownExtension 65309 +#define Vcl_Consts_SUnknownClipboardFormat 65310 +#define Vcl_Consts_SUnknownStreamFormat 65311 +#define System_RTLConsts_SWindowsXP 65312 +#define System_RTLConsts_SWindowsServer2003 65313 +#define System_RTLConsts_SWindowsServer2003R2 65314 +#define System_RTLConsts_SWindowsServer2012 65315 +#define System_RTLConsts_SWindowsServer2012R2 65316 +#define System_RTLConsts_SWindowsServer2016 65317 +#define System_RTLConsts_SWindowsServer2019 65318 +#define System_RTLConsts_SWindowsServer2022 65319 +#define System_RTLConsts_SWindows8 65320 +#define System_RTLConsts_SWindows8Point1 65321 +#define System_RTLConsts_SWindows10 65322 +#define System_RTLConsts_SWindows11 65323 +#define System_RTLConsts_SWinRTInstanceError 65324 +#define System_RTLConsts_sObserverUnsupported 65325 +#define System_RTLConsts_sObserverMultipleSingleCast 65326 +#define System_RTLConsts_sObserverNoInterface 65327 +#define System_RTLConsts_SNonPublicType 65328 +#define System_RTLConsts_SByRefArgMismatch 65329 +#define System_RTLConsts_SPropIsReadOnly 65330 +#define System_RTLConsts_SPropIsWriteOnly 65331 +#define System_RTLConsts_SInvalidRttiDestroy 65332 +#define System_RTLConsts_SServiceNotFound 65333 +#define System_RTLConsts_SVersionStr 65334 +#define System_RTLConsts_SSPVersionStr 65335 +#define System_RTLConsts_SVersion32 65336 +#define System_RTLConsts_SVersion64 65337 +#define System_RTLConsts_SWindows 65338 +#define System_RTLConsts_SWindowsVista 65339 +#define System_RTLConsts_SWindowsServer2008 65340 +#define System_RTLConsts_SWindows7 65341 +#define System_RTLConsts_SWindowsServer2008R2 65342 +#define System_RTLConsts_SWindows2000 65343 +#define System_RTLConsts_sCannotNegateTimespan 65344 +#define System_RTLConsts_sInvalidTimespanFormat 65345 +#define System_RTLConsts_sTimespanElementTooLong 65346 +#define System_RTLConsts_SNoContext 65347 +#define System_RTLConsts_SNoContextFound 65348 +#define System_RTLConsts_SNoIndex 65349 +#define System_RTLConsts_SNoSearch 65350 +#define System_RTLConsts_SNoTableOfContents 65351 +#define System_RTLConsts_SNoTopics 65352 +#define System_RTLConsts_SNothingFound 65353 +#define System_RTLConsts_SArgumentOutOfRange 65354 +#define System_RTLConsts_SArgumentNil 65355 +#define System_RTLConsts_SGenericItemNotFound 65356 +#define System_RTLConsts_SGenericDuplicateItem 65357 +#define System_RTLConsts_SInsufficientRtti 65358 +#define System_RTLConsts_SParameterCountMismatch 65359 +#define System_RTLConsts_SThreadExternalCheckTerminated 65360 +#define System_RTLConsts_SThreadExternalSetReturnValue 65361 +#define System_RTLConsts_SParamIsNil 65362 +#define System_RTLConsts_SParamIsNegative 65363 +#define System_RTLConsts_SInputBufferExceed 65364 +#define System_RTLConsts_SInvalidCharsInPath 65365 +#define System_RTLConsts_hNoFilterViewer 65366 +#define System_RTLConsts_sArgumentInvalid 65367 +#define System_RTLConsts_sInvalidStringAndObjectArrays 65368 +#define System_RTLConsts_sSameArrays 65369 +#define System_RTLConsts_sNoConstruct 65370 +#define System_RTLConsts_sInvalidTimeoutValue 65371 +#define System_RTLConsts_sSpinCountOutOfRange 65372 +#define System_RTLConsts_sTimespanTooLong 65373 +#define System_RTLConsts_sInvalidTimespanDuration 65374 +#define System_RTLConsts_sTimespanValueCannotBeNan 65375 +#define System_RTLConsts_SReadError 65376 +#define System_RTLConsts_SReadOnlyProperty 65377 +#define System_RTLConsts_SRegCreateFailed 65378 +#define System_RTLConsts_SRegGetDataFailed 65379 +#define System_RTLConsts_SRegSetDataFailed 65380 +#define System_RTLConsts_SResNotFound 65381 +#define System_RTLConsts_SSeekNotImplemented 65382 +#define System_RTLConsts_SSortedListError 65383 +#define System_RTLConsts_SUnknownGroup 65384 +#define System_RTLConsts_SUnknownProperty 65385 +#define System_RTLConsts_SWriteError 65386 +#define System_RTLConsts_SThreadCreateError 65387 +#define System_RTLConsts_SThreadError 65388 +#define System_RTLConsts_SThreadExternalTerminate 65389 +#define System_RTLConsts_SThreadExternalWait 65390 +#define System_RTLConsts_SThreadStartError 65391 +#define System_RTLConsts_SFCreateErrorEx 65392 +#define System_RTLConsts_SFOpenErrorEx 65393 +#define System_RTLConsts_SInvalidImage 65394 +#define System_RTLConsts_SInvalidName 65395 +#define System_RTLConsts_SInvalidProperty 65396 +#define System_RTLConsts_SInvalidPropertyPath 65397 +#define System_RTLConsts_SInvalidPropertyValue 65398 +#define System_RTLConsts_SInvalidRegType 65399 +#define System_RTLConsts_SListCapacityError 65400 +#define System_RTLConsts_SListCountError 65401 +#define System_RTLConsts_SListIndexError 65402 +#define System_RTLConsts_SListIndexErrorRangeReason 65403 +#define System_RTLConsts_SListIndexErrorEmptyReason 65404 +#define System_RTLConsts_SMemoryStreamError 65405 +#define System_RTLConsts_SNoComSupport 65406 +#define System_RTLConsts_SPropertyException 65407 +#define System_SysConst_SInvalidCharCount 65408 +#define System_SysConst_SInvalidDestinationIndex 65409 +#define System_SysConst_SInvalidCodePage 65410 +#define System_SysConst_SInvalidEncodingName 65411 +#define System_SysConst_SNoMappingForUnicodeCharacter 65412 +#define System_SysConst_SInvalidStringBaseIndex 65413 +#define System_RTLConsts_SAncestorNotFound 65414 +#define System_RTLConsts_SAssignError 65415 +#define System_RTLConsts_SBitsIndexError 65416 +#define System_RTLConsts_SCantWriteResourceStreamError 65417 +#define System_RTLConsts_SCheckSynchronizeError 65418 +#define System_RTLConsts_SClassNotFound 65419 +#define System_RTLConsts_SDuplicateClass 65420 +#define System_RTLConsts_SDuplicateItem 65421 +#define System_RTLConsts_SDuplicateName 65422 +#define System_RTLConsts_SDuplicateString 65423 +#define System_SysConst_SShortDayNameTue 65424 +#define System_SysConst_SShortDayNameWed 65425 +#define System_SysConst_SShortDayNameThu 65426 +#define System_SysConst_SShortDayNameFri 65427 +#define System_SysConst_SShortDayNameSat 65428 +#define System_SysConst_SLongDayNameSun 65429 +#define System_SysConst_SLongDayNameMon 65430 +#define System_SysConst_SLongDayNameTue 65431 +#define System_SysConst_SLongDayNameWed 65432 +#define System_SysConst_SLongDayNameThu 65433 +#define System_SysConst_SLongDayNameFri 65434 +#define System_SysConst_SLongDayNameSat 65435 +#define System_SysConst_SInvalidSourceArray 65436 +#define System_SysConst_SInvalidDestinationArray 65437 +#define System_SysConst_SCharIndexOutOfBounds 65438 +#define System_SysConst_SByteIndexOutOfBounds 65439 +#define System_SysConst_SShortMonthNameNov 65440 +#define System_SysConst_SShortMonthNameDec 65441 +#define System_SysConst_SLongMonthNameJan 65442 +#define System_SysConst_SLongMonthNameFeb 65443 +#define System_SysConst_SLongMonthNameMar 65444 +#define System_SysConst_SLongMonthNameApr 65445 +#define System_SysConst_SLongMonthNameMay 65446 +#define System_SysConst_SLongMonthNameJun 65447 +#define System_SysConst_SLongMonthNameJul 65448 +#define System_SysConst_SLongMonthNameAug 65449 +#define System_SysConst_SLongMonthNameSep 65450 +#define System_SysConst_SLongMonthNameOct 65451 +#define System_SysConst_SLongMonthNameNov 65452 +#define System_SysConst_SLongMonthNameDec 65453 +#define System_SysConst_SShortDayNameSun 65454 +#define System_SysConst_SShortDayNameMon 65455 +#define System_SysConst_SObjectDisposed 65456 +#define System_SysConst_SAssertError 65457 +#define System_SysConst_SAbstractError 65458 +#define System_SysConst_SModuleAccessViolation 65459 +#define System_SysConst_SOSError 65460 +#define System_SysConst_SUnkOSError 65461 +#define System_SysConst_SShortMonthNameJan 65462 +#define System_SysConst_SShortMonthNameFeb 65463 +#define System_SysConst_SShortMonthNameMar 65464 +#define System_SysConst_SShortMonthNameApr 65465 +#define System_SysConst_SShortMonthNameMay 65466 +#define System_SysConst_SShortMonthNameJun 65467 +#define System_SysConst_SShortMonthNameJul 65468 +#define System_SysConst_SShortMonthNameAug 65469 +#define System_SysConst_SShortMonthNameSep 65470 +#define System_SysConst_SShortMonthNameOct 65471 +#define System_SysConst_SVarTypeNotUsableWithPrefix 65472 +#define System_SysConst_SVarTypeTooManyCustom 65473 +#define System_SysConst_SVarTypeCouldNotConvert 65474 +#define System_SysConst_SVarTypeConvertOverflow 65475 +#define System_SysConst_SVarOverflow 65476 +#define System_SysConst_SVarInvalid 65477 +#define System_SysConst_SVarBadType 65478 +#define System_SysConst_SVarNotImplemented 65479 +#define System_SysConst_SVarUnexpected 65480 +#define System_SysConst_SExternalException 65481 +#define System_SysConst_SAssertionFailed 65482 +#define System_SysConst_SIntfCastError 65483 +#define System_SysConst_SSafecallException 65484 +#define System_SysConst_SMonitorLockException 65485 +#define System_SysConst_SNoMonitorSupportException 65486 +#define System_SysConst_SNotImplemented 65487 +#define System_SysConst_SInvalidFormat 65488 +#define System_SysConst_SArgumentMissing 65489 +#define System_SysConst_SDispatchError 65490 +#define System_SysConst_SReadAccess 65491 +#define System_SysConst_SWriteAccess 65492 +#define System_SysConst_SExecuteAccess 65493 +#define System_SysConst_SInvalidAccess 65494 +#define System_SysConst_SVarArrayCreate 65495 +#define System_SysConst_SVarArrayBounds 65496 +#define System_SysConst_SVarArrayLocked 65497 +#define System_SysConst_SInvalidVarCast 65498 +#define System_SysConst_SInvalidVarOp 65499 +#define System_SysConst_SInvalidVarNullOp 65500 +#define System_SysConst_SInvalidVarOpWithHResultWithPrefix 65501 +#define System_SysConst_SVarTypeOutOfRangeWithPrefix 65502 +#define System_SysConst_SVarTypeAlreadyUsedWithPrefix 65503 +#define System_SysConst_SRangeError 65504 +#define System_SysConst_SIntOverflow 65505 +#define System_SysConst_SInvalidOp 65506 +#define System_SysConst_SZeroDivide 65507 +#define System_SysConst_SOverflow 65508 +#define System_SysConst_SUnderflow 65509 +#define System_SysConst_SInvalidPointer 65510 +#define System_SysConst_SInvalidCast 65511 +#define System_SysConst_SAccessViolationArg3 65512 +#define System_SysConst_SAccessViolationNoArg 65513 +#define System_SysConst_SStackOverflow 65514 +#define System_SysConst_SControlC 65515 +#define System_SysConst_SPrivilege 65516 +#define System_SysConst_SOperationAborted 65517 +#define System_SysConst_SException 65518 +#define System_SysConst_SExceptTitle 65519 +#define System_SysConst_SUnknown 65520 +#define System_SysConst_SInvalidInteger 65521 +#define System_SysConst_SInvalidTimeStamp 65522 +#define System_SysConst_SInvalidGUID 65523 +#define System_SysConst_STimeEncodeError 65524 +#define System_SysConst_SDateEncodeError 65525 +#define System_SysConst_SOutOfMemory 65526 +#define System_SysConst_SInOutError 65527 +#define System_SysConst_SFileNotFound 65528 +#define System_SysConst_SInvalidUnknownFilename 65529 +#define System_SysConst_STooManyOpenFiles 65530 +#define System_SysConst_SAccessDenied 65531 +#define System_SysConst_SEndOfFile 65532 +#define System_SysConst_SDiskFull 65533 +#define System_SysConst_SInvalidInput 65534 +#define System_SysConst_SDivByZero 65535 +STRINGTABLE +BEGIN + System_Win_ComConst_SVarNotObject, L"Variant does not reference an automation object" + System_Win_ComConst_STooManyParams, L"Dispatch methods do not support more than 64 parameters" + ncSockets_ECannotSetPortWhileConnectionIsActiveStr, L"Cannot set Port property whilst the connection is active" + ncSockets_ECannotSetHostWhileConnectionIsActiveStr, L"Cannot set Host property whilst the connection is active" + ncSockets_ECannotSendWhileSocketInactiveStr, L"Cannot send data while socket is inactive" + ncSockets_ECannotSetUseReaderThreadWhileActiveStr, L"Cannot set UseReaderThread property whilst the connection is active" + ncSockets_ECannotSetFamilyWhileConnectionIsActiveStr, L"Cannot set Family property whilst the connection is active" + ncSockets_EOpenSSLNotAvailableStr, L"OpenSSL libraries not available" + Vcl_Consts_SStyleRegisterError, L"Style '%s' already registered" + Vcl_Consts_SStyleClassRegisterError, L"Style class '%s' already registered" + Vcl_Consts_SStyleNotFound, L"Style '%s' not found" + Vcl_Consts_SStyleClassNotFound, L"Style class '%s' not found" + Vcl_Consts_SStyleInvalidHandle, L"Invalid style handle" + Vcl_Consts_SStyleFormatError, L"Invalid style format" + Vcl_Consts_SStyleHookClassRegistered, L"Class '%s' is already registered for '%s'" + Vcl_Consts_SStyleHookClassNotRegistered, L"Class '%s' is not registered for '%s'" + Vcl_Consts_SStyleInvalidParameter, L"%s parameter cannot be nil" + Vcl_Consts_SStyleFeatureNotSupported, L"Feature not supported by this style" + Vcl_Consts_SStyleNotRegistered, L"Style '%s' is not registered" + Vcl_Consts_SStyleUnregisterError, L"Cannot unregister the system style" + Vcl_Consts_SStyleNotRegisteredNoName, L"Style not registered" + Vcl_Consts_sBeginInvokeNoHandle, L"Cannot call BeginInvoke on a control with no parent or window handle" + System_Win_ComConst_SOleError, L"OLE error %.8x" + System_Win_ComConst_SNoMethod, L"Method '%s' not supported by automation object" + Vcl_Consts_SDockZoneNotFound, L" - Dock zone not found" + Vcl_Consts_SDockZoneHasNoCtl, L" - Dock zone has no control" + Vcl_Consts_SDockZoneVersionConflict, L"Error loading dock zone from the stream. Expecting version %d, but found %d." + Vcl_Consts_SPromptArrayTooShort, L"Length of value array must be >= length of prompt array" + Vcl_Consts_SPromptArrayEmpty, L"Prompt array must not be empty" + Vcl_Consts_SUsername, L"&Username" + Vcl_Consts_SPassword, L"&Password" + Vcl_Consts_SDomain, L"&Domain" + Vcl_Consts_SLogin, L"Login" + Vcl_Consts_STrayIconRemoveError, L"Cannot remove shell notification icon" + Vcl_Consts_SWindowsVistaRequired, L"%s requires Windows Vista or later" + Vcl_Consts_STaskDlgButtonCaption, L"Button%d" + Vcl_Consts_STaskDlgRadioButtonCaption, L"RadioButton%d" + Vcl_Consts_SInvalidTaskDlgButtonCaption, L"Caption cannot be empty" + Vcl_Consts_SStyleLoadError, L"Unable to load style '%s'" + Vcl_Consts_SStyleLoadErrors, L"Unable to load styles: %s" + Vcl_Consts_SmkcDown, L"Down" + Vcl_Consts_SmkcIns, L"Ins" + Vcl_Consts_SmkcDel, L"Del" + Vcl_Consts_SmkcShift, L"Shift+" + Vcl_Consts_SmkcCtrl, L"Ctrl+" + Vcl_Consts_SmkcAlt, L"Alt+" + Vcl_Consts_SOutOfRange, L"Value must be between %d and %d" + Vcl_Consts_sAllFilter, L"All" + Vcl_Consts_SIconToClipboard, L"Clipboard does not support Icons" + Vcl_Consts_SCannotOpenClipboard, L"Cannot open clipboard: %s" + Vcl_Consts_SInvalidMemoSize, L"Text exceeds memo capacity" + Vcl_Consts_SInvalidPrinterOp, L"Operation not supported on selected printer" + Vcl_Consts_SNoDefaultPrinter, L"There is no default printer currently selected" + Vcl_Consts_SDuplicateMenus, L"Menu '%s' is already being used by another form" + Vcl_Consts_SDockedCtlNeedsName, L"Docked control must have a name" + Vcl_Consts_SDockTreeRemoveError, L"Error removing control from dock tree" + Vcl_Consts_SMsgDlgAll, L"&All" + Vcl_Consts_SMsgDlgNoToAll, L"N&o to All" + Vcl_Consts_SMsgDlgYesToAll, L"Yes to &All" + Vcl_Consts_SMsgDlgClose, L"&Close" + Vcl_Consts_SmkcBkSp, L"BkSp" + Vcl_Consts_SmkcTab, L"Tab" + Vcl_Consts_SmkcEsc, L"Esc" + Vcl_Consts_SmkcEnter, L"Enter" + Vcl_Consts_SmkcSpace, L"Space" + Vcl_Consts_SmkcPgUp, L"PgUp" + Vcl_Consts_SmkcPgDn, L"PgDn" + Vcl_Consts_SmkcEnd, L"End" + Vcl_Consts_SmkcHome, L"Home" + Vcl_Consts_SmkcLeft, L"Left" + Vcl_Consts_SmkcUp, L"Up" + Vcl_Consts_SmkcRight, L"Right" + Vcl_Consts_SVEnhMetafiles, L"Enhanced Metafiles" + Vcl_Consts_SVIcons, L"Icons" + Vcl_Consts_SVBitmaps, L"Bitmaps" + Vcl_Consts_SVTIFFImages, L"TIFF Images" + Vcl_Consts_SMsgDlgWarning, L"Warning" + Vcl_Consts_SMsgDlgError, L"Error" + Vcl_Consts_SMsgDlgInformation, L"Information" + Vcl_Consts_SMsgDlgConfirm, L"Confirm" + Vcl_Consts_SMsgDlgYes, L"&Yes" + Vcl_Consts_SMsgDlgNo, L"&No" + Vcl_Consts_SMsgDlgOK, L"OK" + Vcl_Consts_SMsgDlgCancel, L"Cancel" + Vcl_Consts_SMsgDlgHelp, L"&Help" + Vcl_Consts_SMsgDlgAbort, L"&Abort" + Vcl_Consts_SMsgDlgRetry, L"&Retry" + Vcl_Consts_SMsgDlgIgnore, L"&Ignore" + Vcl_Consts_SNoMDIForm, L"Cannot create form. No MDI forms are currently active" + Vcl_Consts_SImageCanvasNeedsBitmap, L"Can only modify an image if it contains a bitmap" + Vcl_Consts_SControlParentSetToSelf, L"A control cannot have itself as its parent" + Vcl_Consts_SControlNonMainThreadUsage, L"Control '%s' is used on a not main thread" + Vcl_Consts_SOKButton, L"OK" + Vcl_Consts_SCancelButton, L"Cancel" + Vcl_Consts_SYesButton, L"&Yes" + Vcl_Consts_SNoButton, L"&No" + Vcl_Consts_SHelpButton, L"&Help" + Vcl_Consts_SCloseButton, L"&Close" + Vcl_Consts_SIgnoreButton, L"&Ignore" + Vcl_Consts_SRetryButton, L"&Retry" + Vcl_Consts_SAbortButton, L"Abort" + Vcl_Consts_SAllButton, L"&All" + Vcl_Consts_SCannotDragForm, L"Cannot drag a form" + Vcl_Consts_SVMetafiles, L"Metafiles" + Vcl_Consts_SParentGivenNotAParent, L"Parent given is not a parent of '%s'" + Vcl_Consts_SMDIChildNotVisible, L"Cannot hide an MDI Child Form" + Vcl_Consts_SVisibleChanged, L"Cannot change Visible in OnShow or OnHide" + Vcl_Consts_SCannotShowModal, L"Cannot make a visible window modal" + Vcl_Consts_SScrollBarRange, L"Scrollbar property out of range" + Vcl_Consts_SPropertyOutOfRange, L"%s property out of range" + Vcl_Consts_SMenuIndexError, L"Menu index out of range" + Vcl_Consts_SMenuReinserted, L"Menu inserted twice" + Vcl_Consts_SMenuNotFound, L"Sub-menu is not in menu" + Vcl_Consts_SNoTimers, L"Not enough timers available" + Vcl_Consts_SNotPrinting, L"Printer is not currently printing" + Vcl_Consts_SPrinting, L"Printing in progress" + Vcl_Consts_SPrinterIndexError, L"Printer index out of range" + Vcl_Consts_SInvalidPrinter, L"Printer selected is not valid" + Vcl_Consts_SDeviceOnPort, L"%s on %s" + Vcl_Consts_SGroupIndexTooLow, L"GroupIndex cannot be less than a previous menu item's GroupIndex" + Vcl_Consts_SOutOfResources, L"Out of system resources" + Vcl_Consts_SNoCanvasHandle, L"Canvas does not allow drawing" + Vcl_Consts_SInvalidTextFormatFlag, L"Text format flag '%s' not supported" + Vcl_Consts_SInvalidFrameIndex, L"Invalid image frame index %d: there are %d frames (0-%d)" + Vcl_Consts_SInvalidImageSize, L"Invalid image size" + Vcl_Consts_SInvalidImageList, L"Invalid ImageList" + Vcl_Consts_SReplaceImage, L"Unable to Replace Image" + Vcl_Consts_SInsertImage, L"Unable to Insert Image" + Vcl_Consts_SImageIndexError, L"Invalid ImageList Index" + Vcl_Consts_SImageReadFail, L"Failed to read ImageList data from stream" + Vcl_Consts_SImageWriteFail, L"Failed to write ImageList data to stream" + Vcl_Consts_SWindowDCError, L"Error creating window device context" + Vcl_Consts_SWindowClass, L"Error creating window class" + Vcl_Consts_SCannotFocus, L"Cannot focus a disabled or invisible window" + Vcl_Consts_SParentRequired, L"Control '%s' has no parent window" + Vcl_Consts_SControlPath, L". Path:\r\n%s" + System_RTLConsts_sObserverNoSinglecastFound, L"No single cast observer with ID %d was added to the observer collection" + System_RTLConsts_sObserverNoMulticastFound, L"No multi cast observer with ID %d was added to the observer collection" + System_RTLConsts_sObserverNotAvailable, L"Observer is not available" + System_RTLConsts_sMustWaitOnOneEvent, L"Must wait on at least one event" + System_RTLConsts_sBeginInvokeDestroying, L"Cannot call BeginInvoke on a TComponent in the process of destruction" + Vcl_Consts_SInvalidBitmap, L"Bitmap image is not valid" + Vcl_Consts_SInvalidIcon, L"Icon image is not valid" + Vcl_Consts_SInvalidMetafile, L"Metafile is not valid" + Vcl_Consts_SInvalidPixelFormat, L"Invalid pixel format" + Vcl_Consts_SInvalidImage, L"Invalid image" + Vcl_Consts_SScanLine, L"Scan line index out of range" + Vcl_Consts_SChangeIconSize, L"Cannot change the size of an icon" + Vcl_Consts_SChangeWicSize, L"Cannot change the size of a WIC Image" + Vcl_Consts_SUnknownExtension, L"Unknown picture file extension (.%s)" + Vcl_Consts_SUnknownClipboardFormat, L"Unsupported clipboard format" + Vcl_Consts_SUnknownStreamFormat, L"Unsupported stream format" + System_RTLConsts_SWindowsXP, L"Windows XP" + System_RTLConsts_SWindowsServer2003, L"Windows Server 2003" + System_RTLConsts_SWindowsServer2003R2, L"Windows Server 2003 R2" + System_RTLConsts_SWindowsServer2012, L"Windows Server 2012" + System_RTLConsts_SWindowsServer2012R2, L"Windows Server 2012 R2" + System_RTLConsts_SWindowsServer2016, L"Windows Server 2016" + System_RTLConsts_SWindowsServer2019, L"Windows Server 2019" + System_RTLConsts_SWindowsServer2022, L"Windows Server 2022" + System_RTLConsts_SWindows8, L"Windows 8" + System_RTLConsts_SWindows8Point1, L"Windows 8.1" + System_RTLConsts_SWindows10, L"Windows 10" + System_RTLConsts_SWindows11, L"Windows 11" + System_RTLConsts_SWinRTInstanceError, L"Cannot create instance of class %s" + System_RTLConsts_sObserverUnsupported, L"Observer is not supported" + System_RTLConsts_sObserverMultipleSingleCast, L"Cannot have multiple single cast observers added to the observers collection" + System_RTLConsts_sObserverNoInterface, L"The object does not implement the observer interface" + System_RTLConsts_SNonPublicType, L"Type '%s' is not declared in the interface section of a unit" + System_RTLConsts_SByRefArgMismatch, L"VAR and OUT arguments must match parameter type exactly" + System_RTLConsts_SPropIsReadOnly, L"Property '%s' is read-only" + System_RTLConsts_SPropIsWriteOnly, L"Property '%s' is write-only" + System_RTLConsts_SInvalidRttiDestroy, L"RTTI objects cannot be manually destroyed by application code" + System_RTLConsts_SServiceNotFound, L"Specified Login Credential Service not found" + System_RTLConsts_SVersionStr, L"%s (Version %d.%d, Build %d, %5:s)" + System_RTLConsts_SSPVersionStr, L"%s Service Pack %4:d (Version %1:d.%2:d, Build %3:d, %5:s)" + System_RTLConsts_SVersion32, L"32-bit Edition" + System_RTLConsts_SVersion64, L"64-bit Edition" + System_RTLConsts_SWindows, L"Windows" + System_RTLConsts_SWindowsVista, L"Windows Vista" + System_RTLConsts_SWindowsServer2008, L"Windows Server 2008" + System_RTLConsts_SWindows7, L"Windows 7" + System_RTLConsts_SWindowsServer2008R2, L"Windows Server 2008 R2" + System_RTLConsts_SWindows2000, L"Windows 2000" + System_RTLConsts_sCannotNegateTimespan, L"Negating the minimum value of a Timespan is invalid" + System_RTLConsts_sInvalidTimespanFormat, L"Invalid Timespan format" + System_RTLConsts_sTimespanElementTooLong, L"Timespan element too long" + System_RTLConsts_SNoContext, L"No context-sensitive help installed" + System_RTLConsts_SNoContextFound, L"No help found for context %d" + System_RTLConsts_SNoIndex, L"Unable to open Index" + System_RTLConsts_SNoSearch, L"Unable to open Search" + System_RTLConsts_SNoTableOfContents, L"Unable to find a Table of Contents" + System_RTLConsts_SNoTopics, L"No topic-based help system installed" + System_RTLConsts_SNothingFound, L"No help found for %s" + System_RTLConsts_SArgumentOutOfRange, L"Argument out of range" + System_RTLConsts_SArgumentNil, L"Argument must not be nil" + System_RTLConsts_SGenericItemNotFound, L"Item not found" + System_RTLConsts_SGenericDuplicateItem, L"Duplicates not allowed" + System_RTLConsts_SInsufficientRtti, L"Insufficient RTTI available to support this operation" + System_RTLConsts_SParameterCountMismatch, L"Parameter count mismatch" + System_RTLConsts_SThreadExternalCheckTerminated, L"Cannot call CheckTerminated on an externally created thread" + System_RTLConsts_SThreadExternalSetReturnValue, L"Cannot call SetReturnValue on an externally create thread" + System_RTLConsts_SParamIsNil, L"Parameter %s cannot be nil" + System_RTLConsts_SParamIsNegative, L"Parameter %s cannot be a negative value" + System_RTLConsts_SInputBufferExceed, L"Input buffer exceeded for %s = %d, %s = %d" + System_RTLConsts_SInvalidCharsInPath, L"Invalid characters in path" + System_RTLConsts_hNoFilterViewer, L"No help viewer that supports filters" + System_RTLConsts_sArgumentInvalid, L"Invalid argument" + System_RTLConsts_sInvalidStringAndObjectArrays, L"Length of Strings and Objects arrays must be equal" + System_RTLConsts_sSameArrays, L"Source and Destination arrays must not be the same" + System_RTLConsts_sNoConstruct, L"Class %s is not intended to be constructed" + System_RTLConsts_sInvalidTimeoutValue, L"Invalid Timeout value: %s" + System_RTLConsts_sSpinCountOutOfRange, L"SpinCount out of range. Must be between 0 and %d" + System_RTLConsts_sTimespanTooLong, L"Timespan too long" + System_RTLConsts_sInvalidTimespanDuration, L"The duration cannot be returned because the absolute value exceeds the value of TTimeSpan.MaxValue" + System_RTLConsts_sTimespanValueCannotBeNan, L"Value cannot be NaN" + System_RTLConsts_SReadError, L"Stream read error" + System_RTLConsts_SReadOnlyProperty, L"Property is read-only" + System_RTLConsts_SRegCreateFailed, L"Failed to create key %s" + System_RTLConsts_SRegGetDataFailed, L"Failed to get data for '%s'" + System_RTLConsts_SRegSetDataFailed, L"Failed to set data for '%s'" + System_RTLConsts_SResNotFound, L"Resource %s not found" + System_RTLConsts_SSeekNotImplemented, L"%s.Seek not implemented" + System_RTLConsts_SSortedListError, L"Operation not allowed on sorted list" + System_RTLConsts_SUnknownGroup, L"%s not in a class registration group" + System_RTLConsts_SUnknownProperty, L"Property %s does not exist" + System_RTLConsts_SWriteError, L"Stream write error" + System_RTLConsts_SThreadCreateError, L"Thread creation error: %s" + System_RTLConsts_SThreadError, L"Thread Error: %s (%d)" + System_RTLConsts_SThreadExternalTerminate, L"Cannot terminate an externally created thread" + System_RTLConsts_SThreadExternalWait, L"Cannot wait for an externally created thread" + System_RTLConsts_SThreadStartError, L"Cannot call Start on a running or suspended thread" + System_RTLConsts_SFCreateErrorEx, L"Cannot create file \"%s\". %s" + System_RTLConsts_SFOpenErrorEx, L"Cannot open file \"%s\". %s" + System_RTLConsts_SInvalidImage, L"Invalid stream format" + System_RTLConsts_SInvalidName, L"''%s'' is not a valid component name" + System_RTLConsts_SInvalidProperty, L"Invalid property value" + System_RTLConsts_SInvalidPropertyPath, L"Invalid property path" + System_RTLConsts_SInvalidPropertyValue, L"Invalid property value" + System_RTLConsts_SInvalidRegType, L"Invalid data type for '%s'" + System_RTLConsts_SListCapacityError, L"List capacity out of bounds (%d)" + System_RTLConsts_SListCountError, L"List count out of bounds (%d)" + System_RTLConsts_SListIndexError, L"List index out of bounds (%d)" + System_RTLConsts_SListIndexErrorRangeReason, L". %s range is 0..%d" + System_RTLConsts_SListIndexErrorEmptyReason, L". %s is empty" + System_RTLConsts_SMemoryStreamError, L"Out of memory while expanding memory stream" + System_RTLConsts_SNoComSupport, L"%s has not been registered as a COM class" + System_RTLConsts_SPropertyException, L"Error reading %s%s%s: %s" + System_SysConst_SInvalidCharCount, L"Invalid count (%d)" + System_SysConst_SInvalidDestinationIndex, L"Invalid destination index (%d)" + System_SysConst_SInvalidCodePage, L"Invalid code page" + System_SysConst_SInvalidEncodingName, L"Invalid encoding name" + System_SysConst_SNoMappingForUnicodeCharacter, L"No mapping for the Unicode character exists in the target multi-byte code page" + System_SysConst_SInvalidStringBaseIndex, L"Invalid StringBaseIndex" + System_RTLConsts_SAncestorNotFound, L"Ancestor for '%s' not found" + System_RTLConsts_SAssignError, L"Cannot assign a %s to a %s" + System_RTLConsts_SBitsIndexError, L"Bits index out of range" + System_RTLConsts_SCantWriteResourceStreamError, L"Can't write to a read-only resource stream" + System_RTLConsts_SCheckSynchronizeError, L"CheckSynchronize called from thread $%x, which is NOT the main thread" + System_RTLConsts_SClassNotFound, L"Class %s not found" + System_RTLConsts_SDuplicateClass, L"A class named %s already exists" + System_RTLConsts_SDuplicateItem, L"List does not allow duplicates ($0%x)" + System_RTLConsts_SDuplicateName, L"A component named %s already exists" + System_RTLConsts_SDuplicateString, L"String list does not allow duplicates" + System_SysConst_SShortDayNameTue, L"Tue" + System_SysConst_SShortDayNameWed, L"Wed" + System_SysConst_SShortDayNameThu, L"Thu" + System_SysConst_SShortDayNameFri, L"Fri" + System_SysConst_SShortDayNameSat, L"Sat" + System_SysConst_SLongDayNameSun, L"Sunday" + System_SysConst_SLongDayNameMon, L"Monday" + System_SysConst_SLongDayNameTue, L"Tuesday" + System_SysConst_SLongDayNameWed, L"Wednesday" + System_SysConst_SLongDayNameThu, L"Thursday" + System_SysConst_SLongDayNameFri, L"Friday" + System_SysConst_SLongDayNameSat, L"Saturday" + System_SysConst_SInvalidSourceArray, L"Invalid source array" + System_SysConst_SInvalidDestinationArray, L"Invalid destination array" + System_SysConst_SCharIndexOutOfBounds, L"Character index out of bounds (%d)" + System_SysConst_SByteIndexOutOfBounds, L"Start index out of bounds (%d)" + System_SysConst_SShortMonthNameNov, L"Nov" + System_SysConst_SShortMonthNameDec, L"Dec" + System_SysConst_SLongMonthNameJan, L"January" + System_SysConst_SLongMonthNameFeb, L"February" + System_SysConst_SLongMonthNameMar, L"March" + System_SysConst_SLongMonthNameApr, L"April" + System_SysConst_SLongMonthNameMay, L"May" + System_SysConst_SLongMonthNameJun, L"June" + System_SysConst_SLongMonthNameJul, L"July" + System_SysConst_SLongMonthNameAug, L"August" + System_SysConst_SLongMonthNameSep, L"September" + System_SysConst_SLongMonthNameOct, L"October" + System_SysConst_SLongMonthNameNov, L"November" + System_SysConst_SLongMonthNameDec, L"December" + System_SysConst_SShortDayNameSun, L"Sun" + System_SysConst_SShortDayNameMon, L"Mon" + System_SysConst_SObjectDisposed, L"Method called on disposed object" + System_SysConst_SAssertError, L"%s (%s, line %d)" + System_SysConst_SAbstractError, L"Abstract Error" + System_SysConst_SModuleAccessViolation, L"Access violation at address %p in module '%s' (offset %x). %s of address %p" + System_SysConst_SOSError, L"System Error. Code: %d.\r\n%s%s" + System_SysConst_SUnkOSError, L"A call to an OS function failed" + System_SysConst_SShortMonthNameJan, L"Jan" + System_SysConst_SShortMonthNameFeb, L"Feb" + System_SysConst_SShortMonthNameMar, L"Mar" + System_SysConst_SShortMonthNameApr, L"Apr" + System_SysConst_SShortMonthNameMay, L"May" + System_SysConst_SShortMonthNameJun, L"Jun" + System_SysConst_SShortMonthNameJul, L"Jul" + System_SysConst_SShortMonthNameAug, L"Aug" + System_SysConst_SShortMonthNameSep, L"Sep" + System_SysConst_SShortMonthNameOct, L"Oct" + System_SysConst_SVarTypeNotUsableWithPrefix, L"Custom variant type (%s%.4x) is not usable" + System_SysConst_SVarTypeTooManyCustom, L"Too many custom variant types have been registered" + System_SysConst_SVarTypeCouldNotConvert, L"Could not convert variant of type (%s) into type (%s)" + System_SysConst_SVarTypeConvertOverflow, L"Overflow while converting variant of type (%s) into type (%s)" + System_SysConst_SVarOverflow, L"Variant overflow" + System_SysConst_SVarInvalid, L"Invalid argument" + System_SysConst_SVarBadType, L"Invalid variant type" + System_SysConst_SVarNotImplemented, L"Operation not supported" + System_SysConst_SVarUnexpected, L"Unexpected variant error" + System_SysConst_SExternalException, L"External exception %x" + System_SysConst_SAssertionFailed, L"Assertion failed" + System_SysConst_SIntfCastError, L"Interface not supported" + System_SysConst_SSafecallException, L"Exception in safecall method" + System_SysConst_SMonitorLockException, L"Object lock not owned" + System_SysConst_SNoMonitorSupportException, L"Monitor support function not initialized" + System_SysConst_SNotImplemented, L"Feature not implemented" + System_SysConst_SInvalidFormat, L"Format '%s' invalid or incompatible with argument" + System_SysConst_SArgumentMissing, L"No argument for format '%s'" + System_SysConst_SDispatchError, L"Variant method calls not supported" + System_SysConst_SReadAccess, L"Read" + System_SysConst_SWriteAccess, L"Write" + System_SysConst_SExecuteAccess, L"Execution" + System_SysConst_SInvalidAccess, L"Invalid access" + System_SysConst_SVarArrayCreate, L"Error creating variant or safe array" + System_SysConst_SVarArrayBounds, L"Variant or safe array index out of bounds" + System_SysConst_SVarArrayLocked, L"Variant or safe array is locked" + System_SysConst_SInvalidVarCast, L"Invalid variant type conversion" + System_SysConst_SInvalidVarOp, L"Invalid variant operation" + System_SysConst_SInvalidVarNullOp, L"Invalid NULL variant operation" + System_SysConst_SInvalidVarOpWithHResultWithPrefix, L"Invalid variant operation (%s%.8x)\n%s" + System_SysConst_SVarTypeOutOfRangeWithPrefix, L"Custom variant type (%s%.4x) is out of range" + System_SysConst_SVarTypeAlreadyUsedWithPrefix, L"Custom variant type (%s%.4x) already used by %s" + System_SysConst_SRangeError, L"Range check error" + System_SysConst_SIntOverflow, L"Integer overflow" + System_SysConst_SInvalidOp, L"Invalid floating point operation" + System_SysConst_SZeroDivide, L"Floating point division by zero" + System_SysConst_SOverflow, L"Floating point overflow" + System_SysConst_SUnderflow, L"Floating point underflow" + System_SysConst_SInvalidPointer, L"Invalid pointer operation" + System_SysConst_SInvalidCast, L"Invalid class typecast" + System_SysConst_SAccessViolationArg3, L"Access violation at address %p. %s of address %p" + System_SysConst_SAccessViolationNoArg, L"Access violation" + System_SysConst_SStackOverflow, L"Stack overflow" + System_SysConst_SControlC, L"Control-C hit" + System_SysConst_SPrivilege, L"Privileged instruction" + System_SysConst_SOperationAborted, L"Operation aborted" + System_SysConst_SException, L"Exception %s in module %s at %p.\r\n%s%s\r\n" + System_SysConst_SExceptTitle, L"Application Error" + System_SysConst_SUnknown, L"" + System_SysConst_SInvalidInteger, L"'%s' is not a valid integer value" + System_SysConst_SInvalidTimeStamp, L"'%d.%d' is not a valid timestamp" + System_SysConst_SInvalidGUID, L"'%s' is not a valid GUID value" + System_SysConst_STimeEncodeError, L"Invalid argument to time encode" + System_SysConst_SDateEncodeError, L"Invalid argument to date encode" + System_SysConst_SOutOfMemory, L"Out of memory" + System_SysConst_SInOutError, L"I/O error %d" + System_SysConst_SFileNotFound, L"File not found" + System_SysConst_SInvalidUnknownFilename, L"Invalid filename" + System_SysConst_STooManyOpenFiles, L"Too many open files" + System_SysConst_SAccessDenied, L"File access denied" + System_SysConst_SEndOfFile, L"Read beyond end of file" + System_SysConst_SDiskFull, L"Disk full" + System_SysConst_SInvalidInput, L"Invalid numeric input" + System_SysConst_SDivByZero, L"Division by zero" +END + +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win32\release\Controls.res */ +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win32\release\Dialogs.res */ +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win32\release\Buttons.res */ +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win32\release\SPIN.RES */ +/* D:\_Delphi\_Library\Netcom7\Demos\TCP\SimpleSockets_TLS\Client\ufrmMain.dfm */ +/* D:\_Delphi\_Library\Netcom7\Demos\TCP\SimpleSockets_TLS\Client\Client.res */ +/* D:\_Delphi\_Library\Netcom7\Demos\TCP\SimpleSockets_TLS\Client\Client.drf */ diff --git a/Demos/TCP/SimpleSockets_TLS/Client/Client.identcache b/Demos/TCP/SimpleSockets_TLS/Client/Client.identcache new file mode 100644 index 0000000..ef31e90 Binary files /dev/null and b/Demos/TCP/SimpleSockets_TLS/Client/Client.identcache differ diff --git a/Demos/TCP/SimpleSockets_TLS/Client/Client.res b/Demos/TCP/SimpleSockets_TLS/Client/Client.res new file mode 100644 index 0000000..07e9981 Binary files /dev/null and b/Demos/TCP/SimpleSockets_TLS/Client/Client.res differ diff --git a/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.dcu b/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.dcu new file mode 100644 index 0000000..b9cca5e Binary files /dev/null and b/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.dcu differ diff --git a/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.dfm b/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.dfm new file mode 100644 index 0000000..0e8b317 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.dfm @@ -0,0 +1,173 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + ActiveControl = edtDataToSend + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'TCPClient - TLS' + ClientHeight = 243 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 169 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start TCP Client' + TabOrder = 0 + OnClick = btnActivateClick + end + object pnlAddress: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtHost: TEdit + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 281 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + TextHint = 'Enter host address' + OnChange = edtHostChange + end + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 291 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 211 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object btnSendData: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send' + Default = True + TabOrder = 0 + OnClick = btnSendDataClick + end + object Panel2: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtDataToSend: TEdit + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 407 + Height = 21 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = 'This is some text data' + TextHint = 'Enter data to send here' + OnEnter = edtDataToSendEnter + OnExit = edtDataToSendExit + end + end + end + object TCPClient: TncTCPClient + OnConnected = TCPClientConnected + OnDisconnected = TCPClientDisconnected + OnReadData = TCPClientReadData + OnReconnected = TCPClientReconnected + Left = 208 + Top = 80 + end +end diff --git a/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.pas b/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.pas new file mode 100644 index 0000000..8142475 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Client/ufrmMain.pas @@ -0,0 +1,247 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, + System.Diagnostics, ncLines, ncSockets; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pnlAddress: TPanel; + edtHost: TEdit; + edtPort: TSpinEdit; + Panel1: TPanel; + btnSendData: TButton; + Panel2: TPanel; + edtDataToSend: TEdit; + TCPClient: TncTCPClient; + procedure btnActivateClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure TCPClientConnected(Sender: TObject; aLine: TncLine); + procedure TCPClientDisconnected(Sender: TObject; aLine: TncLine); + procedure TCPClientReconnected(Sender: TObject; aLine: TncLine); + procedure edtHostChange(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure btnSendDataClick(Sender: TObject); + procedure edtDataToSendEnter(Sender: TObject); + procedure edtDataToSendExit(Sender: TObject); + procedure TCPClientReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormCreate(Sender: TObject); + private + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + // Configure TLS settings for the client + TCPClient.UseTLS := True; // Enable TLS encryption + TCPClient.TlsProvider := tpSChannel; // Use Windows SChannel (Windows built-in TLS) + TCPClient.IgnoreCertificateErrors := True; // For demo purposes with self-signed certificates + + // Set initial button caption + btnActivate.Caption := 'Start TLS Client'; + + Log('TLS Client configured with SChannel provider'); + Log('Note: Certificate errors are ignored for demo purposes'); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + TCPClient.Active := False; + Log('TLS Client shutdown complete'); +end; + +// ***************************************************************************** +// Start/Stop Main CLient +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if TCPClient.Active then + begin + // Deactivate the TCP client + TCPClient.Active := False; + btnActivate.Caption := 'Start TLS Client'; + Log('TLS Client Deactivated'); + end + else + begin + // Check if the host field is blank + if Trim(edtHost.Text) = '' then + begin + Log('Host field cannot be blank.'); + Exit; // Exit the procedure if the host field is blank + end; + + try + // Set the host from the text field + TCPClient.Host := edtHost.Text; + + // Activate the TCP client + TCPClient.Port := edtPort.Value; + TCPClient.Active := True; + btnActivate.Caption := 'Stop TLS Client'; + Log('TLS Client Activated - attempting secure connection...'); + except + on E: Exception do + Log('Failed to activate TLS Client: ' + E.Message); + end; + end; +end; + +// ***************************************************************************** +// Change host (server) +// ***************************************************************************** +procedure TForm1.edtHostChange(Sender: TObject); +begin + try + TCPClient.Host := edtHost.Text; + except + edtHost.OnChange := nil; + try + edtHost.Text := TCPClient.Host; + finally + edtHost.OnChange := edtHostChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Change Main Client port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + TCPClient.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := TCPClient.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Data to send +// ***************************************************************************** +procedure TForm1.edtDataToSendEnter(Sender: TObject); +begin + btnSendData.Default := True; +end; + +procedure TForm1.edtDataToSendExit(Sender: TObject); +begin + btnSendData.Default := False; +end; + +procedure TForm1.btnSendDataClick(Sender: TObject); +begin + // Check if the data field is blank + if Trim(edtDataToSend.Text) = '' then + begin + Log('Cannot send - Data field cannot be blank.'); + Exit; // Exit the procedure if the data field is blank + end; + + try + // Send the data + TCPClient.Send(edtDataToSend.Text); + Log('Data sent via TLS: ' + edtDataToSend.Text); + except + on E: Exception do + Log('Failed to send data via TLS: ' + E.Message); + end; +end; + +// ***************************************************************************** +// TCPClientConnected +// ***************************************************************************** +procedure TForm1.TCPClientConnected(Sender: TObject; aLine: TncLine); +begin + if TCPClient.UseTLS then + Log('Connected with TLS encryption (SChannel)') + else + Log('Connected without encryption'); + btnActivate.Caption := 'Deactivate'; +end; + +// ***************************************************************************** +// TCPClientDisconnected +// ***************************************************************************** +procedure TForm1.TCPClientDisconnected(Sender: TObject; aLine: TncLine); +begin + Log('TLS Connection Disconnected'); + btnActivate.Caption := 'Start TLS Client'; +end; + +// ***************************************************************************** +// TCPClientReconnected +// ***************************************************************************** +procedure TForm1.TCPClientReconnected(Sender: TObject; aLine: TncLine); +begin + Log('TLS Connection Reconnected'); +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.TCPClientReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + BytesReceived: TBytes; +begin + BytesReceived := Copy(aBuf, 0, aBufCount); + + Log('Received via TLS: ' + StringOf(BytesReceived)); + +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/TCP/SimpleSockets_TLS/Server/Server.dpr b/Demos/TCP/SimpleSockets_TLS/Server/Server.dpr new file mode 100644 index 0000000..63d6f38 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Server/Server.dpr @@ -0,0 +1,17 @@ +program Server; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/TCP/SimpleSockets_TLS/Server/Server.dproj b/Demos/TCP/SimpleSockets_TLS/Server/Server.dproj new file mode 100644 index 0000000..c8ac3b5 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Server/Server.dproj @@ -0,0 +1,260 @@ + + + {0B2EB3CC-F54E-41A8-A712-8771BC0FC4AD} + Server.dpr + True + Debug + Server + 3 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + Server + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + $(BDS)\bin\delphi_PROJECTICON.ico + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + Server.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + False + False + False + False + False + False + True + True + + + 12 + + + + diff --git a/Demos/TCP/SimpleSockets_TLS/Server/Server.dproj.local b/Demos/TCP/SimpleSockets_TLS/Server/Server.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Server/Server.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/SimpleSockets_TLS/Server/Server.identcache b/Demos/TCP/SimpleSockets_TLS/Server/Server.identcache new file mode 100644 index 0000000..4a109ca Binary files /dev/null and b/Demos/TCP/SimpleSockets_TLS/Server/Server.identcache differ diff --git a/Demos/TCP/SimpleSockets_TLS/Server/Server.res b/Demos/TCP/SimpleSockets_TLS/Server/Server.res new file mode 100644 index 0000000..a57e245 Binary files /dev/null and b/Demos/TCP/SimpleSockets_TLS/Server/Server.res differ diff --git a/Demos/TCP/SimpleSockets_TLS/Server/server.key b/Demos/TCP/SimpleSockets_TLS/Server/server.key new file mode 100644 index 0000000..be9053f --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Server/server.key @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQCZF6wX9HCEqm0K +yByBjMqIzbN9dpOc9kX5tJSMF2TLuSFxjQqL8qiTJsY5lFevpZ6OvA7kI+X5u5AV +Fu15Epl9GSdSuYxVYj33NGWTyLUEb4ctwF5ado86D+ezQP8Dnlg5bhPPimhBQTpv +/Fl/FptrcyzzYEBWCyeSbzy8hPQLEomJc8A5OX7l+wm5dhFM6tWTHRR0gV1ZXIIk +1nQgXdF+HcUeamHY2+xpF0wLdCSTTj/em21blPmEE7JtmxYuAXFqo3H9YPlTNwJv +6Ztsl59XRJFOFiWm8PINB23oDwDI+yTqXbzSRIX0BpZs3B/TSSneVjKOFZVxYdnM +lr1UMeefAgMBAAECggEANbCfoicP7vb2FvnnRWfi/+dkM3QKgNm94Lz7+8WYi/n5 +SKF2OW54wGKw0jC8L9WdreE2N7x/Qv4ModjQn81uFvljWRfJp4g0wyWVGichlNSo +S9tTO9aolGxPjgYVaWd2+W0pdXfM6FW/8NZHbNK43w4djZ0L8yEmV6y7WEIodFkY +8jDmU3OBjdJ0/bdh5zQe/g+IY2RF6+JIYUM4qsxWiWWvtLXIL5npVo0oMOAlNI+/ +iR6i3fXrvR3HvHBK9n/aLeXg4Qei2buNVSbVhM7zOjf1ziDypb7/VGJLf/Kkv8wB +qrHTNa5d8N6JsmDNRNhtw01TmezHFMrGmEDrMQBXwQKBgQDPOwqPBUAD4/1rAp9/ +QvZQAiU443E+20I9eQlewCNc+/vbNHF9N8lqNm03LR0o/JIHCbU+w+POFXqyvoRG +3Zj3j3lfpR3kO8ED3qy2o3LRi3/Rdu10XyAC6DCTc5HDtY26SGiM4LMSiYJKcxyT +AA0BPi7RuaEEdAByFnTfUwbFzQKBgQC9Hvx6T2YLWAWbrsUcKwkJPWdYjI5HH3hn +vTnFSsmLKpV4olwDT4R2yYlk0Wpt29Nu0ePSI5QxAwfKuwdmt701LkyRsErhZS29 +gzOvo2cCRB1R59Xnpj/nLQTVQw5tnHaT/fb+I6C8lIZRT8vZv9Xs+PUijbONf0aL +8ZIw2ew3GwKBgQCEY2efbu8yjRh8oLRcjN7mxjgZW9QhH9n1g7mkuoLdCG4h4CMQ +p+8Y16R2N3AFmzV/IYiUjHigU8CLKINA8piirxoPLGEoSbRJUJxuIYVcsQ37N0sD +qTG+Ka++w3o/2WCtvUxtk69TDF4cSeXbU5D7Vkp62WgwfBs8x3PqqBQPkQKBgEM/ +qXe0lAykmBnr45tIkkX+16jdEhqoTiBVYR2OomwiEFR9J0rmE6xJrdlzveyipmRZ +rjEjBacH9NVZ/B/CZj1q4T9M+NN9Lu6coNxrtk1P+z0MuztMGp0RnQ5YceD4KhIl +1JY6BQYJqllvjoU3edJyFHjc+mPuRh+tHtbQJvbRAoGAR1T9fGCYn+uDwBq2B9Jt +wMMXDD6homo+OiqEALAjUt2dOxCDH84IhGnSYP27M/pAwsMI416oskPXXEPV4nB+ +GNxbI9eKnAwiWkktbY610j6pSmHu1T0Z1GBm5HnXYrtFUHi9k+1LU/iuj2mouNus +XpqwE8eeQQeaqJP7BmuwJXk= +-----END PRIVATE KEY----- diff --git a/Demos/TCP/SimpleSockets_TLS/Server/server.pfx b/Demos/TCP/SimpleSockets_TLS/Server/server.pfx new file mode 100644 index 0000000..0b1ad11 Binary files /dev/null and b/Demos/TCP/SimpleSockets_TLS/Server/server.pfx differ diff --git a/Demos/TCP/SimpleSockets_TLS/Server/ufrmMain.dfm b/Demos/TCP/SimpleSockets_TLS/Server/ufrmMain.dfm new file mode 100644 index 0000000..18b9359 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Server/ufrmMain.dfm @@ -0,0 +1,122 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'TCPServer - TLS' + ClientHeight = 243 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 182 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Activate' + TabOrder = 0 + OnClick = btnActivateClick + end + object pblPort: TPanel + AlignWithMargins = True + Left = 115 + Top = 3 + Width = 412 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 0 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 16233 + OnChange = edtPortChange + end + object btnShutdownAllClients: TButton + AlignWithMargins = True + Left = 256 + Top = 5 + Width = 151 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + Caption = 'Shutdown all clients' + TabOrder = 1 + OnClick = btnShutdownAllClientsClick + end + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 224 + Width = 527 + Height = 19 + Panels = < + item + Text = 'Connections: 0' + Width = 150 + end> + end + object TCPServer: TncTCPServer + OnConnected = TCPServerConnected + OnDisconnected = TCPServerDisconnected + OnReadData = TCPServerReadData + Left = 92 + Top = 52 + end +end diff --git a/Demos/TCP/SimpleSockets_TLS/Server/ufrmMain.pas b/Demos/TCP/SimpleSockets_TLS/Server/ufrmMain.pas new file mode 100644 index 0000000..963afa7 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/Server/ufrmMain.pas @@ -0,0 +1,294 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, Vcl.ComCtrls, + System.Diagnostics, ncLines, ncSocketList, ncSockets; + +type + TForm1 = class(TForm) + memLog: TMemo; + TCPServer: TncTCPServer; + pnlToolbar: TPanel; + btnActivate: TButton; + pblPort: TPanel; + edtPort: TSpinEdit; + btnShutdownAllClients: TButton; + StatusBar1: TStatusBar; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure TCPServerConnected(Sender: TObject; aLine: TncLine); + procedure TCPServerDisconnected(Sender: TObject; aLine: TncLine); + procedure btnActivateClick(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure btnShutdownAllClientsClick(Sender: TObject); + procedure TCPServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + private + FConnectionCount: Integer; + procedure UpdateConnectionCount; + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +function FileSize(const AFilename: string): Int64; +var + FileStream: TFileStream; +begin + Result := 0; + if FileExists(AFilename) then + try + FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone); + try + Result := FileStream.Size; + finally + FileStream.Free; + end; + except + Result := 0; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +var + CertPath: string; +begin + FConnectionCount := 0; + UpdateConnectionCount; + + // Configure TLS settings for the server + TCPServer.UseTLS := True; // Enable TLS encryption + TCPServer.TlsProvider := tpSChannel; // Use Windows SChannel (Windows built-in TLS) + + // Verify certificate file exists + CertPath := ExtractFilePath(Application.ExeName) + 'server.pfx'; + if FileExists(CertPath) then + begin + TCPServer.CertificateFile := CertPath; // Certificate file path + TCPServer.PrivateKeyPassword := 'test'; // Certificate password + TCPServer.IgnoreCertificateErrors := False; // For demo purposes + + Log('Certificate file found: ' + CertPath); + Log('Certificate file size: ' + IntToStr(FileSize(CertPath)) + ' bytes'); + end + else + begin + Log('ERROR: Certificate file not found: ' + CertPath); + Log('Please ensure server.pfx is in the same directory as the executable'); + // Still configure TLS but it will fail + TCPServer.CertificateFile := CertPath; + TCPServer.PrivateKeyPassword := 'test'; + TCPServer.IgnoreCertificateErrors := False; + end; + + // Set initial button caption + btnActivate.Caption := 'Start TLS Server'; + + Log('TLS Server configured with SChannel provider'); + Log('Note: Certificate errors are ignored for demo purposes'); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + TCPServer.Active := False; + Log('TLS Server shutdown complete'); +end; + +// ***************************************************************************** +// Start/Stop Main Server +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if TCPServer.Active then + begin + // Deactivate the TCP Server + TCPServer.Active := False; + btnActivate.Caption := 'Start TLS Server'; + Log('TLS Server Deactivated'); + end + else + begin + try + // Validate TLS configuration before starting + if not FileExists(TCPServer.CertificateFile) then + begin + Log('ERROR: Certificate file not found: ' + TCPServer.CertificateFile); + Log('Cannot start TLS server without valid certificate'); + Exit; + end; + + Log('Starting TLS server with configuration:'); + Log(' UseTLS: ' + BoolToStr(TCPServer.UseTLS, True)); + Log(' TlsProvider: ' + IntToStr(Ord(TCPServer.TlsProvider))); + Log(' Certificate: ' + TCPServer.CertificateFile); + Log(' IgnoreCertErrors: ' + BoolToStr(TCPServer.IgnoreCertificateErrors, True)); + + // Activate the TCP Server + TCPServer.Port := edtPort.Value; + TCPServer.Active := True; + btnActivate.Caption := 'Stop TLS Server'; + Log('TLS Server Activated at port: ' + IntToStr(TCPServer.Port)); + Log('Server ready to accept TLS connections'); + + except + on E: Exception do + begin + Log('Failed to activate TLS Server: ' + E.Message); + Log('Exception class: ' + E.ClassName); + end; + end; + end; +end; + +// ***************************************************************************** +// Change Main Client port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + TCPServer.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := TCPServer.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Shutdown all Clients +// ***************************************************************************** +procedure TForm1.btnShutdownAllClientsClick(Sender: TObject); +var + SocketList: TSocketList; + i: Integer; +begin + SocketList := TCPServer.Lines.LockList; + try + Log('Shutting down all TLS clients...'); + for i := 0 to SocketList.Count - 1 do + TCPServer.ShutDownLine(SocketList.Lines[i]); + Log('All TLS clients shutdown requested'); + finally + TCPServer.Lines.UnlockList; + end; +end; + +procedure TForm1.UpdateConnectionCount; +begin + StatusBar1.Panels[0].Text := 'TLS Connections: ' + IntToStr(FConnectionCount); +end; + +// ***************************************************************************** +// TCPServerConnected +// ***************************************************************************** +procedure TForm1.TCPServerConnected(Sender: TObject; aLine: TncLine); +begin + Inc(FConnectionCount); + UpdateConnectionCount; + + Log('TLS Client Connected: ' + aLine.PeerIP + ' (Handle: ' + IntToStr(aLine.Handle) + ')'); + Log('Starting TLS handshake...'); + + try + // Send welcome message + TCPServer.Send(aLine, BytesOf('Hello mr. ' + IntToStr(aLine.Handle) + ' - TLS connection established')); + Log('Welcome message sent to: ' + aLine.PeerIP); + Log('TLS handshake completed successfully'); + except + on E: Exception do + begin + Log('ERROR during TLS handshake with ' + aLine.PeerIP + ': ' + E.Message); + Log('Exception class: ' + E.ClassName); + // Don't re-raise - let the connection continue to see what happens + end; + end; +end; + +// ***************************************************************************** +// TCPServerDisconnected +// ***************************************************************************** +procedure TForm1.TCPServerDisconnected(Sender: TObject; aLine: TncLine); +begin + Dec(FConnectionCount); + UpdateConnectionCount; + + Log('TLS Client Disconnected: ' + aLine.PeerIP + ' (Handle: ' + IntToStr(aLine.Handle) + ')'); + Log('Connection duration: Client was connected'); + +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.TCPServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + BytesReceived: TBytes; + ReceivedText: string; +begin + try + BytesReceived := Copy(aBuf, 0, aBufCount); + + // Convert bytes to string using proper UTF-8 decoding + ReceivedText := TEncoding.UTF8.GetString(BytesReceived); + + Log('Received via TLS: "' + ReceivedText + '" from: ' + aLine.PeerIP + ' (Handle: ' + IntToStr(aLine.Handle) + ')'); + + // Send back the buffer received + TCPServer.Send(aLine, BytesReceived); + + Log('Data sent via TLS: ' + ReceivedText + ' to: ' + aLine.PeerIP); + except + on E: Exception do + begin + Log('ERROR in TLS data handling with ' + aLine.PeerIP + ': ' + E.Message); + Log('Exception class: ' + E.ClassName); + end; + end; +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/TCP/SimpleSockets_TLS/SimpleSockets_TLS.groupproj b/Demos/TCP/SimpleSockets_TLS/SimpleSockets_TLS.groupproj new file mode 100644 index 0000000..3122a45 --- /dev/null +++ b/Demos/TCP/SimpleSockets_TLS/SimpleSockets_TLS.groupproj @@ -0,0 +1,48 @@ + + + {A9A55D39-6A58-48E9-AA5F-4DED5B38E8A8} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Demos/VideoChat/Client/AndroidManifest.template.xml b/Demos/TCP/VideoChat/Client/AndroidManifest.template.xml similarity index 100% rename from Demos/VideoChat/Client/AndroidManifest.template.xml rename to Demos/TCP/VideoChat/Client/AndroidManifest.template.xml diff --git a/Demos/VideoChat/Client/VideoChatClient.deployproj b/Demos/TCP/VideoChat/Client/VideoChatClient.deployproj similarity index 98% rename from Demos/VideoChat/Client/VideoChatClient.deployproj rename to Demos/TCP/VideoChat/Client/VideoChatClient.deployproj index 2b87501..d1546ba 100644 --- a/Demos/VideoChat/Client/VideoChatClient.deployproj +++ b/Demos/TCP/VideoChat/Client/VideoChatClient.deployproj @@ -1,462 +1,462 @@ - - - - 12 - - - 4JPNU18C10101373 - 4JPNU18C10101373 - - - - VideoChatClient\ - VideoChatClient.exe - ProjectOutput - 0 - - - True - True - - - VideoChatClient\ - VideoChatClient.exe - ProjectOutput - 0 - - - True - True - - - - - - VideoChatClient\res\drawable\ - splash_image_def.xml - AndroidSplashImageDef - 1 - - - True - - - VideoChatClient\res\drawable-mdpi\ - ic_notification.png - Android_NotificationIcon24 - 1 - - - True - - - VideoChatClient\res\values-v21\ - styles.xml - AndroidSplashStylesV21 - 1 - - - True - - - VideoChatClient\res\drawable-xxhdpi\ - ic_notification.png - Android_NotificationIcon72 - 1 - - - True - - - VideoChatClient\res\drawable-normal\ - splash_image.png - Android_SplashImage470 - 1 - - - True - - - VideoChatClient\res\drawable-xxxhdpi\ - ic_notification.png - Android_NotificationIcon96 - 1 - - - True - - - VideoChatClient\res\drawable-xhdpi\ - ic_notification.png - Android_NotificationIcon48 - 1 - - - True - - - VideoChatClient\classes\ - classes.dex - AndroidClassesDexFile - 1 - - - True - - - VideoChatClient\res\drawable-mdpi\ - ic_launcher.png - Android_LauncherIcon48 - 1 - - - True - - - VideoChatClient\res\values\ - styles.xml - AndroidSplashStyles - 1 - - - True - - - VideoChatClient\res\drawable-ldpi\ - ic_launcher.png - Android_LauncherIcon36 - 1 - - - True - - - VideoChatClient\res\drawable-small\ - splash_image.png - Android_SplashImage426 - 1 - - - True - - - VideoChatClient\res\drawable-xlarge\ - splash_image.png - Android_SplashImage960 - 1 - - - True - - - VideoChatClient\res\drawable-hdpi\ - ic_launcher.png - Android_LauncherIcon72 - 1 - - - True - - - VideoChatClient\res\drawable-hdpi\ - ic_notification.png - Android_NotificationIcon36 - 1 - - - True - - - VideoChatClient\res\drawable-xxhdpi\ - ic_launcher.png - Android_LauncherIcon144 - 1 - - - True - - - VideoChatClient\res\drawable-xhdpi\ - ic_launcher.png - Android_LauncherIcon96 - 1 - - - True - - - VideoChatClient\res\values\ - strings.xml - Android_Strings - 1 - - - True - - - VideoChatClient\res\drawable-large\ - splash_image.png - Android_SplashImage640 - 1 - - - True - - - VideoChatClient\res\values\ - colors.xml - Android_Colors - 1 - - - True - - - VideoChatClient\ - AndroidManifest.xml - ProjectAndroidManifest - 1 - - - True - - - VideoChatClient\library\lib\armeabi-v7a\ - libVideoChatClient.so - ProjectOutput - 1 - - - True - True - - - - - VideoChatClient\res\drawable-hdpi\ - ic_launcher.png - Android_LauncherIcon72 - 1 - - - True - - - VideoChatClient\res\drawable-xxhdpi\ - ic_notification.png - Android_NotificationIcon72 - 1 - - - True - - - VideoChatClient\res\drawable-xlarge\ - splash_image.png - Android_SplashImage960 - 1 - - - True - - - VideoChatClient\res\drawable-hdpi\ - ic_notification.png - Android_NotificationIcon36 - 1 - - - True - - - VideoChatClient\res\drawable-mdpi\ - ic_notification.png - Android_NotificationIcon24 - 1 - - - True - - - VideoChatClient\res\values\ - styles.xml - AndroidSplashStyles - 1 - - - True - - - VideoChatClient\res\drawable-xhdpi\ - ic_notification.png - Android_NotificationIcon48 - 1 - - - True - - - VideoChatClient\library\lib\armeabi\ - libVideoChatClient.so - AndroidLibnativeArmeabiFile - 1 - - - True - - - VideoChatClient\res\values\ - strings.xml - Android_Strings - 1 - - - True - - - VideoChatClient\res\drawable-xhdpi\ - ic_launcher.png - Android_LauncherIcon96 - 1 - - - True - - - VideoChatClient\res\values\ - colors.xml - Android_Colors - 1 - - - True - - - VideoChatClient\res\drawable-xxhdpi\ - ic_launcher.png - Android_LauncherIcon144 - 1 - - - True - - - VideoChatClient\library\lib\arm64-v8a\ - libVideoChatClient.so - ProjectOutput - 1 - - - True - True - - - VideoChatClient\res\drawable-large\ - splash_image.png - Android_SplashImage640 - 1 - - - True - - - VideoChatClient\classes\ - classes.dex - AndroidClassesDexFile - 1 - - - True - - - VideoChatClient\ - AndroidManifest.xml - ProjectAndroidManifest - 1 - - - True - - - VideoChatClient\res\values-v21\ - styles.xml - AndroidSplashStylesV21 - 1 - - - True - - - VideoChatClient\res\drawable-mdpi\ - ic_launcher.png - Android_LauncherIcon48 - 1 - - - True - - - VideoChatClient\res\drawable-xxxhdpi\ - ic_notification.png - Android_NotificationIcon96 - 1 - - - True - - - VideoChatClient\res\drawable\ - splash_image_def.xml - AndroidSplashImageDef - 1 - - - True - - - VideoChatClient\res\drawable-normal\ - splash_image.png - Android_SplashImage470 - 1 - - - True - - - VideoChatClient\library\lib\mips\ - libVideoChatClient.so - AndroidLibnativeMipsFile - 1 - - - True - - - VideoChatClient\res\drawable-ldpi\ - ic_launcher.png - Android_LauncherIcon36 - 1 - - - True - - - VideoChatClient\res\drawable-small\ - splash_image.png - Android_SplashImage426 - 1 - - - True - - - VideoChatClient\library\lib\armeabi-v7a\ - libVideoChatClient.so - AndroidLibnativeArmeabiv7aFile - 1 - - - True - - - + + + + 12 + + + 4JPNU18C10101373 + 4JPNU18C10101373 + + + + VideoChatClient\ + VideoChatClient.exe + ProjectOutput + 0 + + + True + True + + + VideoChatClient\ + VideoChatClient.exe + ProjectOutput + 0 + + + True + True + + + + + + VideoChatClient\res\drawable\ + splash_image_def.xml + AndroidSplashImageDef + 1 + + + True + + + VideoChatClient\res\drawable-mdpi\ + ic_notification.png + Android_NotificationIcon24 + 1 + + + True + + + VideoChatClient\res\values-v21\ + styles.xml + AndroidSplashStylesV21 + 1 + + + True + + + VideoChatClient\res\drawable-xxhdpi\ + ic_notification.png + Android_NotificationIcon72 + 1 + + + True + + + VideoChatClient\res\drawable-normal\ + splash_image.png + Android_SplashImage470 + 1 + + + True + + + VideoChatClient\res\drawable-xxxhdpi\ + ic_notification.png + Android_NotificationIcon96 + 1 + + + True + + + VideoChatClient\res\drawable-xhdpi\ + ic_notification.png + Android_NotificationIcon48 + 1 + + + True + + + VideoChatClient\classes\ + classes.dex + AndroidClassesDexFile + 1 + + + True + + + VideoChatClient\res\drawable-mdpi\ + ic_launcher.png + Android_LauncherIcon48 + 1 + + + True + + + VideoChatClient\res\values\ + styles.xml + AndroidSplashStyles + 1 + + + True + + + VideoChatClient\res\drawable-ldpi\ + ic_launcher.png + Android_LauncherIcon36 + 1 + + + True + + + VideoChatClient\res\drawable-small\ + splash_image.png + Android_SplashImage426 + 1 + + + True + + + VideoChatClient\res\drawable-xlarge\ + splash_image.png + Android_SplashImage960 + 1 + + + True + + + VideoChatClient\res\drawable-hdpi\ + ic_launcher.png + Android_LauncherIcon72 + 1 + + + True + + + VideoChatClient\res\drawable-hdpi\ + ic_notification.png + Android_NotificationIcon36 + 1 + + + True + + + VideoChatClient\res\drawable-xxhdpi\ + ic_launcher.png + Android_LauncherIcon144 + 1 + + + True + + + VideoChatClient\res\drawable-xhdpi\ + ic_launcher.png + Android_LauncherIcon96 + 1 + + + True + + + VideoChatClient\res\values\ + strings.xml + Android_Strings + 1 + + + True + + + VideoChatClient\res\drawable-large\ + splash_image.png + Android_SplashImage640 + 1 + + + True + + + VideoChatClient\res\values\ + colors.xml + Android_Colors + 1 + + + True + + + VideoChatClient\ + AndroidManifest.xml + ProjectAndroidManifest + 1 + + + True + + + VideoChatClient\library\lib\armeabi-v7a\ + libVideoChatClient.so + ProjectOutput + 1 + + + True + True + + + + + VideoChatClient\res\drawable-hdpi\ + ic_launcher.png + Android_LauncherIcon72 + 1 + + + True + + + VideoChatClient\res\drawable-xxhdpi\ + ic_notification.png + Android_NotificationIcon72 + 1 + + + True + + + VideoChatClient\res\drawable-xlarge\ + splash_image.png + Android_SplashImage960 + 1 + + + True + + + VideoChatClient\res\drawable-hdpi\ + ic_notification.png + Android_NotificationIcon36 + 1 + + + True + + + VideoChatClient\res\drawable-mdpi\ + ic_notification.png + Android_NotificationIcon24 + 1 + + + True + + + VideoChatClient\res\values\ + styles.xml + AndroidSplashStyles + 1 + + + True + + + VideoChatClient\res\drawable-xhdpi\ + ic_notification.png + Android_NotificationIcon48 + 1 + + + True + + + VideoChatClient\library\lib\armeabi\ + libVideoChatClient.so + AndroidLibnativeArmeabiFile + 1 + + + True + + + VideoChatClient\res\values\ + strings.xml + Android_Strings + 1 + + + True + + + VideoChatClient\res\drawable-xhdpi\ + ic_launcher.png + Android_LauncherIcon96 + 1 + + + True + + + VideoChatClient\res\values\ + colors.xml + Android_Colors + 1 + + + True + + + VideoChatClient\res\drawable-xxhdpi\ + ic_launcher.png + Android_LauncherIcon144 + 1 + + + True + + + VideoChatClient\library\lib\arm64-v8a\ + libVideoChatClient.so + ProjectOutput + 1 + + + True + True + + + VideoChatClient\res\drawable-large\ + splash_image.png + Android_SplashImage640 + 1 + + + True + + + VideoChatClient\classes\ + classes.dex + AndroidClassesDexFile + 1 + + + True + + + VideoChatClient\ + AndroidManifest.xml + ProjectAndroidManifest + 1 + + + True + + + VideoChatClient\res\values-v21\ + styles.xml + AndroidSplashStylesV21 + 1 + + + True + + + VideoChatClient\res\drawable-mdpi\ + ic_launcher.png + Android_LauncherIcon48 + 1 + + + True + + + VideoChatClient\res\drawable-xxxhdpi\ + ic_notification.png + Android_NotificationIcon96 + 1 + + + True + + + VideoChatClient\res\drawable\ + splash_image_def.xml + AndroidSplashImageDef + 1 + + + True + + + VideoChatClient\res\drawable-normal\ + splash_image.png + Android_SplashImage470 + 1 + + + True + + + VideoChatClient\library\lib\mips\ + libVideoChatClient.so + AndroidLibnativeMipsFile + 1 + + + True + + + VideoChatClient\res\drawable-ldpi\ + ic_launcher.png + Android_LauncherIcon36 + 1 + + + True + + + VideoChatClient\res\drawable-small\ + splash_image.png + Android_SplashImage426 + 1 + + + True + + + VideoChatClient\library\lib\armeabi-v7a\ + libVideoChatClient.so + AndroidLibnativeArmeabiv7aFile + 1 + + + True + + + diff --git a/Demos/VideoChat/Client/VideoChatClient.dpr b/Demos/TCP/VideoChat/Client/VideoChatClient.dpr similarity index 94% rename from Demos/VideoChat/Client/VideoChatClient.dpr rename to Demos/TCP/VideoChat/Client/VideoChatClient.dpr index b1bc7b7..91996b1 100644 --- a/Demos/VideoChat/Client/VideoChatClient.dpr +++ b/Demos/TCP/VideoChat/Client/VideoChatClient.dpr @@ -1,19 +1,19 @@ -program VideoChatClient; - -uses - System.StartUpCopy, - FMX.Forms, - FMX.Types, - ufrmMain in 'ufrmMain.pas' {frmMain}, - CommonCommands in '..\Server\CommonCommands.pas'; - -{$R *.res} - -begin - {$IFDEF DEBUG} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} - Application.Initialize; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program VideoChatClient; + +uses + System.StartUpCopy, + FMX.Forms, + FMX.Types, + ufrmMain in 'ufrmMain.pas' {frmMain}, + CommonCommands in '..\Server\CommonCommands.pas'; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/Demos/VideoChat/Client/VideoChatClient.dproj b/Demos/TCP/VideoChat/Client/VideoChatClient.dproj similarity index 98% rename from Demos/VideoChat/Client/VideoChatClient.dproj rename to Demos/TCP/VideoChat/Client/VideoChatClient.dproj index 900c066..bc960b3 100644 --- a/Demos/VideoChat/Client/VideoChatClient.dproj +++ b/Demos/TCP/VideoChat/Client/VideoChatClient.dproj @@ -1,1354 +1,1354 @@ - - - {E544FF24-71AB-4245-B7DE-2E2358404669} - 18.8 - FMX - VideoChatClient.dpr - True - Release - Win64 - 32787 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - true - true - true - true - true - true - true - true - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\delphi_PROJECTICNS.icns - VideoChatClient - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - - - true - PerMonitorV2 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - VideoChatClient.dpr - - - - - - true - - - - - ic_notification.png - true - - - - - ic_launcher.png - true - - - - - ic_notification.png - true - - - - - splash_image.png - true - - - - - VideoChatClient.exe - true - - - - - ic_notification.png - true - - - - - VideoChatClient.exe - true - - - - - styles.xml - true - - - - - true - - - - - ic_notification.png - true - - - - - splash_image.png - true - - - - - ic_notification.png - true - - - - - ic_notification.png - true - - - - - true - - - - - ic_notification.png - true - - - - - true - - - - - libVideoChatClient.so - true - - - - - true - - - - - ic_launcher.png - true - - - - - ic_notification.png - true - - - - - classes.dex - true - - - - - ic_launcher.png - true - - - - - true - - - - - ic_launcher.png - true - - - - - splash_image.png - true - - - - - splash_image.png - true - - - - - true - - - - - ic_launcher.png - true - - - - - ic_launcher.png - true - - - - - libVideoChatClient.so - true - - - - - splash_image.png - true - - - - - classes.dex - true - - - - - true - - - - - ic_notification.png - true - - - - - ic_launcher.png - true - - - - - styles.xml - true - - - - - ic_launcher.png - true - - - - - ic_launcher.png - true - - - - - ic_notification.png - true - - - - - true - - - - - true - - - - - true - - - - - splash_image.png - true - - - - - true - - - - - splash_image.png - true - - - - - libVideoChatClient.so - true - - - - - ic_launcher.png - true - - - - - splash_image.png - true - - - - - true - - - - - libVideoChatClient.so - true - - - - - libVideoChatClient.so - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - True - True - True - - - 12 - - - - - + + + {E544FF24-71AB-4245-B7DE-2E2358404669} + 18.8 + FMX + VideoChatClient.dpr + True + Release + Win64 + 32787 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + VideoChatClient + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + VideoChatClient.dpr + + + + + + true + + + + + ic_notification.png + true + + + + + ic_launcher.png + true + + + + + ic_notification.png + true + + + + + splash_image.png + true + + + + + VideoChatClient.exe + true + + + + + ic_notification.png + true + + + + + VideoChatClient.exe + true + + + + + styles.xml + true + + + + + true + + + + + ic_notification.png + true + + + + + splash_image.png + true + + + + + ic_notification.png + true + + + + + ic_notification.png + true + + + + + true + + + + + ic_notification.png + true + + + + + true + + + + + libVideoChatClient.so + true + + + + + true + + + + + ic_launcher.png + true + + + + + ic_notification.png + true + + + + + classes.dex + true + + + + + ic_launcher.png + true + + + + + true + + + + + ic_launcher.png + true + + + + + splash_image.png + true + + + + + splash_image.png + true + + + + + true + + + + + ic_launcher.png + true + + + + + ic_launcher.png + true + + + + + libVideoChatClient.so + true + + + + + splash_image.png + true + + + + + classes.dex + true + + + + + true + + + + + ic_notification.png + true + + + + + ic_launcher.png + true + + + + + styles.xml + true + + + + + ic_launcher.png + true + + + + + ic_launcher.png + true + + + + + ic_notification.png + true + + + + + true + + + + + true + + + + + true + + + + + splash_image.png + true + + + + + true + + + + + splash_image.png + true + + + + + libVideoChatClient.so + true + + + + + ic_launcher.png + true + + + + + splash_image.png + true + + + + + true + + + + + libVideoChatClient.so + true + + + + + libVideoChatClient.so + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + True + True + True + True + + + 12 + + + + + diff --git a/Demos/VideoChat/Client/VideoChatClient.dproj.local b/Demos/TCP/VideoChat/Client/VideoChatClient.dproj.local similarity index 99% rename from Demos/VideoChat/Client/VideoChatClient.dproj.local rename to Demos/TCP/VideoChat/Client/VideoChatClient.dproj.local index 827bc5a..7193ca5 100644 --- a/Demos/VideoChat/Client/VideoChatClient.dproj.local +++ b/Demos/TCP/VideoChat/Client/VideoChatClient.dproj.local @@ -1,48 +1,48 @@ - - - - 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas - 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 00:19:14.000.567,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 09:24:02.000.042,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 09:29:13.000.265,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 09:29:13.000.265,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx - 2020/08/12 09:29:28.000.515,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj - 2020/08/12 10:06:25.000.279,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\Unit1.pas - 2020/08/12 10:06:52.000.317,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\Unit1.pas - - - - - + + + + 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas + 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 00:19:14.000.567,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 09:24:02.000.042,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 09:29:13.000.265,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 09:29:13.000.265,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx + 2020/08/12 09:29:28.000.515,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj + 2020/08/12 10:06:25.000.279,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\Unit1.pas + 2020/08/12 10:06:52.000.317,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\Unit1.pas + + + + + diff --git a/Demos/VideoChat/Client/VideoChatClient.dsk b/Demos/TCP/VideoChat/Client/VideoChatClient.dsk similarity index 94% rename from Demos/VideoChat/Client/VideoChatClient.dsk rename to Demos/TCP/VideoChat/Client/VideoChatClient.dsk index 674b3e5..2e5db05 100644 --- a/Demos/VideoChat/Client/VideoChatClient.dsk +++ b/Demos/TCP/VideoChat/Client/VideoChatClient.dsk @@ -1,768 +1,768 @@ -[Closed Files] -File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.Graphics.pas',0,1,4137,1,4144,0,0,, -File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas',0,1,1,3,10,0,0,, -File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,465,39,481,0,0,, -File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,1155,3,1170,0,0,, -File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,610,86,624,0,0,, -File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.Edit.pas',0,1,1362,1,1379,0,0,, -File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\RTL\SYS\System.SysUtils.pas',0,1,34069,1,34086,0,0,, -File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,3261,1,3276,0,0,, -File_8=TSourceModule,'C:\Users\Programmer\Documents\Development\Temp\NetComTester\Client\ufrmMain.pas',0,1,1,57,7,0,0,, -File_9=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncThreads.pas',0,1,107,1,123,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dproj -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dproj] -ModuleType=TBaseProject - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dpr -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dpr -CursorX=3 -CursorY=14 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas -CursorX=1 -CursorY=74 -TopLine=67 -LeftCol=1 -Elisions= -Bookmarks={1,87,1} -EditViewName=Borland.FormDesignerView - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=28 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[PropInspDesignerSelection] -ArrangeBy=Name -SelectedItem=Name,OnPaint -ExpandedItems=BorderIcons=0,Constraints=0,Anchors=0,"LiveBindings Designer=0",Caret=0,Fill=0,FormFactor=0,Padding=0,Border=0,SystemStatusBar=0,Touch=0 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-318 -Top=-363 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.Graphics.pas',0,1,4137,1,4144,0,0,, +File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas',0,1,1,3,10,0,0,, +File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,465,39,481,0,0,, +File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,1155,3,1170,0,0,, +File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,610,86,624,0,0,, +File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\fmx\FMX.Edit.pas',0,1,1362,1,1379,0,0,, +File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\RTL\SYS\System.SysUtils.pas',0,1,34069,1,34086,0,0,, +File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,3261,1,3276,0,0,, +File_8=TSourceModule,'C:\Users\Programmer\Documents\Development\Temp\NetComTester\Client\ufrmMain.pas',0,1,1,57,7,0,0,, +File_9=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncThreads.pas',0,1,107,1,123,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dproj +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dproj] +ModuleType=TBaseProject + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dpr +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dpr +CursorX=3 +CursorY=14 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pas +CursorX=1 +CursorY=74 +TopLine=67 +LeftCol=1 +Elisions= +Bookmarks={1,87,1} +EditViewName=Borland.FormDesignerView + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=28 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[PropInspDesignerSelection] +ArrangeBy=Name +SelectedItem=Name,OnPaint +ExpandedItems=BorderIcons=0,Constraints=0,Anchors=0,"LiveBindings Designer=0",Caret=0,Fill=0,FormFactor=0,Padding=0,Border=0,SystemStatusBar=0,Touch=0 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-318 +Top=-363 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/VideoChat/Client/VideoChatClient.identcache b/Demos/TCP/VideoChat/Client/VideoChatClient.identcache similarity index 100% rename from Demos/VideoChat/Client/VideoChatClient.identcache rename to Demos/TCP/VideoChat/Client/VideoChatClient.identcache diff --git a/Demos/VideoChat/Client/VideoChatClient.res b/Demos/TCP/VideoChat/Client/VideoChatClient.res similarity index 100% rename from Demos/VideoChat/Client/VideoChatClient.res rename to Demos/TCP/VideoChat/Client/VideoChatClient.res diff --git a/Demos/VideoChat/Client/ufrmMain.fmx b/Demos/TCP/VideoChat/Client/ufrmMain.fmx similarity index 98% rename from Demos/VideoChat/Client/ufrmMain.fmx rename to Demos/TCP/VideoChat/Client/ufrmMain.fmx index 01ffd4a..fc7dcb3 100644 --- a/Demos/VideoChat/Client/ufrmMain.fmx +++ b/Demos/TCP/VideoChat/Client/ufrmMain.fmx @@ -1,1442 +1,1442 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'NetCom Video Chat Demo' - ClientHeight = 576 - ClientWidth = 957 - FormFactor.Width = 320 - FormFactor.Height = 480 - FormFactor.Devices = [Desktop] - OnCreate = FormCreate - OnDestroy = FormDestroy - OnPaint = FormPaint - DesignerMasterStyle = 0 - object ToolBar: TToolBar - Size.Width = 957.000000000000000000 - Size.Height = 48.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'toolbarstyle' - TabOrder = 1 - TabStop = False - object btnConnect: TButton - Align = Left - Margins.Right = 5.000000000000000000 - Position.X = 48.000000000000000000 - Size.Width = 105.000000000000000000 - Size.Height = 48.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Text = 'Connect' - OnClick = btnConnectClick - end - object edtUsername: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Client - StyleLookup = 'transparentedit' - TabOrder = 2 - Size.Width = 799.000000000000000000 - Size.Height = 48.000000000000000000 - Size.PlatformDefault = False - TextPrompt = 'Enter your username' - OnEnter = edtUsernameEnter - OnExit = edtUsernameExit - end - object btnMasterView: TButton - Align = Left - Size.Width = 48.000000000000000000 - Size.Height = 48.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'drawertoolbutton' - TabOrder = 4 - end - end - object ltContent: TLayout - Align = Client - Margins.Left = 48.000000000000000000 - Size.Width = 909.000000000000000000 - Size.Height = 528.000000000000000000 - Size.PlatformDefault = False - TabOrder = 2 - object ltCameras: TGridPanelLayout - Align = Client - Padding.Left = 5.000000000000000000 - Padding.Top = 5.000000000000000000 - Padding.Right = 5.000000000000000000 - Padding.Bottom = 5.000000000000000000 - Size.Width = 909.000000000000000000 - Size.Height = 323.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - TabStop = False - ColumnCollection = < - item - Value = 50.000000000000000000 - end - item - Value = 50.000000000000000000 - end> - ControlCollection = < - item - Column = 0 - Control = imgUserVideo - Row = 0 - end - item - Column = 1 - Control = imgPeerUserVideo - Row = 0 - end> - RowCollection = < - item - Value = 100.000000000000000000 - end - item - SizeStyle = Auto - end> - object imgUserVideo: TImage - MultiResBitmap.Height = 256 - MultiResBitmap.Width = 256 - MultiResBitmap = < - item - Width = 256 - Height = 256 - PNG = { - 89504E470D0A1A0A0000000D49484452000001000000010008060000005C72A8 - 66000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 - 4A6C49444154785EEDBD69705CC795A89979EFADBD5028EC0417102401901037 - 71114951A2244BA216DBA224B764BBDD1D6DBB9F67625EC44C77CCC49B989F8E - FE39332F5EC4EB9988F7625E77DBEE68B9F52CB5B5D9962C4AB2245214497111 - 3781044002044882D80B05D47EEFCD39A7942C11BC5900AAEE2DA000E4C7A860 - 9D045095F7E4C993FB4922914824128944229148241289442291482412894422 - 9148241289442291482412894422914824128944229148241289442291482412 - 8944229148241289442291482412894422914824128944229148241289442291 - 4824128944229148241289442291482412894422914824128944229148241289 - 4400E5FF4B962A8CD19718F3C23B9F41886612E23128A52A218ACA980B7F05E4 - 0CFCCC04992984A4E0673A24275EA734492865F83B92A58974008B9C4719D342 - 8CD5404186A1E286A08287A0C686E047155099FDF01E2B7FD1C0E726E133E3F0 - 7612DE47E133A3E02CA2F0B99128A5A39F508ACE42B248910E6011F13263EE34 - 212BA1A16E80CA5E0B95B01692C3F0FF8294237C297C3589C0FF23E01446A063 - 31E826E4D66B944236258B01E900CA981F43D77D82B12668815741855F89157E - A12AFB5C41A7C01DC22DE82DDCACA4B4EF573894909425D2019419CF99660314 - 4A337FAD28F70A3F1B907906CF701B5EBDF87A475106F98F2465C0A236AEA502 - 567A682DDBA0305AA192E0F87DC902CF88F3075DD0ABE994CE60E1910E608138 - 649A3849B705DEB63B55E9E17332194252669CA4F408496762246D4C115D9F84 - D7444CD71353BA393566E01CBF6EEACC8C46A0A74E88120AAB9AA251A2C1FB60 - B5AAF9829A5619D0B40AA2A941A2B902C4AD85895BF1138F8B100F184D76F5C0 - 2EE80CE0BF0E700617DF5694C9AF5325F3897400F3C8CF1953CE30B65EA1740B - 656C2D54D8A2F40F7F67EA2689A5C7483C350CAF1BA9C4E4D5CEC49D0A5D6AD0 - 61546C68F379567B7C9E3AE2775713BFA690003C0CF8B4C281BF638CD2EB2663 - 1777527AEDEF28059F20990FA40398075E324D1F34BA5BE1ED76A8BC81AF53E7 - 0ED4065D8F9368F226998AF6A42627BF3A1BA7E90C7C54F9C0DC2E5A71DF0E7F - 689DA7C2BB8A04353F098137803E45618041C6E0BF73F087175E5794C4D7A992 - 52211D400979C634436E42764145D80CB5B5A0CA9026642AD54F27263A9291C9 - F350E1CDF2AAF0B3C1147008DB76F82BDBBD61CF1A56097A08F21FCD09304CE8 - E4904BA087D3EF290A0E152425403A80128015DF47C85E78DB0E463CE76E71C6 - 24935357C9D8C4B1EBE3C9C1BE25B596EE6A5CE3AADED75C1DDC40AA5D0AA9E0 - C9B302CAC3E1400774054E4847E03CD20138C841D30C40C5DF034AC5C93DF5EB - D49981417B72AA870C8F1FBB3E9ABCB9B42A7D3EBCAB9ADC55FBD7D604D7913A - 50D25C772A1AE00C2E4D812338AC28384C90388074000E80DB71AB18DB09CA7C - 009AAB5967C871122F3549C627CE40C53FF139B46ACB7537AD46AAF63E18AADC - 49EA3C15A40AF4376B6F097E01C7425F8C537A466E43B68F74003679C134DBC0 - 200FC0DB59BBB5389937D54F86863FE81ECC0C0F6478B20470D535BAEA9E6C69 - 08AE21F550C9E7325F8267138EBCA9289D5C961481740045F23C6361C2D813F0 - 76CDD729F9818A9F1AEFA003A31F9E1E35E3B17959AA5BAC28FE805AF3C4AE9A - AA76D6088EC0C39367A25FA7F4A3DF533ACE65490148075020B8967F9EB15DD0 - EAEF85D78C2D15D4F474A483DE1A3B7C7AC448C670324B324798DB4FEB9FDE5D - 176E672B5542DC3C590818B10EAF13DB283D2DF7101486740005F09269D641A5 - 7E0A2CAC8E2709819FEB135DE4D6C8BB678664C5B787EA0D28B5CFEEACAF6C25 - 2B671B1AC0CF87C159BCFFBAA20CF324C92C4807301718A32F10B29331B61FA4 - BCB3FBA04C161D2483C36F75DC4A4746E4049583B8C3B55ADDF3ED2B430DA401 - 7A5E33D92DC63B39F6262167643093D9910E60165E662C9866EC69783BE3583F - 9D2113836F0E5E8FF574CAA3AF2524B0AECDDB70A861ADDB432A79523EFADD94 - FEF1354AA7B82C11201DC00C3CCF583365EC196846F2AE55C3CF32A36749DFC8 - E123A33C49320FD41E3C5053B383348101E75D76859F2519A5EFBD45692F4F92 - DC8374007978C134F7C07F0FCED4DD8C4F9291DBAF75F4A54764777F2170D7D6 - 6A2B5E6E6FF2576423230981C2C361C0E76F2ACAC9AF532477231DC03D3C639A - 1E37214F8362D6F3240BD8EA8F1C233DA3478F4478926401A979F840B8763F59 - 076596B7370065762D4DC81FDF5394144F9200D201DC053FBCF30228A59A2759 - 48A7C844FFAFBBAF95FB461EC5ED515D8D75956AB8AA8A7A3C3EC5EBF2134DF3 - 2B1AF3514A14A610FCF7F5F29A49D2D4242663C434759AC0B38766321367A954 - C2888C8F67068627CC74AAACF72FE046A2553F6A5DE7F5B0304FB2004E600C9C - C09BF24CC1374807C07999B11519C69E0323111ED70545B1B12ED237F8C6E783 - E5B475375BD19B9BEAB4AAAA06ADC253AF78593D75931AA23A1C59C820519626 - A366920EE993A9217D7C7C30D3DB375C5E8E41230D2F3ED8106ECDCE0D086D9B - 521A876EC2DBAF517A9B272D6BA403009E33CD16153A0050F985EBCCB8A167E8 - B0D13D71F6D882CF286385F7B4AD5FADD5D7366B7EB69AF8C82A28C41937CA94 - 0AD0579A24C84D3D4E6FE84323BDA9CE6B37CAC12154EED81FAC3FA862990AF5 - 02FAD22193EFBDA328DD3C69D9B2EC1DC021D3BC4F21E42018B350177844B7EF - 95DEEECC40FF8275F99570D8E7DBD8D6E6AA71B742FF64DD1CB7C8CE3B262129 - 12233D99D17457E24A67A719892C58400F1C1234FDB8A525DFD163286C8C5EFC - E11B8A7291272D4B96B50378D134B783D17E8B8B16121132DCFBCBE3BD0B117D - 87FA7CAEC0B6CDEDAE3A6F3BF393F50A9BDBF1E272C1A4C4A071722D339CEC88 - 9DBFD4C112897977A018A5A8F927FB9A7DE1FC3B37614870E44D4A4F7371D9B1 - 6C1D00B4FCBBE1E11FE6A285893ED23FF0EA91012ECE1B9EB6D615DEB50DF7D3 - 30D9EA644B6F1A2445E1C50C92668C18CC8406DB205F574A95B8A842144A894A - 55E2662AF128F0CAFECC01B067C026C8C564EFE0D95467D7BC8FBD1B7F78A0B1 - B229FF462ED0F367D013F8828BCB8A65E90066AAFCD0D49BA36749CF7C6EECC1 - F059C1EDEDADAE35A17D8A8734F1E4823175658A25CC8811D3237A7C326AC626 - 63466432A64F15D715D782619F1AAE0828818A80E6AF08A9012D4C7D4A58D1CC - 82C27BDD8D99227D99FEE8F1A9731D5DF319E6ACEEC903D5D53BC97A2877A8EF - 56202347DF5694535C5C362C3B073053B71F2BFFE0A7A42B72FCC8044F2A2938 - A1E7DBB17D8B7BA57B3FD5480D4F9E133080652C4E46F5A83EA88F8E8C24076F - 0EB364725EBAD9D4EB75791B56D56935B5B55A486BA07E52435961B6C474329A - BE953E96387BEEE27C4D1C86F71DA86C7884B4E6730290F827E8099CE3E2B260 - 593980E74C733314F2412EDE8B71EB03A3337AE658C9E3D3675BFCDDDB377BD6 - 781F01ABCBBBE7C0824192FA38B9991A19BA95BAD13FC832F353E16783BABC2E - CFEA350D9EDAFA954A15595DD0F0C12463A9FEE4A753A7CE5D9A8F1E4168E7FE - 8A954FAA6DF05638A7028DC3E17714E51217973CCBC6017C8FB1F5E6D7EBFC96 - 678642D76FBD1BBB3275E14CC963CDF9B6B4AFF5B6D43C455DA48127CD0C2319 - A8F4FDA98181DE447FDF1065FABC759B8B81518DFAD634D57B1A1B9BB52A1877 - D3B95D22C2326430D93DFA7EE262C7759E5432825B7706563E1BD8088D8165D9 - 178C832994BEF35B4AAFF1A425CDB270007C93CF4B507344EBFCC68D775397A7 - 2E9C2C69E577AF6EA8F46F6B3DA804C8269E34234602BAC8B727BA125D5D7DCC - 28EF5D78F9A09A4BF3B56C5CE35E51D9AAFAE636C4D113A43371AEE7FD4CFFCD - 926EB30E6EDD1358FDAC07CBC2D213804AA1BB287D7D396C165AF20E8087EEFA - 01BCF57D9DF20D38E61FF8C0B852CA6E3F76F7430FEF7E406B501F0365CFBA61 - 479F207DC99EBECBA981FE2575BAD0D3B8A6C6BBAE69935639FB2427944B5A1F - 343E8E1E3DF545298705381C687C52DD08E5229A1348B8297D159CC0BCCC072D - 144BDA01E0C11E188C7E1FDE5A5A1F787076FB137265FCC49192ED0B77AF6DAE - F3DFBFFA39C54D56F2242138A1678C929EA9CECB978CF1D1257D7E5DADAA0906 - DB366D566BC8BAD9260ECD34B915FFF2C63BE9EBBD258BF053B5F74068C5A364 - 2378194B5E20612449C86B4BF900D1927600874CF3103CA0F054DFF059726DF4 - F091112E3A4EF0E13DBBDC2BDD07A1399B318C15B6F8B1CB572EE86323CBEA80 - 8A0B1C81BF7DD3F6597B0494E8E95BE9C353474F966CB34ECDC103B5753BC476 - 028EE1DADB8AF23617971C4BD601E0797E283C0CE165A1949B7C70DB6EE5C35B - 0E511F69E54942708C9FB8D2777AA975F50B058706BE8D4DBB669B236009D235 - 71F4E2DBA5DA5E3CD36621A824C7966A3C8125E90078249FE745DDBAA9513274 - E31F8F9424428CA76DFD0AFF96952F53357FB82A939154AA77E26CFCF2C51E9E - 2401FC6DF7ADF3ACAFDAA1D0FC4B88CC2013F18BB75E4B755E2BC9E4DCEA7F77 - A0395843EAB998038C086F2F7E6B2946165A720E0063F86518FB4BA8FC96305E - 78B0A7FBEF4F5FA6E938FCD859827B776F73AFF57E7BA62E3F76F727CF9D3F6D - C62665DC40014AA0C25BB17DDBAE1987053824B89EFCC3D48953E7798A636028 - F296BFD9B5497480082A4AD245E9BF2CB518834BCE013C6F9A7F06FF59BA7278 - A4B7F717DD979C0EE4919DE57F6CDFA3AE1A96F75C0163249DE81EFD22D17DB9 - 8F274966C0D7B2A9C9D752F300A5F9574DF431FAD9C49F8E7FECF42A019E226C - FE69CBE63C4789FBDF52947FE3EF97044BCA01BC8017763086D7744D03BB7037 - 3F302E3BBDDC875B79434F3EF09C12C85E062AC48893C1A9B3973ED7A30B7734 - 7631A285C2BEE08ECD0FAAFEFC1BA6CC18B918FDE08B779CDE4A8CCB83AB9E54 - 378986904BEDF4E092710078690734ED3F84B7968D1DE35DE4FAE01B4706B9E8 - 08785C37FCC4AEEF531F59C7932CA407F54BD1B3A72F94FBEEBD720577158676 - ECDAEA6ED036F3240B2C417A221F9EFE8DD3C78D1B5E3CB0A2AA553814315C84 - BCBA542E1F111E8A586CC0B85FD509C1D8FD96CA9F4CD1C8D761BC9C43AB0879 - 2A0FEEFAF3BC959F113D7679E8C8E49913E765E52F1ED41DEA1075893AE5C9D3 - C032C0B2C032E1498E0036731BE33F72F16EB2B68636C7E545CD92700029C676 - 432DB3848686B4CCCD5F77F5C08891A7D8070D2DF8F8B6BFC87B6CD72089C9D3 - D7DE4FF674DDE029129BA02E51A7A85B9E340D2C0B2C13679D804E30F82BDA10 - 4FC881B6A633F6001717358B7E08F01DC6AA34C6FE12DE5A3CF2F031D2E964E8 - 6EECF6636B93AFF21B29323675F2D2A7C59EBF77124A5CAA6B457DA356155EA9 - F8FCB58AC75D43351686570555981F7F254D5976A2CBCD681AFE63CCA471A6D3 - 497845CC547AD44CC447F4F1C8ADCCEDA10146320B7E1E01E31304F76C7E44F5 - 884F5062AC8189C3A7FFD5C9E100861CAFDB4FF0F4E0BDE050E015180A8C7179 - 51B2E81DC021D37C091E62351773E0A51D7DFFE5886327BA70C2AFF2E9077E40 - BDE21D6366828C448E9FFE78BECEE4DF8B1A0804DCAB9B37B94295AD4A806DA0 - 9ECCEA64427CE4B550BC3E621869579F31C5AE98636397D3FDBDDD463A8D4E63 - DEC15804E17DBB1E537CE2CB40704E60E2FD2F5E757262B0E9DF1F582FBA7C04 - 7A0237DE5694D7B9B82859D40EE07BA6D90AA5FC1D2EE6C06E5BCF3F755C70EA - C61E5CEAAB7A66EFF3F966FBF549723BFAF9A94FE7FBD49E5A5553ED6B6ADEAD - 557A7628EEF4BA447A7E867450F9325AD2DD6B4452E7127DBDA78CF1D1796D05 - A9EA51430FEE7E44AB202B78D234707560FCBD136F39B544883710ADFBEBF6AD - 50592C479BC1C3FEFEB78AD2C5C545C7A275008F32A65531F65750C296F8F7A3 - 6748F7F007471C33CAD013071ED7AAB337035BF8BAF29F84CA3F3F5D640CBEE1 - 6BD9B0D3555FF988EA4A6F98AF4A9F0F9F9B9846C67D353334F169A2FBEA99F9 - 0A52822B04E187F63E96CF09E863F458F4C3231F71D1361852AC662769E1620E - A840D1714AFFF9134A9D9B689A4716AD0380AEFF5EC8FC835CCC81B3FEBDFFF9 - D34E2EDA26B067F716CF5AEF0B5C9C46B6DB7FE4D447F3D1F26BA1CA90AFB5ED - 51AD9A7E2B992A3E265F29F17A94297D4C3992E8EAF8508F4E94FC7013F604C2 - 07763F9E6F3890EE4BBEEDE48EC1E6BF7DA44D74F310D8E1A23D2BB0281DC041 - D30C400DF889794F970C1E86F5BD317A21D6F595235B6D31426FE0FE869FC098 - C2B2BD97A5C9C4F867A70F977ACCAF064341FFA6FB9ED57CFAA3C91976C6CD84 - 9791B4696813990C8D28462269E8668299D088EABA4E554A99AA6A4455DD54D5 - DC54D3DC9AC6420AD5C376BE4F4F689F243A3BFE586A47807302550FED3A48DD - 82F31794E8B12F077FE95424E240EB7DDEA6176BB642AF735ABD812E58668A90 - 5F1E5694924794729A45E9009E67EC31C2D8FD5CCC3139486EDFFCD51147B6DB - 664FF53DBEE567C2833D06494C1CBF04C65DBAD97EECEA07B66E3DE80A799F4D - 9A89392F6F795D34694C6A037A2C3A90999C18CD4C44C6592C569461D24020E0 - AA0C57B92A2A6BB440A851ADD01B931996F7AAF47BF12ABE54269A7C3776E1C2 - E1520E0D70D760E5BECD4FC380DC1AF4C52013131F5DFC07A74E11AEFAF181A6 - 8A06C1B083D22FDFA2F4632E2D1A169D03C0C33E69C67E0A6FA7CD70635CBFDE - FFAFE37C3AE2CCC45FD5771FFE81F0482F2399C9D3D70EA787074A1629C6DBD2 - B6D5B5BAFA47BAA9CF298C9647552399F1F8D5F4D0506F7A6878043209EA2805 - 5471D7D7D5BAEBEB9B5D55FE0D29C3C87B11E7DDB8DDDA58AA77EC956477E705 - 9EE438EEBAC6CA8A5DEB0F82455B26EAF028F1D81F4EFCC689494177B8566BFE - 1FDBB741AB7F6FAFD0800FFFE5DB8A52F2A0B24EB2E81CC0F3A6F904FCB7F56B - E91B9CDCEE9B0DE6D1E87E968BD388758E1C495EBD52924D3ED9EEFEB62D3FD4 - B5F41E9E9417EC66A712B43B7DA3EFABCCC8D0826C4B75D5D6D7B95737DDE7F1 - B196B90C1734DD7D327EFEE2ABC654B42427EABCEB5A570736D55BCE8220E981 - F4BB4E05156978F14043552B59CBC5BBB9F096A27CC8DF2F0A16950338649A15 - D0ECFF149AB76933DF0694EFB5BF3F73DE48C66CB77CEEA6E6DAE0BED53F138D - FB716F3F6E4DE5A2A3F8D6B7B47BD7D7FC249936AA7892102F51A65223B10B89 - DEEEAFCC055A8BBF17C5ED76FB9A5BEEF3D406B626C9CC13945EB71A49F68CFF - 3271B5F32B9EE428153BF76E139E1DA0449F3A7EE31FD27DBDB6A340A9DE80B2 - FE6F766E035B9CE6F4C0284DB0C55F2CA65EC0822E21150AA574D7BD951F8974 - D05B4E547EA6B915FF8ED58744951F4FF5E1C11E2E3A062E6755EC7AE039DFFA - F0DFCE54F915378DB3E1A923E3C7CFFC3AD6F9D597E552F911CC0BE609F34686 - E29F615EF98F2CC033867DEB427F83CF8CCFCE931D03CB08CB8A8BDF00658A65 - 8B65CC538A066D0D6D8E8B39D036D146B9B82858340E00037C2A8C593C3B283D - 35F4C7538E748143FB77ED1605F0C47BF5A64E5D3CE6F4C11EC5EDF7861FDEF3 - 3FEB01F65CBEF57CDC8547278D73B1CFCEFF3AD175E522338D79DD6C540898B7 - 7877C779CC2B9934BEC4BCF31F4D039F159F199F1D75C0931D01CB08CB0ACB8C - 27E5C0B2C532E6A22DD0E6D0F6B898036D146D958B65CFA27100D0D7DA0A0AB7 - 4CF04C7491DB4E44F8C1B8FD18BA9B8BD3485C1D39A9C7261C8DE2A3866BAA02 - FBB6FFEF699AB6CC67DC4163AEDBD1D33DAFC52E7C798C65D20BB2C5B81830AF - F10B5F7E8E79C767E0C916F0D95107A80B9EE408585658665C9C0696B16BCDAA - 394D5ECE04DADC7807B5C495441B455BE562D9B3281CC0CF195320A33BB89803 - 94AD8F1C3EE348EBEFDBDEFA24F4472D1359D938FD0E4FFAB9EA1A1A82BB5BFF - 0F9D64844128B3ADFE48E2F3E8E727DED22363E33C79D18179C767C067C9D71B - 401DA02E50273CC911B0CCB0ECB89803CBD8BF6D1D4E24DB66EC4FA747D006B9 - 98036D75B11C175E140EE00C63EBA1890F7031C7D42D32644CD91FFBE3755DAA - 9FB473310706F0C4187E5C740477C3CA95EEEDCDFF219DD68527DA5CAA1A9D3C - D7FF068EA9B153CD931731CCC467C167C267E389D3405DA04E50373CC911B2F1 - 170543012C6B2C732E160DDA1EDA201773A0AD6618DBC0C5B2665138008552CB - 211C50B239FCC76EDBCB7E78D007EFEAE3E234307AAF93013CB5DA867AD7D635 - FFAB99368451835DA6EBC6D4C973FFB650CB7AA5049F099F0D9F91274D037582 - BA411DF124DB60D9A57AC7CF72711A58E658F65C2C1AB441B4452EE680B44531 - 0C287B07F08C69862863166F9D9A24E34E04F8C45B7A45177562DC7E27437767 - C7FCF7AFFBDFF2557E35462F474F1EFF83914A2DD988C1F86CF88CF8AC3C691A - A81BD491937302F1CEAF7AB02CB99803CB1CCB9E8B45833688B6C8C5BB5903C3 - 80BCE1E1CB85B277005E42368337B578EA8933C4762B8967FCB357740BC04B3B - F85BDB28BE802FB8A3ED7FC9D7ED275103BAC8A7FE041DFEB29DE1770A7C467C - 567C669E340DD411EA0A75C6936C93AF2CB1ECD106B85834F96C312D58B52A37 - CADE0140DFCA729B2ED492E4F889CF6D1F32F1EDD8BE053460A9949908E975EA - C61E46290DECDAFE3FA48D8C2568499648FA64FCE2979F7369D9907D6678762E - 4E0375853A43DDF1245B6059629972F11BA0ECB3366013B445B4492EE680866B - 237F5BB694B50378CE341BC0022CDDA8A91EF4B8F6B6FCE3F8CFB3DAFD101773 - E0459D89CB971DDBF013DAB9FBBBBA92161A993A619C897F7561C984982E147C - 76D40117A7813A43DD71D13658A658B65CCC8136607F2E40E736391DB45DB461 - 2E962565ED002073A2586C64FCD875DBAD7360D7E63651EB8FB7F4661CBAA1D7 - B7A1ED3E5715B3442C4268827E3579E9CB135C5CB6A00E50175C9C06EA0EB748 - 73D11658A658B65CFC06B081AC2DD8249F4DE6B3E172A1AC1D007850CB693CBC - DE2B79B3CFF636587763702F7F9B035B88A9AF2E5DE4A22DF0608FB2AEEAA7A2 - 1D7E6ED375237EEEEC512ECE2B5473A9AEBA15214FD3DA1A7F6B5B23BEF03DA6 - E1CFF8AFCD2BA80BD4091773A0EEBCEB6B7E8ABAE449B6C0B215F50244B65028 - 6893689B5CBC9BB276008E8CB14AC1CB8CAD483386177D4CC389537F78896760 - FBCA9F7131076E1C9938F6D9675CB445C5FEFD3F139DEAC3B5F0A953E7FECD48 - CCC36CBF4AA96F5D6BBDA7A9A6C9DBC01A55B75EC3180BA93E9FD0F11B898409 - C3EEA891D64693837420D537DA97E8E91A2206B3541AA7513D1E6F70CFF63FCB - 188625C41B9E229C3C76EC1FB8688BCAFD0F3D24BA7B3076EED63FD8BD7434DF - 294137A5AFBE4669492E34B54BD9EE566AFBF9CF711DD5327176EB0FBD3DE654 - D4D60699E0AECD0714AF75CF7FFC72DF09632A6A3B70049EE76795DAF7B89803 - 77C3C52EF6FD5E8F464B1A25C7D7D2D6103AD0B6A7E681FAA7036DE19D9E1AA5 - 49F528D554D3BC8A2BFF78177F86BF83BF8B7FE35F1FD81A6AAFDBAE35375710 - C39FD0C7464B16F18619866EC633B703AB2B37EAFAF45E93A918AB3457B017BE - DFB2E9A660741277AFA8B46CD2517D152C75B5AF9B8B45919E60E9EAEDE1462E - E600638D5DFEBBBF2BCB7B22CA7608004D8EE5D61D1D149919E8B7B5F68FB1FD - 69A535BA2FC6F77362E61F23F960300F2E4E2371337DAA949B7C423BF7B436FC - 74CF8F6A9FA8FF5160857A3F3CABEDA534FC0CFC2CFC4CFC6CFC0EFE23C741DD - A08EB8380DD429EA968B4583658C65CDC51C6813681B5C2C0AB44DB4512EE610 - D972B950960EE025D3F4413355C7C51C897E6AFB928FC0B6CDEDF0D096D35AC9 - 817147028906B76C7D4A14C9C76D6A4389CB17856BDF7609B46F5EBDF2A77BFE - A2F201F777DD6E77C9669DF1B3F13BF0BBE03B57F16447411DA1AEB89803758A - BAE5A22D9237AD658D3681B6C1C5A211D928DA32DA3417CB8AB2740069429AC0 - 6B5ABAAA539793B6C370B9EABCD642662493ECB67F951746EED52ABDCF703187 - D74DCC5877CFA7F0458EEEEDC716ABFEC5070F563F52F5B2EA763BB6857636F0 - BBE03BBF8FDF6DB7D5B4C2B2BA429DF1841CA85BD431178B2679ADEB065ED9CE - C51C5ABDD7F6C61D918DA22DA34D73B1AC28D72180F54C3E34029173676D8D41 - 31D027F35B6FF6D1C749BF1371FD7D6DED4F8B027866C688E361BBBCCDEBEA1A - BFBFF9479E7A754E1B59D25142A25708193D3E4606DFEF21B7DEBE486EFEDBD9 - EC0BDF631AFE0C7F077F772EE077631E302F3CC9115057A8332EE640DDA28EB9 - 583458D64684F473F11B7CA4196D844B4581360A155E344C75F4A0935394A503 - 5005CAD2E3246A37A8A36F635B9BC2AC139FC98181EBFC6DD1645B7F9FFE2817 - 7360749CD8954B8EC68C0F3EB06763DD23D53F54BD5EF1D6624E72142AFC49B0 - F4FF7E92DC7EEB28899C3C4A625D5F91D4E04DA24F4488118F655FF81ED3F067 - F83BF8BB37E06FF06FF1336602F38079C13CF12447409D89220BA18EB550D8F6 - 1EFBD42D6B99A36D04DADB2C3B4F0B016D3419B72E078A6CBA1C283B0780D154 - A0965B2E7A48DE24B637E7B86ADC96092C3C2E9AECEFB37DAAD0DBD2F6982830 - 26BB153F67A6929623A9C552F9D8FEFBAB76BABF4D7C3E4BD8B23BC46F1132F0 - FB2B64E80F50E1AF5C24AC88E86126FC0DFE2D7E067E167E665E202F9827CC1B - 4FB10DEACCBC11B39CE4431D7B5B5A2D8EB65012FD7D43C4B06EDF55ABDCB68F - F126FBAC0E006DBA1C2305959D03F013B202C74C5CCC11ED4ED90AB4983DF411 - B0CEC69A5172C36EA8AFECCC7F0DB54413C218FDF19EEE4B5CB44DF8B1FD3B42 - 1B956F71D1421A5CE4ED77BBC8C8874761D8E1DC88033F0B3F133F1BBF231F98 - 37CC23176D93B8D6790983A0723107EADAEE8A0096B91E2537B9F80D6023760F - 08C5AFC5440E80A26D73B16C283B07A00B9404CA3327AF9CCD1B68722E78DAD6 - AF8687B578E0D4E0D04C6DDB9CC0BBFA44D775256FA7CE3B15CAAB62EFFE4D15 - 1B1561C83204C7EEB7DFFA8CA4471C898C2E043F1BBF03BF2B1F9847CC2B176D - 8131063102321773A0AE51E75C2C1A51D9A38DA0AD70B128A29D17702F89654E - 4964DB0B4DD9390070BD96EEBF6E92184DDB1BFF6BF5B5CDFC6D0EDC169ABAD1 - 6FBBC6E0459DFC6D0E8CDB9FECED72645BB16FDD8686F0C6D4412E4E039532FC - C9ADECD81D4318951CF80EFC2EFCCE7CDF8679C53C73D11689EBD73A50975CCC - 21D279A160D98BB6068B6CA510D0563326B1345822DB5E68CACE014069589494 - 1EB32AB350B420B3C4DF6371326AF7CA2ABCA21B6FE9E5628E4C82763931F657 - BC0177C581C6EF88C6FCB84E36F8FE5592E8BBF675C23C82DF89DF2D5CD784BC - 629E31EF3CA5685087A84B2EE6409DA3EEB9581458F668035CCC21B2954211D9 - ACC8B6179AB2720078E537FC6789D89A1AB6E700B2633A8F606521AADB6EFD7D - 6B9B77890EFC246FF475F0B7B6A87976DB231E9FF54834365B4338261FB404A6 - 9D37F0BB310FA29E00E6B916F2CE455B8874893AF73535DB0EF12DB401B015BB - F707E4B1D930B7F1B2A1AC1C403563D5604C9609C0D4F594ADFDF9AE754DF5F0 - A1D688BFA323F66F89A9F45866BEB377F539B0EE8F27F5BC15E25802239FDC2C - E9787FAE601E86FF649D4B433C90777C062E160DEAD24DB4312EE650C39EEDFC - 6DD1886C006DC5BB61ADAD218CC866D1B6438CCDE9BEC7F9A2AC1C8041883016 - DC6477A72D07A085AB84BBE49283376D555235100808BBFFE3F1ABFCAD2DC20F - 871F87EEB47545E43276C11D0B57689BE48D9E6C9E2C40DEB3CFE0007A346679 - E0EC3000CA808B4591CF06F2D9CC5CC967B35098B6EF247092B272002A21966D - 9EE03533663C626B979E56E1B11426D349CCEEDDFEEED5CD9B44DD7FBCA597BF - 2D9A8A1DBBD68BB6F7666284444E3B7262D951304F98B77BC167C067E162D188 - 748ABA77AF69B6B57F1F6DC0D4AD4B8D229B2904B459305A8B7D896C7C2129AF - 1E00A596B12E68D0FE449A9F59BA73664218C9B5205CA14ACBC6225CFBFFFA8A - 6E7B78B7ABC22015A39F41E7623E66FB0B05F294CD9B807CCF5208A853D42D17 - 73B82A2A5BF8DBA26109D3728047643385020EC062BB221B5F48CACA01288C59 - BCA33969DF01504D10FA2BA6DB3E59A804AC973F1893DA009894AD433F789EDF - EB715BD68C7137DE424EFACD06E62D66DD614FF059F099B85824CCFC5AB7D311 - 9541A1886C4164338522B25D918D2F2465E50018A516E5E893D635E042C8AE00 - A8D66E971E9FB415948312974A3DD648BF9968D4FEC6A2CD35F7F1B7D398383B - C30E9C32217A4EBCF891EF990A418F452D0E00CB00CB828B4521B405B019BB3B - 02F3D86E05FFBF2C282B074019B3DC140BE34A5B0E405BD1289C583463315B27 - 0B5D2BEA57241338A49B8E3119B137FBAF52EAAF4C5B0ED6A4C640170E6EEF2D - 1599F151E101A2EC33C1B371B128F4A855B758065016B6561ACCD8A4D016F2D9 - CE5CC963BB651517A07C1C00631446B6160700DD285B13755A558570CC654427 - 6C3900AD2A2C0C8891898C5996AB0A21D0B271A52892CF54E7E2B92334D66555 - 4136B2103C1B178B221D9D10C68380B2B0F5B946248F03C8633B734564BB591B - 075BE7E28253360EE0BB793C6366CABAA7BA1014AF47B84C04AD89ADA545C5E7 - B7ECEAF2BA9498DDDD7FEEB555C27DE889EB96CD70654BFCBA38B45EBE679B2B - 0C7A6DA26DC1A2B228047D2A92106D09CE673B73259FEDBE24E8E92E1465E300 - BC7994A2C762B66E00A11E97B55721B831B650A8CB6D098291498B6FBF2D044F - 2DB34CFEA5A1DDC3E3B98B053C7E9C12B4D56A2DB3BD29C8649A75C6DEE3B6BD - B986E982EEBAC763ABBB3E83ED96CD30A06C1C00B84AE159697D3C62CB01104D - F3F37739A8030E40710B562C92F66316A85AC6B2FE9C5CF80D7F059312E4D9A3 - 656C470ECAA4A8C5B5508DD9DE5C23B209AA29F61C401EDBCD67EB0B41393900 - E1B8C848256C2DA929AAB567C10C7B138B08D398E5F8AF62246CC5FAA76E97AA - F87C96CFCD446CAF58CE3BA23CE3B3E13372B128443A169545A1886C42D1982D - 0790CF76F3D9FA4250360E40234418E081A632B61C00A8DAA26C53C7A3D9F650 - 1566191F1ABA696FCB72558DD090F5C8E29900BC43BE3CBBC275B696C18C9455 - C7A2B22814276CE25EF2D96E3E5B5F08CAC60164F2E4C56EB950CDDADD62547C - 8AB5104C8AE5381D660A0FC6CD19AD22249C0731D3B6FCCA82902FCF5A45D0D6 - 049868B24E54168522B20991ED14423EDBCD67EB0B41D9640410760DCDA8BD73 - 00221466DF0128845974C732695B730B8AAA080D79314D00DE215F9E615C6D6B - 08400CEB074359D8EE523B6113F792CF764101D20148ACD8ED412C06EC3EA3A2 - A8F61C88641AE5E40084DE5209851D2F70E832DA7E6E93506B97D1E5B6D56534 - 532961B3A9B86D07D69977F2E539DF33CE1546544B2F09CAC2B6E374C226EE25 - 9FED82A13BDEDB2896B27100AE3C4AD16C0EEF982E58DE61F69F1BBA8C96011E - 55ECCDEE1AF1987008A1B8CB66D978CEE4CBB39188D97200D4AD5A9CACA82C0A - 45641322DB29847CB69BCFD61782B271005082C22DBFCCE3B2974766ED72C248 - DBF6A4916152CBF651D5EEBA71745C18FA4C0BDBDA92BE20E4CBB33E316E6B0B - B6A26A96B2139545A1386113F792CF76F3D9FA4250360E201FAA477C97FD5C31 - 0DEB1972AA5AC383150AD5A965D38FA9FAECCD70A73386994858E3E087CB2A88 - CC9C70555AF38CCF86CFC8C5E2D0348B8E45655128229B30756A6BF9259FEDC2 - B8A06CE67ACAC60180F6859B68B4AAB03DCFACEBD6E8AC1822D426669A5AB6FD - 2A5E627B434A4A77594EBC796C87A6987F3C8208F819C3653F06A3C62CFB0844 - 655128229B60B6F775886D171C80ADA18593948D0348526B4B8D6881802D07C0 - 5219CBE72A0E380096495B2AAACB6DD80EF6A0DFA696089B9E4A68A116D14420 - E615F37C2FE9016AFB066685EA96AE85A82C0A856A825E61CA66305A7F20DF04 - 76D96CEC281B07F0BB3C4A7105C5FB03E68A994C898F7A06EDDD026B26E296D6 - 2C9931038AC76BCBB9A4AF8F0A62EA10E25F6B3BF2D5BC912FAFF99E6DAED040 - 2020BA7F5154168580B6409960C7681EDB992B5A85785EE1F53C8DDD4250360E - 80508ABB39ACAD7585BD6D93FAF8A4F00CB91AAEB4B57D541F8F0823FFB8C295 - B64249C57BBB0659226171868156DB11AAE60D515EF199F0D9B85814EE50A538 - B64324622B4E9A1AAE101F19CF633B734564BB591B075BE7E282533E0E006002 - CFE80AD89BB0D36F0F0837A52B36C349676E0F0D787DD6BD0B6A458DBD136F06 - 63F109B725F697B7067451EDE835FC25C1555593CDEBBD649F099E8D8B45A185 - C216056019A407ECDDEFA804F238803CB63357F2D86ED974FF91B272009431CB - 640E74A36C3900339D32A09A5A3FD75F616BBCCE48C6602997654CAB55866C9F - 794F5C1AFD8ABF9D46E5FD8E5EC15F1242DBC551BA9317476DDF94A405ACBAC5 - 32C0B2E06251086DC154A6B2B663833CB66BEB966BA7292B076052C1CC7A8503 - 13763AB1DE2A13D06CAFAD99316A8983AD05F595E0CA6CE935D1DD39984CA56F - 7331877F1574831B6CFB979281790B086ED54BA7D283F1AB9D96E7290CAAA815 - BAE5E145655028225B6019D3F68A85C8764536BE909495035019B38CB9601065 - DB0198716A197B2A3EF12D448590999CB0C4BE4A6698D75D5F67FB12C8E439E3 - 047F3B8DEAFD1B20F3B6CFBE380FE4A9E6217184EE789E672904D429EA968B39 - 44655028D4A7581C80C8660A4515D8AE22E8E52E2465E500A0BF65510E98BA4B - F1DB3B0FA04FA686F8DB1C542301EAF5DA9A604CF7F776F8DCD66D9DEEFA7A5B - D74B2393674F5F33D2694BBEDD4142C2BB1EE252F980798231AF057C067816DB - ADB448A7A87B2C032E1605DA80A29996FD1B229B2904B459305A8B7D81B1D89A - 58749AB272008C1061E89B8A96367B5B6C23E3C2C2F436ACB235AB66C4623123 - E3B60E03428175FCAD2D2247231FF1B7D3086D02E35FE3C857388277F5BA6C9E - 44448E4685CF5028229D9A19F7352C032E16453E1BC8673373259FCDE6B3F185 - A2AC1C4094D25168F12D33C59EB5F68233667AFA86E0432D8750B49A5ADB5D75 - 23923AC7DFE64813BDDA555B6F7BCA3EDED539901A322E70711AB58FAD22EEDA - 85DF228879A8FB9630423AC1BCC7BB2EDBBECA0875893AE5620E3D92FA92BF2D - 1A910DA0ADA0CD70B12844368BB68D36CEC5B2A0AC1CC02794E2A92E8B87F4D4 - 114B60CF42C8CEE6A68865A9480B69B66B50A2AFF7946818E05DDD64EBD2CA3B - 8CBC7BFE53239E100D8D48FDB3AD0B3A2988DF8D7910CD48609E31EF5CB48548 - 97A873D43D178B466803602B765700F2D86C84DB78D950560E000163B2CCBEBA - ABED3900449FA2965D68D44F6AA8CBDE3C80313E3A261A06B87CACD5EEAE40C4 - 4CC6D2E34723BF238984C570B0F01A9EDA407C4DB62FDF2D18FC4EFC6EA10141 - 5E31CF98779E52348ADBED465D723107EA1C75CFC5A2C0B2471BE0620E91AD14 - 8AC86645B6BDD0949D0300B76B5192A6900073BB440DCD9CD187462CD74BE3F6 - 4FCFEA35B67B01FAE0E411FE36076E59F536B76EE1A22D123D570723573C87B9 - 380D544ADDA32B49F88187A1346DA9686EC077E077E177E6FB36CC2BE6998BB6 - F035B7DC27DAFE2BD279A160D98BB6008B6CA510D0565D8AD501886C7BA1293B - 07A01162592F8612522A36EEB0D50B48755EBB01FD74CB292C4F43BDAD6BA590 - F8D5AED35E8FF58E79EF0ACF36EA72DBEA61DC61F2C4B1CB9357CC8FB9680127 - E1561C7A08C6E4B6AEB59F11FC6CFC8E7C137E08E611F3CA455B5045553DB581 - AD5CCC81BA469D73B1683CB5D6B2471B415BE1625184DAB6E2F8DFB27225B2ED - 85A6EC1C401C940415DE3211186AF1D80A279D1DD3C5480F17736821B28A51CD - 56D3C932C94C6694592A27AE5BFBD7B7D8BE15F70E918F8F9D8D76981F4117DB - A21FC40D1A5AF16C1BA97DFC6147B70DE367E167E267E37708813C61DE308F3C - C536BEF56D9B93C4BA4487BA469D73B128B0CCB52A629DBD041BB13BFEF7AE0B - 5AF28C368DB6CDC5B2A1EC1CC07B8A92026559BA4ADE55F6CFDA6746D3D60BF6 - 54E2F5AD69B2DD6C26BBBB3E11DD5B471BFDF73B31177087894F8F9D9BB8A8FE - 5E34277007DC31D8F89D8DA4FEDB0F9340EBE6A28E12E3DFE0DFE267E067E167 - E605F28279C2BCF114DBA0CE94D5811D5CCC813A4E765FFD848B45932D73287B - 2EE630C6D3B6F72CF8D75A6F8D429B46DBE662D950760E0001F76B9DB1F79310 - 53ECCD0324AE74769A143F7E3A9E958D6BF9DBA2D1A391093DA1590CD34C337F - 60E3E63D5C7484E899935DC39F8EBD6A2693331E56C1433935FBAAC89A1FEC81 - AEFBC324BC071DC27D30EC5945B4CA30DED4937DE17B4CC39FE1EFE0EFE2DFE0 - DF8A0EF6DC0DE4218279C13CF12447409DA1EEB8980375AC47C76C6FA6119539 - DA46ACA3D3D6F0056DD4EB27967E92C8A6CB81B2740080455990512DBC7D87AD - 137C66249220096299E051C3640D55ED5D5985243A3BFEE8557C162FEFAA26F7 - 39B12FE06E92BD3DC3B77E73E995D4B0719127CD88BB1286511BD121549386A7 - D6919587B690D52FEDCABEF03DA6E1CFF077F077E7027E37E4E15F302F3CC911 - 5057A8332EE640DDA28EB9583458D658E65CFC06B08DAC8DD8006D145A29D1BC - 8F740073053AAC7D3866E2628EE026EF1C4D333FFA50F2127F9B83E28CFDFA56 - 5B5757237A7422AA4F24DFE3628E649A288196758FC03739AA6F964864867EFB - F9E1B14FC75F136D1B2E15F85DF89DF8DD98079EEC1034AB2BD4194FC881BA45 - 1D73B168B0ACB1CCB99843641B8522B251B465B4692E961565E9005E57149CE5 - B2B42ABE35F66F818D9DBFD4215A0DF0AEAA6AE36F6D3175F1C2FB9AA259767B - A515BD3ED0D6BE8D8B8E12EBB874E3D62F4EBE32F145FA77E974DA91E53711F8 - D9F81DB77EF9C5AFF13B79B2A3A08E50575CCCE1766B63A85B2EDA4254D66813 - 681B5C2C1A918DA22DA34D73B1AC284B078080D7B4CED8837DB81AD7D85A56C3 - 168B4D104BB759F1915A4FE39A5946BCB3935D11B831F66B2E4EC3B3C6B7C7E9 - A1C0DDE0387CF017277F3DFAC1D0BFC66E1B5FC2B3DA0E3D859F819F859F899F - 9D1DEB337B813DF281BA411D71711AA9DEC82B7667FE112C632C6B2EE6409BB0 - DB9B41DB441BE5620E912D970B65EB005C940A9556BDAFD9766CAC64EFA070A9 - CABBAE698615EEB993ECEEBCA0E9EE935CCC914C10D5DFDEFC94EAF1D80A1F3E - 1B78F67EECADCFFF74E39533FF152BEE6497713433A95FC309BB7C4B8859E067 - F83BF8BBF837F8B7F819F859F6CFF3CF0CEA0475833AE249395CBAFB8B64F765 - E1998842C957C6C9DE5BB6972FF3D9663E5B2E07C039952F2F98E65F83B54E5B - 52C99864F2EA7F3C62BBAB163EF4F05F291ED2C4C52C78F3ECC4914BEF189311 - DB174DA8C150D0BBAFFDE766DAB08C09DDA6EBC6C4C92FFEC04CC3D67A733150 - CDA5BAAA6B2AD440C0A3F0E3D050E933462C91CA8C0D4F32DD66DCFE22C00D3F - 957B1EF8765AC958E66114B73A913CDEF177C654D476EC7FB5221CA83CB0F9B9 - 7B77FF9929D21779FBE83F73B16836FC8703ED2EC5B20230F996A2FC237F5F76 - 946D0F0081CA6F595A42057B573515BEB07D0FE981294B900A348CE07D9B1DD9 - BE8B066B5E1BFD27D141213474FFB61D0F73715EC10A9E1EBA1DC1ADBA388EC7 - 17BE4F0FDD8A2C44E54782DB763C24AAFCA83BB367FC174E547E24B879F366D1 - D65F912D140ADAA4A0F2239DFCFFB2A4AC1D00D41CA1F2AAF6AFB53D568F9DBE - D4095F600D155643D6B9AA6A6C6F3A4212D7BA3B32E3F4F75C9C06F3B3FB825B - B638BA3F603152B1F9FEBD869F6DE6E234507789AB9DC2F888858265AA5613EB - A929B081AC2DD8249F4DE6B3E172A1AC1DC03B8A3208BD00CBA68FE03A52979D - 12B40135332C7523FD191773600BE1DBB4C9B2FFBC58A267CEFE4E33DDC2B57A - 33E4D9E5BF6FEB2E2E2E3BF0D98D4A752717A7813A43DD71D13658A6A2D61F6D - 006D818B45A2719B9C0EDA2EDA3017CB92B276000864D0B2334B851E57D5DE07 - 6DDFC293387BEEA2A817E00A936627560410CA74163B7DEEBFB9556B04E12C61 - F71EFF96FB1FE4D2B221FBCCF0EC5C9C06EA0A7586BAE349B6C0B2C432E5E237 - 40D9676DC02655BB1E0CA14D723107781B4B78F772A3EC1D4092904BA0488B21 - 54EEB47ADC42C1431FA9FEA43068856F6393632DB3998825A6CE76FE3FB896CD - 93A61352EF0FECD8FD2855AC33E04B0D7CC6C0FDBB1FC567E649D3C8AEF783AE - 50673CC936F9CA327D2379D4EEC11FA4728FD816DD94DADE58546ACADE01BCA7 - 285146E9752EE6F054902A575DA3EDA3B653A7CE5D621962E9A6A93E52E36FBB - CFB1C07B4664743CF165CF7F7269AA70271BF3B1FB2A1ED8F76CA9970817127C - 367C469CFFE049D340DDA08E50573CC936588658965CCC81653EF9C539DB4B8B - 6883688B5CBC9BFED7282DAB00A022CADE01202663966E1AF40A94BAA75B6C07 - F3C0F15FB27B54B8C3CCD35CB543F1071D3BC9971E191C4A5EEAFF4FB8B4C593 - A6A1AB9935C13DDBFFAC949B85160A7C267C367C469E348DEC721FE80675C493 - 6C83658765C8C56924AF8E1DB63FF627046D106D918B3920CD917D0BA5665138 - 002FA53DA050CBDA7C7025A9578301DBCF90B8D871DD8813CBDE02BC45B8E2FE - EDBBB9E808E9C15BB7D2E77AFF63BEE140C6304215DBD7BC1868BB0FBAC8CE9E - 1D5818A882CF82CF84CFC613A781BA409DA06E78922304B76FDF29BA09DA8C91 - CB890B5FD98AFA83A0EDA10D723107DAAA8BDABFB0643E581406065D2903946A - 89000B99D7AABFB5CB76645F247EBEE743680EAC91832B4993779DFD83427793 - 191E1C9C3AD5F57F6AC4258C3D87BBE158ADEFC18A07F71ED2C2D5B62F305928 - 30EFF80CF82CA21D7E084EF8A12E50273CC911B0CC44137F58C6B10B3D1F70D1 - 16687B68835CCC611272166D968B65CDA2696112849C87CC5AF66A57B5B346E6 - F6837FB047A6FF66441F348421B77CADF57BB440A5A363731CE7C68E9FFBBFDD - CC9DB7AB68D04C6368D7BA9771C6DCA9D062F301E615D7F731EFF80C3CD9023E - FBE467E7FE2F27C7FC089615961917A781658C65CDC5A2419B43DBE3620EB451 - 68451645F71F59340E00A3A99882595578004FFDD3BB1D1933478F9D3E65A605 - B108A01B19DCBD65BFDDD061F762A6E3C9C8D193FFAF16A3EF88760C22D99613 - 57091EDAF6235FEBC62DB86D96FFA8ECC0BCF95BDAB7615E717D3F5FAB8FCF8A - CF8CCF8E3AE0C98E8065846525ECFA43D9621973D1166873687B5CCC81365A8E - 917FF2B1681C00C2183B0D19B65494703B5BA97AEDCF05503D6DC6BFBCF10E0C - E22CE1B6543F6908EDD8E5D806A13BE05AF7E4E92FDE49F444FFDEEB56F3B64C - 181D87D6050F54EDDBF9231C5363B86CFEA30507F38279C2BC917AFF43A2483E - 77C067C467C567766A9DFF6EB08CB0ACB8F80D50A6F18B37DEC132E6294583B6 - 8636C7C51C689B29C6CE707151E0688B361F3C6F9A4FC07F968A38DE45AE0FBE - 71C4917164F0E13DBBDC8DEE67B9388DD8E5A123C99EAE929C85C70344FE6D5B - 7EA86BE959B708636CBC4C8276256FF4756446861C8DC8335770661F2FEDC0B8 - FDA2D0DDF7822724E3E72FBEEAD4DEFE7BC1717F6053FD012E4E233D907E77EA - E849DB91849186170F3454B5125118B90B6F29CA87FCFDA260D1398043A65901 - 99FE09BC9DD6BD04B7AEF7FED78E73E9E888EDC9178CEB56FDEDBDDFA73E62B9 - 90823092993C7DED707A78A0646BBCDE96B6ADAED5D53FD24D7D4EBB113DAA1A - C98CC7AFA687867AD343C3239049DBAD9C18AAE02DBD7851A7ABCABF21651873 - 0AD082B3FCA9DEB157F098344F721C775D6365C5AEF507C1A22D73252C41BAC6 - FE70E2374E2CFBB943B56AF3FFD4BE1D5AFB7B27FF0CF8F05FBEAD28935C5E14 - 2C3A07808013F816647C3B17734C0E92DB377F75C491D04B4A38ECAB7C7CCBCF - A84AAC61C80C9298387EE98F7AD45EFCB899C05B6B025BB71E7485BCCF26CDC4 - 9CF722785D34694C6A037A2C3AA047224399C8D898994A163526C5C8BCAE7075 - B5160ED76B815023DECF2FBAA23B1F18C32F134DBE1BBB70E1B013C13CF2A185 - A0ACF66D7E1A9A04CB7D7CCC2013137FBAF48FE6F8789C27D962D58F0F345534 - 90155CFC064ABF7C8BD2BCF736942B8BD2011C34CD40107A01D0CC4DF3F6F030 - ACEFB5C10BB19E4E4726963C6DAD2B02F737FC045A7DCB528F91226313C74E7F - C492A5336C440B55867C6DED4F6B3EFDD1B974B345785D4A2C9356A366924C29 - 462269A4CC04C63EC0E07E8AA2AA8CA81A71AB6EAA6A6E0C18A07849D0E53642 - C98C595410561C9E60F45E0CE0E9440CBF99C0EBBD2BF7EF7A5CF5106B300E18 - F7C7BE1CFC65AAB3CB91602681756DDEA6971BB6424B3FADDE406F2003639A5F - 1E5614DB7124E69B45E90010E805EC85CC5B0ED1245334D2FB9F3F75EC086670 - EFEE6DEE26EF212E4EC34C9091C891531F31C3FE7EF2D9C83A82D6B647B56AFA - AD64CA7A5946398037F6E863CA9144D7E58F304C3A4F2E1954F5A8E103BB1F17 - 85F842527DE97762274E3A765741F3DF3ED2E6F50863FE7D0E5D7FDB31051682 - 45EB001E654CAB62ECAF40F996DD65A36748F7F00747C4076F8A20F4C481C7B5 - 6AB69F8BD3D027C9EDC867273E2EC58CB6081C1AF837B4EED21A2A0EA8AEF486 - 84207AEE7C824B7A785127DED587D77595B2AB7F37B8DC177E68EF635A85A03B - 0EE863F458F4C3231F71D136754F1EA8AED9495AB898032A50749CD27F2EB75B - 7FE7CAA27500C8F74CB3159ADEEF703107D4C44CCF3F755C488F8C3852283829 - 58F5CCDEE7950011460B422710FDFCD4A7F3D113B81BB5AAA6DAD7D4BC5BABF4 - EC50DCE975F3E50CA0C5CD684977AF11499DC32BBAEDDED25B28D8F2871EDCFD - 48BECA6FC6C8C5F1F74EBCE5C4A41FE2AEADD5D6FD75FB56A82C9609469590DF - FF56511CBD14653E59D40E0081A1C04BF01096ADBAF14932D2F75F8E5CE3A26D - 14B747AD7CEA811F521F119E10CC0E078E9FFEB8D47302F9500381807B4D73BB - ABA2B24509B00DD493599D6F234EA1787DC430D2AE3E638A5D31C7C62EA7FB7B - BB8D74DAF6D5DFC58063FEF0BE5D8FE5EBF6B304E99978FF8B579D38E67B87A6 - 7F7F60BDBF42104998901BD0F57F9D8B8B9245EF005E32CD6AA8717F016F2DC6 - 3E7C8C748E1E3D627BDBE71DA8CFE7AA3CB8EBCFEF0D267A079C189C3A79E953 - 7DAA74AB0373855297E65E51DFA886C38D8ACF5FAB78DC354C6555AA8B05A992 - DDA8430DC6B2AB0B2AA5B84AC09849E346864E51838E9BA9F4A899888F1891C8 - 40FAF6D000639905EFE2E216DFE0DE2D8F0A27FC000CEE3971F8F4BF3A795949 - CDC307C275FB89E8CE0803BA03AFBCAE28F3DAFB719A45EF0090174D739F49C8 - 3E2EE6C0A1C0B55F745FCC0C0F3866105A45C8137C7CDB5F286E22BC569CE924 - 36F5E5B54F4AB94F603982EBFCC1FBD73F4A356BDC7D04B7F94E7D74FE157D32 - EAD8365C3CEBBFFEA72D5B445D7F186B1D7F43518E7371D1B2A013484EA151FA - 051492E546612CB8553F6A852EBBBDF881778306868686AD0D4F9A061A68C5AE - F54F397D827039E35DDFBA0A37F9E4ADFC50164E577EB419B41D51E5475B439B - E3E2A2664938003C7A09551C2F8DB48CFB70D9A6E1C5076D070EB91B34B4AFBB - 9A796E7CA1D05BDD547FA062E7DE6D4E1F205A4EA0EE5087818DF58F804E2D15 - 11C98EF9A12C9CADFCB8DDF7C106D1921F8047D3DF5F2CC77D67634919E70B8C - ED628C59F682C343B25B878D8E89B3C71CDD838E1383A1271F782EDFEA0062C4 - C9E0D4D94B9F9772D7E0520477F705776C7E5078B08783B3FDD10FBE78C7C909 - 3FA472C7FEE0CA836A3B0C212DF583527AE44D4A1D3953500E2CADD68931FA3C - 63DF837796B0536021E9DE5F745F72723E00C125C2CA6FED7B4CAB660FF1240B - 2623A978D7F017A9AB9DC2002092E97836B4ADF1B7D63DA050EB71DB3BE863F4 - B3893F1DFFD8A9A5BE3BE0B8BFF9A72D9B5522DC75D9FF16A5BF052FE0E8772E - 244BCB01002F3316CC30F6975042963DEB78AD58F7DF1FBF4CD3CE1A0D92DD31 - B8D6FB6D22D8367C874C84F44E9D3F7FD68C4D3A7A067EA98031FC308C973084 - F71D28D1D3D7937F983A71EA3C4F710CE676D196BFD9B74974C30F5494A48BD2 - 7F81AE7F494E322E144BCE0120D00B68A68C3D2FEAC24D8D92A11BFF78C4763C - 38117876C0BFA5E165E101220EF60652D7C6CFC63BBF2ADB0B2317028CDEEB59 - 5FB563A6561F0FF6C42F0EBEE6D4DEFE7B59FDEF0E34076B8431FEA06F49DF82 - D6BF2476B3902C490780E43B2B804CF491FE81578F0C70D15194AA2A7FE5439B - 9F131E25BE0B2341461357FA4EA706FA4779D2B2042FEDC0B8FDA2D0DD778347 - 7A273EBBF48E53A7FAEEA5F187071A2B9BAC4347041A9245BBD77F3696AC0340 - C0091C8207B4DE07070C9F25D7460F1FB12C1D3A01CE0B54ECDFB1D3BDD27D70 - A6210182C382C4E5CB1732E3A34BAA6B391B78579F7FD3A62D5A58BCB3320776 - F96FA50F4F1E3B7BC6E9F1FE1D6A0E1EA8ADDB21B613F8C26B50F9DFE6E29263 - 493B80674CD3E326E407F090969D6350B06CE8137265FCC491921D5775AF6DAE - F3DFBFFAB97C9B86EE8047738D51D233F5D5A58B4E5C4D5ECEE015DD7803335E - C22ABAABEF6E70730F86F14A5FED2D59C4A3AABD0742F58F9236C88868497C34 - 45C86F16538CBF4259D20E00799EB1308CE07E006F2DC1220063E070EACAC4D9 - 93256B7DB137107A78F7035A83FA18287BC6F3FC59471021FDC96B3D1DA9DBB7 - 16F516D37BF1AC5859ED5DBFAE5D0D9335B3557C70CEE9CC20FB64F2E8C993A5 - 6AF591CA1D7B828D073D1BE1ADE8CC448250FADF61DCEFD856F27264C93B00E4 - 65C65664187B092CC9D21DC75062B7DE8D5D99BA70A6A42DAF6BCDAAB06FFBBA - A7349F705FB9053C5C94BA3DD19DE8BAD2C78C85B9B7DF2E5475A9BED68D4D9E - 15952DF90EEFDC8B9E209D89733DEF3B11BA7B26825B7706563E1BD808CDBEC5 - 26A052E82E4A5F7F8DD2924C369613CBC20120DF636CBDC9D873E0042CCF3C5F - 4E00F16D695FEB6DA9798ABAF26F70990623197D9CF4A706067A13FD7D43F315 - 77A05870F79E6F4D53BDA7B1B159AB226B40DBC21D7CF78277F5E1156D784B13 - 4F2A19B3547EA650FACE6F2975EC246939B36C1C00F29C696E86423FC8C57B31 - 6E7D607446CF1C2B7950C7EC24E103DBB7BA577B1F8691A7F0649B108324C119 - DC4C8D0CDD4ADDE81F9CAFE01BB381414A3CABD734786AEB5742A55F051DEAB9 - 5FA2629231BCA5172FEA2C6577FF0EA19DFB2B563EA9622F4C78541A1A83C3EF - 284AD9DFEAEB14CBCA0120CF33763F61EC312E4E03ACCF1CFA8474967262F06E - 702BB16FC7F62D9ED5EE870A720400CE17B03819D527F4DBFAD8C86872F0E6F0 - 7CC522C033F9DE8655755A756D8D56A9ADA07E5233DBB8DE0254FCD48DF46778 - 3FBFD35B79F331CB841F3C18FD18C6FC962BE89632CBCE0120874C73373CF8C3 - 5C9C063A81B133E49A9321C566037B04C1EDEDADAE35A17DF9620DCC0533A34C - 997173CC4CA4A3FA542C6A262663466432566C7C022D18F6A9E18A80E2AB0868 - C18A901AD0C2D4AB841557F13109F1E45EA63F7A7CEA5C47D77CB4F877C0905E - D53BC9FA7C951F123F7B435196C409BF4258960E0079D1341F80EE5EDEFDFB13 - 3DA47FE0B5D26C169A09DC4DE86D6ED8412BC91630CA3987039F15183E3083A4 - B32F460C66421B6CF0BB1655E2A20A81A12F51A94ADCF82AA81B3F0BA0E7149B - 201793BD83674BB58B6F261A5F3ED058B94EBCC907814A70EC4D4539C9C565C5 - B27500083881ED609CDFE2A285C43819EAFDD5F1EBA5383B301B187D28B06D73 - BBABCEDBCEFC64BDC2C463D672C5A4E05E12A4571F4A5E8A9DBFD4E164949EB9 - 827BFB9B7FBC6FADAFCABABDF70E4BED745FA12C6B0780E0C420D4AC27A1860B - 75810788FA7ED5DDEDF429C242C04B4A7C1BDBDA5C35EE561220EB1CED193808 - B6F424467A32A3E9AEC495CE4E33B27047A0F1545FD38F5B5A44077B10286C06 - AF0FA1DB7F91272D4B96BD0340C009B4801378069C8070DB2E1E251E3A6C743B - 1D4FA01870E2D0D3B67EB5565FDBACF9D96AE223ABA0108BBA30C42EA0AF34B4 - F237F538BDA10F8DF4A63AAFDD98AF09BD99C0F3FCF507552C53A15E405F3A64 - F2BD7714A59B272D5BA403E064370B11728831F1CDB660EC2CD245FA06DFF87C - 10EC87A72E3CE8105CCD4D755A55558356E1A957FCAC81BA945AA2387C7988A9 - 4CB18C3962C6E9A03E991AD2C7C70733BD7DC3E550E1BF41CB46F209B7922630 - 6CA16D43973FEE22E4EDE5B0C9672E48077017CF9866089A8C1740297997E4F0 - E6A19BBFEEEA59C821C15CC83A86C6BA4A355C55A5783D01EA717989A6F9158D - F928250A5308FEFBBA8534499A9AC4648C98A64E1344D7E32C95499AC954CC88 - 8C8F67068627CAABA25BC12E3FC6F0CB13C62B0B38F1B134216FBEA728F3B2CC - BB18900EE01EF801A2A74131C2D36108185266E418E97132E4B8A478C20F1DA8 - 6C7828BBC49777D721FCAC2709DDFEA57CB0A718A403C803C6135008D907953D - AF8EF0F291DBFFDAD1978E38730391A430DCE15A6DC59FB737892EEDB803141E - DE957E7CA99EE7B78B740033C0230BE1E460DE3571EC0D8C9D21D7E773E39024 - B7B1672D18F04CAD7E9251FADE528CE4E314D201CC02C6184C33F634BCCDBB91 - 04C1B981E1B76FF7397535B9440C5ED15D776845D34C637D4EBF9BD23F2EB518 - 7E4E231DC05C608CBE40C84EC6B23704E7DD9003CA64D1413238FC56C72D392C - 7016ECEED73DDFBE32D4401A661A960106A5F4D89B849C214B287A6FA9900EA0 - 005E344DDC517610C694755FA788819FEB135DE4E6C8BB67868D640C4449B1A8 - DE8052FBECCEBACA56B24AC9B34FE30E60CC23F07AFF0D4519E2499259900EA0 - 407ECE98721E2F2021642FBC663448DC4014E9A0B786FE786A98A6E3B2352A00 - E6F6D3FAA777D785DBD9CA7C1B7AEE00468CBDAD93DB293DF577944A875B00D2 - 0114C97718AB52197B021438EB1D806091A9F10E3A30FAE1E951331E2BEBF5F4 - 8546F107D49A2776D554B5B3C6B96C7906AF7A03FAFC1FFE9ED2719E242900E9 - 006C72C834378212F168B170CFF9DDE0D060AA9F0C0D7FD03D58EE1B89E61BDC - C853F7644B43700DA99FADABCF9984CA7FF46D45B9C26549114807E0008F32A6 - 5531B6139489478C670D8105866BA626C9F8C449323C7EFAF368396D2D9E5F34 - 52B5EBC150E51E52E7A92055A03FA8FB3303BF804733BF18A7F4CC2794CA8956 - 9B4807E020074D33E023640F28152F0BCDBB5A7037301E484EF5802338767D34 - 79B32FCD939734DE554DEEAAFD6B6B82EB481D2869AE71070CA8F8171330D63F - AC284B3A74FA7C221D400980614105A174AFCAD87DD02398B555BB031E3D9EBA - 4AC6C68EF78E6506FA97D410C1D5B8C655BDAFB93AB88154E73BA22B029467C2 - 18FF2BC2D809E8EE973C5EE372433A801282878B3C94EE5418DB3C97A1C1DD40 - 57602AD54F27263A9291C9F367E3F3193ECB193412DCBA2D10DC14A8F4AF2561 - B7420A3A9D885D7D93D24B29C6CEC8C33BA5433A8079E0C78C79A38C6D851A7C - 3FBC023C79CEE0E4A11E27D1E44D3215ED4E4D4E5E0187B000518A6602A3EF54 - 6CDCE10FB5782ABCAB48D0E52715605C05393D04FE2606AF2F43945EF815A572 - 576589910E601EC13D041718DBA0936CBCBF26A8C145E91FFECED44D124B8F91 - 786A185ED75389C9EECE84198FCCCB12A3E20FAB152D6D3ECF5A8FCF5347FCEE - 6AE2D71412808799F370E76EE0EFF0C04E9F0663FCAD945E956BF9F38774000B - 040E0FBC846C86B7ED50A1435FA7DA033E27932124654E929401AF7494648C04 - D10DF85F8FC5F4CCD494614E8D19B8E8A0A77576C7616085D6DC1AC5C5372558 - ADBA8241550B043435445CAA8F686EFCBF827814784193EE01A329B86517019F - 835DFB0E68E62FC96EFEC2201D401980D188D28CE175E27861C59C27C8162938 - 91D7E9A6B44B46E55978A40328339E33CD06289466FE5A51EC30A15C80CC3378 - 86DBF0EAC5D73B8A32C87F24290316B5712D7570F27082B1261810AF52095909 - 15A8B6DC1D025678F86F14F27C53815725A57D7232AF7C910E601181E1CA3C94 - 3632C61AC021D49A94D651C62A17CA29606567944E288C0D1B78128FD2C11463 - 0332ECD6E2413A80450E6E430E315603051906A7103228AD840A89938A3897E0 - 07E760EB0E01F85CACCC71784D82C389C26747A1759F80CF8D44291D95DB7117 - 37D2012C75A08DFE2E213E2F0C27A026BBA0C5CE3A04E839A82E7EE82643880E - E9D91501484FC12F6492D06DFF1D210919544322914824128944229148241289 - 4422914824128944229148241289442291482412894422914824128944229148 - 2412894422914824128944229148241289442291482412894422914824128944 - 2291482412894422914824128944229148241289442291482412894422914824 - 1289442291482412C9728390FF1F97ED6E34D64226CD0000000049454E44AE42 - 6082} - FileName = 'C:\Users\Programmer\Pictures\Icons\'#931#969#964#942#961#951#962'\icon_simulation.png' - end> - Align = Client - Size.Width = 444.500000000000000000 - Size.Height = 313.000000000000000000 - Size.PlatformDefault = False - end - object imgPeerUserVideo: TImage - MultiResBitmap.Height = 256 - MultiResBitmap.Width = 256 - MultiResBitmap = < - item - Width = 256 - Height = 256 - PNG = { - 89504E470D0A1A0A0000000D49484452000001000000010008060000005C72A8 - 66000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 - 4A6C49444154785EEDBD69705CC795A89979EFADBD5028EC0417102401901037 - 71114951A2244BA216DBA224B764BBDD1D6DBB9F67625EC44C77CCC49B989F8E - FE39332F5EC4EB9988F7625E77DBEE68B9F52CB5B5D9962C4AB2245214497111 - 3781044002044882D80B05D47EEFCD39A7942C11BC5900AAEE2DA000E4C7A860 - 9D045095F7E4C993FB4922914824128944229148241289442291482412894422 - 9148241289442291482412894422914824128944229148241289442291482412 - 8944229148241289442291482412894422914824128944229148241289442291 - 4824128944229148241289442291482412894422914824128944229148241289 - 4400E5FF4B962A8CD19718F3C23B9F41886612E23128A52A218ACA980B7F05E4 - 0CFCCC04992984A4E0673A24275EA734492865F83B92A58974008B9C4719D342 - 8CD5404186A1E286A08287A0C686E047155099FDF01E2B7FD1C0E726E133E3F0 - 7612DE47E133A3E02CA2F0B99128A5A39F508ACE42B248910E6011F13263EE34 - 212BA1A16E80CA5E0B95B01692C3F0FF8294237C297C3589C0FF23E01446A063 - 31E826E4D66B944236258B01E900CA981F43D77D82B12668815741855F89157E - A12AFB5C41A7C01DC22DE82DDCACA4B4EF573894909425D2019419CF99660314 - 4A337FAD28F70A3F1B907906CF701B5EBDF87A475106F98F2465C0A236AEA502 - 567A682DDBA0305AA192E0F87DC902CF88F3075DD0ABE994CE60E1910E608138 - 649A3849B705DEB63B55E9E17332194252669CA4F408496762246D4C115D9F84 - D7444CD71353BA393566E01CBF6EEACC8C46A0A74E88120AAB9AA251A2C1FB60 - B5AAF9829A5619D0B40AA2A941A2B902C4AD85895BF1138F8B100F184D76F5C0 - 2EE80CE0BF0E700617DF5694C9AF5325F3897400F3C8CF1953CE30B65EA1740B - 656C2D54D8A2F40F7F67EA2689A5C7483C350CAF1BA9C4E4D5CEC49D0A5D6AD0 - 61546C68F379567B7C9E3AE2775713BFA690003C0CF8B4C281BF638CD2EB2663 - 1777527AEDEF28059F20990FA40398075E324D1F34BA5BE1ED76A8BC81AF53E7 - 0ED4065D8F9368F226998AF6A42627BF3A1BA7E90C7C54F9C0DC2E5A71DF0E7F - 689DA7C2BB8A04353F098137803E45618041C6E0BF73F087175E5794C4D7A992 - 52211D400979C634436E42764145D80CB5B5A0CA9026642AD54F27263A9291C9 - F350E1CDF2AAF0B3C1147008DB76F82BDBBD61CF1A56097A08F21FCD09304CE8 - E4904BA087D3EF290A0E152425403A80128015DF47C85E78DB0E463CE76E71C6 - 24935357C9D8C4B1EBE3C9C1BE25B596EE6A5CE3AADED75C1DDC40AA5D0AA9E0 - C9B302CAC3E1400774054E4847E03CD20138C841D30C40C5DF034AC5C93DF5EB - D49981417B72AA870C8F1FBB3E9ABCB9B42A7D3EBCAB9ADC55FBD7D604D7913A - 50D25C772A1AE00C2E4D812338AC28384C90388074000E80DB71AB18DB09CA7C - 009AAB5967C871122F3549C627CE40C53FF139B46ACB7537AD46AAF63E18AADC - 49EA3C15A40AF4376B6F097E01C7425F8C537A466E43B68F74003679C134DBC0 - 200FC0DB59BBB5389937D54F86863FE81ECC0C0F6478B20470D535BAEA9E6C69 - 08AE21F550C9E7325F8267138EBCA9289D5C961481740045F23C6361C2D813F0 - 76CDD729F9818A9F1AEFA003A31F9E1E35E3B17959AA5BAC28FE805AF3C4AE9A - AA76D6088EC0C39367A25FA7F4A3DF533ACE65490148075020B8967F9EB15DD0 - EAEF85D78C2D15D4F474A483DE1A3B7C7AC448C670324B324798DB4FEB9FDE5D - 176E672B5542DC3C590818B10EAF13DB283D2DF7101486740005F09269D641A5 - 7E0A2CAC8E2709819FEB135DE4D6C8BB678664C5B787EA0D28B5CFEEACAF6C25 - 2B671B1AC0CF87C159BCFFBAA20CF324C92C4807301718A32F10B29331B61FA4 - BCB3FBA04C161D2483C36F75DC4A4746E4049583B8C3B55ADDF3ED2B430DA401 - 7A5E33D92DC63B39F6262167643093D9910E60165E662C9866EC69783BE3583F - 9D2113836F0E5E8FF574CAA3AF2524B0AECDDB70A861ADDB432A79523EFADD94 - FEF1354AA7B82C11201DC00C3CCF583365EC196846F2AE55C3CF32A36749DFC8 - E123A33C49320FD41E3C5053B383348101E75D76859F2519A5EFBD45692F4F92 - DC8374007978C134F7C07F0FCED4DD8C4F9291DBAF75F4A54764777F2170D7D6 - 6A2B5E6E6FF2576423230981C2C361C0E76F2ACAC9AF532477231DC03D3C639A - 1E37214F8362D6F3240BD8EA8F1C233DA3478F4478926401A979F840B8763F59 - 076596B7370065762D4DC81FDF5394144F9200D201DC053FBCF30228A59A2759 - 48A7C844FFAFBBAF95FB461EC5ED515D8D75956AB8AA8A7A3C3EC5EBF2134DF3 - 2B1AF3514A14A610FCF7F5F29A49D2D4242663C434759AC0B38766321367A954 - C2888C8F67068627CC74AAACF72FE046A2553F6A5DE7F5B0304FB2004E600C9C - C09BF24CC1374807C07999B11519C69E0323111ED70545B1B12ED237F8C6E783 - E5B475375BD19B9BEAB4AAAA06ADC253AF78593D75931AA23A1C59C820519626 - A366920EE993A9217D7C7C30D3DB375C5E8E41230D2F3ED8106ECDCE0D086D9B - 521A876EC2DBAF517A9B272D6BA403009E33CD16153A0050F985EBCCB8A167E8 - B0D13D71F6D882CF286385F7B4AD5FADD5D7366B7EB69AF8C82A28C41937CA94 - 0AD0579A24C84D3D4E6FE84323BDA9CE6B37CAC12154EED81FAC3FA862990AF5 - 02FAD22193EFBDA328DD3C69D9B2EC1DC021D3BC4F21E42018B350177844B7EF - 95DEEECC40FF8275F99570D8E7DBD8D6E6AA71B742FF64DD1CB7C8CE3B262129 - 12233D99D17457E24A67A719892C58400F1C1234FDB8A525DFD163286C8C5EFC - E11B8A7291272D4B96B50378D134B783D17E8B8B16121132DCFBCBE3BD0B117D - 87FA7CAEC0B6CDEDAE3A6F3BF393F50A9BDBF1E272C1A4C4A071722D339CEC88 - 9DBFD4C112897977A018A5A8F927FB9A7DE1FC3B37614870E44D4A4F7371D9B1 - 6C1D00B4FCBBE1E11FE6A285893ED23FF0EA91012ECE1B9EB6D615DEB50DF7D3 - 30D9EA644B6F1A2445E1C50C92668C18CC8406DB205F574A95B8A842144A894A - 55E2662AF128F0CAFECC01B067C026C8C564EFE0D95467D7BC8FBD1B7F78A0B1 - B229FF462ED0F367D013F8828BCB8A65E90066AAFCD0D49BA36749CF7C6EECC1 - F059C1EDEDADAE35A17D8A8734F1E4823175658A25CC8811D3237A7C326AC626 - 63466432A64F15D715D782619F1AAE0828818A80E6AF08A9012D4C7D4A58D1CC - 82C27BDD8D99227D99FEE8F1A9731D5DF319E6ACEEC903D5D53BC97A2877A8EF - 56202347DF5694535C5C362C3B073053B71F2BFFE0A7A42B72FCC8044F2A2938 - A1E7DBB17D8B7BA57B3FD5480D4F9E133080652C4E46F5A83EA88F8E8C24076F - 0EB364725EBAD9D4EB75791B56D56935B5B55A486BA07E52435961B6C474329A - BE953E96387BEEE27C4D1C86F71DA86C7884B4E6730290F827E8099CE3E2B260 - 593980E74C733314F2412EDE8B71EB03A3337AE658C9E3D3675BFCDDDB377BD6 - 781F01ABCBBBE7C0824192FA38B9991A19BA95BAD13FC832F353E16783BABC2E - CFEA350D9EDAFA954A15595DD0F0C12463A9FEE4A753A7CE5D9A8F1E4168E7FE - 8A954FAA6DF05638A7028DC3E17714E51217973CCBC6017C8FB1F5E6D7EBFC96 - 678642D76FBD1BBB3275E14CC963CDF9B6B4AFF5B6D43C455DA48127CD0C2319 - A8F4FDA98181DE447FDF1065FABC759B8B81518DFAD634D57B1A1B9BB52A1877 - D3B95D22C2326430D93DFA7EE262C7759E5432825B7706563E1BD8088D8165D9 - 178C832994BEF35B4AAFF1A425CDB270007C93CF4B507344EBFCC68D775397A7 - 2E9C2C69E577AF6EA8F46F6B3DA804C8269E34234602BAC8B727BA125D5D7DCC - 28EF5D78F9A09A4BF3B56C5CE35E51D9AAFAE636C4D113A43371AEE7FD4CFFCD - 926EB30E6EDD1358FDAC07CBC2D213804AA1BB287D7D396C165AF20E8087EEFA - 01BCF57D9DF20D38E61FF8C0B852CA6E3F76F7430FEF7E406B501F0365CFBA61 - 479F207DC99EBECBA981FE2575BAD0D3B8A6C6BBAE69935639FB2427944B5A1F - 343E8E1E3DF545298705381C687C52DD08E5229A1348B8297D159CC0BCCC072D - 144BDA01E0C11E188C7E1FDE5A5A1F787076FB137265FCC49192ED0B77AF6DAE - F3DFBFFA39C54D56F2242138A1678C929EA9CECB978CF1D1257D7E5DADAA0906 - DB366D566BC8BAD9260ECD34B915FFF2C63BE9EBBD258BF053B5F74068C5A364 - 2378194B5E20612449C86B4BF900D1927600874CF3103CA0F054DFF059726DF4 - F091112E3A4EF0E13DBBDC2BDD07A1399B318C15B6F8B1CB572EE86323CBEA80 - 8A0B1C81BF7DD3F6597B0494E8E95BE9C353474F966CB34ECDC103B5753BC476 - 028EE1DADB8AF23617971C4BD601E0797E283C0CE165A1949B7C70DB6EE5C35B - 0E511F69E54942708C9FB8D2777AA975F50B058706BE8D4DBB669B236009D235 - 71F4E2DBA5DA5E3CD36621A824C7966A3C8125E90078249FE745DDBAA9513274 - E31F8F9424428CA76DFD0AFF96952F53357FB82A939154AA77E26CFCF2C51E9E - 2401FC6DF7ADF3ACAFDAA1D0FC4B88CC2013F18BB75E4B755E2BC9E4DCEA7F77 - A0395843EAB998038C086F2F7E6B2946165A720E0063F86518FB4BA8FC96305E - 78B0A7FBEF4F5FA6E938FCD859827B776F73AFF57E7BA62E3F76F727CF9D3F6D - C62665DC40014AA0C25BB17DDBAE1987053824B89EFCC3D48953E7798A636028 - F296BFD9B5497480082A4AD245E9BF2CB518834BCE013C6F9A7F06FF59BA7278 - A4B7F717DD979C0EE4919DE57F6CDFA3AE1A96F75C0163249DE81EFD22D17DB9 - 8F274966C0D7B2A9C9D752F300A5F9574DF431FAD9C49F8E7FECF42A019E226C - FE69CBE63C4789FBDF52947FE3EF97044BCA01BC8017763086D7744D03BB7037 - 3F302E3BBDDC875B79434F3EF09C12C85E062AC48893C1A9B3973ED7A30B7734 - 7631A285C2BEE08ECD0FAAFEFC1BA6CC18B918FDE08B779CDE4A8CCB83AB9E54 - 378986904BEDF4E092710078690734ED3F84B7968D1DE35DE4FAE01B4706B9E8 - 08785C37FCC4AEEF531F59C7932CA407F54BD1B3A72F94FBEEBD720577158676 - ECDAEA6ED036F3240B2C417A221F9EFE8DD3C78D1B5E3CB0A2AA553814315C84 - BCBA542E1F111E8A586CC0B85FD509C1D8FD96CA9F4CD1C8D761BC9C43AB0879 - 2A0FEEFAF3BC959F113D7679E8C8E49913E765E52F1ED41DEA1075893AE5C9D3 - C032C0B2C032E1498E0036731BE33F72F16EB2B68636C7E545CD92700029C676 - 432DB3848686B4CCCD5F77F5C08891A7D8070D2DF8F8B6BFC87B6CD72089C9D3 - D7DE4FF674DDE029129BA02E51A7A85B9E340D2C0B2C13679D804E30F82BDA10 - 4FC881B6A633F6001717358B7E08F01DC6AA34C6FE12DE5A3CF2F031D2E964E8 - 6EECF6636B93AFF21B29323675F2D2A7C59EBF77124A5CAA6B457DA356155EA9 - F8FCB58AC75D43351686570555981F7F254D5976A2CBCD681AFE63CCA471A6D3 - 497845CC547AD44CC447F4F1C8ADCCEDA10146320B7E1E01E31304F76C7E44F5 - 884F5062AC8189C3A7FFD5C9E100861CAFDB4FF0F4E0BDE050E015180A8C7179 - 51B2E81DC021D37C091E62351773E0A51D7DFFE5886327BA70C2AFF2E9077E40 - BDE21D6366828C448E9FFE78BECEE4DF8B1A0804DCAB9B37B94295AD4A806DA0 - 9ECCEA64427CE4B550BC3E621869579F31C5AE98636397D3FDBDDD463A8D4E63 - DEC15804E17DBB1E537CE2CB40704E60E2FD2F5E757262B0E9DF1F582FBA7C04 - 7A0237DE5694D7B9B82859D40EE07BA6D90AA5FC1D2EE6C06E5BCF3F755C70EA - C61E5CEAAB7A66EFF3F966FBF549723BFAF9A94FE7FBD49E5A5553ED6B6ADEAD - 557A7628EEF4BA447A7E867450F9325AD2DD6B4452E7127DBDA78CF1D1796D05 - A9EA51430FEE7E44AB202B78D234707560FCBD136F39B544883710ADFBEBF6AD - 50592C479BC1C3FEFEB78AD2C5C545C7A275008F32A65531F65750C296F8F7A3 - 6748F7F007471C33CAD013071ED7AAB337035BF8BAF29F84CA3F3F5D640CBEE1 - 6BD9B0D3555FF988EA4A6F98AF4A9F0F9F9B9846C67D353334F169A2FBEA99F9 - 0A52822B04E187F63E96CF09E863F458F4C3231F71D1361852AC662769E1620E - A840D1714AFFF9134A9D9B689A4716AD0380AEFF5EC8FC835CCC81B3FEBDFFF9 - D34E2EDA26B067F716CF5AEF0B5C9C46B6DB7FE4D447F3D1F26BA1CA90AFB5ED - 51AD9A7E2B992A3E265F29F17A94297D4C3992E8EAF8508F4E94FC7013F604C2 - 07763F9E6F3890EE4BBEEDE48EC1E6BF7DA44D74F310D8E1A23D2BB0281DC041 - D30C400DF889794F970C1E86F5BD317A21D6F595235B6D31426FE0FE869FC098 - C2B2BD97A5C9C4F867A70F977ACCAF064341FFA6FB9ED57CFAA3C91976C6CD84 - 9791B4696813990C8D28462269E8668299D088EABA4E554A99AA6A4455DD54D5 - DC54D3DC9AC6420AD5C376BE4F4F689F243A3BFE586A47807302550FED3A48DD - 82F31794E8B12F077FE95424E240EB7DDEA6176BB642AF735ABD812E58668A90 - 5F1E5694924794729A45E9009E67EC31C2D8FD5CCC3139486EDFFCD51147B6DB - 664FF53DBEE567C2833D06494C1CBF04C65DBAD97EECEA07B66E3DE80A799F4D - 9A89392F6F795D34694C6A037A2C3A90999C18CD4C44C6592C569461D24020E0 - AA0C57B92A2A6BB440A851ADD01B931996F7AAF47BF12ABE54269A7C3776E1C2 - E1520E0D70D760E5BECD4FC380DC1AF4C52013131F5DFC07A74E11AEFAF181A6 - 8A06C1B083D22FDFA2F4632E2D1A169D03C0C33E69C67E0A6FA7CD70635CBFDE - FFAFE37C3AE2CCC45FD5771FFE81F0482F2399C9D3D70EA787074A1629C6DBD2 - B6D5B5BAFA47BAA9CF298C9647552399F1F8D5F4D0506F7A6878043209EA2805 - 5471D7D7D5BAEBEB9B5D55FE0D29C3C87B11E7DDB8DDDA58AA77EC956477E705 - 9EE438EEBAC6CA8A5DEB0F82455B26EAF028F1D81F4EFCC689494177B8566BFE - 1FDBB741AB7F6FAFD0800FFFE5DB8A52F2A0B24EB2E81CC0F3A6F904FCB7F56B - E91B9CDCEE9B0DE6D1E87E968BD388758E1C495EBD52924D3ED9EEFEB62D3FD4 - B5F41E9E9417EC66A712B43B7DA3EFABCCC8D0826C4B75D5D6D7B95737DDE7F1 - B196B90C1734DD7D327EFEE2ABC654B42427EABCEB5A570736D55BCE8220E981 - F4BB4E05156978F14043552B59CBC5BBB9F096A27CC8DF2F0A16950338649A15 - D0ECFF149AB76933DF0694EFB5BF3F73DE48C66CB77CEEA6E6DAE0BED53F138D - FB716F3F6E4DE5A2A3F8D6B7B47BD7D7FC249936AA7892102F51A65223B10B89 - DEEEAFCC055A8BBF17C5ED76FB9A5BEEF3D406B626C9CC13945EB71A49F68CFF - 3271B5F32B9EE428153BF76E139E1DA0449F3A7EE31FD27DBDB6A340A9DE80B2 - FE6F766E035B9CE6F4C0284DB0C55F2CA65EC0822E21150AA574D7BD951F8974 - D05B4E547EA6B915FF8ED58744951F4FF5E1C11E2E3A062E6755EC7AE039DFFA - F0DFCE54F915378DB3E1A923E3C7CFFC3AD6F9D597E552F911CC0BE609F34686 - E29F615EF98F2CC033867DEB427F83CF8CCFCE931D03CB08CB8A8BDF00658A65 - 8B65CC538A066D0D6D8E8B39D036D146B9B82858340E00037C2A8C593C3B283D - 35F4C7538E748143FB77ED1605F0C47BF5A64E5D3CE6F4C11EC5EDF7861FDEF3 - 3FEB01F65CBEF57CDC8547278D73B1CFCEFF3AD175E522338D79DD6C540898B7 - 7877C779CC2B9934BEC4BCF31F4D039F159F199F1D75C0931D01CB08CB0ACB8C - 27E5C0B2C532E6A22DD0E6D0F6B898036D146D958B65CFA27100D0D7DA0A0AB7 - 4CF04C7491DB4E44F8C1B8FD18BA9B8BD3485C1D39A9C7261C8DE2A3866BAA02 - FBB6FFEF699AB6CC67DC4163AEDBD1D33DAFC52E7C798C65D20BB2C5B81830AF - F10B5F7E8E79C767E0C916F0D95107A80B9EE408585658665C9C0696B16BCDAA - 394D5ECE04DADC7807B5C495441B455BE562D9B3281CC0CF195320A33BB89803 - 94AD8F1C3EE348EBEFDBDEFA24F4472D1359D938FD0E4FFAB9EA1A1A82BB5BFF - 0F9D64844128B3ADFE48E2F3E8E727DED22363E33C79D18179C767C067C9D71B - 401DA02E50273CC911B0CCB0ECB89803CBD8BF6D1D4E24DB66EC4FA747D006B9 - 98036D75B11C175E140EE00C63EBA1890F7031C7D42D32644CD91FFBE3755DAA - 9FB473310706F0C4187E5C740477C3CA95EEEDCDFF219DD68527DA5CAA1A9D3C - D7FF068EA9B153CD931731CCC467C167C267E389D3405DA04E50373CC911B2F1 - 170543012C6B2C732E160DDA1EDA201773A0AD6618DBC0C5B2665138008552CB - 211C50B239FCC76EDBCB7E78D007EFEAE3E234307AAF93013CB5DA867AD7D635 - FFAB99368451835DA6EBC6D4C973FFB650CB7AA5049F099F0D9F91274D037582 - BA411DF124DB60D9A57AC7CF72711A58E658F65C2C1AB441B4452EE680B44531 - 0C287B07F08C69862863166F9D9A24E34E04F8C45B7A45177562DC7E27437767 - C7FCF7AFFBDFF2557E35462F474F1EFF83914A2DD988C1F86CF88CF8AC3C691A - A81BD491937302F1CEAF7AB02CB99803CB1CCB9E8B45833688B6C8C5BB5903C3 - 80BCE1E1CB85B277005E42368337B578EA8933C4762B8967FCB357740BC04B3B - F85BDB28BE802FB8A3ED7FC9D7ED275103BAC8A7FE041DFEB29DE1770A7C467C - 567C669E340DD411EA0A75C6936C93AF2CB1ECD106B85834F96C312D58B52A37 - CADE0140DFCA729B2ED492E4F889CF6D1F32F1EDD8BE053460A9949908E975EA - C61E46290DECDAFE3FA48D8C2568499648FA64FCE2979F7369D9907D6678762E - 4E0375853A43DDF1245B6059629972F11BA0ECB3366013B445B4492EE680866B - 237F5BB694B50378CE341BC0022CDDA8A91EF4B8F6B6FCE3F8CFB3DAFD101773 - E0459D89CB971DDBF013DAB9FBBBBA92161A993A619C897F7561C984982E147C - 76D40117A7813A43DD71D13658A658B65CCC8136607F2E40E736391DB45DB461 - 2E962565ED002073A2586C64FCD875DBAD7360D7E63651EB8FB7F4661CBAA1D7 - B7A1ED3E5715B3442C4268827E3579E9CB135C5CB6A00E50175C9C06EA0EB748 - 73D11658A658B65CFC06B081AC2DD8249F4DE6B3E172A1AC1D007850CB693CBC - DE2B79B3CFF636587763702F7F9B035B88A9AF2E5DE4A22DF0608FB2AEEAA7A2 - 1D7E6ED375237EEEEC512ECE2B5473A9AEBA15214FD3DA1A7F6B5B23BEF03DA6 - E1CFF8AFCD2BA80BD4091773A0EEBCEB6B7E8ABAE449B6C0B215F50244B65028 - 6893689B5CBC9BB276008E8CB14AC1CB8CAD483386177D4CC389537F78896760 - FBCA9F7131076E1C9938F6D9675CB445C5FEFD3F139DEAC3B5F0A953E7FECD48 - CCC36CBF4AA96F5D6BBDA7A9A6C9DBC01A55B75EC3180BA93E9FD0F11B898409 - C3EEA891D64693837420D537DA97E8E91A2206B3541AA7513D1E6F70CFF63FCB - 188625C41B9E229C3C76EC1FB8688BCAFD0F3D24BA7B3076EED63FD8BD7434DF - 294137A5AFBE4669492E34B54BD9EE566AFBF9CF711DD5327176EB0FBD3DE654 - D4D60699E0AECD0714AF75CF7FFC72DF09632A6A3B70049EE76795DAF7B89803 - 77C3C52EF6FD5E8F464B1A25C7D7D2D6103AD0B6A7E681FAA7036DE19D9E1AA5 - 49F528D554D3BC8A2BFF78177F86BF83BF8B7FE35F1FD81A6AAFDBAE35375710 - C39FD0C7464B16F18619866EC633B703AB2B37EAFAF45E93A918AB3457B017BE - DFB2E9A660741277AFA8B46CD2517D152C75B5AF9B8B45919E60E9EAEDE1462E - E600638D5DFEBBBF2BCB7B22CA7608004D8EE5D61D1D149919E8B7B5F68FB1FD - 69A535BA2FC6F77362E61F23F960300F2E4E2371337DAA949B7C423BF7B436FC - 74CF8F6A9FA8FF5160857A3F3CABEDA534FC0CFC2CFC4CFC6CFC0EFE23C741DD - A08EB8380DD429EA968B4583658C65CDC51C6813681B5C2C0AB44DB4512EE610 - D972B950960EE025D3F4413355C7C51C897E6AFB928FC0B6CDEDF0D096D35AC9 - 817147028906B76C7D4A14C9C76D6A4389CB17856BDF7609B46F5EBDF2A77BFE - A2F201F777DD6E77C9669DF1B3F13BF0BBE03B57F16447411DA1AEB89803758A - BAE5A22D9237AD658D3681B6C1C5A211D928DA32DA3417CB8AB2740069429AC0 - 6B5ABAAA539793B6C370B9EABCD642662493ECB67F951746EED52ABDCF703187 - D74DCC5877CFA7F0458EEEEDC716ABFEC5070F563F52F5B2EA763BB6857636F0 - BBE03BBF8FDF6DB7D5B4C2B2BA429DF1841CA85BD431178B2679ADEB065ED9CE - C51C5ABDD7F6C61D918DA22DA34D73B1AC28D72180F54C3E34029173676D8D41 - 31D027F35B6FF6D1C749BF1371FD7D6DED4F8B027866C688E361BBBCCDEBEA1A - BFBFF9479E7A754E1B59D25142A25708193D3E4606DFEF21B7DEBE486EFEDBD9 - EC0BDF631AFE0C7F077F772EE077631E302F3CC9115057A8332EE640DDA28EB9 - 583458D64684F473F11B7CA4196D844B4581360A155E344C75F4A0935394A503 - 5005CAD2E3246A37A8A36F635B9BC2AC139FC98181EBFC6DD1645B7F9FFE2817 - 7360749CD8954B8EC68C0F3EB06763DD23D53F54BD5EF1D6624E72142AFC49B0 - F4FF7E92DC7EEB28899C3C4A625D5F91D4E04DA24F4488118F655FF81ED3F067 - F83BF8BB37E06FF06FF1336602F38079C13CF12447409D89220BA18EB550D8F6 - 1EFBD42D6B99A36D04DADB2C3B4F0B016D3419B72E078A6CBA1C283B0780D154 - A0965B2E7A48DE24B637E7B86ADC96092C3C2E9AECEFB37DAAD0DBD2F6982830 - 26BB153F67A6929623A9C552F9D8FEFBAB76BABF4D7C3E4BD8B23BC46F1132F0 - FB2B64E80F50E1AF5C24AC88E86126FC0DFE2D7E067E167E665E202F9827CC1B - 4FB10DEACCBC11B39CE4431D7B5B5A2D8EB65012FD7D43C4B06EDF55ABDCB68F - F126FBAC0E006DBA1C2305959D03F013B202C74C5CCC11ED4ED90AB4983DF411 - B0CEC69A5172C36EA8AFECCC7F0DB54413C218FDF19EEE4B5CB44DF8B1FD3B42 - 1B956F71D1421A5CE4ED77BBC8C8874761D8E1DC88033F0B3F133F1BBF231F98 - 37CC23176D93B8D6790983A0723107EADAEE8A0096B91E2537B9F80D6023760F - 08C5AFC5440E80A26D73B16C283B07A00B9404CA3327AF9CCD1B68722E78DAD6 - AF8687B578E0D4E0D04C6DDB9CC0BBFA44D775256FA7CE3B15CAAB62EFFE4D15 - 1B1561C83204C7EEB7DFFA8CA4471C898C2E043F1BBF03BF2B1F9847CC2B176D - 8131063102321773A0AE51E75C2C1A51D9A38DA0AD70B128A29D17702F89654E - 4964DB0B4DD9390070BD96EEBF6E92184DDB1BFF6BF5B5CDFC6D0EDC169ABAD1 - 6FBBC6E0459DFC6D0E8CDB9FECED72645BB16FDD8686F0C6D4412E4E039532FC - C9ADECD81D4318951CF80EFC2EFCCE7CDF8679C53C73D11689EBD73A50975CCC - 21D279A160D98BB6068B6CA510D0563326B1345822DB5E68CACE014069589494 - 1EB32AB350B420B3C4DF6371326AF7CA2ABCA21B6FE9E5628E4C82763931F657 - BC0177C581C6EF88C6FCB84E36F8FE5592E8BBF675C23C82DF89DF2D5CD784BC - 629E31EF3CA5685087A84B2EE6409DA3EEB9581458F668035CCC21B2954211D9 - ACC8B6179AB2720078E537FC6789D89A1AB6E700B2633A8F606521AADB6EFD7D - 6B9B77890EFC246FF475F0B7B6A87976DB231E9FF54834365B4338261FB404A6 - 9D37F0BB310FA29E00E6B916F2CE455B8874893AF73535DB0EF12DB401B015BB - F707E4B1D930B7F1B2A1AC1C403563D5604C9609C0D4F594ADFDF9AE754DF5F0 - A1D688BFA323F66F89A9F45866BEB377F539B0EE8F27F5BC15E25802239FDC2C - E9787FAE601E86FF649D4B433C90777C062E160DEAD24DB4312EE650C39EEDFC - 6DD1886C006DC5BB61ADAD218CC866D1B6438CCDE9BEC7F9A2AC1C8041883016 - DC6477A72D07A085AB84BBE49283376D555235100808BBFFE3F1ABFCAD2DC20F - 871F87EEB47545E43276C11D0B57689BE48D9E6C9E2C40DEB3CFE0007A346679 - E0EC3000CA808B4591CF06F2D9CC5CC967B35098B6EF247092B272002A21966D - 9EE03533663C626B979E56E1B11426D349CCEEDDFEEED5CD9B44DD7FBCA597BF - 2D9A8A1DBBD68BB6F7666284444E3B7262D951304F98B77BC167C067E162D188 - 748ABA77AF69B6B57F1F6DC0D4AD4B8D229B2904B459305A8B7D896C7C2129AF - 1E00A596B12E68D0FE449A9F59BA73664218C9B5205CA14ACBC6225CFBFFFA8A - 6E7B78B7ABC22015A39F41E7623E66FB0B05F294CD9B807CCF5208A853D42D17 - 73B82A2A5BF8DBA26109D3728047643385020EC062BB221B5F48CACA01288C59 - BCA33969DF01504D10FA2BA6DB3E59A804AC973F1893DA009894AD433F789EDF - EB715BD68C7137DE424EFACD06E62D66DD614FF059F099B85824CCFC5AB7D311 - 9541A1886C4164338522B25D918D2F2465E50018A516E5E893D635E042C8AE00 - A8D66E971E9FB415948312974A3DD648BF9968D4FEC6A2CD35F7F1B7D398383B - C30E9C32217A4EBCF891EF990A418F452D0E00CB00CB828B4521B405B019BB3B - 02F3D86E05FFBF2C282B074019B3DC140BE34A5B0E405BD1289C583463315B27 - 0B5D2BEA57241338A49B8E3119B137FBAF52EAAF4C5B0ED6A4C640170E6EEF2D - 1599F151E101A2EC33C1B371B128F4A855B758065016B6561ACCD8A4D016F2D9 - CE5CC963BB651517A07C1C00631446B6160700DD285B13755A558570CC654427 - 6C3900AD2A2C0C8891898C5996AB0A21D0B271A52892CF54E7E2B92334D66555 - 4136B2103C1B178B221D9D10C68380B2B0F5B946248F03C8633B734564BB591B - 075BE7E28253360EE0BB793C6366CABAA7BA1014AF47B84C04AD89ADA545C5E7 - B7ECEAF2BA9498DDDD7FEEB555C27DE889EB96CD70654BFCBA38B45EBE679B2B - 0C7A6DA26DC1A2B228047D2A92106D09CE673B73259FEDBE24E8E92E1465E300 - BC7994A2C762B66E00A11E97B55721B831B650A8CB6D098291498B6FBF2D044F - 2DB34CFEA5A1DDC3E3B98B053C7E9C12B4D56A2DB3BD29C8649A75C6DEE3B6BD - B986E982EEBAC763ABBB3E83ED96CD30A06C1C00B84AE159697D3C62CB01104D - F3F37739A8030E40710B562C92F66316A85AC6B2FE9C5CF80D7F059312E4D9A3 - 656C470ECAA4A8C5B5508DD9DE5C23B209AA29F61C401EDBCD67EB0B41393900 - E1B8C848256C2DA929AAB567C10C7B138B08D398E5F8AF62246CC5FAA76E97AA - F87C96CFCD446CAF58CE3BA23CE3B3E13372B128443A169545A1886C42D1982D - 0790CF76F3D9FA4250360E40234418E081A632B61C00A8DAA26C53C7A3D9F650 - 1566191F1ABA696FCB72558DD090F5C8E29900BC43BE3CBBC275B696C18C9455 - C7A2B22814276CE25EF2D96E3E5B5F08CAC60164F2E4C56EB950CDDADD62547C - 8AB5104C8AE5381D660A0FC6CD19AD22249C0731D3B6FCCA82902FCF5A45D0D6 - 049868B24E54168522B20991ED14423EDBCD67EB0B41D9640410760DCDA8BD73 - 00221466DF0128845974C732695B730B8AAA080D79314D00DE215F9E615C6D6B - 08400CEB074359D8EE523B6113F792CF764101D20148ACD8ED412C06EC3EA3A2 - A8F61C88641AE5E40084DE5209851D2F70E832DA7E6E93506B97D1E5B6D56534 - 532961B3A9B86D07D69977F2E539DF33CE1546544B2F09CAC2B6E374C226EE25 - 9FED82A13BDEDB2896B27100AE3C4AD16C0EEF982E58DE61F69F1BBA8C96011E - 55ECCDEE1AF1987008A1B8CB66D978CEE4CBB39188D97200D4AD5A9CACA82C0A - 45641322DB29847CB69BCFD61782B271005082C22DBFCCE3B2974766ED72C248 - DBF6A4916152CBF651D5EEBA71745C18FA4C0BDBDA92BE20E4CBB33E316E6B0B - B6A26A96B2139545A1386113F792CF76F3D9FA4250360E201FAA477C97FD5C31 - 0DEB1972AA5AC383150AD5A965D38FA9FAECCD70A73386994858E3E087CB2A88 - CC9C70555AF38CCF86CFC8C5E2D0348B8E45655128229B30756A6BF9259FEDC2 - B8A06CE67ACAC60180F6859B68B4AAB03DCFACEBD6E8AC1822D426669A5AB6FD - 2A5E627B434A4A77594EBC796C87A6987F3C8208F819C3653F06A3C62CFB0844 - 655128229B60B6F775886D171C80ADA18593948D0348526B4B8D6881802D07C0 - 5219CBE72A0E380096495B2AAACB6DD80EF6A0DFA696089B9E4A68A116D14420 - E615F37C2FE9016AFB066685EA96AE85A82C0A856A825E61CA66305A7F20DF04 - 76D96CEC281B07F0BB3C4A7105C5FB03E68A994C898F7A06EDDD026B26E296D6 - 2C9931038AC76BCBB9A4AF8F0A62EA10E25F6B3BF2D5BC912FAFF99E6DAED040 - 2020BA7F5154168580B6409960C7681EDB992B5A85785EE1F53C8DDD4250360E - 80508ABB39ACAD7585BD6D93FAF8A4F00CB91AAEB4B57D541F8F0823FFB8C295 - B64249C57BBB0659226171868156DB11AAE60D515EF199F0D9B85814EE50A538 - B64324622B4E9A1AAE101F19CF633B734564BB591B075BE7E282533E0E006002 - CFE80AD89BB0D36F0F0837A52B36C349676E0F0D787DD6BD0B6A458DBD136F06 - 63F109B725F697B7067451EDE835FC25C1555593CDEBBD649F099E8D8B45A185 - C216056019A407ECDDEFA804F238803CB63357F2D86ED974FF91B272009431CB - 640E74A36C3900339D32A09A5A3FD75F616BBCCE48C6602997654CAB55866C9F - 794F5C1AFD8ABF9D46E5FD8E5EC15F1242DBC551BA9317476DDF94A405ACBAC5 - 32C0B2E06251086DC154A6B2B663833CB66BEB966BA7292B076052C1CC7A8503 - 13763AB1DE2A13D06CAFAD99316A8983AD05F595E0CA6CE935D1DD39984CA56F - 7331877F1574831B6CFB979281790B086ED54BA7D283F1AB9D96E7290CAAA815 - BAE5E145655028225B6019D3F68A85C8764536BE909495035019B38CB9601065 - DB0198716A197B2A3EF12D448590999CB0C4BE4A6698D75D5F67FB12C8E439E3 - 047F3B8DEAFD1B20F3B6CFBE380FE4A9E6217184EE789E672904D429EA968B39 - 44655028D4A7581C80C8660A4515D8AE22E8E52E2465E500A0BF65510E98BA4B - F1DB3B0FA04FA686F8DB1C542301EAF5DA9A604CF7F776F8DCD66D9DEEFA7A5B - D74B2393674F5F33D2694BBEDD4142C2BB1EE252F980798231AF057C067816DB - ADB448A7A87B2C032E1605DA80A29996FD1B229B2904B459305A8B7D81B1D89A - 58749AB272008C1061E89B8A96367B5B6C23E3C2C2F436ACB235AB66C4623123 - E3B60E03428175FCAD2D2247231FF1B7D3086D02E35FE3C857388277F5BA6C9E - 44448E4685CF5028229D9A19F7352C032E16453E1BC8673373259FCDE6B3F185 - A2AC1C4094D25168F12D33C59EB5F68233667AFA86E0432D8750B49A5ADB5D75 - 23923AC7DFE64813BDDA555B6F7BCA3EDED539901A322E70711AB58FAD22EEDA - 85DF228879A8FB9630423AC1BCC7BB2EDBBECA0875893AE5620E3D92FA92BF2D - 1A910DA0ADA0CD70B12844368BB68D36CEC5B2A0AC1CC02794E2A92E8B87F4D4 - 114B60CF42C8CEE6A68865A9480B69B66B50A2AFF7946818E05DDD64EBD2CA3B - 8CBC7BFE53239E100D8D48FDB3AD0B3A2988DF8D7910CD48609E31EF5CB48548 - 97A873D43D178B466803602B765700F2D86C84DB78D950560E000163B2CCBEBA - ABED3900449FA2965D68D44F6AA8CBDE3C80313E3A261A06B87CACD5EEAE40C4 - 4CC6D2E34723BF238984C570B0F01A9EDA407C4DB62FDF2D18FC4EFC6EA10141 - 5E31CF98779E52348ADBED465D723107EA1C75CFC5A2C0B2471BE0620E91AD14 - 8AC86645B6BDD0949D0300B76B5192A6900073BB440DCD9CD187462CD74BE3F6 - 4FCFEA35B67B01FAE0E411FE36076E59F536B76EE1A22D123D570723573C87B9 - 380D544ADDA32B49F88187A1346DA9686EC077E077E177E6FB36CC2BE6998BB6 - F035B7DC27DAFE2BD279A160D98BB6008B6CA510D0565D8AD501886C7BA1293B - 07A01162592F8612522A36EEB0D50B48755EBB01FD74CB292C4F43BDAD6BA590 - F8D5AED35E8FF58E79EF0ACF36EA72DBEA61DC61F2C4B1CB9357CC8FB9680127 - E1561C7A08C6E4B6AEB59F11FC6CFC8E7C137E08E611F3CA455B5045553DB581 - AD5CCC81BA469D73B1683CB5D6B2471B415BE1625184DAB6E2F8DFB27225B2ED - 85A6EC1C401C940415DE3211186AF1D80A279D1DD3C5480F17736821B28A51CD - 56D3C932C94C6694592A27AE5BFBD7B7D8BE15F70E918F8F9D8D76981F4117DB - A21FC40D1A5AF16C1BA97DFC6147B70DE367E167E267E37708813C61DE308F3C - C536BEF56D9B93C4BA4487BA469D73B128B0CCB52A629DBD041BB13BFEF7AE0B - 5AF28C368DB6CDC5B2A1EC1CC07B8A92026559BA4ADE55F6CFDA6746D3D60BF6 - 54E2F5AD69B2DD6C26BBBB3E11DD5B471BFDF73B31177087894F8F9D9BB8A8FE - 5E34277007DC31D8F89D8DA4FEDB0F9340EBE6A28E12E3DFE0DFE267E067E167 - E605F28279C2BCF114DBA0CE94D5811D5CCC813A4E765FFD848B45932D73287B - 2EE630C6D3B6F72CF8D75A6F8D429B46DBE662D950760E0001F76B9DB1F79310 - 53ECCD0324AE74769A143F7E3A9E958D6BF9DBA2D1A391093DA1590CD34C337F - 60E3E63D5C7484E899935DC39F8EBD6A2693331E56C1433935FBAAC89A1FEC81 - AEFBC324BC071DC27D30EC5945B4CA30DED4937DE17B4CC39FE1EFE0EFE2DFE0 - DF8A0EF6DC0DE4218279C13CF12447409DA1EEB8980375AC47C76C6FA6119539 - DA46ACA3D3D6F0056DD4EB27967E92C8A6CB81B2740080455990512DBC7D87AD - 137C66249220096299E051C3640D55ED5D5985243A3BFEE8557C162FEFAA26F7 - 39B12FE06E92BD3DC3B77E73E995D4B0719127CD88BB1286511BD121549386A7 - D6919587B690D52FEDCABEF03DA6E1CFF077F077E7027E37E4E15F302F3CC911 - 5057A8332EE640DDA28EB9583458D658E65CFC06B08DAC8DD8006D145A29D1BC - 8F740073053AAC7D3866E2628EE026EF1C4D333FFA50F2127F9B83E28CFDFA56 - 5B5757237A7422AA4F24DFE3628E649A288196758FC03739AA6F964864867EFB - F9E1B14FC75F136D1B2E15F85DF89DF8DD98079EEC1034AB2BD4194FC881BA45 - 1D73B168B0ACB1CCB99843641B8522B251B465B4692E961565E9005E57149CE5 - B2B42ABE35F66F818D9DBFD4215A0DF0AEAA6AE36F6D3175F1C2FB9AA259767B - A515BD3ED0D6BE8D8B8E12EBB874E3D62F4EBE32F145FA77E974DA91E53711F8 - D9F81DB77EF9C5AFF13B79B2A3A08E50575CCCE1766B63A85B2EDA4254D66813 - 681B5C2C1A918DA22DA34D73B1AC284B078080D7B4CED8837DB81AD7D85A56C3 - 168B4D104BB759F1915A4FE39A5946BCB3935D11B831F66B2E4EC3B3C6B7C7E9 - A1C0DDE0387CF017277F3DFAC1D0BFC66E1B5FC2B3DA0E3D859F819F859F899F - 9D1DEB337B813DF281BA411D71711AA9DEC82B7667FE112C632C6B2EE6409BB0 - DB9B41DB441BE5620E912D970B65EB005C940A9556BDAFD9766CAC64EFA070A9 - CABBAE698615EEB993ECEEBCA0E9EE935CCC914C10D5DFDEFC94EAF1D80A1F3E - 1B78F67EECADCFFF74E39533FF152BEE6497713433A95FC309BB7C4B8859E067 - F83BF8BBF837F8B7F819F859F6CFF3CF0CEA0475833AE249395CBAFB8B64F765 - E1998842C957C6C9DE5BB6972FF3D9663E5B2E07C039952F2F98E65F83B54E5B - 52C99864F2EA7F3C62BBAB163EF4F05F291ED2C4C52C78F3ECC4914BEF189311 - DB174DA8C150D0BBAFFDE766DAB08C09DDA6EBC6C4C92FFEC04CC3D67A733150 - CDA5BAAA6B2AD440C0A3F0E3D050E933462C91CA8C0D4F32DD66DCFE22C00D3F - 957B1EF8765AC958E66114B73A913CDEF177C654D476EC7FB5221CA83CB0F9B9 - 7B77FF9929D21779FBE83F73B16836FC8703ED2EC5B20230F996A2FC237F5F76 - 946D0F0081CA6F595A42057B573515BEB07D0FE981294B900A348CE07D9B1DD9 - BE8B066B5E1BFD27D141213474FFB61D0F73715EC10A9E1EBA1DC1ADBA388EC7 - 17BE4F0FDD8A2C44E54782DB763C24AAFCA83BB367FC174E547E24B879F366D1 - D65F912D140ADAA4A0F2239DFCFFB2A4AC1D00D41CA1F2AAF6AFB53D568F9DBE - D4095F600D155643D6B9AA6A6C6F3A4212D7BA3B32E3F4F75C9C06F3B3FB825B - B638BA3F603152B1F9FEBD869F6DE6E234507789AB9DC2F888858265AA5613EB - A929B081AC2DD8249F4DE6B3E172A1AC1DC03B8A3208BD00CBA68FE03A52979D - 12B40135332C7523FD191773600BE1DBB4C9B2FFBC58A267CEFE4E33DDC2B57A - 33E4D9E5BF6FEB2E2E2E3BF0D98D4A752717A7813A43DD71D13658A6A2D61F6D - 006D818B45A2719B9C0EDA2EDA3017CB92B276000864D0B2334B851E57D5DE07 - 6DDFC293387BEEA2A817E00A936627560410CA74163B7DEEBFB9556B04E12C61 - F71EFF96FB1FE4D2B221FBCCF0EC5C9C06EA0A7586BAE349B6C0B2C432E5E237 - 40D9676DC02655BB1E0CA14D723107781B4B78F772A3EC1D4092904BA0488B21 - 54EEB47ADC42C1431FA9FEA43068856F6393632DB3998825A6CE76FE3FB896CD - 93A61352EF0FECD8FD2855AC33E04B0D7CC6C0FDBB1FC567E649D3C8AEF783AE - 50673CC936F9CA327D2379D4EEC11FA4728FD816DD94DADE58546ACADE01BCA7 - 285146E9752EE6F054902A575DA3EDA3B653A7CE5D621962E9A6A93E52E36FBB - CFB1C07B4664743CF165CF7F7269AA70271BF3B1FB2A1ED8F76CA9970817127C - 367C469CFFE049D340DDA08E50573CC936588658965CCC81653EF9C539DB4B8B - 6883688B5CBC9BFED7282DAB00A022CADE01202663966E1AF40A94BAA75B6C07 - F3C0F15FB27B54B8C3CCD35CB543F1071D3BC9971E191C4A5EEAFF4FB8B4C593 - A6A1AB9935C13DDBFFAC949B85160A7C267C367C469E348DEC721FE80675C493 - 6C83658765C8C56924AF8E1DB63FF627046D106D918B3920CD917D0BA5665138 - 002FA53DA050CBDA7C7025A9578301DBCF90B8D871DD8813CBDE02BC45B8E2FE - EDBBB9E808E9C15BB7D2E77AFF63BEE140C6304215DBD7BC1868BB0FBAC8CE9E - 1D5818A882CF82CF84CFC613A781BA409DA06E78922304B76FDF29BA09DA8C91 - CB890B5FD98AFA83A0EDA10D723107DAAA8BDABFB0643E581406065D2903946A - 89000B99D7AABFB5CB76645F247EBEE743680EAC91832B4993779DFD83427793 - 191E1C9C3AD5F57F6AC4258C3D87BBE158ADEFC18A07F71ED2C2D5B62F305928 - 30EFF80CF82CA21D7E084EF8A12E50273CC911B0CC44137F58C6B10B3D1F70D1 - 16687B68835CCC611272166D968B65CDA2696112849C87CC5AF66A57B5B346E6 - F6837FB047A6FF66441F348421B77CADF57BB440A5A363731CE7C68E9FFBBFDD - CC9DB7AB68D04C6368D7BA9771C6DCA9D062F301E615D7F731EFF80C3CD9023E - FBE467E7FE2F27C7FC089615961917A781658C65CDC5A2419B43DBE3620EB451 - 68451645F71F59340E00A3A99882595578004FFDD3BB1D1933478F9D3E65A605 - B108A01B19DCBD65BFDDD061F762A6E3C9C8D193FFAF16A3EF88760C22D99613 - 57091EDAF6235FEBC62DB86D96FFA8ECC0BCF95BDAB7615E717D3F5FAB8FCF8A - CF8CCF8E3AE0C98E8065846525ECFA43D9621973D1166873687B5CCC81365A8E - 917FF2B1681C00C2183B0D19B65494703B5BA97AEDCF05503D6DC6BFBCF10E0C - E22CE1B6543F6908EDD8E5D806A13BE05AF7E4E92FDE49F444FFDEEB56F3B64C - 181D87D6050F54EDDBF9231C5363B86CFEA30507F38279C2BC917AFF43A2483E - 77C067C467C567766A9DFF6EB08CB0ACB8F80D50A6F18B37DEC132E6294583B6 - 8636C7C51C689B29C6CE707151E0688B361F3C6F9A4FC07F968A38DE45AE0FBE - 71C4917164F0E13DBBDC8DEE67B9388DD8E5A123C99EAE929C85C70344FE6D5B - 7EA86BE959B708636CBC4C8276256FF4756446861C8DC8335770661F2FEDC0B8 - FDA2D0DDF7822724E3E72FBEEAD4DEFE7BC1717F6053FD012E4E233D907E77EA - E849DB91849186170F3454B5125118B90B6F29CA87FCFDA260D1398043A65901 - 99FE09BC9DD6BD04B7AEF7FED78E73E9E888EDC9178CEB56FDEDBDDFA73E62B9 - 90823092993C7DED707A78A0646BBCDE96B6ADAED5D53FD24D7D4EBB113DAA1A - C98CC7AFA687867AD343C3239049DBAD9C18AAE02DBD7851A7ABCABF21651873 - 0AD082B3FCA9DEB157F098344F721C775D6365C5AEF507C1A22D73252C41BAC6 - FE70E2374E2CFBB943B56AF3FFD4BE1D5AFB7B27FF0CF8F05FBEAD28935C5E14 - 2C3A07808013F816647C3B17734C0E92DB377F75C491D04B4A38ECAB7C7CCBCF - A84AAC61C80C9298387EE98F7AD45EFCB899C05B6B025BB71E7485BCCF26CDC4 - 9CF722785D34694C6A037A2C3AA047224399C8D898994A163526C5C8BCAE7075 - B5160ED76B815023DECF2FBAA23B1F18C32F134DBE1BBB70E1B013C13CF2A185 - A0ACF66D7E1A9A04CB7D7CCC2013137FBAF48FE6F8789C27D962D58F0F345534 - 90155CFC064ABF7C8BD2BCF736942B8BD2011C34CD40107A01D0CC4DF3F6F030 - ACEFB5C10BB19E4E4726963C6DAD2B02F737FC045A7DCB528F91226313C74E7F - C492A5336C440B55867C6DED4F6B3EFDD1B974B345785D4A2C9356A366924C29 - 462269A4CC04C63EC0E07E8AA2AA8CA81A71AB6EAA6A6E0C18A07849D0E53642 - C98C595410561C9E60F45E0CE0E9440CBF99C0EBBD2BF7EF7A5CF5106B300E18 - F7C7BE1CFC65AAB3CB91602681756DDEA6971BB6424B3FADDE406F2003639A5F - 1E5614DB7124E69B45E90010E805EC85CC5B0ED1245334D2FB9F3F75EC086670 - EFEE6DEE26EF212E4EC34C9091C891531F31C3FE7EF2D9C83A82D6B647B56AFA - AD64CA7A5946398037F6E863CA9144D7E58F304C3A4F2E1954F5A8E103BB1F17 - 85F842527DE97762274E3A765741F3DF3ED2E6F50863FE7D0E5D7FDB31051682 - 45EB001E654CAB62ECAF40F996DD65A36748F7F00747C4076F8A20F4C481C7B5 - 6AB69F8BD3D027C9EDC867273E2EC58CB6081C1AF837B4EED21A2A0EA8AEF486 - 84207AEE7C824B7A785127DED587D77595B2AB7F37B8DC177E68EF635A85A03B - 0EE863F458F4C3231F71D136754F1EA8AED9495AB898032A50749CD27F2EB75B - 7FE7CAA27500C8F74CB3159ADEEF703107D4C44CCF3F755C488F8C3852283829 - 58F5CCDEE7950011460B422710FDFCD4A7F3D113B81BB5AAA6DAD7D4BC5BABF4 - EC50DCE975F3E50CA0C5CD684977AF11499DC32BBAEDDED25B28D8F2871EDCFD - 48BECA6FC6C8C5F1F74EBCE5C4A41FE2AEADD5D6FD75FB56A82C9609469590DF - FF56511CBD14653E59D40E0081A1C04BF01096ADBAF14932D2F75F8E5CE3A26D - 14B747AD7CEA811F521F119E10CC0E078E9FFEB8D47302F9500381807B4D73BB - ABA2B24509B00DD493599D6F234EA1787DC430D2AE3E638A5D31C7C62EA7FB7B - BB8D74DAF6D5DFC58063FEF0BE5D8FE5EBF6B304E99978FF8B579D38E67B87A6 - 7F7F60BDBF42104998901BD0F57F9D8B8B9245EF005E32CD6AA8717F016F2DC6 - 3E7C8C748E1E3D627BDBE71DA8CFE7AA3CB8EBCFEF0D267A079C189C3A79E953 - 7DAA74AB0373855297E65E51DFA886C38D8ACF5FAB78DC354C6555AA8B05A992 - DDA8430DC6B2AB0B2AA5B84AC09849E346864E51838E9BA9F4A899888F1891C8 - 40FAF6D000639905EFE2E216DFE0DE2D8F0A27FC000CEE3971F8F4BF3A795949 - CDC307C275FB89E8CE0803BA03AFBCAE28F3DAFB719A45EF0090174D739F49C8 - 3E2EE6C0A1C0B55F745FCC0C0F3866105A45C8137C7CDB5F286E22BC569CE924 - 36F5E5B54F4AB94F603982EBFCC1FBD73F4A356BDC7D04B7F94E7D74FE157D32 - EAD8365C3CEBBFFEA72D5B445D7F186B1D7F43518E7371D1B2A013484EA151FA - 051492E546612CB8553F6A852EBBBDF881778306868686AD0D4F9A061A68C5AE - F54F397D827039E35DDFBA0A37F9E4ADFC50164E577EB419B41D51E5475B439B - E3E2A2664938003C7A09551C2F8DB48CFB70D9A6E1C5076D070EB91B34B4AFBB - 9A796E7CA1D05BDD547FA062E7DE6D4E1F205A4EA0EE5087818DF58F804E2D15 - 11C98EF9A12C9CADFCB8DDF7C106D1921F8047D3DF5F2CC77D67634919E70B8C - ED628C59F682C343B25B878D8E89B3C71CDD838E1383A1271F782EDFEA0062C4 - C9E0D4D94B9F9772D7E0520477F705776C7E5078B08783B3FDD10FBE78C7C909 - 3FA472C7FEE0CA836A3B0C212DF583527AE44D4A1D3953500E2CADD68931FA3C - 63DF837796B0536021E9DE5F745F72723E00C125C2CA6FED7B4CAB660FF1240B - 2623A978D7F017A9AB9DC2002092E97836B4ADF1B7D63DA050EB71DB3BE863F4 - B3893F1DFFD8A9A5BE3BE0B8BFF9A72D9B5522DC75D9FF16A5BF052FE0E8772E - 244BCB01002F3316CC30F6975042963DEB78AD58F7DF1FBF4CD3CE1A0D92DD31 - B8D6FB6D22D8367C874C84F44E9D3F7FD68C4D3A7A067EA98031FC308C973084 - F71D28D1D3D7937F983A71EA3C4F710CE676D196BFD9B74974C30F5494A48BD2 - 7F81AE7F494E322E144BCE0120D00B68A68C3D2FEAC24D8D92A11BFF78C4763C - 38117876C0BFA5E165E101220EF60652D7C6CFC63BBF2ADB0B2317028CDEEB59 - 5FB563A6561F0FF6C42F0EBEE6D4DEFE7B59FDEF0E34076B8431FEA06F49DF82 - D6BF2476B3902C490780E43B2B804CF491FE81578F0C70D15194AA2A7FE5439B - 9F131E25BE0B2341461357FA4EA706FA4779D2B2042FEDC0B8FDA2D0DD778347 - 7A273EBBF48E53A7FAEEA5F187071A2B9BAC4347041A9245BBD77F3696AC0340 - C0091C8207B4DE07070C9F25D7460F1FB12C1D3A01CE0B54ECDFB1D3BDD27D70 - A6210182C382C4E5CB1732E3A34BAA6B391B78579F7FD3A62D5A58BCB3320776 - F96FA50F4F1E3B7BC6E9F1FE1D6A0E1EA8ADDB21B613F8C26B50F9DFE6E29263 - 493B80674CD3E326E407F090969D6350B06CE8137265FCC491921D5775AF6DAE - F3DFBFFAB97C9B86EE8047738D51D233F5D5A58B4E5C4D5ECEE015DD7803335E - C22ABAABEF6E70730F86F14A5FED2D59C4A3AABD0742F58F9236C88868497C34 - 45C86F16538CBF4259D20E00799EB1308CE07E006F2DC1220063E070EACAC4D9 - 93256B7DB137107A78F7035A83FA18287BC6F3FC59471021FDC96B3D1DA9DBB7 - 16F516D37BF1AC5859ED5DBFAE5D0D9335B3557C70CEE9CC20FB64F2E8C993A5 - 6AF591CA1D7B828D073D1BE1ADE8CC448250FADF61DCEFD856F27264C93B00E4 - 65C65664187B092CC9D21DC75062B7DE8D5D99BA70A6A42DAF6BCDAAB06FFBBA - A7349F705FB9053C5C94BA3DD19DE8BAD2C78C85B9B7DF2E5475A9BED68D4D9E - 15952DF90EEFDC8B9E209D89733DEF3B11BA7B26825B7706563E1BD808CDBEC5 - 26A052E82E4A5F7F8DD2924C369613CBC20120DF636CBDC9D873E0042CCF3C5F - 4E00F16D695FEB6DA9798ABAF26F70990623197D9CF4A706067A13FD7D43F315 - 77A05870F79E6F4D53BDA7B1B159AB226B40DBC21D7CF78277F5E1156D784B13 - 4F2A19B3547EA650FACE6F2975EC246939B36C1C00F29C696E86423FC8C57B31 - 6E7D607446CF1C2B7950C7EC24E103DBB7BA577B1F8691A7F0649B108324C119 - DC4C8D0CDD4ADDE81F9CAFE01BB381414A3CABD734786AEB5742A55F051DEAB9 - 5FA2629231BCA5172FEA2C6577FF0EA19DFB2B563EA9622F4C78541A1A83C3EF - 284AD9DFEAEB14CBCA0120CF33763F61EC312E4E03ACCF1CFA8474967262F06E - 702BB16FC7F62D9ED5EE870A720400CE17B03819D527F4DBFAD8C86872F0E6F0 - 7CC522C033F9DE8655755A756D8D56A9ADA07E5233DBB8DE0254FCD48DF46778 - 3FBFD35B79F331CB841F3C18FD18C6FC962BE89632CBCE0120874C73373CF8C3 - 5C9C063A81B133E49A9321C566037B04C1EDEDADAE35A17DF9620DCC0533A34C - 997173CC4CA4A3FA542C6A262663466432566C7C022D18F6A9E18A80E2AB0868 - C18A901AD0C2D4AB841557F13109F1E45EA63F7A7CEA5C47D77CB4F877C0905E - D53BC9FA7C951F123F7B435196C409BF4258960E0079D1341F80EE5EDEFDFB13 - 3DA47FE0B5D26C169A09DC4DE86D6ED8412BC91630CA3987039F15183E3083A4 - B32F460C66421B6CF0BB1655E2A20A81A12F51A94ADCF82AA81B3F0BA0E7149B - 201793BD83674BB58B6F261A5F3ED058B94EBCC907814A70EC4D4539C9C565C5 - B27500083881ED609CDFE2A285C43819EAFDD5F1EBA5383B301B187D28B06D73 - BBABCEDBCEFC64BDC2C463D672C5A4E05E12A4571F4A5E8A9DBFD4E164949EB9 - 827BFB9B7FBC6FADAFCABABDF70E4BED745FA12C6B0780E0C420D4AC27A1860B - 75810788FA7ED5DDEDF429C242C04B4A7C1BDBDA5C35EE561220EB1CED193808 - B6F424467A32A3E9AEC495CE4E33B27047A0F1545FD38F5B5A44077B10286C06 - AF0FA1DB7F91272D4B96BD0340C009B4801378069C8070DB2E1E251E3A6C743B - 1D4FA01870E2D0D3B67EB5565FDBACF9D96AE223ABA0108BBA30C42EA0AF34B4 - F237F538BDA10F8DF4A63AAFDD98AF09BD99C0F3FCF507552C53A15E405F3A64 - F2BD7714A59B272D5BA403E064370B11728831F1CDB660EC2CD245FA06DFF87C - 10EC87A72E3CE8105CCD4D755A55558356E1A957FCAC81BA945AA2387C7988A9 - 4CB18C3962C6E9A03E991AD2C7C70733BD7DC3E550E1BF41CB46F209B7922630 - 6CA16D43973FEE22E4EDE5B0C9672E48077017CF9866089A8C1740297997E4F0 - E6A19BBFEEEA59C821C15CC83A86C6BA4A355C55A5783D01EA717989A6F9158D - F928250A5308FEFBBA8534499A9AC4648C98A64E1344D7E32C95499AC954CC88 - 8C8F67068627CAABA25BC12E3FC6F0CB13C62B0B38F1B134216FBEA728F3B2CC - BB18900EE01EF801A2A74131C2D36108185266E418E97132E4B8A478C20F1DA8 - 6C7828BBC49777D721FCAC2709DDFEA57CB0A718A403C803C6135008D907953D - AF8EF0F291DBFFDAD1978E38730391A430DCE15A6DC59FB737892EEDB803141E - DE957E7CA99EE7B78B740033C0230BE1E460DE3571EC0D8C9D21D7E773E39024 - B7B1672D18F04CAD7E9251FADE528CE4E314D201CC02C6184C33F634BCCDBB91 - 04C1B981E1B76FF7397535B9440C5ED15D776845D34C637D4EBF9BD23F2EB518 - 7E4E231DC05C608CBE40C84EC6B23704E7DD9003CA64D1413238FC56C72D392C - 7016ECEED73DDFBE32D4401A661A960106A5F4D89B849C214B287A6FA9900EA0 - 005E344DDC517610C694755FA788819FEB135DE4E6C8BB67868D640C4449B1A8 - DE8052FBECCEBACA56B24AC9B34FE30E60CC23F07AFF0D4519E2499259900EA0 - 407ECE98721E2F2021642FBC663448DC4014E9A0B786FE786A98A6E3B2352A00 - E6F6D3FAA777D785DBD9CA7C1B7AEE00468CBDAD93DB293DF577944A875B00D2 - 0114C97718AB52197B021438EB1D806091A9F10E3A30FAE1E951331E2BEBF5F4 - 8546F107D49A2776D554B5B3C6B96C7906AF7A03FAFC1FFE9ED2719E242900E9 - 006C72C834378212F168B170CFF9DDE0D060AA9F0C0D7FD03D58EE1B89E61BDC - C853F7644B43700DA99FADABCF9984CA7FF46D45B9C26549114807E0008F32A6 - 5531B6139489478C670D8105866BA626C9F8C449323C7EFAF368396D2D9E5F34 - 52B5EBC150E51E52E7A92055A03FA8FB3303BF804733BF18A7F4CC2794CA8956 - 9B4807E020074D33E023640F28152F0BCDBB5A7037301E484EF5802338767D34 - 79B32FCD939734DE554DEEAAFD6B6B82EB481D2869AE71070CA8F8171330D63F - AC284B3A74FA7C221D400980614105A174AFCAD87DD02398B555BB031E3D9EBA - 4AC6C68EF78E6506FA97D410C1D5B8C655BDAFB93AB88154E73BA22B029467C2 - 18FF2BC2D809E8EE973C5EE372433A801282878B3C94EE5418DB3C97A1C1DD40 - 57602AD54F27263A9291C9F367E3F3193ECB193412DCBA2D10DC14A8F4AF2561 - B7420A3A9D885D7D93D24B29C6CEC8C33BA5433A8079E0C78C79A38C6D851A7C - 3FBC023C79CEE0E4A11E27D1E44D3215ED4E4D4E5E0187B000518A6602A3EF54 - 6CDCE10FB5782ABCAB48D0E52715605C05393D04FE2606AF2F43945EF815A572 - 576589910E601EC13D041718DBA0936CBCBF26A8C145E91FFECED44D124B8F91 - 786A185ED75389C9EECE84198FCCCB12A3E20FAB152D6D3ECF5A8FCF5347FCEE - 6AE2D71412808799F370E76EE0EFF0C04E9F0663FCAD945E956BF9F38774000B - 040E0FBC846C86B7ED50A1435FA7DA033E27932124654E929401AF7494648C04 - D10DF85F8FC5F4CCD494614E8D19B8E8A0A77576C7616085D6DC1AC5C5372558 - ADBA8241550B043435445CAA8F686EFCBF827814784193EE01A329B86517019F - 835DFB0E68E62FC96EFEC2201D401980D188D28CE175E27861C59C27C8162938 - 91D7E9A6B44B46E55978A40328339E33CD06289466FE5A51EC30A15C80CC3378 - 86DBF0EAC5D73B8A32C87F24290316B5712D7570F27082B1261810AF52095909 - 15A8B6DC1D025678F86F14F27C53815725A57D7232AF7C910E601181E1CA3C94 - 3632C61AC021D49A94D651C62A17CA29606567944E288C0D1B78128FD2C11463 - 0332ECD6E2413A80450E6E430E315603051906A7103228AD840A89938A3897E0 - 07E760EB0E01F85CACCC71784D82C389C26747A1759F80CF8D44291D95DB7117 - 37D2012C75A08DFE2E213E2F0C27A026BBA0C5CE3A04E839A82E7EE82643880E - E9D91501484FC12F6492D06DFF1D210919544322914824128944229148241289 - 4422914824128944229148241289442291482412894422914824128944229148 - 2412894422914824128944229148241289442291482412894422914824128944 - 2291482412894422914824128944229148241289442291482412894422914824 - 1289442291482412C9728390FF1F97ED6E34D64226CD0000000049454E44AE42 - 6082} - FileName = - 'C:\Users\Programmer\Pictures\Icons\'#931#969#964#942#961#951#962'\256x256\icon_simulati' + - 'on_256.png' - end> - Align = Client - Size.Width = 444.500000000000000000 - Size.Height = 313.000000000000000000 - Size.PlatformDefault = False - end - end - object ltSendText: TLayout - Align = Bottom - Padding.Left = 5.000000000000000000 - Padding.Top = 5.000000000000000000 - Padding.Right = 5.000000000000000000 - Padding.Bottom = 5.000000000000000000 - Position.Y = 480.000000000000000000 - Size.Width = 909.000000000000000000 - Size.Height = 48.000000000000000000 - Size.PlatformDefault = False - TabOrder = 2 - TabStop = False - object edtTextToSend: TEdit - Touch.InteractiveGestures = [LongTap, DoubleTap] - Align = Client - StyleLookup = 'editstyle' - TabOrder = 0 - Margins.Right = 5.000000000000000000 - Size.Width = 823.000000000000000000 - Size.Height = 38.000000000000000000 - Size.PlatformDefault = False - OnEnter = edtTextToSendEnter - OnExit = edtTextToSendExit - end - object btnSendText: TButton - Align = Right - Position.X = 833.000000000000000000 - Position.Y = 5.000000000000000000 - Size.Width = 71.000000000000000000 - Size.Height = 38.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Text = 'Send' - OnClick = btnSendTextClick - end - end - object ltMessages: TLayout - Align = Bottom - Padding.Left = 5.000000000000000000 - Padding.Top = 5.000000000000000000 - Padding.Right = 5.000000000000000000 - Padding.Bottom = 5.000000000000000000 - Position.Y = 328.000000000000000000 - Size.Width = 909.000000000000000000 - Size.Height = 152.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - TabStop = False - object memMessages: TMemo - Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] - DataDetectorTypes = [] - ReadOnly = True - Align = Client - Size.Width = 899.000000000000000000 - Size.Height = 142.000000000000000000 - Size.PlatformDefault = False - TabOrder = 0 - Viewport.Width = 895.000000000000000000 - Viewport.Height = 138.000000000000000000 - end - end - object Splitter: TSplitter - Align = Bottom - Cursor = crVSplit - MinSize = 20.000000000000000000 - Position.Y = 323.000000000000000000 - ShowGrip = False - Size.Width = 909.000000000000000000 - Size.Height = 5.000000000000000000 - Size.PlatformDefault = False - end - end - object CameraComponent: TCameraComponent - OnSampleBufferReady = CameraComponentSampleBufferReady - Left = 184 - Top = 128 - end - object MultiView: TMultiView - TargetControl = ltContent - MasterButton = btnMasterView - Mode = NavigationPane - NavigationPaneOptions.CollapsedWidth = 48.000000000000000000 - Size.Width = 250.000000000000000000 - Size.Height = 50.000000000000000000 - Size.PlatformDefault = False - TabOrder = 5 - object lbUsers: TListBox - Align = Client - Size.Width = 48.000000000000000000 - Size.Height = 528.000000000000000000 - Size.PlatformDefault = False - StyleLookup = 'transparentlistboxstyle' - TabOrder = 2 - DisableFocusEffect = True - ItemHeight = 48.000000000000000000 - DefaultItemStyles.ItemStyle = 'listboxitemleftdetail' - DefaultItemStyles.GroupHeaderStyle = '' - DefaultItemStyles.GroupFooterStyle = '' - Viewport.Width = 48.000000000000000000 - Viewport.Height = 528.000000000000000000 - end - end - object Client: TncClientSource - Port = 17244 - CommandProcessorThreadsPerCPU = 1 - CommandProcessorThreadsGrowUpto = 10 - ExecCommandTimeout = 2000 - EncryptionKey = 'SetEncryptionKey' - OnConnected = ClientConnected - OnDisconnected = ClientDisconnected - OnHandleCommand = ClientHandleCommand - Host = 'LocalHost' - Left = 64 - Top = 128 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'NetCom Video Chat Demo' + ClientHeight = 576 + ClientWidth = 957 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + OnDestroy = FormDestroy + OnPaint = FormPaint + DesignerMasterStyle = 0 + object ToolBar: TToolBar + Size.Width = 957.000000000000000000 + Size.Height = 48.000000000000000000 + Size.PlatformDefault = False + StyleLookup = 'toolbarstyle' + TabOrder = 1 + TabStop = False + object btnConnect: TButton + Align = Left + Margins.Right = 5.000000000000000000 + Position.X = 48.000000000000000000 + Size.Width = 105.000000000000000000 + Size.Height = 48.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Text = 'Connect' + OnClick = btnConnectClick + end + object edtUsername: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Client + StyleLookup = 'transparentedit' + TabOrder = 2 + Size.Width = 799.000000000000000000 + Size.Height = 48.000000000000000000 + Size.PlatformDefault = False + TextPrompt = 'Enter your username' + OnEnter = edtUsernameEnter + OnExit = edtUsernameExit + end + object btnMasterView: TButton + Align = Left + Size.Width = 48.000000000000000000 + Size.Height = 48.000000000000000000 + Size.PlatformDefault = False + StyleLookup = 'drawertoolbutton' + TabOrder = 4 + end + end + object ltContent: TLayout + Align = Client + Margins.Left = 48.000000000000000000 + Size.Width = 909.000000000000000000 + Size.Height = 528.000000000000000000 + Size.PlatformDefault = False + TabOrder = 2 + object ltCameras: TGridPanelLayout + Align = Client + Padding.Left = 5.000000000000000000 + Padding.Top = 5.000000000000000000 + Padding.Right = 5.000000000000000000 + Padding.Bottom = 5.000000000000000000 + Size.Width = 909.000000000000000000 + Size.Height = 323.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + TabStop = False + ColumnCollection = < + item + Value = 50.000000000000000000 + end + item + Value = 50.000000000000000000 + end> + ControlCollection = < + item + Column = 0 + Control = imgUserVideo + Row = 0 + end + item + Column = 1 + Control = imgPeerUserVideo + Row = 0 + end> + RowCollection = < + item + Value = 100.000000000000000000 + end + item + SizeStyle = Auto + end> + object imgUserVideo: TImage + MultiResBitmap.Height = 256 + MultiResBitmap.Width = 256 + MultiResBitmap = < + item + Width = 256 + Height = 256 + PNG = { + 89504E470D0A1A0A0000000D49484452000001000000010008060000005C72A8 + 66000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 + 4A6C49444154785EEDBD69705CC795A89979EFADBD5028EC0417102401901037 + 71114951A2244BA216DBA224B764BBDD1D6DBB9F67625EC44C77CCC49B989F8E + FE39332F5EC4EB9988F7625E77DBEE68B9F52CB5B5D9962C4AB2245214497111 + 3781044002044882D80B05D47EEFCD39A7942C11BC5900AAEE2DA000E4C7A860 + 9D045095F7E4C993FB4922914824128944229148241289442291482412894422 + 9148241289442291482412894422914824128944229148241289442291482412 + 8944229148241289442291482412894422914824128944229148241289442291 + 4824128944229148241289442291482412894422914824128944229148241289 + 4400E5FF4B962A8CD19718F3C23B9F41886612E23128A52A218ACA980B7F05E4 + 0CFCCC04992984A4E0673A24275EA734492865F83B92A58974008B9C4719D342 + 8CD5404186A1E286A08287A0C686E047155099FDF01E2B7FD1C0E726E133E3F0 + 7612DE47E133A3E02CA2F0B99128A5A39F508ACE42B248910E6011F13263EE34 + 212BA1A16E80CA5E0B95B01692C3F0FF8294237C297C3589C0FF23E01446A063 + 31E826E4D66B944236258B01E900CA981F43D77D82B12668815741855F89157E + A12AFB5C41A7C01DC22DE82DDCACA4B4EF573894909425D2019419CF99660314 + 4A337FAD28F70A3F1B907906CF701B5EBDF87A475106F98F2465C0A236AEA502 + 567A682DDBA0305AA192E0F87DC902CF88F3075DD0ABE994CE60E1910E608138 + 649A3849B705DEB63B55E9E17332194252669CA4F408496762246D4C115D9F84 + D7444CD71353BA393566E01CBF6EEACC8C46A0A74E88120AAB9AA251A2C1FB60 + B5AAF9829A5619D0B40AA2A941A2B902C4AD85895BF1138F8B100F184D76F5C0 + 2EE80CE0BF0E700617DF5694C9AF5325F3897400F3C8CF1953CE30B65EA1740B + 656C2D54D8A2F40F7F67EA2689A5C7483C350CAF1BA9C4E4D5CEC49D0A5D6AD0 + 61546C68F379567B7C9E3AE2775713BFA690003C0CF8B4C281BF638CD2EB2663 + 1777527AEDEF28059F20990FA40398075E324D1F34BA5BE1ED76A8BC81AF53E7 + 0ED4065D8F9368F226998AF6A42627BF3A1BA7E90C7C54F9C0DC2E5A71DF0E7F + 689DA7C2BB8A04353F098137803E45618041C6E0BF73F087175E5794C4D7A992 + 52211D400979C634436E42764145D80CB5B5A0CA9026642AD54F27263A9291C9 + F350E1CDF2AAF0B3C1147008DB76F82BDBBD61CF1A56097A08F21FCD09304CE8 + E4904BA087D3EF290A0E152425403A80128015DF47C85E78DB0E463CE76E71C6 + 24935357C9D8C4B1EBE3C9C1BE25B596EE6A5CE3AADED75C1DDC40AA5D0AA9E0 + C9B302CAC3E1400774054E4847E03CD20138C841D30C40C5DF034AC5C93DF5EB + D49981417B72AA870C8F1FBB3E9ABCB9B42A7D3EBCAB9ADC55FBD7D604D7913A + 50D25C772A1AE00C2E4D812338AC28384C90388074000E80DB71AB18DB09CA7C + 009AAB5967C871122F3549C627CE40C53FF139B46ACB7537AD46AAF63E18AADC + 49EA3C15A40AF4376B6F097E01C7425F8C537A466E43B68F74003679C134DBC0 + 200FC0DB59BBB5389937D54F86863FE81ECC0C0F6478B20470D535BAEA9E6C69 + 08AE21F550C9E7325F8267138EBCA9289D5C961481740045F23C6361C2D813F0 + 76CDD729F9818A9F1AEFA003A31F9E1E35E3B17959AA5BAC28FE805AF3C4AE9A + AA76D6088EC0C39367A25FA7F4A3DF533ACE65490148075020B8967F9EB15DD0 + EAEF85D78C2D15D4F474A483DE1A3B7C7AC448C670324B324798DB4FEB9FDE5D + 176E672B5542DC3C590818B10EAF13DB283D2DF7101486740005F09269D641A5 + 7E0A2CAC8E2709819FEB135DE4D6C8BB678664C5B787EA0D28B5CFEEACAF6C25 + 2B671B1AC0CF87C159BCFFBAA20CF324C92C4807301718A32F10B29331B61FA4 + BCB3FBA04C161D2483C36F75DC4A4746E4049583B8C3B55ADDF3ED2B430DA401 + 7A5E33D92DC63B39F6262167643093D9910E60165E662C9866EC69783BE3583F + 9D2113836F0E5E8FF574CAA3AF2524B0AECDDB70A861ADDB432A79523EFADD94 + FEF1354AA7B82C11201DC00C3CCF583365EC196846F2AE55C3CF32A36749DFC8 + E123A33C49320FD41E3C5053B383348101E75D76859F2519A5EFBD45692F4F92 + DC8374007978C134F7C07F0FCED4DD8C4F9291DBAF75F4A54764777F2170D7D6 + 6A2B5E6E6FF2576423230981C2C361C0E76F2ACAC9AF532477231DC03D3C639A + 1E37214F8362D6F3240BD8EA8F1C233DA3478F4478926401A979F840B8763F59 + 076596B7370065762D4DC81FDF5394144F9200D201DC053FBCF30228A59A2759 + 48A7C844FFAFBBAF95FB461EC5ED515D8D75956AB8AA8A7A3C3EC5EBF2134DF3 + 2B1AF3514A14A610FCF7F5F29A49D2D4242663C434759AC0B38766321367A954 + C2888C8F67068627CC74AAACF72FE046A2553F6A5DE7F5B0304FB2004E600C9C + C09BF24CC1374807C07999B11519C69E0323111ED70545B1B12ED237F8C6E783 + E5B475375BD19B9BEAB4AAAA06ADC253AF78593D75931AA23A1C59C820519626 + A366920EE993A9217D7C7C30D3DB375C5E8E41230D2F3ED8106ECDCE0D086D9B + 521A876EC2DBAF517A9B272D6BA403009E33CD16153A0050F985EBCCB8A167E8 + B0D13D71F6D882CF286385F7B4AD5FADD5D7366B7EB69AF8C82A28C41937CA94 + 0AD0579A24C84D3D4E6FE84323BDA9CE6B37CAC12154EED81FAC3FA862990AF5 + 02FAD22193EFBDA328DD3C69D9B2EC1DC021D3BC4F21E42018B350177844B7EF + 95DEEECC40FF8275F99570D8E7DBD8D6E6AA71B742FF64DD1CB7C8CE3B262129 + 12233D99D17457E24A67A719892C58400F1C1234FDB8A525DFD163286C8C5EFC + E11B8A7291272D4B96B50378D134B783D17E8B8B16121132DCFBCBE3BD0B117D + 87FA7CAEC0B6CDEDAE3A6F3BF393F50A9BDBF1E272C1A4C4A071722D339CEC88 + 9DBFD4C112897977A018A5A8F927FB9A7DE1FC3B37614870E44D4A4F7371D9B1 + 6C1D00B4FCBBE1E11FE6A285893ED23FF0EA91012ECE1B9EB6D615DEB50DF7D3 + 30D9EA644B6F1A2445E1C50C92668C18CC8406DB205F574A95B8A842144A894A + 55E2662AF128F0CAFECC01B067C026C8C564EFE0D95467D7BC8FBD1B7F78A0B1 + B229FF462ED0F367D013F8828BCB8A65E90066AAFCD0D49BA36749CF7C6EECC1 + F059C1EDEDADAE35A17D8A8734F1E4823175658A25CC8811D3237A7C326AC626 + 63466432A64F15D715D782619F1AAE0828818A80E6AF08A9012D4C7D4A58D1CC + 82C27BDD8D99227D99FEE8F1A9731D5DF319E6ACEEC903D5D53BC97A2877A8EF + 56202347DF5694535C5C362C3B073053B71F2BFFE0A7A42B72FCC8044F2A2938 + A1E7DBB17D8B7BA57B3FD5480D4F9E133080652C4E46F5A83EA88F8E8C24076F + 0EB364725EBAD9D4EB75791B56D56935B5B55A486BA07E52435961B6C474329A + BE953E96387BEEE27C4D1C86F71DA86C7884B4E6730290F827E8099CE3E2B260 + 593980E74C733314F2412EDE8B71EB03A3337AE658C9E3D3675BFCDDDB377BD6 + 781F01ABCBBBE7C0824192FA38B9991A19BA95BAD13FC832F353E16783BABC2E + CFEA350D9EDAFA954A15595DD0F0C12463A9FEE4A753A7CE5D9A8F1E4168E7FE + 8A954FAA6DF05638A7028DC3E17714E51217973CCBC6017C8FB1F5E6D7EBFC96 + 678642D76FBD1BBB3275E14CC963CDF9B6B4AFF5B6D43C455DA48127CD0C2319 + A8F4FDA98181DE447FDF1065FABC759B8B81518DFAD634D57B1A1B9BB52A1877 + D3B95D22C2326430D93DFA7EE262C7759E5432825B7706563E1BD8088D8165D9 + 178C832994BEF35B4AAFF1A425CDB270007C93CF4B507344EBFCC68D775397A7 + 2E9C2C69E577AF6EA8F46F6B3DA804C8269E34234602BAC8B727BA125D5D7DCC + 28EF5D78F9A09A4BF3B56C5CE35E51D9AAFAE636C4D113A43371AEE7FD4CFFCD + 926EB30E6EDD1358FDAC07CBC2D213804AA1BB287D7D396C165AF20E8087EEFA + 01BCF57D9DF20D38E61FF8C0B852CA6E3F76F7430FEF7E406B501F0365CFBA61 + 479F207DC99EBECBA981FE2575BAD0D3B8A6C6BBAE69935639FB2427944B5A1F + 343E8E1E3DF545298705381C687C52DD08E5229A1348B8297D159CC0BCCC072D + 144BDA01E0C11E188C7E1FDE5A5A1F787076FB137265FCC49192ED0B77AF6DAE + F3DFBFFA39C54D56F2242138A1678C929EA9CECB978CF1D1257D7E5DADAA0906 + DB366D566BC8BAD9260ECD34B915FFF2C63BE9EBBD258BF053B5F74068C5A364 + 2378194B5E20612449C86B4BF900D1927600874CF3103CA0F054DFF059726DF4 + F091112E3A4EF0E13DBBDC2BDD07A1399B318C15B6F8B1CB572EE86323CBEA80 + 8A0B1C81BF7DD3F6597B0494E8E95BE9C353474F966CB34ECDC103B5753BC476 + 028EE1DADB8AF23617971C4BD601E0797E283C0CE165A1949B7C70DB6EE5C35B + 0E511F69E54942708C9FB8D2777AA975F50B058706BE8D4DBB669B236009D235 + 71F4E2DBA5DA5E3CD36621A824C7966A3C8125E90078249FE745DDBAA9513274 + E31F8F9424428CA76DFD0AFF96952F53357FB82A939154AA77E26CFCF2C51E9E + 2401FC6DF7ADF3ACAFDAA1D0FC4B88CC2013F18BB75E4B755E2BC9E4DCEA7F77 + A0395843EAB998038C086F2F7E6B2946165A720E0063F86518FB4BA8FC96305E + 78B0A7FBEF4F5FA6E938FCD859827B776F73AFF57E7BA62E3F76F727CF9D3F6D + C62665DC40014AA0C25BB17DDBAE1987053824B89EFCC3D48953E7798A636028 + F296BFD9B5497480082A4AD245E9BF2CB518834BCE013C6F9A7F06FF59BA7278 + A4B7F717DD979C0EE4919DE57F6CDFA3AE1A96F75C0163249DE81EFD22D17DB9 + 8F274966C0D7B2A9C9D752F300A5F9574DF431FAD9C49F8E7FECF42A019E226C + FE69CBE63C4789FBDF52947FE3EF97044BCA01BC8017763086D7744D03BB7037 + 3F302E3BBDDC875B79434F3EF09C12C85E062AC48893C1A9B3973ED7A30B7734 + 7631A285C2BEE08ECD0FAAFEFC1BA6CC18B918FDE08B779CDE4A8CCB83AB9E54 + 378986904BEDF4E092710078690734ED3F84B7968D1DE35DE4FAE01B4706B9E8 + 08785C37FCC4AEEF531F59C7932CA407F54BD1B3A72F94FBEEBD720577158676 + ECDAEA6ED036F3240B2C417A221F9EFE8DD3C78D1B5E3CB0A2AA553814315C84 + BCBA542E1F111E8A586CC0B85FD509C1D8FD96CA9F4CD1C8D761BC9C43AB0879 + 2A0FEEFAF3BC959F113D7679E8C8E49913E765E52F1ED41DEA1075893AE5C9D3 + C032C0B2C032E1498E0036731BE33F72F16EB2B68636C7E545CD92700029C676 + 432DB3848686B4CCCD5F77F5C08891A7D8070D2DF8F8B6BFC87B6CD72089C9D3 + D7DE4FF674DDE029129BA02E51A7A85B9E340D2C0B2C13679D804E30F82BDA10 + 4FC881B6A633F6001717358B7E08F01DC6AA34C6FE12DE5A3CF2F031D2E964E8 + 6EECF6636B93AFF21B29323675F2D2A7C59EBF77124A5CAA6B457DA356155EA9 + F8FCB58AC75D43351686570555981F7F254D5976A2CBCD681AFE63CCA471A6D3 + 497845CC547AD44CC447F4F1C8ADCCEDA10146320B7E1E01E31304F76C7E44F5 + 884F5062AC8189C3A7FFD5C9E100861CAFDB4FF0F4E0BDE050E015180A8C7179 + 51B2E81DC021D37C091E62351773E0A51D7DFFE5886327BA70C2AFF2E9077E40 + BDE21D6366828C448E9FFE78BECEE4DF8B1A0804DCAB9B37B94295AD4A806DA0 + 9ECCEA64427CE4B550BC3E621869579F31C5AE98636397D3FDBDDD463A8D4E63 + DEC15804E17DBB1E537CE2CB40704E60E2FD2F5E757262B0E9DF1F582FBA7C04 + 7A0237DE5694D7B9B82859D40EE07BA6D90AA5FC1D2EE6C06E5BCF3F755C70EA + C61E5CEAAB7A66EFF3F966FBF549723BFAF9A94FE7FBD49E5A5553ED6B6ADEAD + 557A7628EEF4BA447A7E867450F9325AD2DD6B4452E7127DBDA78CF1D1796D05 + A9EA51430FEE7E44AB202B78D234707560FCBD136F39B544883710ADFBEBF6AD + 50592C479BC1C3FEFEB78AD2C5C545C7A275008F32A65531F65750C296F8F7A3 + 6748F7F007471C33CAD013071ED7AAB337035BF8BAF29F84CA3F3F5D640CBEE1 + 6BD9B0D3555FF988EA4A6F98AF4A9F0F9F9B9846C67D353334F169A2FBEA99F9 + 0A52822B04E187F63E96CF09E863F458F4C3231F71D1361852AC662769E1620E + A840D1714AFFF9134A9D9B689A4716AD0380AEFF5EC8FC835CCC81B3FEBDFFF9 + D34E2EDA26B067F716CF5AEF0B5C9C46B6DB7FE4D447F3D1F26BA1CA90AFB5ED + 51AD9A7E2B992A3E265F29F17A94297D4C3992E8EAF8508F4E94FC7013F604C2 + 07763F9E6F3890EE4BBEEDE48EC1E6BF7DA44D74F310D8E1A23D2BB0281DC041 + D30C400DF889794F970C1E86F5BD317A21D6F595235B6D31426FE0FE869FC098 + C2B2BD97A5C9C4F867A70F977ACCAF064341FFA6FB9ED57CFAA3C91976C6CD84 + 9791B4696813990C8D28462269E8668299D088EABA4E554A99AA6A4455DD54D5 + DC54D3DC9AC6420AD5C376BE4F4F689F243A3BFE586A47807302550FED3A48DD + 82F31794E8B12F077FE95424E240EB7DDEA6176BB642AF735ABD812E58668A90 + 5F1E5694924794729A45E9009E67EC31C2D8FD5CCC3139486EDFFCD51147B6DB + 664FF53DBEE567C2833D06494C1CBF04C65DBAD97EECEA07B66E3DE80A799F4D + 9A89392F6F795D34694C6A037A2C3A90999C18CD4C44C6592C569461D24020E0 + AA0C57B92A2A6BB440A851ADD01B931996F7AAF47BF12ABE54269A7C3776E1C2 + E1520E0D70D760E5BECD4FC380DC1AF4C52013131F5DFC07A74E11AEFAF181A6 + 8A06C1B083D22FDFA2F4632E2D1A169D03C0C33E69C67E0A6FA7CD70635CBFDE + FFAFE37C3AE2CCC45FD5771FFE81F0482F2399C9D3D70EA787074A1629C6DBD2 + B6D5B5BAFA47BAA9CF298C9647552399F1F8D5F4D0506F7A6878043209EA2805 + 5471D7D7D5BAEBEB9B5D55FE0D29C3C87B11E7DDB8DDDA58AA77EC956477E705 + 9EE438EEBAC6CA8A5DEB0F82455B26EAF028F1D81F4EFCC689494177B8566BFE + 1FDBB741AB7F6FAFD0800FFFE5DB8A52F2A0B24EB2E81CC0F3A6F904FCB7F56B + E91B9CDCEE9B0DE6D1E87E968BD388758E1C495EBD52924D3ED9EEFEB62D3FD4 + B5F41E9E9417EC66A712B43B7DA3EFABCCC8D0826C4B75D5D6D7B95737DDE7F1 + B196B90C1734DD7D327EFEE2ABC654B42427EABCEB5A570736D55BCE8220E981 + F4BB4E05156978F14043552B59CBC5BBB9F096A27CC8DF2F0A16950338649A15 + D0ECFF149AB76933DF0694EFB5BF3F73DE48C66CB77CEEA6E6DAE0BED53F138D + FB716F3F6E4DE5A2A3F8D6B7B47BD7D7FC249936AA7892102F51A65223B10B89 + DEEEAFCC055A8BBF17C5ED76FB9A5BEEF3D406B626C9CC13945EB71A49F68CFF + 3271B5F32B9EE428153BF76E139E1DA0449F3A7EE31FD27DBDB6A340A9DE80B2 + FE6F766E035B9CE6F4C0284DB0C55F2CA65EC0822E21150AA574D7BD951F8974 + D05B4E547EA6B915FF8ED58744951F4FF5E1C11E2E3A062E6755EC7AE039DFFA + F0DFCE54F915378DB3E1A923E3C7CFFC3AD6F9D597E552F911CC0BE609F34686 + E29F615EF98F2CC033867DEB427F83CF8CCFCE931D03CB08CB8A8BDF00658A65 + 8B65CC538A066D0D6D8E8B39D036D146B9B82858340E00037C2A8C593C3B283D + 35F4C7538E748143FB77ED1605F0C47BF5A64E5D3CE6F4C11EC5EDF7861FDEF3 + 3FEB01F65CBEF57CDC8547278D73B1CFCEFF3AD175E522338D79DD6C540898B7 + 7877C779CC2B9934BEC4BCF31F4D039F159F199F1D75C0931D01CB08CB0ACB8C + 27E5C0B2C532E6A22DD0E6D0F6B898036D146D958B65CFA27100D0D7DA0A0AB7 + 4CF04C7491DB4E44F8C1B8FD18BA9B8BD3485C1D39A9C7261C8DE2A3866BAA02 + FBB6FFEF699AB6CC67DC4163AEDBD1D33DAFC52E7C798C65D20BB2C5B81830AF + F10B5F7E8E79C767E0C916F0D95107A80B9EE408585658665C9C0696B16BCDAA + 394D5ECE04DADC7807B5C495441B455BE562D9B3281CC0CF195320A33BB89803 + 94AD8F1C3EE348EBEFDBDEFA24F4472D1359D938FD0E4FFAB9EA1A1A82BB5BFF + 0F9D64844128B3ADFE48E2F3E8E727DED22363E33C79D18179C767C067C9D71B + 401DA02E50273CC911B0CCB0ECB89803CBD8BF6D1D4E24DB66EC4FA747D006B9 + 98036D75B11C175E140EE00C63EBA1890F7031C7D42D32644CD91FFBE3755DAA + 9FB473310706F0C4187E5C740477C3CA95EEEDCDFF219DD68527DA5CAA1A9D3C + D7FF068EA9B153CD931731CCC467C167C267E389D3405DA04E50373CC911B2F1 + 170543012C6B2C732E160DDA1EDA201773A0AD6618DBC0C5B2665138008552CB + 211C50B239FCC76EDBCB7E78D007EFEAE3E234307AAF93013CB5DA867AD7D635 + FFAB99368451835DA6EBC6D4C973FFB650CB7AA5049F099F0D9F91274D037582 + BA411DF124DB60D9A57AC7CF72711A58E658F65C2C1AB441B4452EE680B44531 + 0C287B07F08C69862863166F9D9A24E34E04F8C45B7A45177562DC7E27437767 + C7FCF7AFFBDFF2557E35462F474F1EFF83914A2DD988C1F86CF88CF8AC3C691A + A81BD491937302F1CEAF7AB02CB99803CB1CCB9E8B45833688B6C8C5BB5903C3 + 80BCE1E1CB85B277005E42368337B578EA8933C4762B8967FCB357740BC04B3B + F85BDB28BE802FB8A3ED7FC9D7ED275103BAC8A7FE041DFEB29DE1770A7C467C + 567C669E340DD411EA0A75C6936C93AF2CB1ECD106B85834F96C312D58B52A37 + CADE0140DFCA729B2ED492E4F889CF6D1F32F1EDD8BE053460A9949908E975EA + C61E46290DECDAFE3FA48D8C2568499648FA64FCE2979F7369D9907D6678762E + 4E0375853A43DDF1245B6059629972F11BA0ECB3366013B445B4492EE680866B + 237F5BB694B50378CE341BC0022CDDA8A91EF4B8F6B6FCE3F8CFB3DAFD101773 + E0459D89CB971DDBF013DAB9FBBBBA92161A993A619C897F7561C984982E147C + 76D40117A7813A43DD71D13658A658B65CCC8136607F2E40E736391DB45DB461 + 2E962565ED002073A2586C64FCD875DBAD7360D7E63651EB8FB7F4661CBAA1D7 + B7A1ED3E5715B3442C4268827E3579E9CB135C5CB6A00E50175C9C06EA0EB748 + 73D11658A658B65CFC06B081AC2DD8249F4DE6B3E172A1AC1D007850CB693CBC + DE2B79B3CFF636587763702F7F9B035B88A9AF2E5DE4A22DF0608FB2AEEAA7A2 + 1D7E6ED375237EEEEC512ECE2B5473A9AEBA15214FD3DA1A7F6B5B23BEF03DA6 + E1CFF8AFCD2BA80BD4091773A0EEBCEB6B7E8ABAE449B6C0B215F50244B65028 + 6893689B5CBC9BB276008E8CB14AC1CB8CAD483386177D4CC389537F78896760 + FBCA9F7131076E1C9938F6D9675CB445C5FEFD3F139DEAC3B5F0A953E7FECD48 + CCC36CBF4AA96F5D6BBDA7A9A6C9DBC01A55B75EC3180BA93E9FD0F11B898409 + C3EEA891D64693837420D537DA97E8E91A2206B3541AA7513D1E6F70CFF63FCB + 188625C41B9E229C3C76EC1FB8688BCAFD0F3D24BA7B3076EED63FD8BD7434DF + 294137A5AFBE4669492E34B54BD9EE566AFBF9CF711DD5327176EB0FBD3DE654 + D4D60699E0AECD0714AF75CF7FFC72DF09632A6A3B70049EE76795DAF7B89803 + 77C3C52EF6FD5E8F464B1A25C7D7D2D6103AD0B6A7E681FAA7036DE19D9E1AA5 + 49F528D554D3BC8A2BFF78177F86BF83BF8B7FE35F1FD81A6AAFDBAE35375710 + C39FD0C7464B16F18619866EC633B703AB2B37EAFAF45E93A918AB3457B017BE + DFB2E9A660741277AFA8B46CD2517D152C75B5AF9B8B45919E60E9EAEDE1462E + E600638D5DFEBBBF2BCB7B22CA7608004D8EE5D61D1D149919E8B7B5F68FB1FD + 69A535BA2FC6F77362E61F23F960300F2E4E2371337DAA949B7C423BF7B436FC + 74CF8F6A9FA8FF5160857A3F3CABEDA534FC0CFC2CFC4CFC6CFC0EFE23C741DD + A08EB8380DD429EA968B4583658C65CDC51C6813681B5C2C0AB44DB4512EE610 + D972B950960EE025D3F4413355C7C51C897E6AFB928FC0B6CDEDF0D096D35AC9 + 817147028906B76C7D4A14C9C76D6A4389CB17856BDF7609B46F5EBDF2A77BFE + A2F201F777DD6E77C9669DF1B3F13BF0BBE03B57F16447411DA1AEB89803758A + BAE5A22D9237AD658D3681B6C1C5A211D928DA32DA3417CB8AB2740069429AC0 + 6B5ABAAA539793B6C370B9EABCD642662493ECB67F951746EED52ABDCF703187 + D74DCC5877CFA7F0458EEEEDC716ABFEC5070F563F52F5B2EA763BB6857636F0 + BBE03BBF8FDF6DB7D5B4C2B2BA429DF1841CA85BD431178B2679ADEB065ED9CE + C51C5ABDD7F6C61D918DA22DA34D73B1AC28D72180F54C3E34029173676D8D41 + 31D027F35B6FF6D1C749BF1371FD7D6DED4F8B027866C688E361BBBCCDEBEA1A + BFBFF9479E7A754E1B59D25142A25708193D3E4606DFEF21B7DEBE486EFEDBD9 + EC0BDF631AFE0C7F077F772EE077631E302F3CC9115057A8332EE640DDA28EB9 + 583458D64684F473F11B7CA4196D844B4581360A155E344C75F4A0935394A503 + 5005CAD2E3246A37A8A36F635B9BC2AC139FC98181EBFC6DD1645B7F9FFE2817 + 7360749CD8954B8EC68C0F3EB06763DD23D53F54BD5EF1D6624E72142AFC49B0 + F4FF7E92DC7EEB28899C3C4A625D5F91D4E04DA24F4488118F655FF81ED3F067 + F83BF8BB37E06FF06FF1336602F38079C13CF12447409D89220BA18EB550D8F6 + 1EFBD42D6B99A36D04DADB2C3B4F0B016D3419B72E078A6CBA1C283B0780D154 + A0965B2E7A48DE24B637E7B86ADC96092C3C2E9AECEFB37DAAD0DBD2F6982830 + 26BB153F67A6929623A9C552F9D8FEFBAB76BABF4D7C3E4BD8B23BC46F1132F0 + FB2B64E80F50E1AF5C24AC88E86126FC0DFE2D7E067E167E665E202F9827CC1B + 4FB10DEACCBC11B39CE4431D7B5B5A2D8EB65012FD7D43C4B06EDF55ABDCB68F + F126FBAC0E006DBA1C2305959D03F013B202C74C5CCC11ED4ED90AB4983DF411 + B0CEC69A5172C36EA8AFECCC7F0DB54413C218FDF19EEE4B5CB44DF8B1FD3B42 + 1B956F71D1421A5CE4ED77BBC8C8874761D8E1DC88033F0B3F133F1BBF231F98 + 37CC23176D93B8D6790983A0723107EADAEE8A0096B91E2537B9F80D6023760F + 08C5AFC5440E80A26D73B16C283B07A00B9404CA3327AF9CCD1B68722E78DAD6 + AF8687B578E0D4E0D04C6DDB9CC0BBFA44D775256FA7CE3B15CAAB62EFFE4D15 + 1B1561C83204C7EEB7DFFA8CA4471C898C2E043F1BBF03BF2B1F9847CC2B176D + 8131063102321773A0AE51E75C2C1A51D9A38DA0AD70B128A29D17702F89654E + 4964DB0B4DD9390070BD96EEBF6E92184DDB1BFF6BF5B5CDFC6D0EDC169ABAD1 + 6FBBC6E0459DFC6D0E8CDB9FECED72645BB16FDD8686F0C6D4412E4E039532FC + C9ADECD81D4318951CF80EFC2EFCCE7CDF8679C53C73D11689EBD73A50975CCC + 21D279A160D98BB6068B6CA510D0563326B1345822DB5E68CACE014069589494 + 1EB32AB350B420B3C4DF6371326AF7CA2ABCA21B6FE9E5628E4C82763931F657 + BC0177C581C6EF88C6FCB84E36F8FE5592E8BBF675C23C82DF89DF2D5CD784BC + 629E31EF3CA5685087A84B2EE6409DA3EEB9581458F668035CCC21B2954211D9 + ACC8B6179AB2720078E537FC6789D89A1AB6E700B2633A8F606521AADB6EFD7D + 6B9B77890EFC246FF475F0B7B6A87976DB231E9FF54834365B4338261FB404A6 + 9D37F0BB310FA29E00E6B916F2CE455B8874893AF73535DB0EF12DB401B015BB + F707E4B1D930B7F1B2A1AC1C403563D5604C9609C0D4F594ADFDF9AE754DF5F0 + A1D688BFA323F66F89A9F45866BEB377F539B0EE8F27F5BC15E25802239FDC2C + E9787FAE601E86FF649D4B433C90777C062E160DEAD24DB4312EE650C39EEDFC + 6DD1886C006DC5BB61ADAD218CC866D1B6438CCDE9BEC7F9A2AC1C8041883016 + DC6477A72D07A085AB84BBE49283376D555235100808BBFFE3F1ABFCAD2DC20F + 871F87EEB47545E43276C11D0B57689BE48D9E6C9E2C40DEB3CFE0007A346679 + E0EC3000CA808B4591CF06F2D9CC5CC967B35098B6EF247092B272002A21966D + 9EE03533663C626B979E56E1B11426D349CCEEDDFEEED5CD9B44DD7FBCA597BF + 2D9A8A1DBBD68BB6F7666284444E3B7262D951304F98B77BC167C067E162D188 + 748ABA77AF69B6B57F1F6DC0D4AD4B8D229B2904B459305A8B7D896C7C2129AF + 1E00A596B12E68D0FE449A9F59BA73664218C9B5205CA14ACBC6225CFBFFFA8A + 6E7B78B7ABC22015A39F41E7623E66FB0B05F294CD9B807CCF5208A853D42D17 + 73B82A2A5BF8DBA26109D3728047643385020EC062BB221B5F48CACA01288C59 + BCA33969DF01504D10FA2BA6DB3E59A804AC973F1893DA009894AD433F789EDF + EB715BD68C7137DE424EFACD06E62D66DD614FF059F099B85824CCFC5AB7D311 + 9541A1886C4164338522B25D918D2F2465E50018A516E5E893D635E042C8AE00 + A8D66E971E9FB415948312974A3DD648BF9968D4FEC6A2CD35F7F1B7D398383B + C30E9C32217A4EBCF891EF990A418F452D0E00CB00CB828B4521B405B019BB3B + 02F3D86E05FFBF2C282B074019B3DC140BE34A5B0E405BD1289C583463315B27 + 0B5D2BEA57241338A49B8E3119B137FBAF52EAAF4C5B0ED6A4C640170E6EEF2D + 1599F151E101A2EC33C1B371B128F4A855B758065016B6561ACCD8A4D016F2D9 + CE5CC963BB651517A07C1C00631446B6160700DD285B13755A558570CC654427 + 6C3900AD2A2C0C8891898C5996AB0A21D0B271A52892CF54E7E2B92334D66555 + 4136B2103C1B178B221D9D10C68380B2B0F5B946248F03C8633B734564BB591B + 075BE7E28253360EE0BB793C6366CABAA7BA1014AF47B84C04AD89ADA545C5E7 + B7ECEAF2BA9498DDDD7FEEB555C27DE889EB96CD70654BFCBA38B45EBE679B2B + 0C7A6DA26DC1A2B228047D2A92106D09CE673B73259FEDBE24E8E92E1465E300 + BC7994A2C762B66E00A11E97B55721B831B650A8CB6D098291498B6FBF2D044F + 2DB34CFEA5A1DDC3E3B98B053C7E9C12B4D56A2DB3BD29C8649A75C6DEE3B6BD + B986E982EEBAC763ABBB3E83ED96CD30A06C1C00B84AE159697D3C62CB01104D + F3F37739A8030E40710B562C92F66316A85AC6B2FE9C5CF80D7F059312E4D9A3 + 656C470ECAA4A8C5B5508DD9DE5C23B209AA29F61C401EDBCD67EB0B41393900 + E1B8C848256C2DA929AAB567C10C7B138B08D398E5F8AF62246CC5FAA76E97AA + F87C96CFCD446CAF58CE3BA23CE3B3E13372B128443A169545A1886C42D1982D + 0790CF76F3D9FA4250360E40234418E081A632B61C00A8DAA26C53C7A3D9F650 + 1566191F1ABA696FCB72558DD090F5C8E29900BC43BE3CBBC275B696C18C9455 + C7A2B22814276CE25EF2D96E3E5B5F08CAC60164F2E4C56EB950CDDADD62547C + 8AB5104C8AE5381D660A0FC6CD19AD22249C0731D3B6FCCA82902FCF5A45D0D6 + 049868B24E54168522B20991ED14423EDBCD67EB0B41D9640410760DCDA8BD73 + 00221466DF0128845974C732695B730B8AAA080D79314D00DE215F9E615C6D6B + 08400CEB074359D8EE523B6113F792CF764101D20148ACD8ED412C06EC3EA3A2 + A8F61C88641AE5E40084DE5209851D2F70E832DA7E6E93506B97D1E5B6D56534 + 532961B3A9B86D07D69977F2E539DF33CE1546544B2F09CAC2B6E374C226EE25 + 9FED82A13BDEDB2896B27100AE3C4AD16C0EEF982E58DE61F69F1BBA8C96011E + 55ECCDEE1AF1987008A1B8CB66D978CEE4CBB39188D97200D4AD5A9CACA82C0A + 45641322DB29847CB69BCFD61782B271005082C22DBFCCE3B2974766ED72C248 + DBF6A4916152CBF651D5EEBA71745C18FA4C0BDBDA92BE20E4CBB33E316E6B0B + B6A26A96B2139545A1386113F792CF76F3D9FA4250360E201FAA477C97FD5C31 + 0DEB1972AA5AC383150AD5A965D38FA9FAECCD70A73386994858E3E087CB2A88 + CC9C70555AF38CCF86CFC8C5E2D0348B8E45655128229B30756A6BF9259FEDC2 + B8A06CE67ACAC60180F6859B68B4AAB03DCFACEBD6E8AC1822D426669A5AB6FD + 2A5E627B434A4A77594EBC796C87A6987F3C8208F819C3653F06A3C62CFB0844 + 655128229B60B6F775886D171C80ADA18593948D0348526B4B8D6881802D07C0 + 5219CBE72A0E380096495B2AAACB6DD80EF6A0DFA696089B9E4A68A116D14420 + E615F37C2FE9016AFB066685EA96AE85A82C0A856A825E61CA66305A7F20DF04 + 76D96CEC281B07F0BB3C4A7105C5FB03E68A994C898F7A06EDDD026B26E296D6 + 2C9931038AC76BCBB9A4AF8F0A62EA10E25F6B3BF2D5BC912FAFF99E6DAED040 + 2020BA7F5154168580B6409960C7681EDB992B5A85785EE1F53C8DDD4250360E + 80508ABB39ACAD7585BD6D93FAF8A4F00CB91AAEB4B57D541F8F0823FFB8C295 + B64249C57BBB0659226171868156DB11AAE60D515EF199F0D9B85814EE50A538 + B64324622B4E9A1AAE101F19CF633B734564BB591B075BE7E282533E0E006002 + CFE80AD89BB0D36F0F0837A52B36C349676E0F0D787DD6BD0B6A458DBD136F06 + 63F109B725F697B7067451EDE835FC25C1555593CDEBBD649F099E8D8B45A185 + C216056019A407ECDDEFA804F238803CB63357F2D86ED974FF91B272009431CB + 640E74A36C3900339D32A09A5A3FD75F616BBCCE48C6602997654CAB55866C9F + 794F5C1AFD8ABF9D46E5FD8E5EC15F1242DBC551BA9317476DDF94A405ACBAC5 + 32C0B2E06251086DC154A6B2B663833CB66BEB966BA7292B076052C1CC7A8503 + 13763AB1DE2A13D06CAFAD99316A8983AD05F595E0CA6CE935D1DD39984CA56F + 7331877F1574831B6CFB979281790B086ED54BA7D283F1AB9D96E7290CAAA815 + BAE5E145655028225B6019D3F68A85C8764536BE909495035019B38CB9601065 + DB0198716A197B2A3EF12D448590999CB0C4BE4A6698D75D5F67FB12C8E439E3 + 047F3B8DEAFD1B20F3B6CFBE380FE4A9E6217184EE789E672904D429EA968B39 + 44655028D4A7581C80C8660A4515D8AE22E8E52E2465E500A0BF65510E98BA4B + F1DB3B0FA04FA686F8DB1C542301EAF5DA9A604CF7F776F8DCD66D9DEEFA7A5B + D74B2393674F5F33D2694BBEDD4142C2BB1EE252F980798231AF057C067816DB + ADB448A7A87B2C032E1605DA80A29996FD1B229B2904B459305A8B7D81B1D89A + 58749AB272008C1061E89B8A96367B5B6C23E3C2C2F436ACB235AB66C4623123 + E3B60E03428175FCAD2D2247231FF1B7D3086D02E35FE3C857388277F5BA6C9E + 44448E4685CF5028229D9A19F7352C032E16453E1BC8673373259FCDE6B3F185 + A2AC1C4094D25168F12D33C59EB5F68233667AFA86E0432D8750B49A5ADB5D75 + 23923AC7DFE64813BDDA555B6F7BCA3EDED539901A322E70711AB58FAD22EEDA + 85DF228879A8FB9630423AC1BCC7BB2EDBBECA0875893AE5620E3D92FA92BF2D + 1A910DA0ADA0CD70B12844368BB68D36CEC5B2A0AC1CC02794E2A92E8B87F4D4 + 114B60CF42C8CEE6A68865A9480B69B66B50A2AFF7946818E05DDD64EBD2CA3B + 8CBC7BFE53239E100D8D48FDB3AD0B3A2988DF8D7910CD48609E31EF5CB48548 + 97A873D43D178B466803602B765700F2D86C84DB78D950560E000163B2CCBEBA + ABED3900449FA2965D68D44F6AA8CBDE3C80313E3A261A06B87CACD5EEAE40C4 + 4CC6D2E34723BF238984C570B0F01A9EDA407C4DB62FDF2D18FC4EFC6EA10141 + 5E31CF98779E52348ADBED465D723107EA1C75CFC5A2C0B2471BE0620E91AD14 + 8AC86645B6BDD0949D0300B76B5192A6900073BB440DCD9CD187462CD74BE3F6 + 4FCFEA35B67B01FAE0E411FE36076E59F536B76EE1A22D123D570723573C87B9 + 380D544ADDA32B49F88187A1346DA9686EC077E077E177E6FB36CC2BE6998BB6 + F035B7DC27DAFE2BD279A160D98BB6008B6CA510D0565D8AD501886C7BA1293B + 07A01162592F8612522A36EEB0D50B48755EBB01FD74CB292C4F43BDAD6BA590 + F8D5AED35E8FF58E79EF0ACF36EA72DBEA61DC61F2C4B1CB9357CC8FB9680127 + E1561C7A08C6E4B6AEB59F11FC6CFC8E7C137E08E611F3CA455B5045553DB581 + AD5CCC81BA469D73B1683CB5D6B2471B415BE1625184DAB6E2F8DFB27225B2ED + 85A6EC1C401C940415DE3211186AF1D80A279D1DD3C5480F17736821B28A51CD + 56D3C932C94C6694592A27AE5BFBD7B7D8BE15F70E918F8F9D8D76981F4117DB + A21FC40D1A5AF16C1BA97DFC6147B70DE367E167E267E37708813C61DE308F3C + C536BEF56D9B93C4BA4487BA469D73B128B0CCB52A629DBD041BB13BFEF7AE0B + 5AF28C368DB6CDC5B2A1EC1CC07B8A92026559BA4ADE55F6CFDA6746D3D60BF6 + 54E2F5AD69B2DD6C26BBBB3E11DD5B471BFDF73B31177087894F8F9D9BB8A8FE + 5E34277007DC31D8F89D8DA4FEDB0F9340EBE6A28E12E3DFE0DFE267E067E167 + E605F28279C2BCF114DBA0CE94D5811D5CCC813A4E765FFD848B45932D73287B + 2EE630C6D3B6F72CF8D75A6F8D429B46DBE662D950760E0001F76B9DB1F79310 + 53ECCD0324AE74769A143F7E3A9E958D6BF9DBA2D1A391093DA1590CD34C337F + 60E3E63D5C7484E899935DC39F8EBD6A2693331E56C1433935FBAAC89A1FEC81 + AEFBC324BC071DC27D30EC5945B4CA30DED4937DE17B4CC39FE1EFE0EFE2DFE0 + DF8A0EF6DC0DE4218279C13CF12447409DA1EEB8980375AC47C76C6FA6119539 + DA46ACA3D3D6F0056DD4EB27967E92C8A6CB81B2740080455990512DBC7D87AD + 137C66249220096299E051C3640D55ED5D5985243A3BFEE8557C162FEFAA26F7 + 39B12FE06E92BD3DC3B77E73E995D4B0719127CD88BB1286511BD121549386A7 + D6919587B690D52FEDCABEF03DA6E1CFF077F077E7027E37E4E15F302F3CC911 + 5057A8332EE640DDA28EB9583458D658E65CFC06B08DAC8DD8006D145A29D1BC + 8F740073053AAC7D3866E2628EE026EF1C4D333FFA50F2127F9B83E28CFDFA56 + 5B5757237A7422AA4F24DFE3628E649A288196758FC03739AA6F964864867EFB + F9E1B14FC75F136D1B2E15F85DF89DF8DD98079EEC1034AB2BD4194FC881BA45 + 1D73B168B0ACB1CCB99843641B8522B251B465B4692E961565E9005E57149CE5 + B2B42ABE35F66F818D9DBFD4215A0DF0AEAA6AE36F6D3175F1C2FB9AA259767B + A515BD3ED0D6BE8D8B8E12EBB874E3D62F4EBE32F145FA77E974DA91E53711F8 + D9F81DB77EF9C5AFF13B79B2A3A08E50575CCCE1766B63A85B2EDA4254D66813 + 681B5C2C1A918DA22DA34D73B1AC284B078080D7B4CED8837DB81AD7D85A56C3 + 168B4D104BB759F1915A4FE39A5946BCB3935D11B831F66B2E4EC3B3C6B7C7E9 + A1C0DDE0387CF017277F3DFAC1D0BFC66E1B5FC2B3DA0E3D859F819F859F899F + 9D1DEB337B813DF281BA411D71711AA9DEC82B7667FE112C632C6B2EE6409BB0 + DB9B41DB441BE5620E912D970B65EB005C940A9556BDAFD9766CAC64EFA070A9 + CABBAE698615EEB993ECEEBCA0E9EE935CCC914C10D5DFDEFC94EAF1D80A1F3E + 1B78F67EECADCFFF74E39533FF152BEE6497713433A95FC309BB7C4B8859E067 + F83BF8BBF837F8B7F819F859F6CFF3CF0CEA0475833AE249395CBAFB8B64F765 + E1998842C957C6C9DE5BB6972FF3D9663E5B2E07C039952F2F98E65F83B54E5B + 52C99864F2EA7F3C62BBAB163EF4F05F291ED2C4C52C78F3ECC4914BEF189311 + DB174DA8C150D0BBAFFDE766DAB08C09DDA6EBC6C4C92FFEC04CC3D67A733150 + CDA5BAAA6B2AD440C0A3F0E3D050E933462C91CA8C0D4F32DD66DCFE22C00D3F + 957B1EF8765AC958E66114B73A913CDEF177C654D476EC7FB5221CA83CB0F9B9 + 7B77FF9929D21779FBE83F73B16836FC8703ED2EC5B20230F996A2FC237F5F76 + 946D0F0081CA6F595A42057B573515BEB07D0FE981294B900A348CE07D9B1DD9 + BE8B066B5E1BFD27D141213474FFB61D0F73715EC10A9E1EBA1DC1ADBA388EC7 + 17BE4F0FDD8A2C44E54782DB763C24AAFCA83BB367FC174E547E24B879F366D1 + D65F912D140ADAA4A0F2239DFCFFB2A4AC1D00D41CA1F2AAF6AFB53D568F9DBE + D4095F600D155643D6B9AA6A6C6F3A4212D7BA3B32E3F4F75C9C06F3B3FB825B + B638BA3F603152B1F9FEBD869F6DE6E234507789AB9DC2F888858265AA5613EB + A929B081AC2DD8249F4DE6B3E172A1AC1DC03B8A3208BD00CBA68FE03A52979D + 12B40135332C7523FD191773600BE1DBB4C9B2FFBC58A267CEFE4E33DDC2B57A + 33E4D9E5BF6FEB2E2E2E3BF0D98D4A752717A7813A43DD71D13658A6A2D61F6D + 006D818B45A2719B9C0EDA2EDA3017CB92B276000864D0B2334B851E57D5DE07 + 6DDFC293387BEEA2A817E00A936627560410CA74163B7DEEBFB9556B04E12C61 + F71EFF96FB1FE4D2B221FBCCF0EC5C9C06EA0A7586BAE349B6C0B2C432E5E237 + 40D9676DC02655BB1E0CA14D723107781B4B78F772A3EC1D4092904BA0488B21 + 54EEB47ADC42C1431FA9FEA43068856F6393632DB3998825A6CE76FE3FB896CD + 93A61352EF0FECD8FD2855AC33E04B0D7CC6C0FDBB1FC567E649D3C8AEF783AE + 50673CC936F9CA327D2379D4EEC11FA4728FD816DD94DADE58546ACADE01BCA7 + 285146E9752EE6F054902A575DA3EDA3B653A7CE5D621962E9A6A93E52E36FBB + CFB1C07B4664743CF165CF7F7269AA70271BF3B1FB2A1ED8F76CA9970817127C + 367C469CFFE049D340DDA08E50573CC936588658965CCC81653EF9C539DB4B8B + 6883688B5CBC9BFED7282DAB00A022CADE01202663966E1AF40A94BAA75B6C07 + F3C0F15FB27B54B8C3CCD35CB543F1071D3BC9971E191C4A5EEAFF4FB8B4C593 + A6A1AB9935C13DDBFFAC949B85160A7C267C367C469E348DEC721FE80675C493 + 6C83658765C8C56924AF8E1DB63FF627046D106D918B3920CD917D0BA5665138 + 002FA53DA050CBDA7C7025A9578301DBCF90B8D871DD8813CBDE02BC45B8E2FE + EDBBB9E808E9C15BB7D2E77AFF63BEE140C6304215DBD7BC1868BB0FBAC8CE9E + 1D5818A882CF82CF84CFC613A781BA409DA06E78922304B76FDF29BA09DA8C91 + CB890B5FD98AFA83A0EDA10D723107DAAA8BDABFB0643E581406065D2903946A + 89000B99D7AABFB5CB76645F247EBEE743680EAC91832B4993779DFD83427793 + 191E1C9C3AD5F57F6AC4258C3D87BBE158ADEFC18A07F71ED2C2D5B62F305928 + 30EFF80CF82CA21D7E084EF8A12E50273CC911B0CC44137F58C6B10B3D1F70D1 + 16687B68835CCC611272166D968B65CDA2696112849C87CC5AF66A57B5B346E6 + F6837FB047A6FF66441F348421B77CADF57BB440A5A363731CE7C68E9FFBBFDD + CC9DB7AB68D04C6368D7BA9771C6DCA9D062F301E615D7F731EFF80C3CD9023E + FBE467E7FE2F27C7FC089615961917A781658C65CDC5A2419B43DBE3620EB451 + 68451645F71F59340E00A3A99882595578004FFDD3BB1D1933478F9D3E65A605 + B108A01B19DCBD65BFDDD061F762A6E3C9C8D193FFAF16A3EF88760C22D99613 + 57091EDAF6235FEBC62DB86D96FFA8ECC0BCF95BDAB7615E717D3F5FAB8FCF8A + CF8CCF8E3AE0C98E8065846525ECFA43D9621973D1166873687B5CCC81365A8E + 917FF2B1681C00C2183B0D19B65494703B5BA97AEDCF05503D6DC6BFBCF10E0C + E22CE1B6543F6908EDD8E5D806A13BE05AF7E4E92FDE49F444FFDEEB56F3B64C + 181D87D6050F54EDDBF9231C5363B86CFEA30507F38279C2BC917AFF43A2483E + 77C067C467C567766A9DFF6EB08CB0ACB8F80D50A6F18B37DEC132E6294583B6 + 8636C7C51C689B29C6CE707151E0688B361F3C6F9A4FC07F968A38DE45AE0FBE + 71C4917164F0E13DBBDC8DEE67B9388DD8E5A123C99EAE929C85C70344FE6D5B + 7EA86BE959B708636CBC4C8276256FF4756446861C8DC8335770661F2FEDC0B8 + FDA2D0DDF7822724E3E72FBEEAD4DEFE7BC1717F6053FD012E4E233D907E77EA + E849DB91849186170F3454B5125118B90B6F29CA87FCFDA260D1398043A65901 + 99FE09BC9DD6BD04B7AEF7FED78E73E9E888EDC9178CEB56FDEDBDDFA73E62B9 + 90823092993C7DED707A78A0646BBCDE96B6ADAED5D53FD24D7D4EBB113DAA1A + C98CC7AFA687867AD343C3239049DBAD9C18AAE02DBD7851A7ABCABF21651873 + 0AD082B3FCA9DEB157F098344F721C775D6365C5AEF507C1A22D73252C41BAC6 + FE70E2374E2CFBB943B56AF3FFD4BE1D5AFB7B27FF0CF8F05FBEAD28935C5E14 + 2C3A07808013F816647C3B17734C0E92DB377F75C491D04B4A38ECAB7C7CCBCF + A84AAC61C80C9298387EE98F7AD45EFCB899C05B6B025BB71E7485BCCF26CDC4 + 9CF722785D34694C6A037A2C3AA047224399C8D898994A163526C5C8BCAE7075 + B5160ED76B815023DECF2FBAA23B1F18C32F134DBE1BBB70E1B013C13CF2A185 + A0ACF66D7E1A9A04CB7D7CCC2013137FBAF48FE6F8789C27D962D58F0F345534 + 90155CFC064ABF7C8BD2BCF736942B8BD2011C34CD40107A01D0CC4DF3F6F030 + ACEFB5C10BB19E4E4726963C6DAD2B02F737FC045A7DCB528F91226313C74E7F + C492A5336C440B55867C6DED4F6B3EFDD1B974B345785D4A2C9356A366924C29 + 462269A4CC04C63EC0E07E8AA2AA8CA81A71AB6EAA6A6E0C18A07849D0E53642 + C98C595410561C9E60F45E0CE0E9440CBF99C0EBBD2BF7EF7A5CF5106B300E18 + F7C7BE1CFC65AAB3CB91602681756DDEA6971BB6424B3FADDE406F2003639A5F + 1E5614DB7124E69B45E90010E805EC85CC5B0ED1245334D2FB9F3F75EC086670 + EFEE6DEE26EF212E4EC34C9091C891531F31C3FE7EF2D9C83A82D6B647B56AFA + AD64CA7A5946398037F6E863CA9144D7E58F304C3A4F2E1954F5A8E103BB1F17 + 85F842527DE97762274E3A765741F3DF3ED2E6F50863FE7D0E5D7FDB31051682 + 45EB001E654CAB62ECAF40F996DD65A36748F7F00747C4076F8A20F4C481C7B5 + 6AB69F8BD3D027C9EDC867273E2EC58CB6081C1AF837B4EED21A2A0EA8AEF486 + 84207AEE7C824B7A785127DED587D77595B2AB7F37B8DC177E68EF635A85A03B + 0EE863F458F4C3231F71D136754F1EA8AED9495AB898032A50749CD27F2EB75B + 7FE7CAA27500C8F74CB3159ADEEF703107D4C44CCF3F755C488F8C3852283829 + 58F5CCDEE7950011460B422710FDFCD4A7F3D113B81BB5AAA6DAD7D4BC5BABF4 + EC50DCE975F3E50CA0C5CD684977AF11499DC32BBAEDDED25B28D8F2871EDCFD + 48BECA6FC6C8C5F1F74EBCE5C4A41FE2AEADD5D6FD75FB56A82C9609469590DF + FF56511CBD14653E59D40E0081A1C04BF01096ADBAF14932D2F75F8E5CE3A26D + 14B747AD7CEA811F521F119E10CC0E078E9FFEB8D47302F9500381807B4D73BB + ABA2B24509B00DD493599D6F234EA1787DC430D2AE3E638A5D31C7C62EA7FB7B + BB8D74DAF6D5DFC58063FEF0BE5D8FE5EBF6B304E99978FF8B579D38E67B87A6 + 7F7F60BDBF42104998901BD0F57F9D8B8B9245EF005E32CD6AA8717F016F2DC6 + 3E7C8C748E1E3D627BDBE71DA8CFE7AA3CB8EBCFEF0D267A079C189C3A79E953 + 7DAA74AB0373855297E65E51DFA886C38D8ACF5FAB78DC354C6555AA8B05A992 + DDA8430DC6B2AB0B2AA5B84AC09849E346864E51838E9BA9F4A899888F1891C8 + 40FAF6D000639905EFE2E216DFE0DE2D8F0A27FC000CEE3971F8F4BF3A795949 + CDC307C275FB89E8CE0803BA03AFBCAE28F3DAFB719A45EF0090174D739F49C8 + 3E2EE6C0A1C0B55F745FCC0C0F3866105A45C8137C7CDB5F286E22BC569CE924 + 36F5E5B54F4AB94F603982EBFCC1FBD73F4A356BDC7D04B7F94E7D74FE157D32 + EAD8365C3CEBBFFEA72D5B445D7F186B1D7F43518E7371D1B2A013484EA151FA + 051492E546612CB8553F6A852EBBBDF881778306868686AD0D4F9A061A68C5AE + F54F397D827039E35DDFBA0A37F9E4ADFC50164E577EB419B41D51E5475B439B + E3E2A2664938003C7A09551C2F8DB48CFB70D9A6E1C5076D070EB91B34B4AFBB + 9A796E7CA1D05BDD547FA062E7DE6D4E1F205A4EA0EE5087818DF58F804E2D15 + 11C98EF9A12C9CADFCB8DDF7C106D1921F8047D3DF5F2CC77D67634919E70B8C + ED628C59F682C343B25B878D8E89B3C71CDD838E1383A1271F782EDFEA0062C4 + C9E0D4D94B9F9772D7E0520477F705776C7E5078B08783B3FDD10FBE78C7C909 + 3FA472C7FEE0CA836A3B0C212DF583527AE44D4A1D3953500E2CADD68931FA3C + 63DF837796B0536021E9DE5F745F72723E00C125C2CA6FED7B4CAB660FF1240B + 2623A978D7F017A9AB9DC2002092E97836B4ADF1B7D63DA050EB71DB3BE863F4 + B3893F1DFFD8A9A5BE3BE0B8BFF9A72D9B5522DC75D9FF16A5BF052FE0E8772E + 244BCB01002F3316CC30F6975042963DEB78AD58F7DF1FBF4CD3CE1A0D92DD31 + B8D6FB6D22D8367C874C84F44E9D3F7FD68C4D3A7A067EA98031FC308C973084 + F71D28D1D3D7937F983A71EA3C4F710CE676D196BFD9B74974C30F5494A48BD2 + 7F81AE7F494E322E144BCE0120D00B68A68C3D2FEAC24D8D92A11BFF78C4763C + 38117876C0BFA5E165E101220EF60652D7C6CFC63BBF2ADB0B2317028CDEEB59 + 5FB563A6561F0FF6C42F0EBEE6D4DEFE7B59FDEF0E34076B8431FEA06F49DF82 + D6BF2476B3902C490780E43B2B804CF491FE81578F0C70D15194AA2A7FE5439B + 9F131E25BE0B2341461357FA4EA706FA4779D2B2042FEDC0B8FDA2D0DD778347 + 7A273EBBF48E53A7FAEEA5F187071A2B9BAC4347041A9245BBD77F3696AC0340 + C0091C8207B4DE07070C9F25D7460F1FB12C1D3A01CE0B54ECDFB1D3BDD27D70 + A6210182C382C4E5CB1732E3A34BAA6B391B78579F7FD3A62D5A58BCB3320776 + F96FA50F4F1E3B7BC6E9F1FE1D6A0E1EA8ADDB21B613F8C26B50F9DFE6E29263 + 493B80674CD3E326E407F090969D6350B06CE8137265FCC491921D5775AF6DAE + F3DFBFFAB97C9B86EE8047738D51D233F5D5A58B4E5C4D5ECEE015DD7803335E + C22ABAABEF6E70730F86F14A5FED2D59C4A3AABD0742F58F9236C88868497C34 + 45C86F16538CBF4259D20E00799EB1308CE07E006F2DC1220063E070EACAC4D9 + 93256B7DB137107A78F7035A83FA18287BC6F3FC59471021FDC96B3D1DA9DBB7 + 16F516D37BF1AC5859ED5DBFAE5D0D9335B3557C70CEE9CC20FB64F2E8C993A5 + 6AF591CA1D7B828D073D1BE1ADE8CC448250FADF61DCEFD856F27264C93B00E4 + 65C65664187B092CC9D21DC75062B7DE8D5D99BA70A6A42DAF6BCDAAB06FFBBA + A7349F705FB9053C5C94BA3DD19DE8BAD2C78C85B9B7DF2E5475A9BED68D4D9E + 15952DF90EEFDC8B9E209D89733DEF3B11BA7B26825B7706563E1BD808CDBEC5 + 26A052E82E4A5F7F8DD2924C369613CBC20120DF636CBDC9D873E0042CCF3C5F + 4E00F16D695FEB6DA9798ABAF26F70990623197D9CF4A706067A13FD7D43F315 + 77A05870F79E6F4D53BDA7B1B159AB226B40DBC21D7CF78277F5E1156D784B13 + 4F2A19B3547EA650FACE6F2975EC246939B36C1C00F29C696E86423FC8C57B31 + 6E7D607446CF1C2B7950C7EC24E103DBB7BA577B1F8691A7F0649B108324C119 + DC4C8D0CDD4ADDE81F9CAFE01BB381414A3CABD734786AEB5742A55F051DEAB9 + 5FA2629231BCA5172FEA2C6577FF0EA19DFB2B563EA9622F4C78541A1A83C3EF + 284AD9DFEAEB14CBCA0120CF33763F61EC312E4E03ACCF1CFA8474967262F06E + 702BB16FC7F62D9ED5EE870A720400CE17B03819D527F4DBFAD8C86872F0E6F0 + 7CC522C033F9DE8655755A756D8D56A9ADA07E5233DBB8DE0254FCD48DF46778 + 3FBFD35B79F331CB841F3C18FD18C6FC962BE89632CBCE0120874C73373CF8C3 + 5C9C063A81B133E49A9321C566037B04C1EDEDADAE35A17DF9620DCC0533A34C + 997173CC4CA4A3FA542C6A262663466432566C7C022D18F6A9E18A80E2AB0868 + C18A901AD0C2D4AB841557F13109F1E45EA63F7A7CEA5C47D77CB4F877C0905E + D53BC9FA7C951F123F7B435196C409BF4258960E0079D1341F80EE5EDEFDFB13 + 3DA47FE0B5D26C169A09DC4DE86D6ED8412BC91630CA3987039F15183E3083A4 + B32F460C66421B6CF0BB1655E2A20A81A12F51A94ADCF82AA81B3F0BA0E7149B + 201793BD83674BB58B6F261A5F3ED058B94EBCC907814A70EC4D4539C9C565C5 + B27500083881ED609CDFE2A285C43819EAFDD5F1EBA5383B301B187D28B06D73 + BBABCEDBCEFC64BDC2C463D672C5A4E05E12A4571F4A5E8A9DBFD4E164949EB9 + 827BFB9B7FBC6FADAFCABABDF70E4BED745FA12C6B0780E0C420D4AC27A1860B + 75810788FA7ED5DDEDF429C242C04B4A7C1BDBDA5C35EE561220EB1CED193808 + B6F424467A32A3E9AEC495CE4E33B27047A0F1545FD38F5B5A44077B10286C06 + AF0FA1DB7F91272D4B96BD0340C009B4801378069C8070DB2E1E251E3A6C743B + 1D4FA01870E2D0D3B67EB5565FDBACF9D96AE223ABA0108BBA30C42EA0AF34B4 + F237F538BDA10F8DF4A63AAFDD98AF09BD99C0F3FCF507552C53A15E405F3A64 + F2BD7714A59B272D5BA403E064370B11728831F1CDB660EC2CD245FA06DFF87C + 10EC87A72E3CE8105CCD4D755A55558356E1A957FCAC81BA945AA2387C7988A9 + 4CB18C3962C6E9A03E991AD2C7C70733BD7DC3E550E1BF41CB46F209B7922630 + 6CA16D43973FEE22E4EDE5B0C9672E48077017CF9866089A8C1740297997E4F0 + E6A19BBFEEEA59C821C15CC83A86C6BA4A355C55A5783D01EA717989A6F9158D + F928250A5308FEFBBA8534499A9AC4648C98A64E1344D7E32C95499AC954CC88 + 8C8F67068627CAABA25BC12E3FC6F0CB13C62B0B38F1B134216FBEA728F3B2CC + BB18900EE01EF801A2A74131C2D36108185266E418E97132E4B8A478C20F1DA8 + 6C7828BBC49777D721FCAC2709DDFEA57CB0A718A403C803C6135008D907953D + AF8EF0F291DBFFDAD1978E38730391A430DCE15A6DC59FB737892EEDB803141E + DE957E7CA99EE7B78B740033C0230BE1E460DE3571EC0D8C9D21D7E773E39024 + B7B1672D18F04CAD7E9251FADE528CE4E314D201CC02C6184C33F634BCCDBB91 + 04C1B981E1B76FF7397535B9440C5ED15D776845D34C637D4EBF9BD23F2EB518 + 7E4E231DC05C608CBE40C84EC6B23704E7DD9003CA64D1413238FC56C72D392C + 7016ECEED73DDFBE32D4401A661A960106A5F4D89B849C214B287A6FA9900EA0 + 005E344DDC517610C694755FA788819FEB135DE4E6C8BB67868D640C4449B1A8 + DE8052FBECCEBACA56B24AC9B34FE30E60CC23F07AFF0D4519E2499259900EA0 + 407ECE98721E2F2021642FBC663448DC4014E9A0B786FE786A98A6E3B2352A00 + E6F6D3FAA777D785DBD9CA7C1B7AEE00468CBDAD93DB293DF577944A875B00D2 + 0114C97718AB52197B021438EB1D806091A9F10E3A30FAE1E951331E2BEBF5F4 + 8546F107D49A2776D554B5B3C6B96C7906AF7A03FAFC1FFE9ED2719E242900E9 + 006C72C834378212F168B170CFF9DDE0D060AA9F0C0D7FD03D58EE1B89E61BDC + C853F7644B43700DA99FADABCF9984CA7FF46D45B9C26549114807E0008F32A6 + 5531B6139489478C670D8105866BA626C9F8C449323C7EFAF368396D2D9E5F34 + 52B5EBC150E51E52E7A92055A03FA8FB3303BF804733BF18A7F4CC2794CA8956 + 9B4807E020074D33E023640F28152F0BCDBB5A7037301E484EF5802338767D34 + 79B32FCD939734DE554DEEAAFD6B6B82EB481D2869AE71070CA8F8171330D63F + AC284B3A74FA7C221D400980614105A174AFCAD87DD02398B555BB031E3D9EBA + 4AC6C68EF78E6506FA97D410C1D5B8C655BDAFB93AB88154E73BA22B029467C2 + 18FF2BC2D809E8EE973C5EE372433A801282878B3C94EE5418DB3C97A1C1DD40 + 57602AD54F27263A9291C9F367E3F3193ECB193412DCBA2D10DC14A8F4AF2561 + B7420A3A9D885D7D93D24B29C6CEC8C33BA5433A8079E0C78C79A38C6D851A7C + 3FBC023C79CEE0E4A11E27D1E44D3215ED4E4D4E5E0187B000518A6602A3EF54 + 6CDCE10FB5782ABCAB48D0E52715605C05393D04FE2606AF2F43945EF815A572 + 576589910E601EC13D041718DBA0936CBCBF26A8C145E91FFECED44D124B8F91 + 786A185ED75389C9EECE84198FCCCB12A3E20FAB152D6D3ECF5A8FCF5347FCEE + 6AE2D71412808799F370E76EE0EFF0C04E9F0663FCAD945E956BF9F38774000B + 040E0FBC846C86B7ED50A1435FA7DA033E27932124654E929401AF7494648C04 + D10DF85F8FC5F4CCD494614E8D19B8E8A0A77576C7616085D6DC1AC5C5372558 + ADBA8241550B043435445CAA8F686EFCBF827814784193EE01A329B86517019F + 835DFB0E68E62FC96EFEC2201D401980D188D28CE175E27861C59C27C8162938 + 91D7E9A6B44B46E55978A40328339E33CD06289466FE5A51EC30A15C80CC3378 + 86DBF0EAC5D73B8A32C87F24290316B5712D7570F27082B1261810AF52095909 + 15A8B6DC1D025678F86F14F27C53815725A57D7232AF7C910E601181E1CA3C94 + 3632C61AC021D49A94D651C62A17CA29606567944E288C0D1B78128FD2C11463 + 0332ECD6E2413A80450E6E430E315603051906A7103228AD840A89938A3897E0 + 07E760EB0E01F85CACCC71784D82C389C26747A1759F80CF8D44291D95DB7117 + 37D2012C75A08DFE2E213E2F0C27A026BBA0C5CE3A04E839A82E7EE82643880E + E9D91501484FC12F6492D06DFF1D210919544322914824128944229148241289 + 4422914824128944229148241289442291482412894422914824128944229148 + 2412894422914824128944229148241289442291482412894422914824128944 + 2291482412894422914824128944229148241289442291482412894422914824 + 1289442291482412C9728390FF1F97ED6E34D64226CD0000000049454E44AE42 + 6082} + FileName = 'C:\Users\Programmer\Pictures\Icons\'#931#969#964#942#961#951#962'\icon_simulation.png' + end> + Align = Client + Size.Width = 444.500000000000000000 + Size.Height = 313.000000000000000000 + Size.PlatformDefault = False + end + object imgPeerUserVideo: TImage + MultiResBitmap.Height = 256 + MultiResBitmap.Width = 256 + MultiResBitmap = < + item + Width = 256 + Height = 256 + PNG = { + 89504E470D0A1A0A0000000D49484452000001000000010008060000005C72A8 + 66000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 + 4A6C49444154785EEDBD69705CC795A89979EFADBD5028EC0417102401901037 + 71114951A2244BA216DBA224B764BBDD1D6DBB9F67625EC44C77CCC49B989F8E + FE39332F5EC4EB9988F7625E77DBEE68B9F52CB5B5D9962C4AB2245214497111 + 3781044002044882D80B05D47EEFCD39A7942C11BC5900AAEE2DA000E4C7A860 + 9D045095F7E4C993FB4922914824128944229148241289442291482412894422 + 9148241289442291482412894422914824128944229148241289442291482412 + 8944229148241289442291482412894422914824128944229148241289442291 + 4824128944229148241289442291482412894422914824128944229148241289 + 4400E5FF4B962A8CD19718F3C23B9F41886612E23128A52A218ACA980B7F05E4 + 0CFCCC04992984A4E0673A24275EA734492865F83B92A58974008B9C4719D342 + 8CD5404186A1E286A08287A0C686E047155099FDF01E2B7FD1C0E726E133E3F0 + 7612DE47E133A3E02CA2F0B99128A5A39F508ACE42B248910E6011F13263EE34 + 212BA1A16E80CA5E0B95B01692C3F0FF8294237C297C3589C0FF23E01446A063 + 31E826E4D66B944236258B01E900CA981F43D77D82B12668815741855F89157E + A12AFB5C41A7C01DC22DE82DDCACA4B4EF573894909425D2019419CF99660314 + 4A337FAD28F70A3F1B907906CF701B5EBDF87A475106F98F2465C0A236AEA502 + 567A682DDBA0305AA192E0F87DC902CF88F3075DD0ABE994CE60E1910E608138 + 649A3849B705DEB63B55E9E17332194252669CA4F408496762246D4C115D9F84 + D7444CD71353BA393566E01CBF6EEACC8C46A0A74E88120AAB9AA251A2C1FB60 + B5AAF9829A5619D0B40AA2A941A2B902C4AD85895BF1138F8B100F184D76F5C0 + 2EE80CE0BF0E700617DF5694C9AF5325F3897400F3C8CF1953CE30B65EA1740B + 656C2D54D8A2F40F7F67EA2689A5C7483C350CAF1BA9C4E4D5CEC49D0A5D6AD0 + 61546C68F379567B7C9E3AE2775713BFA690003C0CF8B4C281BF638CD2EB2663 + 1777527AEDEF28059F20990FA40398075E324D1F34BA5BE1ED76A8BC81AF53E7 + 0ED4065D8F9368F226998AF6A42627BF3A1BA7E90C7C54F9C0DC2E5A71DF0E7F + 689DA7C2BB8A04353F098137803E45618041C6E0BF73F087175E5794C4D7A992 + 52211D400979C634436E42764145D80CB5B5A0CA9026642AD54F27263A9291C9 + F350E1CDF2AAF0B3C1147008DB76F82BDBBD61CF1A56097A08F21FCD09304CE8 + E4904BA087D3EF290A0E152425403A80128015DF47C85E78DB0E463CE76E71C6 + 24935357C9D8C4B1EBE3C9C1BE25B596EE6A5CE3AADED75C1DDC40AA5D0AA9E0 + C9B302CAC3E1400774054E4847E03CD20138C841D30C40C5DF034AC5C93DF5EB + D49981417B72AA870C8F1FBB3E9ABCB9B42A7D3EBCAB9ADC55FBD7D604D7913A + 50D25C772A1AE00C2E4D812338AC28384C90388074000E80DB71AB18DB09CA7C + 009AAB5967C871122F3549C627CE40C53FF139B46ACB7537AD46AAF63E18AADC + 49EA3C15A40AF4376B6F097E01C7425F8C537A466E43B68F74003679C134DBC0 + 200FC0DB59BBB5389937D54F86863FE81ECC0C0F6478B20470D535BAEA9E6C69 + 08AE21F550C9E7325F8267138EBCA9289D5C961481740045F23C6361C2D813F0 + 76CDD729F9818A9F1AEFA003A31F9E1E35E3B17959AA5BAC28FE805AF3C4AE9A + AA76D6088EC0C39367A25FA7F4A3DF533ACE65490148075020B8967F9EB15DD0 + EAEF85D78C2D15D4F474A483DE1A3B7C7AC448C670324B324798DB4FEB9FDE5D + 176E672B5542DC3C590818B10EAF13DB283D2DF7101486740005F09269D641A5 + 7E0A2CAC8E2709819FEB135DE4D6C8BB678664C5B787EA0D28B5CFEEACAF6C25 + 2B671B1AC0CF87C159BCFFBAA20CF324C92C4807301718A32F10B29331B61FA4 + BCB3FBA04C161D2483C36F75DC4A4746E4049583B8C3B55ADDF3ED2B430DA401 + 7A5E33D92DC63B39F6262167643093D9910E60165E662C9866EC69783BE3583F + 9D2113836F0E5E8FF574CAA3AF2524B0AECDDB70A861ADDB432A79523EFADD94 + FEF1354AA7B82C11201DC00C3CCF583365EC196846F2AE55C3CF32A36749DFC8 + E123A33C49320FD41E3C5053B383348101E75D76859F2519A5EFBD45692F4F92 + DC8374007978C134F7C07F0FCED4DD8C4F9291DBAF75F4A54764777F2170D7D6 + 6A2B5E6E6FF2576423230981C2C361C0E76F2ACAC9AF532477231DC03D3C639A + 1E37214F8362D6F3240BD8EA8F1C233DA3478F4478926401A979F840B8763F59 + 076596B7370065762D4DC81FDF5394144F9200D201DC053FBCF30228A59A2759 + 48A7C844FFAFBBAF95FB461EC5ED515D8D75956AB8AA8A7A3C3EC5EBF2134DF3 + 2B1AF3514A14A610FCF7F5F29A49D2D4242663C434759AC0B38766321367A954 + C2888C8F67068627CC74AAACF72FE046A2553F6A5DE7F5B0304FB2004E600C9C + C09BF24CC1374807C07999B11519C69E0323111ED70545B1B12ED237F8C6E783 + E5B475375BD19B9BEAB4AAAA06ADC253AF78593D75931AA23A1C59C820519626 + A366920EE993A9217D7C7C30D3DB375C5E8E41230D2F3ED8106ECDCE0D086D9B + 521A876EC2DBAF517A9B272D6BA403009E33CD16153A0050F985EBCCB8A167E8 + B0D13D71F6D882CF286385F7B4AD5FADD5D7366B7EB69AF8C82A28C41937CA94 + 0AD0579A24C84D3D4E6FE84323BDA9CE6B37CAC12154EED81FAC3FA862990AF5 + 02FAD22193EFBDA328DD3C69D9B2EC1DC021D3BC4F21E42018B350177844B7EF + 95DEEECC40FF8275F99570D8E7DBD8D6E6AA71B742FF64DD1CB7C8CE3B262129 + 12233D99D17457E24A67A719892C58400F1C1234FDB8A525DFD163286C8C5EFC + E11B8A7291272D4B96B50378D134B783D17E8B8B16121132DCFBCBE3BD0B117D + 87FA7CAEC0B6CDEDAE3A6F3BF393F50A9BDBF1E272C1A4C4A071722D339CEC88 + 9DBFD4C112897977A018A5A8F927FB9A7DE1FC3B37614870E44D4A4F7371D9B1 + 6C1D00B4FCBBE1E11FE6A285893ED23FF0EA91012ECE1B9EB6D615DEB50DF7D3 + 30D9EA644B6F1A2445E1C50C92668C18CC8406DB205F574A95B8A842144A894A + 55E2662AF128F0CAFECC01B067C026C8C564EFE0D95467D7BC8FBD1B7F78A0B1 + B229FF462ED0F367D013F8828BCB8A65E90066AAFCD0D49BA36749CF7C6EECC1 + F059C1EDEDADAE35A17D8A8734F1E4823175658A25CC8811D3237A7C326AC626 + 63466432A64F15D715D782619F1AAE0828818A80E6AF08A9012D4C7D4A58D1CC + 82C27BDD8D99227D99FEE8F1A9731D5DF319E6ACEEC903D5D53BC97A2877A8EF + 56202347DF5694535C5C362C3B073053B71F2BFFE0A7A42B72FCC8044F2A2938 + A1E7DBB17D8B7BA57B3FD5480D4F9E133080652C4E46F5A83EA88F8E8C24076F + 0EB364725EBAD9D4EB75791B56D56935B5B55A486BA07E52435961B6C474329A + BE953E96387BEEE27C4D1C86F71DA86C7884B4E6730290F827E8099CE3E2B260 + 593980E74C733314F2412EDE8B71EB03A3337AE658C9E3D3675BFCDDDB377BD6 + 781F01ABCBBBE7C0824192FA38B9991A19BA95BAD13FC832F353E16783BABC2E + CFEA350D9EDAFA954A15595DD0F0C12463A9FEE4A753A7CE5D9A8F1E4168E7FE + 8A954FAA6DF05638A7028DC3E17714E51217973CCBC6017C8FB1F5E6D7EBFC96 + 678642D76FBD1BBB3275E14CC963CDF9B6B4AFF5B6D43C455DA48127CD0C2319 + A8F4FDA98181DE447FDF1065FABC759B8B81518DFAD634D57B1A1B9BB52A1877 + D3B95D22C2326430D93DFA7EE262C7759E5432825B7706563E1BD8088D8165D9 + 178C832994BEF35B4AAFF1A425CDB270007C93CF4B507344EBFCC68D775397A7 + 2E9C2C69E577AF6EA8F46F6B3DA804C8269E34234602BAC8B727BA125D5D7DCC + 28EF5D78F9A09A4BF3B56C5CE35E51D9AAFAE636C4D113A43371AEE7FD4CFFCD + 926EB30E6EDD1358FDAC07CBC2D213804AA1BB287D7D396C165AF20E8087EEFA + 01BCF57D9DF20D38E61FF8C0B852CA6E3F76F7430FEF7E406B501F0365CFBA61 + 479F207DC99EBECBA981FE2575BAD0D3B8A6C6BBAE69935639FB2427944B5A1F + 343E8E1E3DF545298705381C687C52DD08E5229A1348B8297D159CC0BCCC072D + 144BDA01E0C11E188C7E1FDE5A5A1F787076FB137265FCC49192ED0B77AF6DAE + F3DFBFFA39C54D56F2242138A1678C929EA9CECB978CF1D1257D7E5DADAA0906 + DB366D566BC8BAD9260ECD34B915FFF2C63BE9EBBD258BF053B5F74068C5A364 + 2378194B5E20612449C86B4BF900D1927600874CF3103CA0F054DFF059726DF4 + F091112E3A4EF0E13DBBDC2BDD07A1399B318C15B6F8B1CB572EE86323CBEA80 + 8A0B1C81BF7DD3F6597B0494E8E95BE9C353474F966CB34ECDC103B5753BC476 + 028EE1DADB8AF23617971C4BD601E0797E283C0CE165A1949B7C70DB6EE5C35B + 0E511F69E54942708C9FB8D2777AA975F50B058706BE8D4DBB669B236009D235 + 71F4E2DBA5DA5E3CD36621A824C7966A3C8125E90078249FE745DDBAA9513274 + E31F8F9424428CA76DFD0AFF96952F53357FB82A939154AA77E26CFCF2C51E9E + 2401FC6DF7ADF3ACAFDAA1D0FC4B88CC2013F18BB75E4B755E2BC9E4DCEA7F77 + A0395843EAB998038C086F2F7E6B2946165A720E0063F86518FB4BA8FC96305E + 78B0A7FBEF4F5FA6E938FCD859827B776F73AFF57E7BA62E3F76F727CF9D3F6D + C62665DC40014AA0C25BB17DDBAE1987053824B89EFCC3D48953E7798A636028 + F296BFD9B5497480082A4AD245E9BF2CB518834BCE013C6F9A7F06FF59BA7278 + A4B7F717DD979C0EE4919DE57F6CDFA3AE1A96F75C0163249DE81EFD22D17DB9 + 8F274966C0D7B2A9C9D752F300A5F9574DF431FAD9C49F8E7FECF42A019E226C + FE69CBE63C4789FBDF52947FE3EF97044BCA01BC8017763086D7744D03BB7037 + 3F302E3BBDDC875B79434F3EF09C12C85E062AC48893C1A9B3973ED7A30B7734 + 7631A285C2BEE08ECD0FAAFEFC1BA6CC18B918FDE08B779CDE4A8CCB83AB9E54 + 378986904BEDF4E092710078690734ED3F84B7968D1DE35DE4FAE01B4706B9E8 + 08785C37FCC4AEEF531F59C7932CA407F54BD1B3A72F94FBEEBD720577158676 + ECDAEA6ED036F3240B2C417A221F9EFE8DD3C78D1B5E3CB0A2AA553814315C84 + BCBA542E1F111E8A586CC0B85FD509C1D8FD96CA9F4CD1C8D761BC9C43AB0879 + 2A0FEEFAF3BC959F113D7679E8C8E49913E765E52F1ED41DEA1075893AE5C9D3 + C032C0B2C032E1498E0036731BE33F72F16EB2B68636C7E545CD92700029C676 + 432DB3848686B4CCCD5F77F5C08891A7D8070D2DF8F8B6BFC87B6CD72089C9D3 + D7DE4FF674DDE029129BA02E51A7A85B9E340D2C0B2C13679D804E30F82BDA10 + 4FC881B6A633F6001717358B7E08F01DC6AA34C6FE12DE5A3CF2F031D2E964E8 + 6EECF6636B93AFF21B29323675F2D2A7C59EBF77124A5CAA6B457DA356155EA9 + F8FCB58AC75D43351686570555981F7F254D5976A2CBCD681AFE63CCA471A6D3 + 497845CC547AD44CC447F4F1C8ADCCEDA10146320B7E1E01E31304F76C7E44F5 + 884F5062AC8189C3A7FFD5C9E100861CAFDB4FF0F4E0BDE050E015180A8C7179 + 51B2E81DC021D37C091E62351773E0A51D7DFFE5886327BA70C2AFF2E9077E40 + BDE21D6366828C448E9FFE78BECEE4DF8B1A0804DCAB9B37B94295AD4A806DA0 + 9ECCEA64427CE4B550BC3E621869579F31C5AE98636397D3FDBDDD463A8D4E63 + DEC15804E17DBB1E537CE2CB40704E60E2FD2F5E757262B0E9DF1F582FBA7C04 + 7A0237DE5694D7B9B82859D40EE07BA6D90AA5FC1D2EE6C06E5BCF3F755C70EA + C61E5CEAAB7A66EFF3F966FBF549723BFAF9A94FE7FBD49E5A5553ED6B6ADEAD + 557A7628EEF4BA447A7E867450F9325AD2DD6B4452E7127DBDA78CF1D1796D05 + A9EA51430FEE7E44AB202B78D234707560FCBD136F39B544883710ADFBEBF6AD + 50592C479BC1C3FEFEB78AD2C5C545C7A275008F32A65531F65750C296F8F7A3 + 6748F7F007471C33CAD013071ED7AAB337035BF8BAF29F84CA3F3F5D640CBEE1 + 6BD9B0D3555FF988EA4A6F98AF4A9F0F9F9B9846C67D353334F169A2FBEA99F9 + 0A52822B04E187F63E96CF09E863F458F4C3231F71D1361852AC662769E1620E + A840D1714AFFF9134A9D9B689A4716AD0380AEFF5EC8FC835CCC81B3FEBDFFF9 + D34E2EDA26B067F716CF5AEF0B5C9C46B6DB7FE4D447F3D1F26BA1CA90AFB5ED + 51AD9A7E2B992A3E265F29F17A94297D4C3992E8EAF8508F4E94FC7013F604C2 + 07763F9E6F3890EE4BBEEDE48EC1E6BF7DA44D74F310D8E1A23D2BB0281DC041 + D30C400DF889794F970C1E86F5BD317A21D6F595235B6D31426FE0FE869FC098 + C2B2BD97A5C9C4F867A70F977ACCAF064341FFA6FB9ED57CFAA3C91976C6CD84 + 9791B4696813990C8D28462269E8668299D088EABA4E554A99AA6A4455DD54D5 + DC54D3DC9AC6420AD5C376BE4F4F689F243A3BFE586A47807302550FED3A48DD + 82F31794E8B12F077FE95424E240EB7DDEA6176BB642AF735ABD812E58668A90 + 5F1E5694924794729A45E9009E67EC31C2D8FD5CCC3139486EDFFCD51147B6DB + 664FF53DBEE567C2833D06494C1CBF04C65DBAD97EECEA07B66E3DE80A799F4D + 9A89392F6F795D34694C6A037A2C3A90999C18CD4C44C6592C569461D24020E0 + AA0C57B92A2A6BB440A851ADD01B931996F7AAF47BF12ABE54269A7C3776E1C2 + E1520E0D70D760E5BECD4FC380DC1AF4C52013131F5DFC07A74E11AEFAF181A6 + 8A06C1B083D22FDFA2F4632E2D1A169D03C0C33E69C67E0A6FA7CD70635CBFDE + FFAFE37C3AE2CCC45FD5771FFE81F0482F2399C9D3D70EA787074A1629C6DBD2 + B6D5B5BAFA47BAA9CF298C9647552399F1F8D5F4D0506F7A6878043209EA2805 + 5471D7D7D5BAEBEB9B5D55FE0D29C3C87B11E7DDB8DDDA58AA77EC956477E705 + 9EE438EEBAC6CA8A5DEB0F82455B26EAF028F1D81F4EFCC689494177B8566BFE + 1FDBB741AB7F6FAFD0800FFFE5DB8A52F2A0B24EB2E81CC0F3A6F904FCB7F56B + E91B9CDCEE9B0DE6D1E87E968BD388758E1C495EBD52924D3ED9EEFEB62D3FD4 + B5F41E9E9417EC66A712B43B7DA3EFABCCC8D0826C4B75D5D6D7B95737DDE7F1 + B196B90C1734DD7D327EFEE2ABC654B42427EABCEB5A570736D55BCE8220E981 + F4BB4E05156978F14043552B59CBC5BBB9F096A27CC8DF2F0A16950338649A15 + D0ECFF149AB76933DF0694EFB5BF3F73DE48C66CB77CEEA6E6DAE0BED53F138D + FB716F3F6E4DE5A2A3F8D6B7B47BD7D7FC249936AA7892102F51A65223B10B89 + DEEEAFCC055A8BBF17C5ED76FB9A5BEEF3D406B626C9CC13945EB71A49F68CFF + 3271B5F32B9EE428153BF76E139E1DA0449F3A7EE31FD27DBDB6A340A9DE80B2 + FE6F766E035B9CE6F4C0284DB0C55F2CA65EC0822E21150AA574D7BD951F8974 + D05B4E547EA6B915FF8ED58744951F4FF5E1C11E2E3A062E6755EC7AE039DFFA + F0DFCE54F915378DB3E1A923E3C7CFFC3AD6F9D597E552F911CC0BE609F34686 + E29F615EF98F2CC033867DEB427F83CF8CCFCE931D03CB08CB8A8BDF00658A65 + 8B65CC538A066D0D6D8E8B39D036D146B9B82858340E00037C2A8C593C3B283D + 35F4C7538E748143FB77ED1605F0C47BF5A64E5D3CE6F4C11EC5EDF7861FDEF3 + 3FEB01F65CBEF57CDC8547278D73B1CFCEFF3AD175E522338D79DD6C540898B7 + 7877C779CC2B9934BEC4BCF31F4D039F159F199F1D75C0931D01CB08CB0ACB8C + 27E5C0B2C532E6A22DD0E6D0F6B898036D146D958B65CFA27100D0D7DA0A0AB7 + 4CF04C7491DB4E44F8C1B8FD18BA9B8BD3485C1D39A9C7261C8DE2A3866BAA02 + FBB6FFEF699AB6CC67DC4163AEDBD1D33DAFC52E7C798C65D20BB2C5B81830AF + F10B5F7E8E79C767E0C916F0D95107A80B9EE408585658665C9C0696B16BCDAA + 394D5ECE04DADC7807B5C495441B455BE562D9B3281CC0CF195320A33BB89803 + 94AD8F1C3EE348EBEFDBDEFA24F4472D1359D938FD0E4FFAB9EA1A1A82BB5BFF + 0F9D64844128B3ADFE48E2F3E8E727DED22363E33C79D18179C767C067C9D71B + 401DA02E50273CC911B0CCB0ECB89803CBD8BF6D1D4E24DB66EC4FA747D006B9 + 98036D75B11C175E140EE00C63EBA1890F7031C7D42D32644CD91FFBE3755DAA + 9FB473310706F0C4187E5C740477C3CA95EEEDCDFF219DD68527DA5CAA1A9D3C + D7FF068EA9B153CD931731CCC467C167C267E389D3405DA04E50373CC911B2F1 + 170543012C6B2C732E160DDA1EDA201773A0AD6618DBC0C5B2665138008552CB + 211C50B239FCC76EDBCB7E78D007EFEAE3E234307AAF93013CB5DA867AD7D635 + FFAB99368451835DA6EBC6D4C973FFB650CB7AA5049F099F0D9F91274D037582 + BA411DF124DB60D9A57AC7CF72711A58E658F65C2C1AB441B4452EE680B44531 + 0C287B07F08C69862863166F9D9A24E34E04F8C45B7A45177562DC7E27437767 + C7FCF7AFFBDFF2557E35462F474F1EFF83914A2DD988C1F86CF88CF8AC3C691A + A81BD491937302F1CEAF7AB02CB99803CB1CCB9E8B45833688B6C8C5BB5903C3 + 80BCE1E1CB85B277005E42368337B578EA8933C4762B8967FCB357740BC04B3B + F85BDB28BE802FB8A3ED7FC9D7ED275103BAC8A7FE041DFEB29DE1770A7C467C + 567C669E340DD411EA0A75C6936C93AF2CB1ECD106B85834F96C312D58B52A37 + CADE0140DFCA729B2ED492E4F889CF6D1F32F1EDD8BE053460A9949908E975EA + C61E46290DECDAFE3FA48D8C2568499648FA64FCE2979F7369D9907D6678762E + 4E0375853A43DDF1245B6059629972F11BA0ECB3366013B445B4492EE680866B + 237F5BB694B50378CE341BC0022CDDA8A91EF4B8F6B6FCE3F8CFB3DAFD101773 + E0459D89CB971DDBF013DAB9FBBBBA92161A993A619C897F7561C984982E147C + 76D40117A7813A43DD71D13658A658B65CCC8136607F2E40E736391DB45DB461 + 2E962565ED002073A2586C64FCD875DBAD7360D7E63651EB8FB7F4661CBAA1D7 + B7A1ED3E5715B3442C4268827E3579E9CB135C5CB6A00E50175C9C06EA0EB748 + 73D11658A658B65CFC06B081AC2DD8249F4DE6B3E172A1AC1D007850CB693CBC + DE2B79B3CFF636587763702F7F9B035B88A9AF2E5DE4A22DF0608FB2AEEAA7A2 + 1D7E6ED375237EEEEC512ECE2B5473A9AEBA15214FD3DA1A7F6B5B23BEF03DA6 + E1CFF8AFCD2BA80BD4091773A0EEBCEB6B7E8ABAE449B6C0B215F50244B65028 + 6893689B5CBC9BB276008E8CB14AC1CB8CAD483386177D4CC389537F78896760 + FBCA9F7131076E1C9938F6D9675CB445C5FEFD3F139DEAC3B5F0A953E7FECD48 + CCC36CBF4AA96F5D6BBDA7A9A6C9DBC01A55B75EC3180BA93E9FD0F11B898409 + C3EEA891D64693837420D537DA97E8E91A2206B3541AA7513D1E6F70CFF63FCB + 188625C41B9E229C3C76EC1FB8688BCAFD0F3D24BA7B3076EED63FD8BD7434DF + 294137A5AFBE4669492E34B54BD9EE566AFBF9CF711DD5327176EB0FBD3DE654 + D4D60699E0AECD0714AF75CF7FFC72DF09632A6A3B70049EE76795DAF7B89803 + 77C3C52EF6FD5E8F464B1A25C7D7D2D6103AD0B6A7E681FAA7036DE19D9E1AA5 + 49F528D554D3BC8A2BFF78177F86BF83BF8B7FE35F1FD81A6AAFDBAE35375710 + C39FD0C7464B16F18619866EC633B703AB2B37EAFAF45E93A918AB3457B017BE + DFB2E9A660741277AFA8B46CD2517D152C75B5AF9B8B45919E60E9EAEDE1462E + E600638D5DFEBBBF2BCB7B22CA7608004D8EE5D61D1D149919E8B7B5F68FB1FD + 69A535BA2FC6F77362E61F23F960300F2E4E2371337DAA949B7C423BF7B436FC + 74CF8F6A9FA8FF5160857A3F3CABEDA534FC0CFC2CFC4CFC6CFC0EFE23C741DD + A08EB8380DD429EA968B4583658C65CDC51C6813681B5C2C0AB44DB4512EE610 + D972B950960EE025D3F4413355C7C51C897E6AFB928FC0B6CDEDF0D096D35AC9 + 817147028906B76C7D4A14C9C76D6A4389CB17856BDF7609B46F5EBDF2A77BFE + A2F201F777DD6E77C9669DF1B3F13BF0BBE03B57F16447411DA1AEB89803758A + BAE5A22D9237AD658D3681B6C1C5A211D928DA32DA3417CB8AB2740069429AC0 + 6B5ABAAA539793B6C370B9EABCD642662493ECB67F951746EED52ABDCF703187 + D74DCC5877CFA7F0458EEEEDC716ABFEC5070F563F52F5B2EA763BB6857636F0 + BBE03BBF8FDF6DB7D5B4C2B2BA429DF1841CA85BD431178B2679ADEB065ED9CE + C51C5ABDD7F6C61D918DA22DA34D73B1AC28D72180F54C3E34029173676D8D41 + 31D027F35B6FF6D1C749BF1371FD7D6DED4F8B027866C688E361BBBCCDEBEA1A + BFBFF9479E7A754E1B59D25142A25708193D3E4606DFEF21B7DEBE486EFEDBD9 + EC0BDF631AFE0C7F077F772EE077631E302F3CC9115057A8332EE640DDA28EB9 + 583458D64684F473F11B7CA4196D844B4581360A155E344C75F4A0935394A503 + 5005CAD2E3246A37A8A36F635B9BC2AC139FC98181EBFC6DD1645B7F9FFE2817 + 7360749CD8954B8EC68C0F3EB06763DD23D53F54BD5EF1D6624E72142AFC49B0 + F4FF7E92DC7EEB28899C3C4A625D5F91D4E04DA24F4488118F655FF81ED3F067 + F83BF8BB37E06FF06FF1336602F38079C13CF12447409D89220BA18EB550D8F6 + 1EFBD42D6B99A36D04DADB2C3B4F0B016D3419B72E078A6CBA1C283B0780D154 + A0965B2E7A48DE24B637E7B86ADC96092C3C2E9AECEFB37DAAD0DBD2F6982830 + 26BB153F67A6929623A9C552F9D8FEFBAB76BABF4D7C3E4BD8B23BC46F1132F0 + FB2B64E80F50E1AF5C24AC88E86126FC0DFE2D7E067E167E665E202F9827CC1B + 4FB10DEACCBC11B39CE4431D7B5B5A2D8EB65012FD7D43C4B06EDF55ABDCB68F + F126FBAC0E006DBA1C2305959D03F013B202C74C5CCC11ED4ED90AB4983DF411 + B0CEC69A5172C36EA8AFECCC7F0DB54413C218FDF19EEE4B5CB44DF8B1FD3B42 + 1B956F71D1421A5CE4ED77BBC8C8874761D8E1DC88033F0B3F133F1BBF231F98 + 37CC23176D93B8D6790983A0723107EADAEE8A0096B91E2537B9F80D6023760F + 08C5AFC5440E80A26D73B16C283B07A00B9404CA3327AF9CCD1B68722E78DAD6 + AF8687B578E0D4E0D04C6DDB9CC0BBFA44D775256FA7CE3B15CAAB62EFFE4D15 + 1B1561C83204C7EEB7DFFA8CA4471C898C2E043F1BBF03BF2B1F9847CC2B176D + 8131063102321773A0AE51E75C2C1A51D9A38DA0AD70B128A29D17702F89654E + 4964DB0B4DD9390070BD96EEBF6E92184DDB1BFF6BF5B5CDFC6D0EDC169ABAD1 + 6FBBC6E0459DFC6D0E8CDB9FECED72645BB16FDD8686F0C6D4412E4E039532FC + C9ADECD81D4318951CF80EFC2EFCCE7CDF8679C53C73D11689EBD73A50975CCC + 21D279A160D98BB6068B6CA510D0563326B1345822DB5E68CACE014069589494 + 1EB32AB350B420B3C4DF6371326AF7CA2ABCA21B6FE9E5628E4C82763931F657 + BC0177C581C6EF88C6FCB84E36F8FE5592E8BBF675C23C82DF89DF2D5CD784BC + 629E31EF3CA5685087A84B2EE6409DA3EEB9581458F668035CCC21B2954211D9 + ACC8B6179AB2720078E537FC6789D89A1AB6E700B2633A8F606521AADB6EFD7D + 6B9B77890EFC246FF475F0B7B6A87976DB231E9FF54834365B4338261FB404A6 + 9D37F0BB310FA29E00E6B916F2CE455B8874893AF73535DB0EF12DB401B015BB + F707E4B1D930B7F1B2A1AC1C403563D5604C9609C0D4F594ADFDF9AE754DF5F0 + A1D688BFA323F66F89A9F45866BEB377F539B0EE8F27F5BC15E25802239FDC2C + E9787FAE601E86FF649D4B433C90777C062E160DEAD24DB4312EE650C39EEDFC + 6DD1886C006DC5BB61ADAD218CC866D1B6438CCDE9BEC7F9A2AC1C8041883016 + DC6477A72D07A085AB84BBE49283376D555235100808BBFFE3F1ABFCAD2DC20F + 871F87EEB47545E43276C11D0B57689BE48D9E6C9E2C40DEB3CFE0007A346679 + E0EC3000CA808B4591CF06F2D9CC5CC967B35098B6EF247092B272002A21966D + 9EE03533663C626B979E56E1B11426D349CCEEDDFEEED5CD9B44DD7FBCA597BF + 2D9A8A1DBBD68BB6F7666284444E3B7262D951304F98B77BC167C067E162D188 + 748ABA77AF69B6B57F1F6DC0D4AD4B8D229B2904B459305A8B7D896C7C2129AF + 1E00A596B12E68D0FE449A9F59BA73664218C9B5205CA14ACBC6225CFBFFFA8A + 6E7B78B7ABC22015A39F41E7623E66FB0B05F294CD9B807CCF5208A853D42D17 + 73B82A2A5BF8DBA26109D3728047643385020EC062BB221B5F48CACA01288C59 + BCA33969DF01504D10FA2BA6DB3E59A804AC973F1893DA009894AD433F789EDF + EB715BD68C7137DE424EFACD06E62D66DD614FF059F099B85824CCFC5AB7D311 + 9541A1886C4164338522B25D918D2F2465E50018A516E5E893D635E042C8AE00 + A8D66E971E9FB415948312974A3DD648BF9968D4FEC6A2CD35F7F1B7D398383B + C30E9C32217A4EBCF891EF990A418F452D0E00CB00CB828B4521B405B019BB3B + 02F3D86E05FFBF2C282B074019B3DC140BE34A5B0E405BD1289C583463315B27 + 0B5D2BEA57241338A49B8E3119B137FBAF52EAAF4C5B0ED6A4C640170E6EEF2D + 1599F151E101A2EC33C1B371B128F4A855B758065016B6561ACCD8A4D016F2D9 + CE5CC963BB651517A07C1C00631446B6160700DD285B13755A558570CC654427 + 6C3900AD2A2C0C8891898C5996AB0A21D0B271A52892CF54E7E2B92334D66555 + 4136B2103C1B178B221D9D10C68380B2B0F5B946248F03C8633B734564BB591B + 075BE7E28253360EE0BB793C6366CABAA7BA1014AF47B84C04AD89ADA545C5E7 + B7ECEAF2BA9498DDDD7FEEB555C27DE889EB96CD70654BFCBA38B45EBE679B2B + 0C7A6DA26DC1A2B228047D2A92106D09CE673B73259FEDBE24E8E92E1465E300 + BC7994A2C762B66E00A11E97B55721B831B650A8CB6D098291498B6FBF2D044F + 2DB34CFEA5A1DDC3E3B98B053C7E9C12B4D56A2DB3BD29C8649A75C6DEE3B6BD + B986E982EEBAC763ABBB3E83ED96CD30A06C1C00B84AE159697D3C62CB01104D + F3F37739A8030E40710B562C92F66316A85AC6B2FE9C5CF80D7F059312E4D9A3 + 656C470ECAA4A8C5B5508DD9DE5C23B209AA29F61C401EDBCD67EB0B41393900 + E1B8C848256C2DA929AAB567C10C7B138B08D398E5F8AF62246CC5FAA76E97AA + F87C96CFCD446CAF58CE3BA23CE3B3E13372B128443A169545A1886C42D1982D + 0790CF76F3D9FA4250360E40234418E081A632B61C00A8DAA26C53C7A3D9F650 + 1566191F1ABA696FCB72558DD090F5C8E29900BC43BE3CBBC275B696C18C9455 + C7A2B22814276CE25EF2D96E3E5B5F08CAC60164F2E4C56EB950CDDADD62547C + 8AB5104C8AE5381D660A0FC6CD19AD22249C0731D3B6FCCA82902FCF5A45D0D6 + 049868B24E54168522B20991ED14423EDBCD67EB0B41D9640410760DCDA8BD73 + 00221466DF0128845974C732695B730B8AAA080D79314D00DE215F9E615C6D6B + 08400CEB074359D8EE523B6113F792CF764101D20148ACD8ED412C06EC3EA3A2 + A8F61C88641AE5E40084DE5209851D2F70E832DA7E6E93506B97D1E5B6D56534 + 532961B3A9B86D07D69977F2E539DF33CE1546544B2F09CAC2B6E374C226EE25 + 9FED82A13BDEDB2896B27100AE3C4AD16C0EEF982E58DE61F69F1BBA8C96011E + 55ECCDEE1AF1987008A1B8CB66D978CEE4CBB39188D97200D4AD5A9CACA82C0A + 45641322DB29847CB69BCFD61782B271005082C22DBFCCE3B2974766ED72C248 + DBF6A4916152CBF651D5EEBA71745C18FA4C0BDBDA92BE20E4CBB33E316E6B0B + B6A26A96B2139545A1386113F792CF76F3D9FA4250360E201FAA477C97FD5C31 + 0DEB1972AA5AC383150AD5A965D38FA9FAECCD70A73386994858E3E087CB2A88 + CC9C70555AF38CCF86CFC8C5E2D0348B8E45655128229B30756A6BF9259FEDC2 + B8A06CE67ACAC60180F6859B68B4AAB03DCFACEBD6E8AC1822D426669A5AB6FD + 2A5E627B434A4A77594EBC796C87A6987F3C8208F819C3653F06A3C62CFB0844 + 655128229B60B6F775886D171C80ADA18593948D0348526B4B8D6881802D07C0 + 5219CBE72A0E380096495B2AAACB6DD80EF6A0DFA696089B9E4A68A116D14420 + E615F37C2FE9016AFB066685EA96AE85A82C0A856A825E61CA66305A7F20DF04 + 76D96CEC281B07F0BB3C4A7105C5FB03E68A994C898F7A06EDDD026B26E296D6 + 2C9931038AC76BCBB9A4AF8F0A62EA10E25F6B3BF2D5BC912FAFF99E6DAED040 + 2020BA7F5154168580B6409960C7681EDB992B5A85785EE1F53C8DDD4250360E + 80508ABB39ACAD7585BD6D93FAF8A4F00CB91AAEB4B57D541F8F0823FFB8C295 + B64249C57BBB0659226171868156DB11AAE60D515EF199F0D9B85814EE50A538 + B64324622B4E9A1AAE101F19CF633B734564BB591B075BE7E282533E0E006002 + CFE80AD89BB0D36F0F0837A52B36C349676E0F0D787DD6BD0B6A458DBD136F06 + 63F109B725F697B7067451EDE835FC25C1555593CDEBBD649F099E8D8B45A185 + C216056019A407ECDDEFA804F238803CB63357F2D86ED974FF91B272009431CB + 640E74A36C3900339D32A09A5A3FD75F616BBCCE48C6602997654CAB55866C9F + 794F5C1AFD8ABF9D46E5FD8E5EC15F1242DBC551BA9317476DDF94A405ACBAC5 + 32C0B2E06251086DC154A6B2B663833CB66BEB966BA7292B076052C1CC7A8503 + 13763AB1DE2A13D06CAFAD99316A8983AD05F595E0CA6CE935D1DD39984CA56F + 7331877F1574831B6CFB979281790B086ED54BA7D283F1AB9D96E7290CAAA815 + BAE5E145655028225B6019D3F68A85C8764536BE909495035019B38CB9601065 + DB0198716A197B2A3EF12D448590999CB0C4BE4A6698D75D5F67FB12C8E439E3 + 047F3B8DEAFD1B20F3B6CFBE380FE4A9E6217184EE789E672904D429EA968B39 + 44655028D4A7581C80C8660A4515D8AE22E8E52E2465E500A0BF65510E98BA4B + F1DB3B0FA04FA686F8DB1C542301EAF5DA9A604CF7F776F8DCD66D9DEEFA7A5B + D74B2393674F5F33D2694BBEDD4142C2BB1EE252F980798231AF057C067816DB + ADB448A7A87B2C032E1605DA80A29996FD1B229B2904B459305A8B7D81B1D89A + 58749AB272008C1061E89B8A96367B5B6C23E3C2C2F436ACB235AB66C4623123 + E3B60E03428175FCAD2D2247231FF1B7D3086D02E35FE3C857388277F5BA6C9E + 44448E4685CF5028229D9A19F7352C032E16453E1BC8673373259FCDE6B3F185 + A2AC1C4094D25168F12D33C59EB5F68233667AFA86E0432D8750B49A5ADB5D75 + 23923AC7DFE64813BDDA555B6F7BCA3EDED539901A322E70711AB58FAD22EEDA + 85DF228879A8FB9630423AC1BCC7BB2EDBBECA0875893AE5620E3D92FA92BF2D + 1A910DA0ADA0CD70B12844368BB68D36CEC5B2A0AC1CC02794E2A92E8B87F4D4 + 114B60CF42C8CEE6A68865A9480B69B66B50A2AFF7946818E05DDD64EBD2CA3B + 8CBC7BFE53239E100D8D48FDB3AD0B3A2988DF8D7910CD48609E31EF5CB48548 + 97A873D43D178B466803602B765700F2D86C84DB78D950560E000163B2CCBEBA + ABED3900449FA2965D68D44F6AA8CBDE3C80313E3A261A06B87CACD5EEAE40C4 + 4CC6D2E34723BF238984C570B0F01A9EDA407C4DB62FDF2D18FC4EFC6EA10141 + 5E31CF98779E52348ADBED465D723107EA1C75CFC5A2C0B2471BE0620E91AD14 + 8AC86645B6BDD0949D0300B76B5192A6900073BB440DCD9CD187462CD74BE3F6 + 4FCFEA35B67B01FAE0E411FE36076E59F536B76EE1A22D123D570723573C87B9 + 380D544ADDA32B49F88187A1346DA9686EC077E077E177E6FB36CC2BE6998BB6 + F035B7DC27DAFE2BD279A160D98BB6008B6CA510D0565D8AD501886C7BA1293B + 07A01162592F8612522A36EEB0D50B48755EBB01FD74CB292C4F43BDAD6BA590 + F8D5AED35E8FF58E79EF0ACF36EA72DBEA61DC61F2C4B1CB9357CC8FB9680127 + E1561C7A08C6E4B6AEB59F11FC6CFC8E7C137E08E611F3CA455B5045553DB581 + AD5CCC81BA469D73B1683CB5D6B2471B415BE1625184DAB6E2F8DFB27225B2ED + 85A6EC1C401C940415DE3211186AF1D80A279D1DD3C5480F17736821B28A51CD + 56D3C932C94C6694592A27AE5BFBD7B7D8BE15F70E918F8F9D8D76981F4117DB + A21FC40D1A5AF16C1BA97DFC6147B70DE367E167E267E37708813C61DE308F3C + C536BEF56D9B93C4BA4487BA469D73B128B0CCB52A629DBD041BB13BFEF7AE0B + 5AF28C368DB6CDC5B2A1EC1CC07B8A92026559BA4ADE55F6CFDA6746D3D60BF6 + 54E2F5AD69B2DD6C26BBBB3E11DD5B471BFDF73B31177087894F8F9D9BB8A8FE + 5E34277007DC31D8F89D8DA4FEDB0F9340EBE6A28E12E3DFE0DFE267E067E167 + E605F28279C2BCF114DBA0CE94D5811D5CCC813A4E765FFD848B45932D73287B + 2EE630C6D3B6F72CF8D75A6F8D429B46DBE662D950760E0001F76B9DB1F79310 + 53ECCD0324AE74769A143F7E3A9E958D6BF9DBA2D1A391093DA1590CD34C337F + 60E3E63D5C7484E899935DC39F8EBD6A2693331E56C1433935FBAAC89A1FEC81 + AEFBC324BC071DC27D30EC5945B4CA30DED4937DE17B4CC39FE1EFE0EFE2DFE0 + DF8A0EF6DC0DE4218279C13CF12447409DA1EEB8980375AC47C76C6FA6119539 + DA46ACA3D3D6F0056DD4EB27967E92C8A6CB81B2740080455990512DBC7D87AD + 137C66249220096299E051C3640D55ED5D5985243A3BFEE8557C162FEFAA26F7 + 39B12FE06E92BD3DC3B77E73E995D4B0719127CD88BB1286511BD121549386A7 + D6919587B690D52FEDCABEF03DA6E1CFF077F077E7027E37E4E15F302F3CC911 + 5057A8332EE640DDA28EB9583458D658E65CFC06B08DAC8DD8006D145A29D1BC + 8F740073053AAC7D3866E2628EE026EF1C4D333FFA50F2127F9B83E28CFDFA56 + 5B5757237A7422AA4F24DFE3628E649A288196758FC03739AA6F964864867EFB + F9E1B14FC75F136D1B2E15F85DF89DF8DD98079EEC1034AB2BD4194FC881BA45 + 1D73B168B0ACB1CCB99843641B8522B251B465B4692E961565E9005E57149CE5 + B2B42ABE35F66F818D9DBFD4215A0DF0AEAA6AE36F6D3175F1C2FB9AA259767B + A515BD3ED0D6BE8D8B8E12EBB874E3D62F4EBE32F145FA77E974DA91E53711F8 + D9F81DB77EF9C5AFF13B79B2A3A08E50575CCCE1766B63A85B2EDA4254D66813 + 681B5C2C1A918DA22DA34D73B1AC284B078080D7B4CED8837DB81AD7D85A56C3 + 168B4D104BB759F1915A4FE39A5946BCB3935D11B831F66B2E4EC3B3C6B7C7E9 + A1C0DDE0387CF017277F3DFAC1D0BFC66E1B5FC2B3DA0E3D859F819F859F899F + 9D1DEB337B813DF281BA411D71711AA9DEC82B7667FE112C632C6B2EE6409BB0 + DB9B41DB441BE5620E912D970B65EB005C940A9556BDAFD9766CAC64EFA070A9 + CABBAE698615EEB993ECEEBCA0E9EE935CCC914C10D5DFDEFC94EAF1D80A1F3E + 1B78F67EECADCFFF74E39533FF152BEE6497713433A95FC309BB7C4B8859E067 + F83BF8BBF837F8B7F819F859F6CFF3CF0CEA0475833AE249395CBAFB8B64F765 + E1998842C957C6C9DE5BB6972FF3D9663E5B2E07C039952F2F98E65F83B54E5B + 52C99864F2EA7F3C62BBAB163EF4F05F291ED2C4C52C78F3ECC4914BEF189311 + DB174DA8C150D0BBAFFDE766DAB08C09DDA6EBC6C4C92FFEC04CC3D67A733150 + CDA5BAAA6B2AD440C0A3F0E3D050E933462C91CA8C0D4F32DD66DCFE22C00D3F + 957B1EF8765AC958E66114B73A913CDEF177C654D476EC7FB5221CA83CB0F9B9 + 7B77FF9929D21779FBE83F73B16836FC8703ED2EC5B20230F996A2FC237F5F76 + 946D0F0081CA6F595A42057B573515BEB07D0FE981294B900A348CE07D9B1DD9 + BE8B066B5E1BFD27D141213474FFB61D0F73715EC10A9E1EBA1DC1ADBA388EC7 + 17BE4F0FDD8A2C44E54782DB763C24AAFCA83BB367FC174E547E24B879F366D1 + D65F912D140ADAA4A0F2239DFCFFB2A4AC1D00D41CA1F2AAF6AFB53D568F9DBE + D4095F600D155643D6B9AA6A6C6F3A4212D7BA3B32E3F4F75C9C06F3B3FB825B + B638BA3F603152B1F9FEBD869F6DE6E234507789AB9DC2F888858265AA5613EB + A929B081AC2DD8249F4DE6B3E172A1AC1DC03B8A3208BD00CBA68FE03A52979D + 12B40135332C7523FD191773600BE1DBB4C9B2FFBC58A267CEFE4E33DDC2B57A + 33E4D9E5BF6FEB2E2E2E3BF0D98D4A752717A7813A43DD71D13658A6A2D61F6D + 006D818B45A2719B9C0EDA2EDA3017CB92B276000864D0B2334B851E57D5DE07 + 6DDFC293387BEEA2A817E00A936627560410CA74163B7DEEBFB9556B04E12C61 + F71EFF96FB1FE4D2B221FBCCF0EC5C9C06EA0A7586BAE349B6C0B2C432E5E237 + 40D9676DC02655BB1E0CA14D723107781B4B78F772A3EC1D4092904BA0488B21 + 54EEB47ADC42C1431FA9FEA43068856F6393632DB3998825A6CE76FE3FB896CD + 93A61352EF0FECD8FD2855AC33E04B0D7CC6C0FDBB1FC567E649D3C8AEF783AE + 50673CC936F9CA327D2379D4EEC11FA4728FD816DD94DADE58546ACADE01BCA7 + 285146E9752EE6F054902A575DA3EDA3B653A7CE5D621962E9A6A93E52E36FBB + CFB1C07B4664743CF165CF7F7269AA70271BF3B1FB2A1ED8F76CA9970817127C + 367C469CFFE049D340DDA08E50573CC936588658965CCC81653EF9C539DB4B8B + 6883688B5CBC9BFED7282DAB00A022CADE01202663966E1AF40A94BAA75B6C07 + F3C0F15FB27B54B8C3CCD35CB543F1071D3BC9971E191C4A5EEAFF4FB8B4C593 + A6A1AB9935C13DDBFFAC949B85160A7C267C367C469E348DEC721FE80675C493 + 6C83658765C8C56924AF8E1DB63FF627046D106D918B3920CD917D0BA5665138 + 002FA53DA050CBDA7C7025A9578301DBCF90B8D871DD8813CBDE02BC45B8E2FE + EDBBB9E808E9C15BB7D2E77AFF63BEE140C6304215DBD7BC1868BB0FBAC8CE9E + 1D5818A882CF82CF84CFC613A781BA409DA06E78922304B76FDF29BA09DA8C91 + CB890B5FD98AFA83A0EDA10D723107DAAA8BDABFB0643E581406065D2903946A + 89000B99D7AABFB5CB76645F247EBEE743680EAC91832B4993779DFD83427793 + 191E1C9C3AD5F57F6AC4258C3D87BBE158ADEFC18A07F71ED2C2D5B62F305928 + 30EFF80CF82CA21D7E084EF8A12E50273CC911B0CC44137F58C6B10B3D1F70D1 + 16687B68835CCC611272166D968B65CDA2696112849C87CC5AF66A57B5B346E6 + F6837FB047A6FF66441F348421B77CADF57BB440A5A363731CE7C68E9FFBBFDD + CC9DB7AB68D04C6368D7BA9771C6DCA9D062F301E615D7F731EFF80C3CD9023E + FBE467E7FE2F27C7FC089615961917A781658C65CDC5A2419B43DBE3620EB451 + 68451645F71F59340E00A3A99882595578004FFDD3BB1D1933478F9D3E65A605 + B108A01B19DCBD65BFDDD061F762A6E3C9C8D193FFAF16A3EF88760C22D99613 + 57091EDAF6235FEBC62DB86D96FFA8ECC0BCF95BDAB7615E717D3F5FAB8FCF8A + CF8CCF8E3AE0C98E8065846525ECFA43D9621973D1166873687B5CCC81365A8E + 917FF2B1681C00C2183B0D19B65494703B5BA97AEDCF05503D6DC6BFBCF10E0C + E22CE1B6543F6908EDD8E5D806A13BE05AF7E4E92FDE49F444FFDEEB56F3B64C + 181D87D6050F54EDDBF9231C5363B86CFEA30507F38279C2BC917AFF43A2483E + 77C067C467C567766A9DFF6EB08CB0ACB8F80D50A6F18B37DEC132E6294583B6 + 8636C7C51C689B29C6CE707151E0688B361F3C6F9A4FC07F968A38DE45AE0FBE + 71C4917164F0E13DBBDC8DEE67B9388DD8E5A123C99EAE929C85C70344FE6D5B + 7EA86BE959B708636CBC4C8276256FF4756446861C8DC8335770661F2FEDC0B8 + FDA2D0DDF7822724E3E72FBEEAD4DEFE7BC1717F6053FD012E4E233D907E77EA + E849DB91849186170F3454B5125118B90B6F29CA87FCFDA260D1398043A65901 + 99FE09BC9DD6BD04B7AEF7FED78E73E9E888EDC9178CEB56FDEDBDDFA73E62B9 + 90823092993C7DED707A78A0646BBCDE96B6ADAED5D53FD24D7D4EBB113DAA1A + C98CC7AFA687867AD343C3239049DBAD9C18AAE02DBD7851A7ABCABF21651873 + 0AD082B3FCA9DEB157F098344F721C775D6365C5AEF507C1A22D73252C41BAC6 + FE70E2374E2CFBB943B56AF3FFD4BE1D5AFB7B27FF0CF8F05FBEAD28935C5E14 + 2C3A07808013F816647C3B17734C0E92DB377F75C491D04B4A38ECAB7C7CCBCF + A84AAC61C80C9298387EE98F7AD45EFCB899C05B6B025BB71E7485BCCF26CDC4 + 9CF722785D34694C6A037A2C3AA047224399C8D898994A163526C5C8BCAE7075 + B5160ED76B815023DECF2FBAA23B1F18C32F134DBE1BBB70E1B013C13CF2A185 + A0ACF66D7E1A9A04CB7D7CCC2013137FBAF48FE6F8789C27D962D58F0F345534 + 90155CFC064ABF7C8BD2BCF736942B8BD2011C34CD40107A01D0CC4DF3F6F030 + ACEFB5C10BB19E4E4726963C6DAD2B02F737FC045A7DCB528F91226313C74E7F + C492A5336C440B55867C6DED4F6B3EFDD1B974B345785D4A2C9356A366924C29 + 462269A4CC04C63EC0E07E8AA2AA8CA81A71AB6EAA6A6E0C18A07849D0E53642 + C98C595410561C9E60F45E0CE0E9440CBF99C0EBBD2BF7EF7A5CF5106B300E18 + F7C7BE1CFC65AAB3CB91602681756DDEA6971BB6424B3FADDE406F2003639A5F + 1E5614DB7124E69B45E90010E805EC85CC5B0ED1245334D2FB9F3F75EC086670 + EFEE6DEE26EF212E4EC34C9091C891531F31C3FE7EF2D9C83A82D6B647B56AFA + AD64CA7A5946398037F6E863CA9144D7E58F304C3A4F2E1954F5A8E103BB1F17 + 85F842527DE97762274E3A765741F3DF3ED2E6F50863FE7D0E5D7FDB31051682 + 45EB001E654CAB62ECAF40F996DD65A36748F7F00747C4076F8A20F4C481C7B5 + 6AB69F8BD3D027C9EDC867273E2EC58CB6081C1AF837B4EED21A2A0EA8AEF486 + 84207AEE7C824B7A785127DED587D77595B2AB7F37B8DC177E68EF635A85A03B + 0EE863F458F4C3231F71D136754F1EA8AED9495AB898032A50749CD27F2EB75B + 7FE7CAA27500C8F74CB3159ADEEF703107D4C44CCF3F755C488F8C3852283829 + 58F5CCDEE7950011460B422710FDFCD4A7F3D113B81BB5AAA6DAD7D4BC5BABF4 + EC50DCE975F3E50CA0C5CD684977AF11499DC32BBAEDDED25B28D8F2871EDCFD + 48BECA6FC6C8C5F1F74EBCE5C4A41FE2AEADD5D6FD75FB56A82C9609469590DF + FF56511CBD14653E59D40E0081A1C04BF01096ADBAF14932D2F75F8E5CE3A26D + 14B747AD7CEA811F521F119E10CC0E078E9FFEB8D47302F9500381807B4D73BB + ABA2B24509B00DD493599D6F234EA1787DC430D2AE3E638A5D31C7C62EA7FB7B + BB8D74DAF6D5DFC58063FEF0BE5D8FE5EBF6B304E99978FF8B579D38E67B87A6 + 7F7F60BDBF42104998901BD0F57F9D8B8B9245EF005E32CD6AA8717F016F2DC6 + 3E7C8C748E1E3D627BDBE71DA8CFE7AA3CB8EBCFEF0D267A079C189C3A79E953 + 7DAA74AB0373855297E65E51DFA886C38D8ACF5FAB78DC354C6555AA8B05A992 + DDA8430DC6B2AB0B2AA5B84AC09849E346864E51838E9BA9F4A899888F1891C8 + 40FAF6D000639905EFE2E216DFE0DE2D8F0A27FC000CEE3971F8F4BF3A795949 + CDC307C275FB89E8CE0803BA03AFBCAE28F3DAFB719A45EF0090174D739F49C8 + 3E2EE6C0A1C0B55F745FCC0C0F3866105A45C8137C7CDB5F286E22BC569CE924 + 36F5E5B54F4AB94F603982EBFCC1FBD73F4A356BDC7D04B7F94E7D74FE157D32 + EAD8365C3CEBBFFEA72D5B445D7F186B1D7F43518E7371D1B2A013484EA151FA + 051492E546612CB8553F6A852EBBBDF881778306868686AD0D4F9A061A68C5AE + F54F397D827039E35DDFBA0A37F9E4ADFC50164E577EB419B41D51E5475B439B + E3E2A2664938003C7A09551C2F8DB48CFB70D9A6E1C5076D070EB91B34B4AFBB + 9A796E7CA1D05BDD547FA062E7DE6D4E1F205A4EA0EE5087818DF58F804E2D15 + 11C98EF9A12C9CADFCB8DDF7C106D1921F8047D3DF5F2CC77D67634919E70B8C + ED628C59F682C343B25B878D8E89B3C71CDD838E1383A1271F782EDFEA0062C4 + C9E0D4D94B9F9772D7E0520477F705776C7E5078B08783B3FDD10FBE78C7C909 + 3FA472C7FEE0CA836A3B0C212DF583527AE44D4A1D3953500E2CADD68931FA3C + 63DF837796B0536021E9DE5F745F72723E00C125C2CA6FED7B4CAB660FF1240B + 2623A978D7F017A9AB9DC2002092E97836B4ADF1B7D63DA050EB71DB3BE863F4 + B3893F1DFFD8A9A5BE3BE0B8BFF9A72D9B5522DC75D9FF16A5BF052FE0E8772E + 244BCB01002F3316CC30F6975042963DEB78AD58F7DF1FBF4CD3CE1A0D92DD31 + B8D6FB6D22D8367C874C84F44E9D3F7FD68C4D3A7A067EA98031FC308C973084 + F71D28D1D3D7937F983A71EA3C4F710CE676D196BFD9B74974C30F5494A48BD2 + 7F81AE7F494E322E144BCE0120D00B68A68C3D2FEAC24D8D92A11BFF78C4763C + 38117876C0BFA5E165E101220EF60652D7C6CFC63BBF2ADB0B2317028CDEEB59 + 5FB563A6561F0FF6C42F0EBEE6D4DEFE7B59FDEF0E34076B8431FEA06F49DF82 + D6BF2476B3902C490780E43B2B804CF491FE81578F0C70D15194AA2A7FE5439B + 9F131E25BE0B2341461357FA4EA706FA4779D2B2042FEDC0B8FDA2D0DD778347 + 7A273EBBF48E53A7FAEEA5F187071A2B9BAC4347041A9245BBD77F3696AC0340 + C0091C8207B4DE07070C9F25D7460F1FB12C1D3A01CE0B54ECDFB1D3BDD27D70 + A6210182C382C4E5CB1732E3A34BAA6B391B78579F7FD3A62D5A58BCB3320776 + F96FA50F4F1E3B7BC6E9F1FE1D6A0E1EA8ADDB21B613F8C26B50F9DFE6E29263 + 493B80674CD3E326E407F090969D6350B06CE8137265FCC491921D5775AF6DAE + F3DFBFFAB97C9B86EE8047738D51D233F5D5A58B4E5C4D5ECEE015DD7803335E + C22ABAABEF6E70730F86F14A5FED2D59C4A3AABD0742F58F9236C88868497C34 + 45C86F16538CBF4259D20E00799EB1308CE07E006F2DC1220063E070EACAC4D9 + 93256B7DB137107A78F7035A83FA18287BC6F3FC59471021FDC96B3D1DA9DBB7 + 16F516D37BF1AC5859ED5DBFAE5D0D9335B3557C70CEE9CC20FB64F2E8C993A5 + 6AF591CA1D7B828D073D1BE1ADE8CC448250FADF61DCEFD856F27264C93B00E4 + 65C65664187B092CC9D21DC75062B7DE8D5D99BA70A6A42DAF6BCDAAB06FFBBA + A7349F705FB9053C5C94BA3DD19DE8BAD2C78C85B9B7DF2E5475A9BED68D4D9E + 15952DF90EEFDC8B9E209D89733DEF3B11BA7B26825B7706563E1BD808CDBEC5 + 26A052E82E4A5F7F8DD2924C369613CBC20120DF636CBDC9D873E0042CCF3C5F + 4E00F16D695FEB6DA9798ABAF26F70990623197D9CF4A706067A13FD7D43F315 + 77A05870F79E6F4D53BDA7B1B159AB226B40DBC21D7CF78277F5E1156D784B13 + 4F2A19B3547EA650FACE6F2975EC246939B36C1C00F29C696E86423FC8C57B31 + 6E7D607446CF1C2B7950C7EC24E103DBB7BA577B1F8691A7F0649B108324C119 + DC4C8D0CDD4ADDE81F9CAFE01BB381414A3CABD734786AEB5742A55F051DEAB9 + 5FA2629231BCA5172FEA2C6577FF0EA19DFB2B563EA9622F4C78541A1A83C3EF + 284AD9DFEAEB14CBCA0120CF33763F61EC312E4E03ACCF1CFA8474967262F06E + 702BB16FC7F62D9ED5EE870A720400CE17B03819D527F4DBFAD8C86872F0E6F0 + 7CC522C033F9DE8655755A756D8D56A9ADA07E5233DBB8DE0254FCD48DF46778 + 3FBFD35B79F331CB841F3C18FD18C6FC962BE89632CBCE0120874C73373CF8C3 + 5C9C063A81B133E49A9321C566037B04C1EDEDADAE35A17DF9620DCC0533A34C + 997173CC4CA4A3FA542C6A262663466432566C7C022D18F6A9E18A80E2AB0868 + C18A901AD0C2D4AB841557F13109F1E45EA63F7A7CEA5C47D77CB4F877C0905E + D53BC9FA7C951F123F7B435196C409BF4258960E0079D1341F80EE5EDEFDFB13 + 3DA47FE0B5D26C169A09DC4DE86D6ED8412BC91630CA3987039F15183E3083A4 + B32F460C66421B6CF0BB1655E2A20A81A12F51A94ADCF82AA81B3F0BA0E7149B + 201793BD83674BB58B6F261A5F3ED058B94EBCC907814A70EC4D4539C9C565C5 + B27500083881ED609CDFE2A285C43819EAFDD5F1EBA5383B301B187D28B06D73 + BBABCEDBCEFC64BDC2C463D672C5A4E05E12A4571F4A5E8A9DBFD4E164949EB9 + 827BFB9B7FBC6FADAFCABABDF70E4BED745FA12C6B0780E0C420D4AC27A1860B + 75810788FA7ED5DDEDF429C242C04B4A7C1BDBDA5C35EE561220EB1CED193808 + B6F424467A32A3E9AEC495CE4E33B27047A0F1545FD38F5B5A44077B10286C06 + AF0FA1DB7F91272D4B96BD0340C009B4801378069C8070DB2E1E251E3A6C743B + 1D4FA01870E2D0D3B67EB5565FDBACF9D96AE223ABA0108BBA30C42EA0AF34B4 + F237F538BDA10F8DF4A63AAFDD98AF09BD99C0F3FCF507552C53A15E405F3A64 + F2BD7714A59B272D5BA403E064370B11728831F1CDB660EC2CD245FA06DFF87C + 10EC87A72E3CE8105CCD4D755A55558356E1A957FCAC81BA945AA2387C7988A9 + 4CB18C3962C6E9A03E991AD2C7C70733BD7DC3E550E1BF41CB46F209B7922630 + 6CA16D43973FEE22E4EDE5B0C9672E48077017CF9866089A8C1740297997E4F0 + E6A19BBFEEEA59C821C15CC83A86C6BA4A355C55A5783D01EA717989A6F9158D + F928250A5308FEFBBA8534499A9AC4648C98A64E1344D7E32C95499AC954CC88 + 8C8F67068627CAABA25BC12E3FC6F0CB13C62B0B38F1B134216FBEA728F3B2CC + BB18900EE01EF801A2A74131C2D36108185266E418E97132E4B8A478C20F1DA8 + 6C7828BBC49777D721FCAC2709DDFEA57CB0A718A403C803C6135008D907953D + AF8EF0F291DBFFDAD1978E38730391A430DCE15A6DC59FB737892EEDB803141E + DE957E7CA99EE7B78B740033C0230BE1E460DE3571EC0D8C9D21D7E773E39024 + B7B1672D18F04CAD7E9251FADE528CE4E314D201CC02C6184C33F634BCCDBB91 + 04C1B981E1B76FF7397535B9440C5ED15D776845D34C637D4EBF9BD23F2EB518 + 7E4E231DC05C608CBE40C84EC6B23704E7DD9003CA64D1413238FC56C72D392C + 7016ECEED73DDFBE32D4401A661A960106A5F4D89B849C214B287A6FA9900EA0 + 005E344DDC517610C694755FA788819FEB135DE4E6C8BB67868D640C4449B1A8 + DE8052FBECCEBACA56B24AC9B34FE30E60CC23F07AFF0D4519E2499259900EA0 + 407ECE98721E2F2021642FBC663448DC4014E9A0B786FE786A98A6E3B2352A00 + E6F6D3FAA777D785DBD9CA7C1B7AEE00468CBDAD93DB293DF577944A875B00D2 + 0114C97718AB52197B021438EB1D806091A9F10E3A30FAE1E951331E2BEBF5F4 + 8546F107D49A2776D554B5B3C6B96C7906AF7A03FAFC1FFE9ED2719E242900E9 + 006C72C834378212F168B170CFF9DDE0D060AA9F0C0D7FD03D58EE1B89E61BDC + C853F7644B43700DA99FADABCF9984CA7FF46D45B9C26549114807E0008F32A6 + 5531B6139489478C670D8105866BA626C9F8C449323C7EFAF368396D2D9E5F34 + 52B5EBC150E51E52E7A92055A03FA8FB3303BF804733BF18A7F4CC2794CA8956 + 9B4807E020074D33E023640F28152F0BCDBB5A7037301E484EF5802338767D34 + 79B32FCD939734DE554DEEAAFD6B6B82EB481D2869AE71070CA8F8171330D63F + AC284B3A74FA7C221D400980614105A174AFCAD87DD02398B555BB031E3D9EBA + 4AC6C68EF78E6506FA97D410C1D5B8C655BDAFB93AB88154E73BA22B029467C2 + 18FF2BC2D809E8EE973C5EE372433A801282878B3C94EE5418DB3C97A1C1DD40 + 57602AD54F27263A9291C9F367E3F3193ECB193412DCBA2D10DC14A8F4AF2561 + B7420A3A9D885D7D93D24B29C6CEC8C33BA5433A8079E0C78C79A38C6D851A7C + 3FBC023C79CEE0E4A11E27D1E44D3215ED4E4D4E5E0187B000518A6602A3EF54 + 6CDCE10FB5782ABCAB48D0E52715605C05393D04FE2606AF2F43945EF815A572 + 576589910E601EC13D041718DBA0936CBCBF26A8C145E91FFECED44D124B8F91 + 786A185ED75389C9EECE84198FCCCB12A3E20FAB152D6D3ECF5A8FCF5347FCEE + 6AE2D71412808799F370E76EE0EFF0C04E9F0663FCAD945E956BF9F38774000B + 040E0FBC846C86B7ED50A1435FA7DA033E27932124654E929401AF7494648C04 + D10DF85F8FC5F4CCD494614E8D19B8E8A0A77576C7616085D6DC1AC5C5372558 + ADBA8241550B043435445CAA8F686EFCBF827814784193EE01A329B86517019F + 835DFB0E68E62FC96EFEC2201D401980D188D28CE175E27861C59C27C8162938 + 91D7E9A6B44B46E55978A40328339E33CD06289466FE5A51EC30A15C80CC3378 + 86DBF0EAC5D73B8A32C87F24290316B5712D7570F27082B1261810AF52095909 + 15A8B6DC1D025678F86F14F27C53815725A57D7232AF7C910E601181E1CA3C94 + 3632C61AC021D49A94D651C62A17CA29606567944E288C0D1B78128FD2C11463 + 0332ECD6E2413A80450E6E430E315603051906A7103228AD840A89938A3897E0 + 07E760EB0E01F85CACCC71784D82C389C26747A1759F80CF8D44291D95DB7117 + 37D2012C75A08DFE2E213E2F0C27A026BBA0C5CE3A04E839A82E7EE82643880E + E9D91501484FC12F6492D06DFF1D210919544322914824128944229148241289 + 4422914824128944229148241289442291482412894422914824128944229148 + 2412894422914824128944229148241289442291482412894422914824128944 + 2291482412894422914824128944229148241289442291482412894422914824 + 1289442291482412C9728390FF1F97ED6E34D64226CD0000000049454E44AE42 + 6082} + FileName = + 'C:\Users\Programmer\Pictures\Icons\'#931#969#964#942#961#951#962'\256x256\icon_simulati' + + 'on_256.png' + end> + Align = Client + Size.Width = 444.500000000000000000 + Size.Height = 313.000000000000000000 + Size.PlatformDefault = False + end + end + object ltSendText: TLayout + Align = Bottom + Padding.Left = 5.000000000000000000 + Padding.Top = 5.000000000000000000 + Padding.Right = 5.000000000000000000 + Padding.Bottom = 5.000000000000000000 + Position.Y = 480.000000000000000000 + Size.Width = 909.000000000000000000 + Size.Height = 48.000000000000000000 + Size.PlatformDefault = False + TabOrder = 2 + TabStop = False + object edtTextToSend: TEdit + Touch.InteractiveGestures = [LongTap, DoubleTap] + Align = Client + StyleLookup = 'editstyle' + TabOrder = 0 + Margins.Right = 5.000000000000000000 + Size.Width = 823.000000000000000000 + Size.Height = 38.000000000000000000 + Size.PlatformDefault = False + OnEnter = edtTextToSendEnter + OnExit = edtTextToSendExit + end + object btnSendText: TButton + Align = Right + Position.X = 833.000000000000000000 + Position.Y = 5.000000000000000000 + Size.Width = 71.000000000000000000 + Size.Height = 38.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Text = 'Send' + OnClick = btnSendTextClick + end + end + object ltMessages: TLayout + Align = Bottom + Padding.Left = 5.000000000000000000 + Padding.Top = 5.000000000000000000 + Padding.Right = 5.000000000000000000 + Padding.Bottom = 5.000000000000000000 + Position.Y = 328.000000000000000000 + Size.Width = 909.000000000000000000 + Size.Height = 152.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + TabStop = False + object memMessages: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + ReadOnly = True + Align = Client + Size.Width = 899.000000000000000000 + Size.Height = 142.000000000000000000 + Size.PlatformDefault = False + TabOrder = 0 + Viewport.Width = 895.000000000000000000 + Viewport.Height = 138.000000000000000000 + end + end + object Splitter: TSplitter + Align = Bottom + Cursor = crVSplit + MinSize = 20.000000000000000000 + Position.Y = 323.000000000000000000 + ShowGrip = False + Size.Width = 909.000000000000000000 + Size.Height = 5.000000000000000000 + Size.PlatformDefault = False + end + end + object CameraComponent: TCameraComponent + OnSampleBufferReady = CameraComponentSampleBufferReady + Left = 184 + Top = 128 + end + object MultiView: TMultiView + TargetControl = ltContent + MasterButton = btnMasterView + Mode = NavigationPane + NavigationPaneOptions.CollapsedWidth = 48.000000000000000000 + Size.Width = 250.000000000000000000 + Size.Height = 50.000000000000000000 + Size.PlatformDefault = False + TabOrder = 5 + object lbUsers: TListBox + Align = Client + Size.Width = 48.000000000000000000 + Size.Height = 528.000000000000000000 + Size.PlatformDefault = False + StyleLookup = 'transparentlistboxstyle' + TabOrder = 2 + DisableFocusEffect = True + ItemHeight = 48.000000000000000000 + DefaultItemStyles.ItemStyle = 'listboxitemleftdetail' + DefaultItemStyles.GroupHeaderStyle = '' + DefaultItemStyles.GroupFooterStyle = '' + Viewport.Width = 48.000000000000000000 + Viewport.Height = 528.000000000000000000 + end + end + object Client: TncClientSource + Port = 17244 + CommandProcessorThreadsPerCPU = 1 + CommandProcessorThreadsGrowUpto = 10 + ExecCommandTimeout = 2000 + EncryptionKey = 'SetEncryptionKey' + OnConnected = ClientConnected + OnDisconnected = ClientDisconnected + OnHandleCommand = ClientHandleCommand + Host = 'LocalHost' + Left = 64 + Top = 128 + end +end diff --git a/Demos/VideoChat/Client/ufrmMain.pas b/Demos/TCP/VideoChat/Client/ufrmMain.pas similarity index 96% rename from Demos/VideoChat/Client/ufrmMain.pas rename to Demos/TCP/VideoChat/Client/ufrmMain.pas index 8778f46..39fb0c7 100644 --- a/Demos/VideoChat/Client/ufrmMain.pas +++ b/Demos/TCP/VideoChat/Client/ufrmMain.pas @@ -1,249 +1,249 @@ -unit ufrmMain; - -interface - -uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, - FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, - FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, - FMX.Layouts, ncSources, FMX.Edit, FMX.StdCtrls, FMX.ListView, - FMX.Controls.Presentation, FMX.Objects, FMX.ScrollBox, FMX.Memo, FMX.MultiView, - FMX.ListBox, CommonCommands, FMX.Media; - -type - TfrmMain = class(TForm) - ToolBar: TToolBar; - btnConnect: TButton; - edtUsername: TEdit; - ltContent: TLayout; - Client: TncClientSource; - ltCameras: TGridPanelLayout; - ltSendText: TLayout; - imgUserVideo: TImage; - imgPeerUserVideo: TImage; - edtTextToSend: TEdit; - btnSendText: TButton; - ltMessages: TLayout; - memMessages: TMemo; - Splitter: TSplitter; - btnMasterView: TButton; - MultiView: TMultiView; - lbUsers: TListBox; - CameraComponent: TCameraComponent; - procedure edtUsernameEnter(Sender: TObject); - procedure edtUsernameExit(Sender: TObject); - procedure edtTextToSendEnter(Sender: TObject); - procedure edtTextToSendExit(Sender: TObject); - procedure btnConnectClick(Sender: TObject); - procedure ClientConnected(Sender: TObject; aLine: TncLine); - procedure ClientDisconnected(Sender: TObject; aLine: TncLine); - function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; - const aSenderComponent, aReceiverComponent: string): TArray; - procedure btnSendTextClick(Sender: TObject); - procedure CameraComponentSampleBufferReady(Sender: TObject; const ATime: TMediaTime); - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); - private - ConnectErrorMsg: string; - public - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.fmx} - -procedure TfrmMain.FormCreate(Sender: TObject); -begin - // -end; - -procedure TfrmMain.FormDestroy(Sender: TObject); -begin - Client.Active := False; -end; - -procedure TfrmMain.FormPaint(Sender: TObject; Canvas: TCanvas; - const ARect: TRectF); -begin - // We set the camera on when the form has fully loaded, as in some phones, - // we may not get the permission to use the camera. In such a case, if we - // had enabled the camera at creation time, the application would terminate... - OnPaint := nil; - CameraComponent.Active := True; -end; - -procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - btnConnect.Text := 'Disconnect'; - if edtUsername.Text = '' then - edtUsername.Text := 'Anonymous'; // Although Eponymous - edtUsername.Enabled := False; - end); - - try - Client.ExecCommand(cmdCntUserLogin, BytesOf(edtUsername.Text), True); - except - on e: exception do - begin - // We do not want to show exceptions here, as this might be a reconnect - // attempt, we will show the exception only when the user presses the button - // in btnConnectClick - ConnectErrorMsg := e.Message; - Client.Active := False; - end; - end; -end; - -procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - btnConnect.Text := 'Connect'; - edtUsername.Enabled := True; - lbUsers.Clear; - end); -end; - -procedure TfrmMain.btnConnectClick(Sender: TObject); -begin - if Client.Active then - begin - Client.Active := False; - end - else - begin - Client.Active := True; - if not Client.Active then - raise Exception.Create(ConnectErrorMsg); - end; -end; - -function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; -const aSenderComponent, aReceiverComponent: string): TArray; -begin - SetLength(Result, 0); - - TThread.Synchronize(nil, - - procedure - var - i: Integer; - Username: string; - BytesStream: TBytesStream; - lbIndex: Integer; - PrevUser: string; - begin - // This is called from the server to update information - case aCmd of - cmdSrvUpdateLoggedInUsers: - begin - // Save the user we are on - lbUsers.BeginUpdate; - try - if lbUsers.ItemIndex <> -1 then - PrevUser := lbUsers.Items.Strings[lbUsers.ItemIndex] - else - PrevUser := ''; - - lbUsers.Items.CommaText := StringOf(aData); - - if PrevUser <> '' then - lbUsers.ItemIndex := lbUsers.Items.IndexOf(PrevUser); - finally - lbUsers.EndUpdate; - end; - end; - cmdSrvUpdateImage: - begin - // Extract the #13#10 from the aData - for i := 0 to High(aData) - 1 do - if (aData[i] = 13) and (aData[i + 1] = 10) then - begin - Username := StringOf(Copy(aData, 0, i)); - - BytesStream := TBytesStream.Create(Copy(aData, i + 2)); - try - lbIndex := lbUsers.Items.IndexOf(Username); - lbUsers.ItemByIndex(lbIndex).ItemData.Bitmap.LoadFromStream(BytesStream); - lbUsers.ItemByIndex(lbIndex).StyleLookup := 'listboxitemleftdetail'; - - if lbUsers.ItemIndex = lbIndex then - imgPeerUserVideo.Bitmap.LoadFromStream(BytesStream); - finally - BytesStream.Free; - end; - - Break; - end; - end; - cmdSrvGetText: - begin - memMessages.Lines.Add(StringOf(aData)); - memMessages.ScrollBy(0, 100); - end; - end; - end); -end; - -procedure TfrmMain.CameraComponentSampleBufferReady(Sender: TObject; const ATime: TMediaTime); -var - BytesStream: TBytesStream; -begin - // We got a new image from the camera - // Assign it first to our own imgUserVideo component - CameraComponent.SampleBufferToBitmap(imgUserVideo.Bitmap, True); - - // This try is because the CameraComponent OnSampleBufferReady cannot cope - // with thrown exceptions - try - if Client.Active then - begin - // If we are logged in, send the picture to the server - // (SaveToStream will save it as png format) - BytesStream := TBytesStream.Create; - try - imgUserVideo.Bitmap.SaveToStream(BytesStream); - Client.ExecCommand(cmdCntCameraImage, BytesStream.Bytes, False); - finally - BytesStream.Free; - end; - end; - except - end; -end; - -procedure TfrmMain.btnSendTextClick(Sender: TObject); -begin - Client.ExecCommand(cmdCntGetText, BytesOf(edtUsername.Text + ': ' + edtTextToSend.Text), False); - edtTextToSend.Text := ''; -end; - -procedure TfrmMain.edtUsernameEnter(Sender: TObject); -begin - btnConnect.Default := True; -end; - -procedure TfrmMain.edtUsernameExit(Sender: TObject); -begin - btnConnect.Default := False; -end; - -procedure TfrmMain.edtTextToSendEnter(Sender: TObject); -begin - btnSendText.Default := True; -end; - -procedure TfrmMain.edtTextToSendExit(Sender: TObject); -begin - btnSendText.Default := False; -end; - -end. +unit ufrmMain; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, + FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, + FMX.Layouts, ncSources, FMX.Edit, FMX.StdCtrls, FMX.ListView, + FMX.Controls.Presentation, FMX.Objects, FMX.ScrollBox, FMX.Memo, FMX.MultiView, + FMX.ListBox, CommonCommands, FMX.Media; + +type + TfrmMain = class(TForm) + ToolBar: TToolBar; + btnConnect: TButton; + edtUsername: TEdit; + ltContent: TLayout; + Client: TncClientSource; + ltCameras: TGridPanelLayout; + ltSendText: TLayout; + imgUserVideo: TImage; + imgPeerUserVideo: TImage; + edtTextToSend: TEdit; + btnSendText: TButton; + ltMessages: TLayout; + memMessages: TMemo; + Splitter: TSplitter; + btnMasterView: TButton; + MultiView: TMultiView; + lbUsers: TListBox; + CameraComponent: TCameraComponent; + procedure edtUsernameEnter(Sender: TObject); + procedure edtUsernameExit(Sender: TObject); + procedure edtTextToSendEnter(Sender: TObject); + procedure edtTextToSendExit(Sender: TObject); + procedure btnConnectClick(Sender: TObject); + procedure ClientConnected(Sender: TObject; aLine: TncLine); + procedure ClientDisconnected(Sender: TObject; aLine: TncLine); + function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TArray; + procedure btnSendTextClick(Sender: TObject); + procedure CameraComponentSampleBufferReady(Sender: TObject; const ATime: TMediaTime); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); + private + ConnectErrorMsg: string; + public + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.fmx} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + // +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + Client.Active := False; +end; + +procedure TfrmMain.FormPaint(Sender: TObject; Canvas: TCanvas; + const ARect: TRectF); +begin + // We set the camera on when the form has fully loaded, as in some phones, + // we may not get the permission to use the camera. In such a case, if we + // had enabled the camera at creation time, the application would terminate... + OnPaint := nil; + CameraComponent.Active := True; +end; + +procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); +begin + TThread.Synchronize(nil, + procedure + begin + btnConnect.Text := 'Disconnect'; + if edtUsername.Text = '' then + edtUsername.Text := 'Anonymous'; // Although Eponymous + edtUsername.Enabled := False; + end); + + try + Client.ExecCommand(cmdCntUserLogin, BytesOf(edtUsername.Text), True); + except + on e: exception do + begin + // We do not want to show exceptions here, as this might be a reconnect + // attempt, we will show the exception only when the user presses the button + // in btnConnectClick + ConnectErrorMsg := e.Message; + Client.Active := False; + end; + end; +end; + +procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); +begin + TThread.Synchronize(nil, + procedure + begin + btnConnect.Text := 'Connect'; + edtUsername.Enabled := True; + lbUsers.Clear; + end); +end; + +procedure TfrmMain.btnConnectClick(Sender: TObject); +begin + if Client.Active then + begin + Client.Active := False; + end + else + begin + Client.Active := True; + if not Client.Active then + raise Exception.Create(ConnectErrorMsg); + end; +end; + +function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; +const aSenderComponent, aReceiverComponent: string): TArray; +begin + SetLength(Result, 0); + + TThread.Synchronize(nil, + + procedure + var + i: Integer; + Username: string; + BytesStream: TBytesStream; + lbIndex: Integer; + PrevUser: string; + begin + // This is called from the server to update information + case aCmd of + cmdSrvUpdateLoggedInUsers: + begin + // Save the user we are on + lbUsers.BeginUpdate; + try + if lbUsers.ItemIndex <> -1 then + PrevUser := lbUsers.Items.Strings[lbUsers.ItemIndex] + else + PrevUser := ''; + + lbUsers.Items.CommaText := StringOf(aData); + + if PrevUser <> '' then + lbUsers.ItemIndex := lbUsers.Items.IndexOf(PrevUser); + finally + lbUsers.EndUpdate; + end; + end; + cmdSrvUpdateImage: + begin + // Extract the #13#10 from the aData + for i := 0 to High(aData) - 1 do + if (aData[i] = 13) and (aData[i + 1] = 10) then + begin + Username := StringOf(Copy(aData, 0, i)); + + BytesStream := TBytesStream.Create(Copy(aData, i + 2)); + try + lbIndex := lbUsers.Items.IndexOf(Username); + lbUsers.ItemByIndex(lbIndex).ItemData.Bitmap.LoadFromStream(BytesStream); + lbUsers.ItemByIndex(lbIndex).StyleLookup := 'listboxitemleftdetail'; + + if lbUsers.ItemIndex = lbIndex then + imgPeerUserVideo.Bitmap.LoadFromStream(BytesStream); + finally + BytesStream.Free; + end; + + Break; + end; + end; + cmdSrvGetText: + begin + memMessages.Lines.Add(StringOf(aData)); + memMessages.ScrollBy(0, 100); + end; + end; + end); +end; + +procedure TfrmMain.CameraComponentSampleBufferReady(Sender: TObject; const ATime: TMediaTime); +var + BytesStream: TBytesStream; +begin + // We got a new image from the camera + // Assign it first to our own imgUserVideo component + CameraComponent.SampleBufferToBitmap(imgUserVideo.Bitmap, True); + + // This try is because the CameraComponent OnSampleBufferReady cannot cope + // with thrown exceptions + try + if Client.Active then + begin + // If we are logged in, send the picture to the server + // (SaveToStream will save it as png format) + BytesStream := TBytesStream.Create; + try + imgUserVideo.Bitmap.SaveToStream(BytesStream); + Client.ExecCommand(cmdCntCameraImage, BytesStream.Bytes, False); + finally + BytesStream.Free; + end; + end; + except + end; +end; + +procedure TfrmMain.btnSendTextClick(Sender: TObject); +begin + Client.ExecCommand(cmdCntGetText, BytesOf(edtUsername.Text + ': ' + edtTextToSend.Text), False); + edtTextToSend.Text := ''; +end; + +procedure TfrmMain.edtUsernameEnter(Sender: TObject); +begin + btnConnect.Default := True; +end; + +procedure TfrmMain.edtUsernameExit(Sender: TObject); +begin + btnConnect.Default := False; +end; + +procedure TfrmMain.edtTextToSendEnter(Sender: TObject); +begin + btnSendText.Default := True; +end; + +procedure TfrmMain.edtTextToSendExit(Sender: TObject); +begin + btnSendText.Default := False; +end; + +end. diff --git a/Demos/VideoChat/Server/AndroidManifest.template.xml b/Demos/TCP/VideoChat/Server/AndroidManifest.template.xml similarity index 100% rename from Demos/VideoChat/Server/AndroidManifest.template.xml rename to Demos/TCP/VideoChat/Server/AndroidManifest.template.xml diff --git a/Demos/VideoChat/Server/CommonCommands.pas b/Demos/TCP/VideoChat/Server/CommonCommands.pas similarity index 93% rename from Demos/VideoChat/Server/CommonCommands.pas rename to Demos/TCP/VideoChat/Server/CommonCommands.pas index 78daf13..a8fde58 100644 --- a/Demos/VideoChat/Server/CommonCommands.pas +++ b/Demos/TCP/VideoChat/Server/CommonCommands.pas @@ -1,15 +1,15 @@ -unit CommonCommands; - -interface - -const - cmdCntUserLogin = 0; - cmdSrvUpdateLoggedInUsers = 1; - cmdCntCameraImage = 2; - cmdSrvUpdateImage = 3; - cmdCntGetText = 4; - cmdSrvGetText = 5; - -implementation - -end. +unit CommonCommands; + +interface + +const + cmdCntUserLogin = 0; + cmdSrvUpdateLoggedInUsers = 1; + cmdCntCameraImage = 2; + cmdSrvUpdateImage = 3; + cmdCntGetText = 4; + cmdSrvGetText = 5; + +implementation + +end. diff --git a/Demos/VideoChat/Server/VideoChatServer.dpr b/Demos/TCP/VideoChat/Server/VideoChatServer.dpr similarity index 94% rename from Demos/VideoChat/Server/VideoChatServer.dpr rename to Demos/TCP/VideoChat/Server/VideoChatServer.dpr index 0b8ad85..3ba6988 100644 --- a/Demos/VideoChat/Server/VideoChatServer.dpr +++ b/Demos/TCP/VideoChat/Server/VideoChatServer.dpr @@ -1,18 +1,18 @@ -program VideoChatServer; - -uses - System.StartUpCopy, - FMX.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}, - CommonCommands in 'CommonCommands.pas'; - -{$R *.res} - -begin - {$IFDEF DEBUG} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} - Application.Initialize; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program VideoChatServer; + +uses + System.StartUpCopy, + FMX.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}, + CommonCommands in 'CommonCommands.pas'; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. diff --git a/Demos/VideoChat/Server/VideoChatServer.dproj b/Demos/TCP/VideoChat/Server/VideoChatServer.dproj similarity index 98% rename from Demos/VideoChat/Server/VideoChatServer.dproj rename to Demos/TCP/VideoChat/Server/VideoChatServer.dproj index f5d2aa6..53b886b 100644 --- a/Demos/VideoChat/Server/VideoChatServer.dproj +++ b/Demos/TCP/VideoChat/Server/VideoChatServer.dproj @@ -1,1084 +1,1084 @@ - - - {4E64D787-4C5F-4E0F-BEE7-DDE5A692111D} - 18.8 - FMX - VideoChatServer.dpr - True - Release - Win64 - 32787 - Application - - - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Base - true - - - true - Cfg_1 - true - true - - - true - Cfg_1 - true - true - - - true - Base - true - - - true - Cfg_2 - true - true - - - true - Cfg_2 - true - true - - - .\$(Platform)\$(Config) - .\$(Platform)\$(Config) - false - false - false - false - false - System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) - true - true - true - true - true - true - true - true - $(BDS)\bin\delphi_PROJECTICON.ico - $(BDS)\bin\delphi_PROJECTICNS.icns - VideoChatServer - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= - Debug - true - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png - $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png - $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png - $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png - android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) - Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) - Debug - true - CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= - 1033 - $(BDS)\bin\default_app.manifest - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png - $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png - - - DEBUG;$(DCC_Define) - true - false - true - true - true - - - false - true - PerMonitorV2 - - - true - PerMonitorV2 - - - false - RELEASE;$(DCC_Define) - 0 - 0 - - - true - PerMonitorV2 - - - true - PerMonitorV2 - - - - MainSource - - -
frmMain
- fmx - - - - Cfg_2 - Base - - - Base - - - Cfg_1 - Base - - - - Delphi.Personality.12 - Application - - - - VideoChatServer.dpr - - - - - - true - - - - - true - - - - - true - - - - - VideoChatServer.exe - true - - - - - VideoChatServer.exe - true - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - classes - 1 - - - classes - 1 - - - - - res\xml - 1 - - - res\xml - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\armeabi - 1 - - - library\lib\armeabi - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - library\lib\mips - 1 - - - library\lib\mips - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - - - library\lib\armeabi-v7a - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\values-v21 - 1 - - - res\values-v21 - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - res\drawable - 1 - - - res\drawable - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-ldpi - 1 - - - res\drawable-ldpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-mdpi - 1 - - - res\drawable-mdpi - 1 - - - - - res\drawable-hdpi - 1 - - - res\drawable-hdpi - 1 - - - - - res\drawable-xhdpi - 1 - - - res\drawable-xhdpi - 1 - - - - - res\drawable-xxhdpi - 1 - - - res\drawable-xxhdpi - 1 - - - - - res\drawable-xxxhdpi - 1 - - - res\drawable-xxxhdpi - 1 - - - - - res\drawable-small - 1 - - - res\drawable-small - 1 - - - - - res\drawable-normal - 1 - - - res\drawable-normal - 1 - - - - - res\drawable-large - 1 - - - res\drawable-large - 1 - - - - - res\drawable-xlarge - 1 - - - res\drawable-xlarge - 1 - - - - - res\values - 1 - - - res\values - 1 - - - - - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - Contents\MacOS - 1 - .framework - - - Contents\MacOS - 1 - .framework - - - 0 - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .dll;.bpl - - - - - 1 - .dylib - - - 1 - .dylib - - - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - Contents\MacOS - 1 - .dylib - - - 0 - .bpl - - - - - 0 - - - 0 - - - 0 - - - 0 - - - 0 - - - Contents\Resources\StartUp\ - 0 - - - Contents\Resources\StartUp\ - 0 - - - 0 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - 1 - - - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - 1 - - - 1 - - - 1 - - - - - 1 - - - 1 - - - 1 - - - - - ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF - 1 - - - - - ..\ - 1 - - - ..\ - 1 - - - - - Contents - 1 - - - Contents - 1 - - - - - Contents\Resources - 1 - - - Contents\Resources - 1 - - - - - library\lib\armeabi-v7a - 1 - - - library\lib\arm64-v8a - 1 - - - 1 - - - 1 - - - 1 - - - 1 - - - Contents\MacOS - 1 - - - Contents\MacOS - 1 - - - 0 - - - - - library\lib\armeabi-v7a - 1 - - - - - 1 - - - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - Assets - 1 - - - Assets - 1 - - - - - - - - - - - - - - - True - True - True - True - - - 12 - - - - - - + + + {4E64D787-4C5F-4E0F-BEE7-DDE5A692111D} + 18.8 + FMX + VideoChatServer.dpr + True + Release + Win64 + 32787 + Application + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + true + true + true + true + true + true + true + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + VideoChatServer + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;IndyIPServer;IndySystem;NetCom7;tethering;fmxFireDAC;Quantiser;FireDAC;bindcompfmx;FireDACSqliteDriver;ibmonitor;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;xmlrtl;soapmidas;ibxbindings;rtl;DbxClientDriver;CustomIPTransport;dbexpress;IndyCore;bindcomp;dsnap;FireDACCommon;IndyIPClient;RESTBackendComponents;soapserver;dbxcds;bindengine;CloudService;dsnapxml;dbrtl;IndyProtocols;FireDACCommonDriver;inet;$(DCC_UsePackage) + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + Debug + true + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png + $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png + $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;Quantiser;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;svn;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;Intraweb_14_D10_3;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;NetCom8;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;DirectPanelPackage;DirectGraphics11;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;vclFireDAC;IndySystem;NetCom7;tethering;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;TeeDB;FireDAC;vcltouch;vcldb;bindcompfmx;FireDACSqliteDriver;FireDACPgDriver;ibmonitor;inetdb;FMXTee;soaprtl;DbxCommonDriver;FmxTeeUI;ibxpress;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;ibxbindings;fmxobj;vclwinx;vclib;rtl;Tee;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;vclx;bindcomp;appanalytics;dsnap;officeXPrt;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;TeeUI;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + true + PerMonitorV2 + + + true + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ fmx + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + Application + + + + VideoChatServer.dpr + + + + + + true + + + + + true + + + + + true + + + + + VideoChatServer.exe + true + + + + + VideoChatServer.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 1 + + + classes + 1 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + 1 + + + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + True + True + True + True + + + 12 + + + + + + diff --git a/Demos/VideoChat/Server/VideoChatServer.dproj.local b/Demos/TCP/VideoChat/Server/VideoChatServer.dproj.local similarity index 99% rename from Demos/VideoChat/Server/VideoChatServer.dproj.local rename to Demos/TCP/VideoChat/Server/VideoChatServer.dproj.local index 537c2ef..13ce0f2 100644 --- a/Demos/VideoChat/Server/VideoChatServer.dproj.local +++ b/Demos/TCP/VideoChat/Server/VideoChatServer.dproj.local @@ -1,47 +1,47 @@ - - - - 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas - 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas - 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 00:19:14.000.567,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 09:20:35.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 09:22:06.000.529,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx - 2020/08/12 09:22:06.000.529,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas - 2020/08/12 09:22:13.000.248,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj - 2020/08/12 10:07:55.000.801,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas - - - - - + + + + 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas + 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas + 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 00:19:14.000.567,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 09:20:35.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 09:22:06.000.529,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.fmx=C:\Users\Programmer\Documents\Development\Projects\Unit3.fmx + 2020/08/12 09:22:06.000.529,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas + 2020/08/12 09:22:13.000.248,C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dproj=C:\Users\Programmer\Documents\Development\Projects\Project1.dproj + 2020/08/12 10:07:55.000.801,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas + + + + + diff --git a/Demos/VideoChat/Server/VideoChatServer.dsk b/Demos/TCP/VideoChat/Server/VideoChatServer.dsk similarity index 94% rename from Demos/VideoChat/Server/VideoChatServer.dsk rename to Demos/TCP/VideoChat/Server/VideoChatServer.dsk index 9594ed1..517a193 100644 --- a/Demos/VideoChat/Server/VideoChatServer.dsk +++ b/Demos/TCP/VideoChat/Server/VideoChatServer.dsk @@ -1,763 +1,763 @@ -[Closed Files] -File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas',0,1,1,3,11,0,0,, -File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,1187,51,1209,0,0,, -File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,608,1,612,0,0,,{1 -File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSocketList.pas',0,1,1,1,1,0,0,, -File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,294,37,307,0,0,, -File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,419,1,435,0,0,, -File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,3267,1,3282,0,0,, -File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.SyncObjs.pas',0,1,1039,3,1055,0,0,, -File_8=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncThreads.pas',0,1,162,45,177,0,0,, -File_9=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Windows.pas',0,1,38884,1,38900,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dproj -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dproj] -ModuleType=TBaseProject - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas] -ModuleType=TSourceModule - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dpr -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=00000800010100000000CC0E0000000000000166070000000000000100000000530E000009000000446F636B536974653301000000004D1A00001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=00000800010100000000CC0E00000000000001F50500000000000001000000004612000009000000446F636B536974653201000000004D1A000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=1622 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020100000009000000446F636B5369746531C0440000000000000256060000000000000100000000C04400000F0000004D65737361676556696577466F726DFFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dpr -CursorX=3 -CursorY=13 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas -CursorX=39 -CursorY=9 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks={1,86,1} -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=9900 -Height=1372 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=1372 -TBDockHeight=1372 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=1826 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=1826 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=2884 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=2884 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-1348 -Top=185 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=319 -Top=671 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-8 -Top=-120 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=28 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=1826 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=1826 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas',0,1,1,3,11,0,0,, +File_1=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,1187,51,1209,0,0,, +File_2=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSources.pas',0,1,608,1,612,0,0,,{1 +File_3=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSocketList.pas',0,1,1,1,1,0,0,, +File_4=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas',0,1,294,37,307,0,0,, +File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,419,1,435,0,0,, +File_6=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Winsock2.pas',0,1,3267,1,3282,0,0,, +File_7=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.SyncObjs.pas',0,1,1039,3,1055,0,0,, +File_8=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncThreads.pas',0,1,162,45,177,0,0,, +File_9=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Windows.pas',0,1,38884,1,38900,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dproj +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dproj] +ModuleType=TBaseProject + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas] +ModuleType=TSourceModule + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dpr +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=00000800010100000000CC0E0000000000000166070000000000000100000000530E000009000000446F636B536974653301000000004D1A00001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=00000800010100000000CC0E00000000000001F50500000000000001000000004612000009000000446F636B536974653201000000004D1A000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=1622 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020100000009000000446F636B5369746531C0440000000000000256060000000000000100000000C04400000F0000004D65737361676556696577466F726DFFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dpr +CursorX=3 +CursorY=13 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas +CursorX=39 +CursorY=9 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks={1,86,1} +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pas + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=9900 +Height=1372 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=1372 +TBDockHeight=1372 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=1826 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=1826 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=2884 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=2884 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-1348 +Top=185 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=319 +Top=671 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-8 +Top=-120 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=28 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=1826 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=1826 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/VideoChat/Server/VideoChatServer.identcache b/Demos/TCP/VideoChat/Server/VideoChatServer.identcache similarity index 100% rename from Demos/VideoChat/Server/VideoChatServer.identcache rename to Demos/TCP/VideoChat/Server/VideoChatServer.identcache diff --git a/Demos/VideoChat/Server/VideoChatServer.res b/Demos/TCP/VideoChat/Server/VideoChatServer.res similarity index 100% rename from Demos/VideoChat/Server/VideoChatServer.res rename to Demos/TCP/VideoChat/Server/VideoChatServer.res diff --git a/Demos/VideoChat/Server/ufrmMain.fmx b/Demos/TCP/VideoChat/Server/ufrmMain.fmx similarity index 96% rename from Demos/VideoChat/Server/ufrmMain.fmx rename to Demos/TCP/VideoChat/Server/ufrmMain.fmx index 65de8cb..2406aa0 100644 --- a/Demos/VideoChat/Server/ufrmMain.fmx +++ b/Demos/TCP/VideoChat/Server/ufrmMain.fmx @@ -1,36 +1,36 @@ -object frmMain: TfrmMain - Left = 0 - Top = 0 - Caption = 'NetCom Video Chat Server' - ClientHeight = 480 - ClientWidth = 640 - FormFactor.Width = 320 - FormFactor.Height = 480 - FormFactor.Devices = [Desktop] - OnCreate = FormCreate - OnDestroy = FormDestroy - DesignerMasterStyle = 0 - object memLog: TMemo - Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] - DataDetectorTypes = [] - Align = Client - Size.Width = 640.000000000000000000 - Size.Height = 480.000000000000000000 - Size.PlatformDefault = False - TabOrder = 1 - Viewport.Width = 636.000000000000000000 - Viewport.Height = 476.000000000000000000 - end - object Server: TncServerSource - Port = 17244 - CommandProcessorThreadsPerCPU = 2 - CommandProcessorThreadsGrowUpto = 20 - ExecCommandTimeout = 2000 - EncryptionKey = 'SetEncryptionKey' - OnConnected = ServerConnected - OnDisconnected = ServerDisconnected - OnHandleCommand = ServerHandleCommand - Left = 40 - Top = 40 - end -end +object frmMain: TfrmMain + Left = 0 + Top = 0 + Caption = 'NetCom Video Chat Server' + ClientHeight = 480 + ClientWidth = 640 + FormFactor.Width = 320 + FormFactor.Height = 480 + FormFactor.Devices = [Desktop] + OnCreate = FormCreate + OnDestroy = FormDestroy + DesignerMasterStyle = 0 + object memLog: TMemo + Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] + DataDetectorTypes = [] + Align = Client + Size.Width = 640.000000000000000000 + Size.Height = 480.000000000000000000 + Size.PlatformDefault = False + TabOrder = 1 + Viewport.Width = 636.000000000000000000 + Viewport.Height = 476.000000000000000000 + end + object Server: TncServerSource + Port = 17244 + CommandProcessorThreadsPerCPU = 2 + CommandProcessorThreadsGrowUpto = 20 + ExecCommandTimeout = 2000 + EncryptionKey = 'SetEncryptionKey' + OnConnected = ServerConnected + OnDisconnected = ServerDisconnected + OnHandleCommand = ServerHandleCommand + Left = 40 + Top = 40 + end +end diff --git a/Demos/VideoChat/Server/ufrmMain.pas b/Demos/TCP/VideoChat/Server/ufrmMain.pas similarity index 96% rename from Demos/VideoChat/Server/ufrmMain.pas rename to Demos/TCP/VideoChat/Server/ufrmMain.pas index 6f32137..40c92d2 100644 --- a/Demos/VideoChat/Server/ufrmMain.pas +++ b/Demos/TCP/VideoChat/Server/ufrmMain.pas @@ -1,217 +1,217 @@ -unit ufrmMain; - -interface - -uses - System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, - FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, - FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, - System.SyncObjs, ncSocketList, ncSources, CommonCommands; - -type - TConnectedUserData = class - Line: TncLine; - Image: TBitmap; - end; - - TfrmMain = class(TForm) - Server: TncServerSource; - memLog: TMemo; - procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - function ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; - const aSenderComponent, aReceiverComponent: string): TArray; - procedure ServerDisconnected(Sender: TObject; aLine: TncLine); - procedure ServerConnected(Sender: TObject; aLine: TncLine); - private - ConnectedUsersLock: TCriticalSection; - ConnectedUsers: TStringList; - procedure InformClientsOfLogins(aDontSendToLine: TncLine = nil); - public - end; - -var - frmMain: TfrmMain; - -implementation - -{$R *.fmx} - -procedure TfrmMain.FormCreate(Sender: TObject); -begin - ConnectedUsersLock := TCriticalSection.Create; - - ConnectedUsers := TStringList.Create; - ConnectedUsers.Sorted := True; - ConnectedUsers.Duplicates := dupError; - ConnectedUsers.CaseSensitive := False; - - try - Server.Active := True; - memLog.Lines.Add('Server started! Do not close this window'); - except - on e: Exception do - memLog.Lines.Add('Cannot start server: ' + e.Message); - end; -end; - -procedure TfrmMain.FormDestroy(Sender: TObject); -begin - Server.Active := False; - ConnectedUsers.Free; - ConnectedUsersLock.Free; -end; - -procedure TfrmMain.ServerConnected(Sender: TObject; aLine: TncLine); -begin - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add(aLine.PeerIP + ' Client connected'); - memLog.ScrollBy(0, 100); - end); -end; - -procedure TfrmMain.ServerDisconnected(Sender: TObject; aLine: TncLine); -var - i: Integer; - UserData: TConnectedUserData; -begin - TThread.Synchronize(nil, - procedure - begin - memLog.Lines.Add(aLine.PeerIP + ' Client disconnected'); - memLog.ScrollBy(0, 100); - end); - - // Check Connected Users list to delete the entry - ConnectedUsersLock.Acquire; - try - for i := 0 to ConnectedUsers.Count - 1 do - begin - UserData := TConnectedUserData(ConnectedUsers.Objects[i]); - if UserData.Line = aLine then - begin - UserData.Image.Free; - UserData.Free; - ConnectedUsers.Delete(i); - Break; - end; - end; - finally - ConnectedUsersLock.Release; - end; - - InformClientsOfLogins(aLine); -end; - -// DontSendTo parameter is used by disconnect, so that we don't send the -// disconnected line the message -procedure TfrmMain.InformClientsOfLogins(aDontSendToLine: TncLine = nil); -var - SocketList: TSocketList; - i: Integer; -begin - // Now inform all clients to update their user lists - ConnectedUsersLock.Acquire; - try - SocketList := Server.Lines.LockList; - try - for i := 0 to SocketList.Count - 1 do - if SocketList.Lines[i] <> aDontSendToLine then - Server.ExecCommand(SocketList.Lines[i], cmdSrvUpdateLoggedInUsers, BytesOf(ConnectedUsers.CommaText), False); - finally - Server.Lines.UnlockList; - end; - finally - ConnectedUsersLock.Release; - end; -end; - -function TfrmMain.ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; -const aSenderComponent, aReceiverComponent: string): TArray; -var - UserData: TConnectedUserData; - i, j: Integer; - BytesStream: TBytesStream; - DataToSend: TBytes; - SocketList: TSocketList; -begin - SetLength(Result, 0); - - case aCmd of - cmdCntUserLogin: - begin - // When the user logs in, he/she sends a name which is held in aData - ConnectedUsersLock.Acquire; - try - // If a username already exists, the ConnectedUsers will raise an exception - // as it has Duplicates set to dupError - // This exception will travel back to the client. Since we want a custom - // message, we trap the exception and change its message - UserData := TConnectedUserData.Create; - UserData.Line := aLine; - UserData.Image := TBitmap.Create; - try - ConnectedUsers.AddObject(StringOf(aData), UserData); - except - UserData.Image.Free; - UserData.Free; - raise Exception.Create('Cannot login with this name, another user has already taken it'); - end; - finally - ConnectedUsersLock.Release; - end; - - // Inform all connected clients of the new data - InformClientsOfLogins; - end; - cmdCntCameraImage: - begin - // The client is sending us a video image, update our list - ConnectedUsersLock.Acquire; - try - for i := 0 to ConnectedUsers.Count - 1 do - begin - UserData := TConnectedUserData(ConnectedUsers.Objects[i]); - if UserData.Line = aLine then - begin - BytesStream := TBytesStream.Create(aData); - try - UserData.Image.LoadFromStream(BytesStream); - finally - BytesStream.Free; - end; - - // Send the image to everyone - DataToSend := BytesOf(ConnectedUsers.Strings[i]) + BytesOf(#13#10) + aData; - SocketList := Server.Lines.LockList; - try - for j := 0 to SocketList.Count - 1 do - Server.ExecCommand(SocketList.Lines[j], cmdSrvUpdateImage, DataToSend, False); - finally - Server.Lines.UnlockList; - end; - - Break; - end; - end; - finally - ConnectedUsersLock.Release; - end; - end; - cmdCntGetText: - begin - // Send the text to all users - SocketList := Server.Lines.LockList; - try - for j := 0 to SocketList.Count - 1 do - Server.ExecCommand(SocketList.Lines[j], cmdSrvGetText, aData, False); - finally - Server.Lines.UnlockList; - end; - end; - end; -end; - -end. +unit ufrmMain; + +interface + +uses + System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, + FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, + FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, + System.SyncObjs, ncSocketList, ncSources, CommonCommands; + +type + TConnectedUserData = class + Line: TncLine; + Image: TBitmap; + end; + + TfrmMain = class(TForm) + Server: TncServerSource; + memLog: TMemo; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + function ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TArray; + procedure ServerDisconnected(Sender: TObject; aLine: TncLine); + procedure ServerConnected(Sender: TObject; aLine: TncLine); + private + ConnectedUsersLock: TCriticalSection; + ConnectedUsers: TStringList; + procedure InformClientsOfLogins(aDontSendToLine: TncLine = nil); + public + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.fmx} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + ConnectedUsersLock := TCriticalSection.Create; + + ConnectedUsers := TStringList.Create; + ConnectedUsers.Sorted := True; + ConnectedUsers.Duplicates := dupError; + ConnectedUsers.CaseSensitive := False; + + try + Server.Active := True; + memLog.Lines.Add('Server started! Do not close this window'); + except + on e: Exception do + memLog.Lines.Add('Cannot start server: ' + e.Message); + end; +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + Server.Active := False; + ConnectedUsers.Free; + ConnectedUsersLock.Free; +end; + +procedure TfrmMain.ServerConnected(Sender: TObject; aLine: TncLine); +begin + TThread.Synchronize(nil, + procedure + begin + memLog.Lines.Add(aLine.PeerIP + ' Client connected'); + memLog.ScrollBy(0, 100); + end); +end; + +procedure TfrmMain.ServerDisconnected(Sender: TObject; aLine: TncLine); +var + i: Integer; + UserData: TConnectedUserData; +begin + TThread.Synchronize(nil, + procedure + begin + memLog.Lines.Add(aLine.PeerIP + ' Client disconnected'); + memLog.ScrollBy(0, 100); + end); + + // Check Connected Users list to delete the entry + ConnectedUsersLock.Acquire; + try + for i := 0 to ConnectedUsers.Count - 1 do + begin + UserData := TConnectedUserData(ConnectedUsers.Objects[i]); + if UserData.Line = aLine then + begin + UserData.Image.Free; + UserData.Free; + ConnectedUsers.Delete(i); + Break; + end; + end; + finally + ConnectedUsersLock.Release; + end; + + InformClientsOfLogins(aLine); +end; + +// DontSendTo parameter is used by disconnect, so that we don't send the +// disconnected line the message +procedure TfrmMain.InformClientsOfLogins(aDontSendToLine: TncLine = nil); +var + SocketList: TSocketList; + i: Integer; +begin + // Now inform all clients to update their user lists + ConnectedUsersLock.Acquire; + try + SocketList := Server.Lines.LockList; + try + for i := 0 to SocketList.Count - 1 do + if SocketList.Lines[i] <> aDontSendToLine then + Server.ExecCommand(SocketList.Lines[i], cmdSrvUpdateLoggedInUsers, BytesOf(ConnectedUsers.CommaText), False); + finally + Server.Lines.UnlockList; + end; + finally + ConnectedUsersLock.Release; + end; +end; + +function TfrmMain.ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; +const aSenderComponent, aReceiverComponent: string): TArray; +var + UserData: TConnectedUserData; + i, j: Integer; + BytesStream: TBytesStream; + DataToSend: TBytes; + SocketList: TSocketList; +begin + SetLength(Result, 0); + + case aCmd of + cmdCntUserLogin: + begin + // When the user logs in, he/she sends a name which is held in aData + ConnectedUsersLock.Acquire; + try + // If a username already exists, the ConnectedUsers will raise an exception + // as it has Duplicates set to dupError + // This exception will travel back to the client. Since we want a custom + // message, we trap the exception and change its message + UserData := TConnectedUserData.Create; + UserData.Line := aLine; + UserData.Image := TBitmap.Create; + try + ConnectedUsers.AddObject(StringOf(aData), UserData); + except + UserData.Image.Free; + UserData.Free; + raise Exception.Create('Cannot login with this name, another user has already taken it'); + end; + finally + ConnectedUsersLock.Release; + end; + + // Inform all connected clients of the new data + InformClientsOfLogins; + end; + cmdCntCameraImage: + begin + // The client is sending us a video image, update our list + ConnectedUsersLock.Acquire; + try + for i := 0 to ConnectedUsers.Count - 1 do + begin + UserData := TConnectedUserData(ConnectedUsers.Objects[i]); + if UserData.Line = aLine then + begin + BytesStream := TBytesStream.Create(aData); + try + UserData.Image.LoadFromStream(BytesStream); + finally + BytesStream.Free; + end; + + // Send the image to everyone + DataToSend := BytesOf(ConnectedUsers.Strings[i]) + BytesOf(#13#10) + aData; + SocketList := Server.Lines.LockList; + try + for j := 0 to SocketList.Count - 1 do + Server.ExecCommand(SocketList.Lines[j], cmdSrvUpdateImage, DataToSend, False); + finally + Server.Lines.UnlockList; + end; + + Break; + end; + end; + finally + ConnectedUsersLock.Release; + end; + end; + cmdCntGetText: + begin + // Send the text to all users + SocketList := Server.Lines.LockList; + try + for j := 0 to SocketList.Count - 1 do + Server.ExecCommand(SocketList.Lines[j], cmdSrvGetText, aData, False); + finally + Server.Lines.UnlockList; + end; + end; + end; +end; + +end. diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Certificate/server.pfx b/Demos/TCP/ncSocketsDual_Multi-Socket/Certificate/server.pfx new file mode 100644 index 0000000..0b1ad11 Binary files /dev/null and b/Demos/TCP/ncSocketsDual_Multi-Socket/Certificate/server.pfx differ diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dpr b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dpr new file mode 100644 index 0000000..969aaf0 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dpr @@ -0,0 +1,17 @@ +program Client; + +uses + Vcl.Forms, + uMainClient in 'uMainClient.pas' {Form1}, + Vcl.Themes, + Vcl.Styles; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + TStyleManager.TrySetStyle('Carbon'); + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dproj b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dproj new file mode 100644 index 0000000..2e11d93 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dproj @@ -0,0 +1,1118 @@ + + + {2635BC82-0C4B-4449-AF1B-5DA3BEEDB231} + 20.2 + VCL + True + Release + Win32 + Client + 3 + Application + Client.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Client + Carbon|VCLSTYLE|$(BDSCOMMONDIR)\Styles\Carbon.vsf + + + JvNet;RaizeComponentsVcl;vclwinx;DataSnapServer;TMSVCLUIPackPkgDXE12;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;dbxcds;vcledge;sed12Athens;VCLTMSFNCMapsPkgDXE12;DBXFirebirdDriver;JvAppFrm;dacvcl290;FireDACSqliteDriver;DbxClientDriver;JclVcl;soapmidas;TMSCryptoPkgDEDXE12;Jcl;dbexpress;JvManagedThreads;clinetsuite_12;TMSVCLUIPackPkgExDXE12;vquery290;inet;vcltouch;GLibWMI;JvDB;FireDACDBXDriver;fmxdae;MSICS_Rtl;JvCustom;CustomIPTransport;FireDACMSSQLDriver;LockBox3DR;JvSystem;JvControls;PKIEDB29;acntDX12_R;JvCrypt;JvJans;JvMM;IndySystem;JvGlobus;VirtualTreesR;JclContainers;JvPageComps;vclFireDAC;madDisAsm_;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IcsFmxNewRun;ResizeKitPKD29;bindcompdbx;rtl;FireDACMySQLDriver;DBXSqliteDriver;IcsCommonNewRun;NxStandard6Run_d12;DBXSybaseASEDriver;JvRuntimeDesign;JvXPCtrls;NetCom7;vclimg;DataSnapFireDAC;unidacfmx290;inetdbxpress;FireDAC;JvDocking;JvDlgs;xmlrtl;TMSCryptoPkgDXE12;dsnap;JvCmp;FireDACDb2Driver;DBXOracleDriver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;StyleControls_d12Athens;DatasnapConnectorsFreePascal;vc2;emshosting;FireDACCommonDriver;VCLTMSFNCCorePkgDXE12;IndyIPClient;bindcompvclwinx;emsedge;bindcompfmx;madBasic_;JvBands;crcontrols290;inetdb;GR32_R;FireDACASADriver;vclactnband;fmxFireDAC;FireDACInfxDriver;AcmComponents;DBXMySQLDriver;VclSmp;DataSnapCommon;JvPascalInterpreter;EurekaLogCore;fmxase;JvPluginSystem;DBXOdbcDriver;JvTimeFramework;dbrtl;FireDACOracleDriver;FMXTMSFNCUIPackPkgDXE12;Skia.Package.FMX;FireDACMSAccDriver;DataSnapIndy10ServerTransport;JclDeveloperTools;PKIECtrl29;DataSnapConnectors;MiTeC_Common;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;CnPack_D120A;JvWizards;FMXTMSFNCMapsPkgDXE12;FireDACTDataDriver;Skia.Package.VCL;vcldb;SynEditDR;VCLTMSFNCUIPackPkgDXE12;JvCore;unidacvcl290;dacfmx290;bindcomp;inetstn;MfPackX317;IndyCore;RESTBackendComponents;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;IndyIPServer;vcl;dsnapxml;adortl;dsnapcon;DataSnapClient;DataSnapProviderClient;JvDotNetCtrls;JvHMI;mORMot2Components;IcsVclNewRun;DBXDb2Driver;FMXTMSFNCCorePkgDXE12;dac290;emsclientfiredac;FireDACPgDriver;FireDACDSDriver;JvPrintPreview;tethering;JvStdCtrls;bindcompvcl;CloudService;DBXSybaseASADriver;TMSMemInsightPkgDXE12;mORMot2wsComponents;soaprtl;unidac290;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + RaizeComponentsVcl;vclwinx;DataSnapServer;TMSVCLUIPackPkgDXE12;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;appanalytics;IndyProtocols;vclx;dbxcds;vcledge;VCLTMSFNCMapsPkgDXE12;DBXFirebirdDriver;FireDACSqliteDriver;DbxClientDriver;soapmidas;dbexpress;clinetsuite_12;TMSVCLUIPackPkgExDXE12;inet;vcltouch;FireDACDBXDriver;fmxdae;CustomIPTransport;FireDACMSSQLDriver;LockBox3DR;PKIEDB29;IndySystem;VirtualTreesR;vclFireDAC;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IcsFmxNewRun;ResizeKitPKD29;bindcompdbx;rtl;FireDACMySQLDriver;DBXSqliteDriver;IcsCommonNewRun;NxStandard6Run_d12;DBXSybaseASEDriver;NetCom7;vclimg;DataSnapFireDAC;inetdbxpress;FireDAC;xmlrtl;TMSCryptoPkgDXE12;dsnap;FireDACDb2Driver;DBXOracleDriver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;StyleControls_d12Athens;DatasnapConnectorsFreePascal;emshosting;FireDACCommonDriver;VCLTMSFNCCorePkgDXE12;IndyIPClient;bindcompvclwinx;emsedge;bindcompfmx;inetdb;FireDACASADriver;vclactnband;fmxFireDAC;FireDACInfxDriver;DBXMySQLDriver;VclSmp;DataSnapCommon;fmxase;DBXOdbcDriver;dbrtl;FireDACOracleDriver;FMXTMSFNCUIPackPkgDXE12;FireDACMSAccDriver;DataSnapIndy10ServerTransport;PKIECtrl29;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;FMXTMSFNCMapsPkgDXE12;FireDACTDataDriver;Skia.Package.VCL;vcldb;SynEditDR;VCLTMSFNCUIPackPkgDXE12;bindcomp;inetstn;IndyCore;RESTBackendComponents;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;IndyIPServer;vcl;dsnapxml;adortl;dsnapcon;DataSnapClient;DataSnapProviderClient;IcsVclNewRun;DBXDb2Driver;FMXTMSFNCCorePkgDXE12;emsclientfiredac;FireDACPgDriver;FireDACDSDriver;tethering;bindcompvcl;CloudService;DBXSybaseASADriver;TMSMemInsightPkgDXE12;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + PerMonitorV2 + + + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + PerMonitorV2 + true + 1033 + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + Client.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + Client.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + True + True + + + 12 + + + + + diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dproj.local b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dproj.local new file mode 100644 index 0000000..2cac641 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.dproj.local @@ -0,0 +1,12 @@ + + + + 2025/06/27 10:23:15.000.944,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/06/27 10:25:54.000.288,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/12 15:36:10.000.674,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/15 19:46:01.000.895,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/15 19:47:05.000.814,D:\_Delphi\_Library\Netcom7\NetCom7-Templates\NeCom7-Multi-Socket_ncSocketsPro_v2.0\Client\uMainClient.pas=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/15 19:47:05.000.814,D:\_Delphi\_Library\Netcom7\NetCom7-Templates\NeCom7-Multi-Socket_ncSocketsPro_v2.0\Client\uMainClient.dfm=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.dfm + 2025/07/15 19:47:13.000.854,D:\_Delphi\_Library\Netcom7\NetCom7-Templates\NeCom7-Multi-Socket_ncSocketsPro_v2.0\Client\Client.dproj=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Project1.dproj + + diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.identcache b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.identcache new file mode 100644 index 0000000..c6b129a Binary files /dev/null and b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.identcache differ diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.res b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.res new file mode 100644 index 0000000..bdfb066 Binary files /dev/null and b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/Client.res differ diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Client/uMainClient.dfm b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/uMainClient.dfm new file mode 100644 index 0000000..3a32349 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/uMainClient.dfm @@ -0,0 +1,41 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'Client - ncSocketsPro Demo' + ClientHeight = 203 + ClientWidth = 489 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [] + Position = poMainFormCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 15 + object Memo1: TMemo + Left = 0 + Top = 0 + Width = 489 + Height = 203 + Align = alClient + Lines.Strings = ( + '') + TabOrder = 0 + end + object Timer1: TTimer + Enabled = False + OnTimer = Timer1Timer + Left = 232 + Top = 64 + end + object ClientSocket: TncTCPClientDual + OnConnected = ClientSocketConnected + OnDisconnected = ClientSocketDisconnected + OnCommand = ClientSocketCommand + Left = 120 + Top = 64 + end +end diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Client/uMainClient.pas b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/uMainClient.pas new file mode 100644 index 0000000..1624f67 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Client/uMainClient.pas @@ -0,0 +1,362 @@ +unit uMainClient; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, + System.Classes, Vcl.Graphics,System.Threading, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.jpeg, + Vcl.ExtCtrls, System.SyncObjs, ncLines, ncSocketsDual; + +type + TForm1 = class(TForm) + ClientSocket: TncTCPClientDual; + Memo1: TMemo; + Timer1: TTimer; + procedure ClientSocketConnected(Sender: TObject; aLine: TncLine); + procedure ClientSocketCommand(Sender: TObject; aLine: TncLine; + aCmd: Integer; const aData: TBytes); + procedure ClientSocketReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure ClientSocketDisconnected(Sender: TObject; aLine: TncLine); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + + private + FConnecting: Boolean; + FCommandParser: TStringList; // Pre-allocated for command parsing + FCommandLock: TCriticalSection; // Thread safety for command processing + procedure ConnectToServer; + procedure StartReconnectTimer; + procedure StopReconnectTimer; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +function CaptureScreenshot: TBytes; +var + DC: HDC; // Device context for screen + ScreenBMP: TBitmap; // Bitmap for screen capture + jpgImage: TJPEGImage; // JPEG for compression + MS: TMemoryStream; // Memory stream for processing +begin + Result := nil; + + // Create required objects for screen capture + ScreenBMP := TBitmap.Create; + jpgImage := TJPEGImage.Create; + MS := TMemoryStream.Create; + try + // Set bitmap dimensions to match screen resolution + ScreenBMP.Width := Screen.Width; + ScreenBMP.Height := Screen.Height; + + // Get device context for the entire screen (0 = desktop window) + DC := GetDC(0); + try + // Copy screen pixels to bitmap using BitBlt + // SRCCOPY = direct copy of source pixels + BitBlt(ScreenBMP.Canvas.Handle, 0, 0, Screen.Width, + Screen.Height, DC, 0, 0, SRCCOPY); + finally + // Always release the device context + ReleaseDC(0, DC); + end; + + // Convert to JPEG with 30% quality (already compressed) + jpgImage.Assign(ScreenBMP); + jpgImage.CompressionQuality := 30; + jpgImage.SaveToStream(MS); + + // Return JPEG data directly (no additional compression needed) + MS.Position := 0; + SetLength(Result, MS.Size); + if MS.Size > 0 then + MS.ReadBuffer(Result[0], MS.Size); + + finally + // Clean up resources + ScreenBMP.Free; + jpgImage.Free; + MS.Free; + end; +end; + +procedure TForm1.ConnectToServer; +begin + if FConnecting then + Exit; + + FConnecting := True; + StopReconnectTimer; + + if ClientSocket.Active then + ClientSocket.Active := False; + + // Set connection parameters on main thread (these are just property assignments) + ClientSocket.Host := '192.168.10.30'; + //ClientSocket.Host := '109.134.250.129'; + ClientSocket.Port := 3434; + + // Move the blocking call to background thread + TTask.Run(procedure + begin + try + ClientSocket.Active := True; // Now runs in background thread + except + on E: Exception do + begin + // Marshal back to main thread for UI updates + TThread.Queue(nil, procedure + begin + FConnecting := False; + Log('Connection failed: ' + E.Message); + StartReconnectTimer; + end); + end; + end; + end); +end; + +procedure TForm1.StartReconnectTimer; +begin + if not Timer1.Enabled then + begin + Timer1.Interval := 3000; + Timer1.Enabled := True; + end; +end; + +procedure TForm1.StopReconnectTimer; +begin + Timer1.Enabled := False; +end; + +procedure TForm1.Timer1Timer(Sender: TObject); +begin + Timer1.Enabled := False; + Log('Retrying connection...'); + ConnectToServer; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + + // Configure TLS settings for the client + ClientSocket.UseTLS := True; + ClientSocket.TlsProvider := tpSChannel; + ClientSocket.IgnoreCertificateErrors := True; + + // Initialize command parsing structures + FCommandParser := TStringList.Create; + FCommandParser.Delimiter := '|'; + FCommandParser.StrictDelimiter := True; + FCommandLock := TCriticalSection.Create; + + // Set up events for dual protocol support + ClientSocket.OnCommand := ClientSocketCommand; // Binary protocol handler + ClientSocket.OnReadData := ClientSocketReadData; // Raw text protocol handler + + Log('Client starting......'); + + ConnectToServer; + +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + StopReconnectTimer; + if ClientSocket.Active then + ClientSocket.Active := False; + + // Clean up command parsing structures (same pattern as server) + if Assigned(FCommandParser) then + FCommandParser.Free; + + if Assigned(FCommandLock) then + FCommandLock.Free; +end; + +procedure TForm1.ClientSocketConnected(Sender: TObject; aLine: TncLine); +var + FClientName: String; +begin + FConnecting := False; + StopReconnectTimer; + + FClientName := 'Client' + IntToStr(GetTickCount); + + Log('Connected to server as: ' + FClientName); + + //send over nickname info and authentication command... + self.ClientSocket.SendCommand(0,bytesof('NewAuth|' + FClientName)); +end; + +procedure TForm1.ClientSocketDisconnected(Sender: TObject; aLine: TncLine); +begin + FConnecting := False; + + Log('Disconnected from server'); + + // Only start auto-reconnection if we're not already trying to connect + // This prevents rapid connect/disconnect cycles when server shuts down + if not Timer1.Enabled then + StartReconnectTimer; +end; + +procedure TForm1.ClientSocketCommand(Sender: TObject; aLine: TncLine; + aCmd: Integer; const aData: TBytes); +var + dataReceived: String; + CommandName: string; +begin + // Convert bytes to string + dataReceived := StringOf(aData); + + // Parse command first (no lock needed for parsing) - EXACT same logic as ncSources + FCommandParser.Clear; + FCommandParser.DelimitedText := dataReceived; + + if FCommandParser.Count > 0 then + begin + CommandName := FCommandParser[0]; + + // Lock per command for better concurrency + FCommandLock.Enter; + try +//////////////////////////////////////////////////////////////////////////////// +/// Handle command ScreenShot (server requesting screenshot) +//////////////////////////////////////////////////////////////////////////////// + if CommandName = 'ScreenShot' then + begin + TThread.Queue(nil, + procedure + var + ScreenshotData: TBytes; + begin + // Capture screenshot + ScreenshotData := CaptureScreenshot; + + try + + ClientSocket.SendCommand(0, BytesOf('ScreenShot|') + ScreenshotData); + + Log('SEND SCREENSHOT'); + + except + on E: Exception do + Log('Error sending screenshot: ' + E.Message); + end; + end); + end +//////////////////////////////////////////////////////////////////////////////// +/// Handle command TITLE (server setting window title) +//////////////////////////////////////////////////////////////////////////////// + else if CommandName = 'TITLE' then + begin + if FCommandParser.Count > 1 then + begin + TThread.Queue(nil, + procedure + begin + Self.Caption := FCommandParser[1]; + end); + end; + end +//////////////////////////////////////////////////////////////////////////////// +/// Handle unknown commands +//////////////////////////////////////////////////////////////////////////////// + else + begin + TThread.Queue(nil, + procedure + begin + Log('Unknown command: ' + CommandName); + end); + end; + finally + FCommandLock.Leave; + end; + end + else + begin + // Handle non-command data (direct message) - lock for consistency + FCommandLock.Enter; + try + TThread.Queue(nil, + procedure + begin + Log('Server: ' + dataReceived); + end); + finally + FCommandLock.Leave; + end; + end; +end; + +procedure TForm1.ClientSocketReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + dataReceived: String; +begin + // Convert raw bytes to string + dataReceived := StringOf(Copy(aBuf, 0, aBufCount)); + + // Display received raw text data + TThread.Queue(nil, procedure + begin + + Log(Format('[%s] OnReadData fired: %d bytes', [TimeToStr(Now), aBufCount])); + Log(Format('[%s] Raw text from server: %s', [TimeToStr(Now), dataReceived])); + + + // Send response back to server + try + ClientSocket.Send(Format('CLIENT_RESPONSE: %s', [dataReceived])); + Log(Format('[%s] Sent response back to server', [TimeToStr(Now)])); + except + on E: Exception do + Log(Format('[%s] Error sending response: %s', [TimeToStr(Now), E.Message])); + end; + end); +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + Memo1.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + Memo1.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + Memo1.CopyToClipboard; +end; + +end. + + diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dpr b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dpr new file mode 100644 index 0000000..c7abc8b --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dpr @@ -0,0 +1,17 @@ +program Server; + +uses + Vcl.Forms, + uMainServer in 'uMainServer.pas' {Form1}, + Vcl.Themes, + Vcl.Styles; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + TStyleManager.TrySetStyle('Carbon'); + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dproj b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dproj new file mode 100644 index 0000000..4282122 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dproj @@ -0,0 +1,1118 @@ + + + {643E0350-1175-43AC-972A-F5DD8A0BC559} + 20.2 + VCL + True + Release + Win32 + Server + 3 + Application + Server.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + Server + Carbon|VCLSTYLE|$(BDSCOMMONDIR)\Styles\Carbon.vsf + + + JvNet;RaizeComponentsVcl;vclwinx;DataSnapServer;TMSVCLUIPackPkgDXE12;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;dbxcds;vcledge;sed12Athens;VCLTMSFNCMapsPkgDXE12;DBXFirebirdDriver;JvAppFrm;dacvcl290;FireDACSqliteDriver;DbxClientDriver;JclVcl;soapmidas;TMSCryptoPkgDEDXE12;Jcl;dbexpress;JvManagedThreads;clinetsuite_12;TMSVCLUIPackPkgExDXE12;vquery290;inet;vcltouch;GLibWMI;JvDB;FireDACDBXDriver;fmxdae;MSICS_Rtl;JvCustom;CustomIPTransport;FireDACMSSQLDriver;LockBox3DR;JvSystem;JvControls;PKIEDB29;acntDX12_R;JvCrypt;JvJans;JvMM;IndySystem;JvGlobus;VirtualTreesR;JclContainers;JvPageComps;vclFireDAC;madDisAsm_;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IcsFmxNewRun;ResizeKitPKD29;bindcompdbx;rtl;FireDACMySQLDriver;DBXSqliteDriver;IcsCommonNewRun;NxStandard6Run_d12;DBXSybaseASEDriver;JvRuntimeDesign;JvXPCtrls;NetCom7;vclimg;DataSnapFireDAC;unidacfmx290;inetdbxpress;FireDAC;JvDocking;JvDlgs;xmlrtl;TMSCryptoPkgDXE12;dsnap;JvCmp;FireDACDb2Driver;DBXOracleDriver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;StyleControls_d12Athens;DatasnapConnectorsFreePascal;vc2;emshosting;FireDACCommonDriver;VCLTMSFNCCorePkgDXE12;IndyIPClient;bindcompvclwinx;emsedge;bindcompfmx;madBasic_;JvBands;crcontrols290;inetdb;GR32_R;FireDACASADriver;vclactnband;fmxFireDAC;FireDACInfxDriver;AcmComponents;DBXMySQLDriver;VclSmp;DataSnapCommon;JvPascalInterpreter;EurekaLogCore;fmxase;JvPluginSystem;DBXOdbcDriver;JvTimeFramework;dbrtl;FireDACOracleDriver;FMXTMSFNCUIPackPkgDXE12;Skia.Package.FMX;FireDACMSAccDriver;DataSnapIndy10ServerTransport;JclDeveloperTools;PKIECtrl29;DataSnapConnectors;MiTeC_Common;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;CnPack_D120A;JvWizards;FMXTMSFNCMapsPkgDXE12;FireDACTDataDriver;Skia.Package.VCL;vcldb;SynEditDR;VCLTMSFNCUIPackPkgDXE12;JvCore;unidacvcl290;dacfmx290;bindcomp;inetstn;MfPackX317;IndyCore;RESTBackendComponents;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;IndyIPServer;vcl;dsnapxml;adortl;dsnapcon;DataSnapClient;DataSnapProviderClient;JvDotNetCtrls;JvHMI;mORMot2Components;IcsVclNewRun;DBXDb2Driver;FMXTMSFNCCorePkgDXE12;dac290;emsclientfiredac;FireDACPgDriver;FireDACDSDriver;JvPrintPreview;tethering;JvStdCtrls;bindcompvcl;CloudService;DBXSybaseASADriver;TMSMemInsightPkgDXE12;mORMot2wsComponents;soaprtl;unidac290;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + RaizeComponentsVcl;vclwinx;DataSnapServer;TMSVCLUIPackPkgDXE12;fmx;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;appanalytics;IndyProtocols;vclx;dbxcds;vcledge;VCLTMSFNCMapsPkgDXE12;DBXFirebirdDriver;FireDACSqliteDriver;DbxClientDriver;soapmidas;dbexpress;clinetsuite_12;TMSVCLUIPackPkgExDXE12;inet;vcltouch;FireDACDBXDriver;fmxdae;CustomIPTransport;FireDACMSSQLDriver;LockBox3DR;PKIEDB29;IndySystem;VirtualTreesR;vclFireDAC;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IcsFmxNewRun;ResizeKitPKD29;bindcompdbx;rtl;FireDACMySQLDriver;DBXSqliteDriver;IcsCommonNewRun;NxStandard6Run_d12;DBXSybaseASEDriver;NetCom7;vclimg;DataSnapFireDAC;inetdbxpress;FireDAC;xmlrtl;TMSCryptoPkgDXE12;dsnap;FireDACDb2Driver;DBXOracleDriver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;StyleControls_d12Athens;DatasnapConnectorsFreePascal;emshosting;FireDACCommonDriver;VCLTMSFNCCorePkgDXE12;IndyIPClient;bindcompvclwinx;emsedge;bindcompfmx;inetdb;FireDACASADriver;vclactnband;fmxFireDAC;FireDACInfxDriver;DBXMySQLDriver;VclSmp;DataSnapCommon;fmxase;DBXOdbcDriver;dbrtl;FireDACOracleDriver;FMXTMSFNCUIPackPkgDXE12;FireDACMSAccDriver;DataSnapIndy10ServerTransport;PKIECtrl29;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;FMXTMSFNCMapsPkgDXE12;FireDACTDataDriver;Skia.Package.VCL;vcldb;SynEditDR;VCLTMSFNCUIPackPkgDXE12;bindcomp;inetstn;IndyCore;RESTBackendComponents;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;IndyIPServer;vcl;dsnapxml;adortl;dsnapcon;DataSnapClient;DataSnapProviderClient;IcsVclNewRun;DBXDb2Driver;FMXTMSFNCCorePkgDXE12;emsclientfiredac;FireDACPgDriver;FireDACDSDriver;tethering;bindcompvcl;CloudService;DBXSybaseASADriver;TMSMemInsightPkgDXE12;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + PerMonitorV2 + true + 1033 + + + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + PerMonitorV2 + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + Server.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + Server.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + True + True + + + 12 + + + + + diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dproj.local b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dproj.local new file mode 100644 index 0000000..d07c108 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.dproj.local @@ -0,0 +1,13 @@ + + + + 2025/06/27 10:23:15.000.944,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/06/27 10:25:54.000.288,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/12 15:36:10.000.674,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/15 19:57:51.000.682,=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/15 19:59:32.000.056,D:\_Delphi\_Library\Netcom7\NetCom7-Templates\NeCom7-Multi-Socket_ncSocketsPro_v2.0\Server\uMainServer.pas=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.pas + 2025/07/15 19:59:32.000.056,D:\_Delphi\_Library\Netcom7\NetCom7-Templates\NeCom7-Multi-Socket_ncSocketsPro_v2.0\Server\uMainServer.dfm=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Unit1.dfm + 2025/07/15 19:59:49.000.795,C:\Users\leet\Documents\Embarcadero\Studio\Projects\Server.dproj=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Project1.dproj + 2025/07/15 19:59:59.000.250,D:\_Delphi\_Library\Netcom7\NetCom7-Templates\NeCom7-Multi-Socket_ncSocketsPro_v2.0\Server\Server.dproj=C:\Users\leet\Documents\Embarcadero\Studio\Projects\Server.dproj + + diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.identcache b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.identcache new file mode 100644 index 0000000..59bdb00 Binary files /dev/null and b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.identcache differ diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.res b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.res new file mode 100644 index 0000000..45cdbdf Binary files /dev/null and b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Server.res differ diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Win32/Release/server.pfx b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Win32/Release/server.pfx new file mode 100644 index 0000000..0b1ad11 Binary files /dev/null and b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/Win32/Release/server.pfx differ diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/uMainServer.dfm b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/uMainServer.dfm new file mode 100644 index 0000000..cb2cefd --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/uMainServer.dfm @@ -0,0 +1,110 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'Server - ncSocketsPro Demo' + ClientHeight = 283 + ClientWidth = 780 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [] + Position = poDesktopCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 15 + object Image1: TImage + Left = 578 + Top = 8 + Width = 192 + Height = 145 + end + object ListView1: TListView + Left = 8 + Top = 8 + Width = 564 + Height = 145 + Columns = < + item + Caption = 'IP Address' + Width = 150 + end + item + AutoSize = True + Caption = 'NickName' + end + item + AutoSize = True + Caption = 'Status' + end + item + AutoSize = True + Caption = 'Connected At' + end> + ReadOnly = True + RowSelect = True + PopupMenu = PopupMenu1 + TabOrder = 0 + ViewStyle = vsReport + end + object Memo1: TMemo + Left = 8 + Top = 159 + Width = 762 + Height = 90 + Lines.Strings = ( + '') + TabOrder = 1 + end + object StatusBar1: TStatusBar + Left = 0 + Top = 264 + Width = 780 + Height = 19 + Panels = < + item + Text = 'Status: Offline!' + Width = 150 + end + item + Text = 'Clients Connected: 0' + Width = 150 + end> + end + object PopupMenu1: TPopupMenu + Left = 96 + Top = 64 + object S1: TMenuItem + Caption = 'Send To All' + OnClick = S1Click + end + object S2: TMenuItem + Caption = 'Send To Selected' + OnClick = S2Click + end + object S3: TMenuItem + Caption = 'Send Raw To Selected' + OnClick = S3Click + end + object N1: TMenuItem + Caption = '-' + end + object G1: TMenuItem + Caption = 'GetScreenShot' + OnClick = G1Click + end + object C1: TMenuItem + Caption = 'Change Window Title' + OnClick = C1Click + end + end + object ServerSocket: TncTCPServerDual + OnConnected = ServerSocketConnected + OnDisconnected = ServerSocketDisconnected + OnCommand = ServerSocketCommand + Left = 200 + Top = 72 + end +end diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/Server/uMainServer.pas b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/uMainServer.pas new file mode 100644 index 0000000..9f21246 --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/Server/uMainServer.pas @@ -0,0 +1,566 @@ +unit uMainServer; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Forms, + Vcl.ComCtrls, Vcl.Controls, Vcl.Menus, Vcl.Graphics, + Vcl.Imaging.jpeg, System.Generics.Collections, System.SyncObjs, Vcl.ExtCtrls, + ncSocketList,Vcl.StdCtrls, ncSocketsDual; + +type + TConnectedUserData = class + private + FLine: TncLine; + FID: string; + FConnectedAt: TDateTime; + public + constructor Create(ALine: TncLine; const AID: string); + property Line: TncLine read FLine; + property ID: string read FID; + property ConnectedAt: TDateTime read FConnectedAt; + end; + +type + TForm1 = class(TForm) + StatusBar1: TStatusBar; + ListView1: TListView; + ServerSocket: TncTCPServerDual; + PopupMenu1: TPopupMenu; + S1: TMenuItem; + S2: TMenuItem; + G1: TMenuItem; + Memo1: TMemo; + S3: TMenuItem; + Image1: TImage; + N1: TMenuItem; + C1: TMenuItem; + procedure FormCreate(Sender: TObject); + procedure ServerSocketConnected(Sender: TObject; aLine: TncLine); + procedure ServerSocketDisconnected(Sender: TObject; aLine: TncLine); + procedure ServerSocketCommand(Sender: TObject; aLine: TncLine; + aCmd: Integer; const aData: TBytes); + procedure ServerSocketReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure S1Click(Sender: TObject); + procedure S2Click(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure DisplayScreenShot(const aData: TBytes); + procedure G1Click(Sender: TObject); + procedure S3Click(Sender: TObject); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure C1Click(Sender: TObject); + private + connectedclients: Integer; // Raw TCP connection count + // New optimized data structures + FClientsByLine: TDictionary; + FClientsByID: TDictionary; + FCommandParser: TStringList; // Pre-allocated for command parsing + FClientDataLock: TCriticalSection; // Thread safety for client data + + procedure UpdateClientCount; + function GetClientCount: Integer; + function GetAuthenticatedClientCount: Integer; + function GetClientByID(const AID: string): TConnectedUserData; + function GetClientByLine(aLine: TncLine): TConnectedUserData; + procedure AddClientToUI(AUserData: TConnectedUserData); + procedure RemoveClientFromUI(const ClientID: string); + procedure SendToAllClients(const AMessage: string); + procedure SendToSelectedClient(const AMessage: string); + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +{ TConnectedUserData } + +constructor TConnectedUserData.Create(ALine: TncLine; const AID: string); +begin + inherited Create; + FLine := ALine; + FID := AID; + FConnectedAt := Now; +end; + +{ TForm1 } + +procedure TForm1.AddClientToUI(AUserData: TConnectedUserData); +var + Item: TListItem; +begin + TThread.Queue(nil, + procedure + begin + Item := Form1.ListView1.Items.Add; + Item.Caption := AUserData.Line.PeerIP; // Column 1: IP Address + Item.SubItems.Add(AUserData.ID); // Column 2: NickName/ID + Item.SubItems.Add('Connected'); // Column 3: Status + Item.SubItems.Add(FormatDateTime('hh:nn:ss', AUserData.ConnectedAt)); // Column 4: Connected At + Item.Data := AUserData; + end); +end; + +procedure TForm1.RemoveClientFromUI(const ClientID: string); +var + I: Integer; +begin + for I := ListView1.Items.Count - 1 downto 0 do + begin + if ListView1.Items[I].SubItems[0] = ClientID then + begin + ListView1.Items.Delete(I); + Break; + end; + end; +end; + +function TForm1.GetClientByID(const AID: string): TConnectedUserData; +begin + FClientDataLock.Enter; + try + if not FClientsByID.TryGetValue(AID, Result) then + Result := nil; + finally + FClientDataLock.Leave; + end; +end; + +procedure TForm1.SendToAllClients(const AMessage: string); +var + SocketList: TSocketList; + I: Integer; +begin + // Use the optimized built-in broadcast mechanism (same as ncSources) + SocketList := ServerSocket.Lines.LockList; + try + for I := 0 to SocketList.Count - 1 do + begin + ServerSocket.SendCommand(SocketList.Lines[I], 0, BytesOf(AMessage)); + end; + finally + ServerSocket.Lines.UnlockList; + end; +end; + +procedure TForm1.SendToSelectedClient(const AMessage: string); +var + NickName: string; + UserData: TConnectedUserData; +begin + if Assigned(Form1.ListView1.Selected) then + begin + NickName := Form1.ListView1.Selected.SubItems[0]; + UserData := Form1.GetClientByID(NickName); + + if Assigned(UserData) then + begin + ServerSocket.SendCommand(UserData.Line, 0, BytesOf(AMessage)); + end; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +var + CertPath: string; +begin + // Initialize raw TCP connection counter + connectedclients := 0; + + // Initialize optimized data structures + FClientsByLine := TDictionary.Create; + FClientsByID := TDictionary.Create; + FCommandParser := TStringList.Create; + FCommandParser.Delimiter := '|'; + FCommandParser.StrictDelimiter := True; + FClientDataLock := TCriticalSection.Create; + + // Configure TLS settings for the server + ServerSocket.UseTLS := True; + ServerSocket.TlsProvider := tpSChannel; + CertPath := ExtractFilePath(Application.ExeName) + 'server.pfx'; + ServerSocket.CertificateFile := CertPath; + ServerSocket.PrivateKeyPassword := 'test'; + ServerSocket.IgnoreCertificateErrors := True; // Changed to True for demo purposes + + // Start server with dual protocol support + ServerSocket.Port := 3434; + ServerSocket.OnCommand := ServerSocketCommand; // Binary protocol handler + ServerSocket.OnReadData := ServerSocketReadData; // Raw text protocol handler + ServerSocket.Active := True; + StatusBar1.Panels[0].Text := 'Status: Active'; + + Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height); + Image1.Picture.Bitmap.Canvas.Brush.Color := clBlack; + Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height)); + +end; + +procedure TForm1.S1Click(Sender: TObject); +begin + SendToAllClients('Hello ALL'); +end; + +procedure TForm1.S2Click(Sender: TObject); +begin + SendToSelectedClient('MSG to you'); +end; + +procedure TForm1.S3Click(Sender: TObject); +var + NickName: string; + UserData: TConnectedUserData; +begin + // Send raw text using regular Send method - triggers OnReadData event + if Assigned(Form1.ListView1.Selected) then + begin + NickName := Form1.ListView1.Selected.SubItems[0]; + UserData := Form1.GetClientByID(NickName); + + if Assigned(UserData) then + begin + ServerSocket.Send(UserData.Line, 'RAW TEXT MESSAGE from server - This should trigger OnReadData!'); + Log(Format('[%s] Sent raw text to %s', [TimeToStr(Now), NickName])); + end; + end; +end; + +procedure TForm1.G1Click(Sender: TObject); +begin + SendToSelectedClient('ScreenShot'); +end; + +procedure TForm1.C1Click(Sender: TObject); +var + NickName: string; + UserData: TConnectedUserData; +begin + if Assigned(Form1.ListView1.Selected) then + begin + NickName := Form1.ListView1.Selected.SubItems[0]; + UserData := Form1.GetClientByID(NickName); + + if Assigned(UserData) then + begin + ServerSocket.SendCommand(UserData.Line,0, BytesOf('TITLE|'+ 'THIS IS A NEW TITLE')); + end; + end; +end; + +procedure TForm1.ServerSocketConnected(Sender: TObject; aLine: TncLine); +begin + Inc(connectedclients); + UpdateClientCount; +end; + +procedure TForm1.ServerSocketDisconnected(Sender: TObject; aLine: TncLine); +var + UserData: TConnectedUserData; + ClientID: string; +begin + // Decrement raw TCP connection counter + Dec(connectedclients); + + FClientDataLock.Enter; + try + // O(1) lookup by line reference + if FClientsByLine.TryGetValue(aLine, UserData) then + begin + ClientID := UserData.ID; + + // Remove from both dictionaries - O(1) operations + FClientsByLine.Remove(aLine); + FClientsByID.Remove(ClientID); + + // Clean up the user data object + UserData.Free; + end; + finally + FClientDataLock.Leave; + end; + + // Update UI (outside of lock to avoid deadlock) + if ClientID <> '' then + begin + RemoveClientFromUI(ClientID); + end; + + UpdateClientCount; +end; + +procedure TForm1.ServerSocketCommand(Sender: TObject; aLine: TncLine; + aCmd: Integer; const aData: TBytes); +var + datarecieved: String; + ClientAdded: Boolean; + CommandName: string; + UserData: TConnectedUserData; +begin + // Convert bytes to string - exact same as ncSources! + datarecieved := StringOf(aData); + ClientAdded := False; + + // Parse command first (no lock needed for parsing) + FCommandParser.Clear; + FCommandParser.DelimitedText := datarecieved; + + if FCommandParser.Count > 0 then + begin + CommandName := FCommandParser[0]; + + Log(Format('[%s] Parsed command: %s', [TimeToStr(Now), CommandName])); + + // Lock per command for better concurrency + FClientDataLock.Enter; + try +//////////////////////////////////////////////////////////////////////////////// +/// Handle command NewAuth - EXACT same logic as ncSources +//////////////////////////////////////////////////////////////////////////////// + if CommandName = 'NewAuth' then + begin + Log(Format('[%s] Processing NewAuth command', [TimeToStr(Now)])); + + // Check if we have a client ID + if FCommandParser.Count > 1 then + begin + Log(Format('[%s] Client ID: %s', [TimeToStr(Now), FCommandParser[1]])); + + // Check if client ID already exists to prevent duplicates + if not FClientsByID.ContainsKey(FCommandParser[1]) then + begin + UserData := TConnectedUserData.Create(aLine, FCommandParser[1]); + + // Add to both dictionaries for O(1) lookup + FClientsByLine.Add(aLine, UserData); + FClientsByID.Add(FCommandParser[1], UserData); + ClientAdded := True; + + Log(Format('[%s] Client %s authenticated successfully', [TimeToStr(Now), FCommandParser[1]])); + end + else + begin + Log(Format('[%s] Client %s already exists', [TimeToStr(Now), FCommandParser[1]])); + end; + end + else + begin + Log(Format('[%s] NewAuth command missing client ID', [TimeToStr(Now)])); + end; + end +//////////////////////////////////////////////////////////////////////////////// +/// Handle command ScreenShot (server requesting screenshot) +//////////////////////////////////////////////////////////////////////////////// + else if CommandName = 'ScreenShot' then + begin + + if FCommandParser.Count > 1 then + begin + + TThread.Queue(nil, + procedure + var + imageData: TBytes; + begin + try + // Extract image data from command - skip "ScreenShot|" (10 bytes) + // aData contains: "ScreenShot|" + JPEG binary data + imageData := Copy(aData, 11, Length(aData)); + + Form1.DisplayScreenShot(imageData); + Log('RECEIVE SCREENSHOT'); + + except + on E: Exception do + begin + Log(Format('[%s] Error processing screenshot: %s', [TimeToStr(Now), E.Message])); + end; + end; + end); + end + end +//////////////////////////////////////////////////////////////////////////////// +/// Handle unknown commands +//////////////////////////////////////////////////////////////////////////////// + else + begin + TThread.Queue(nil, + procedure + begin + Log(Format('[%s] Unknown command received: %s', [TimeToStr(Now), CommandName])); + end); + end; + finally + FClientDataLock.Leave; + end; + end + else + begin + Log(Format('[%s] Failed to parse command data', [TimeToStr(Now)])); + end; + + // Update UI outside of lock to prevent deadlock + if ClientAdded then + begin + FClientDataLock.Enter; + try + if FCommandParser.Count > 1 then + begin + if FClientsByID.TryGetValue(FCommandParser[1], UserData) then + AddClientToUI(UserData); + end; + finally + FClientDataLock.Leave; + end; + + // Update status bar after authentication + UpdateClientCount; + Log(Format('[%s] UI updated - Auth count: %d', [TimeToStr(Now), GetAuthenticatedClientCount])); + end; +end; + +procedure TForm1.ServerSocketReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + dataReceived: String; + UserData: TConnectedUserData; +begin + // Convert raw bytes to string + dataReceived := StringOf(Copy(aBuf, 0, aBufCount)); + + // Display received raw text data + TThread.Queue(nil, procedure + begin + Log(Format('[%s] OnReadData fired: %d bytes', [TimeToStr(Now), aBufCount])); + Log(Format(' Raw data: %s', [dataReceived])); + + // Find the user data for this line to get client info + UserData := GetClientByLine(aLine); + if Assigned(UserData) then + begin + Log(Format('[%s] Raw text received from %s', [TimeToStr(Now), UserData.ID])); + end + else + begin + Log(Format('[%s] Raw text received from unknown client', [TimeToStr(Now)])); + end; + end); +end; + +procedure TForm1.UpdateClientCount; +begin + FClientDataLock.Enter; + try + StatusBar1.Panels[1].Text := Format('Raw: %d | Auth: %d', + [connectedclients, FClientsByID.Count]); + finally + FClientDataLock.Leave; + end; +end; + +function TForm1.GetClientCount: Integer; +begin + Result := connectedclients; +end; + +function TForm1.GetAuthenticatedClientCount: Integer; +begin + FClientDataLock.Enter; + try + Result := FClientsByID.Count; + finally + FClientDataLock.Leave; + end; +end; + +function TForm1.GetClientByLine(aLine: TncLine): TConnectedUserData; +begin + FClientDataLock.Enter; + try + if not FClientsByLine.TryGetValue(aLine, Result) then + Result := nil; + finally + FClientDataLock.Leave; + end; +end; + +procedure TForm1.DisplayScreenShot(const aData: TBytes); +var + MS: TMemoryStream; + jpgImage: TJPEGImage; +begin + // Create streams for JPEG loading + MS := TMemoryStream.Create; + jpgImage := TJPEGImage.Create; + try + // Load JPEG data directly into stream + MS.WriteBuffer(aData[0], Length(aData)); + MS.Position := 0; + + // Load JPEG from data stream + jpgImage.LoadFromStream(MS); + + // Display in TImage component + if Assigned(Form1) and Assigned(Form1.Image1) then + begin + Form1.Image1.Picture.Assign(jpgImage); + Form1.Image1.Stretch := True; + end; + + finally + MS.Free; + jpgImage.Free; + end; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + if ServerSocket.Active then + ServerSocket.Active := False; + + FClientDataLock.Enter; + try + for var UserData in FClientsByLine.Values do + UserData.Free; + FClientsByLine.Free; + FClientsByID.Free; + finally + FClientDataLock.Leave; + end; + + FCommandParser.Free; + FClientDataLock.Free; +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + Memo1.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + Memo1.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + Memo1.CopyToClipboard; +end; + +end. diff --git a/Demos/TCP/ncSocketsDual_Multi-Socket/ncSocketsDual_Multi-Socket.groupproj b/Demos/TCP/ncSocketsDual_Multi-Socket/ncSocketsDual_Multi-Socket.groupproj new file mode 100644 index 0000000..483ba6a --- /dev/null +++ b/Demos/TCP/ncSocketsDual_Multi-Socket/ncSocketsDual_Multi-Socket.groupproj @@ -0,0 +1,48 @@ + + + {CC772AFE-3A20-48E0-B003-EBCEAE976C71} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dpr b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dpr new file mode 100644 index 0000000..2f8f3e0 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dpr @@ -0,0 +1,14 @@ +program ThreadedClient; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. \ No newline at end of file diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dproj b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dproj new file mode 100644 index 0000000..2a83196 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dproj @@ -0,0 +1,190 @@ + + + {ECD6784B-722C-4CA2-BC1E-5A3CA0052F74} + ThreadedClient.dpr + True + Release + ThreadedClient + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + ThreadedClient + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + + MainSource + + +
frmMain
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + ThreadedClient.dpr + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dproj.local b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.identcache b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.identcache new file mode 100644 index 0000000..899a96f Binary files /dev/null and b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.identcache differ diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.res b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.res new file mode 100644 index 0000000..d8a8600 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_Benchmark/Client/ThreadedClient.res differ diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Client/ufrmMain.dfm b/Demos/TCP/ncSocketsThd_Benchmark/Client/ufrmMain.dfm new file mode 100644 index 0000000..23b8590 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Client/ufrmMain.dfm @@ -0,0 +1,323 @@ +object frmMain: TfrmMain + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'NetCom7 Threaded Client Demo' + ClientHeight = 700 + ClientWidth = 900 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 900 + Height = 89 + Align = alTop + TabOrder = 0 + object Label1: TLabel + Left = 16 + Top = 16 + Width = 26 + Height = 13 + Caption = 'Host:' + end + object Label2: TLabel + Left = 16 + Top = 48 + Width = 24 + Height = 13 + Caption = 'Port:' + end + object btnConnect: TButton + Left = 256 + Top = 16 + Width = 121 + Height = 25 + Caption = 'Connect' + TabOrder = 0 + OnClick = btnConnectClick + end + object edtHost: TEdit + Left = 47 + Top = 13 + Width = 121 + Height = 21 + TabOrder = 1 + Text = 'localhost' + end + object edtPort: TEdit + Left = 47 + Top = 45 + Width = 121 + Height = 21 + TabOrder = 2 + Text = '8080' + end + object btnClearLog: TButton + Left = 400 + Top = 16 + Width = 75 + Height = 25 + Caption = 'Clear Log' + TabOrder = 3 + OnClick = btnClearLogClick + end + end + object Panel2: TPanel + Left = 0 + Top = 89 + Width = 900 + Height = 320 + Align = alClient + TabOrder = 1 + DesignSize = ( + 900 + 320) + object Label3: TLabel + Left = 16 + Top = 8 + Width = 47 + Height = 13 + Caption = 'Client Log' + end + object memoLog: TMemo + Left = 16 + Top = 27 + Width = 867 + Height = 281 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Consolas' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + end + end + object Panel3: TPanel + Left = 0 + Top = 409 + Width = 900 + Height = 145 + Align = alBottom + TabOrder = 2 + object Label4: TLabel + Left = 16 + Top = 16 + Width = 27 + Height = 13 + Caption = 'Echo:' + end + object Label5: TLabel + Left = 16 + Top = 48 + Width = 44 + Height = 13 + Caption = 'Reverse:' + end + object Label6: TLabel + Left = 16 + Top = 80 + Width = 28 + Height = 13 + Caption = 'Hash:' + end + object btnPing: TButton + Left = 16 + Top = 112 + Width = 75 + Height = 25 + Caption = 'PING' + TabOrder = 0 + OnClick = btnPingClick + end + object edtEcho: TEdit + Left = 63 + Top = 13 + Width = 121 + Height = 21 + TabOrder = 1 + Text = 'Hello World' + OnKeyPress = edtEchoKeyPress + end + object btnEcho: TButton + Left = 200 + Top = 13 + Width = 75 + Height = 25 + Caption = 'ECHO' + TabOrder = 2 + OnClick = btnEchoClick + end + object edtReverse: TEdit + Left = 63 + Top = 45 + Width = 121 + Height = 21 + TabOrder = 3 + Text = 'Hello World' + OnKeyPress = edtReverseKeyPress + end + object btnReverse: TButton + Left = 200 + Top = 45 + Width = 75 + Height = 25 + Caption = 'REVERSE' + TabOrder = 4 + OnClick = btnReverseClick + end + object edtHash: TEdit + Left = 63 + Top = 77 + Width = 121 + Height = 21 + TabOrder = 5 + Text = 'TestData' + OnKeyPress = edtHashKeyPress + end + object btnHash: TButton + Left = 200 + Top = 77 + Width = 75 + Height = 25 + Caption = 'HASH' + TabOrder = 6 + OnClick = btnHashClick + end + object btnCompute: TButton + Left = 97 + Top = 112 + Width = 75 + Height = 25 + Caption = 'COMPUTE' + TabOrder = 7 + OnClick = btnComputeClick + end + object btnTime: TButton + Left = 178 + Top = 112 + Width = 75 + Height = 25 + Caption = 'TIME' + TabOrder = 8 + OnClick = btnTimeClick + end + end + object Panel4: TPanel + Left = 0 + Top = 554 + Width = 900 + Height = 41 + Align = alBottom + TabOrder = 3 + object Label7: TLabel + Left = 16 + Top = 16 + Width = 35 + Height = 13 + Caption = 'Status:' + end + object lblStatus: TLabel + Left = 55 + Top = 16 + Width = 76 + Height = 13 + Caption = 'Disconnected' + Font.Charset = DEFAULT_CHARSET + Font.Color = clRed + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + end + object Panel5: TPanel + Left = 0 + Top = 595 + Width = 900 + Height = 105 + Align = alBottom + TabOrder = 4 + object Label8: TLabel + Left = 16 + Top = 16 + Width = 114 + Height = 13 + Caption = 'Stress Test Settings' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblConcurrency: TLabel + Left = 200 + Top = 40 + Width = 7 + Height = 13 + Caption = '5' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblStressStatus: TLabel + Left = 400 + Top = 72 + Width = 3 + Height = 13 + end + object trackConcurrency: TTrackBar + Left = 16 + Top = 35 + Width = 177 + Height = 33 + Max = 20 + Min = 1 + Position = 5 + TabOrder = 0 + OnChange = trackConcurrencyChange + end + object btnStressTest: TButton + Left = 256 + Top = 35 + Width = 121 + Height = 25 + Caption = 'Start Stress Test' + TabOrder = 1 + OnClick = btnStressTestClick + end + object progressStress: TProgressBar + Left = 400 + Top = 35 + Width = 350 + Height = 25 + TabOrder = 2 + end + object btnStopStress: TButton + Left = 256 + Top = 67 + Width = 121 + Height = 25 + Caption = 'Stop Stress Test' + Enabled = False + TabOrder = 3 + OnClick = btnStopStressClick + end + end +end diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Client/ufrmMain.pas b/Demos/TCP/ncSocketsThd_Benchmark/Client/ufrmMain.pas new file mode 100644 index 0000000..480f33b --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Client/ufrmMain.pas @@ -0,0 +1,543 @@ +unit ufrmMain; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, + System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, + Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ComCtrls, System.DateUtils, + System.Threading, System.SyncObjs, System.Diagnostics, System.Math, + ncSocketsThd, ncLines, ncThreads; + +type + TfrmMain = class(TForm) + Panel1: TPanel; + btnConnect: TButton; + edtHost: TEdit; + edtPort: TEdit; + Label1: TLabel; + Label2: TLabel; + Panel2: TPanel; + memoLog: TMemo; + Label3: TLabel; + Panel3: TPanel; + btnPing: TButton; + edtEcho: TEdit; + btnEcho: TButton; + Label4: TLabel; + edtReverse: TEdit; + btnReverse: TButton; + Label5: TLabel; + edtHash: TEdit; + btnHash: TButton; + Label6: TLabel; + btnCompute: TButton; + btnTime: TButton; + Panel4: TPanel; + Label7: TLabel; + lblStatus: TLabel; + btnClearLog: TButton; + Panel5: TPanel; + Label8: TLabel; + trackConcurrency: TTrackBar; + lblConcurrency: TLabel; + btnStressTest: TButton; + progressStress: TProgressBar; + lblStressStatus: TLabel; + btnStopStress: TButton; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnConnectClick(Sender: TObject); + procedure btnPingClick(Sender: TObject); + procedure btnEchoClick(Sender: TObject); + procedure btnReverseClick(Sender: TObject); + procedure btnHashClick(Sender: TObject); + procedure btnComputeClick(Sender: TObject); + procedure btnTimeClick(Sender: TObject); + procedure btnClearLogClick(Sender: TObject); + procedure trackConcurrencyChange(Sender: TObject); + procedure btnStressTestClick(Sender: TObject); + procedure btnStopStressClick(Sender: TObject); + procedure edtEchoKeyPress(Sender: TObject; var Key: Char); + procedure edtReverseKeyPress(Sender: TObject; var Key: Char); + procedure edtHashKeyPress(Sender: TObject; var Key: Char); + private + FClient: TncTCPClientThd; + FStressTestRunning: Boolean; + FStressTestTask: ITask; + FStressTestLock: TCriticalSection; + FRequestCount: Integer; + FResponseCount: Integer; + FErrorCount: Integer; + + procedure ClientConnected(Sender: TObject; aLine: TncLine); + procedure ClientDisconnected(Sender: TObject; aLine: TncLine); + procedure ClientReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); + procedure LogMessage(const aMessage: string); + procedure UpdateStatus; + procedure SendCommand(const aCommand: string); + procedure UpdateStressTestProgress(aProgress: Integer; const aStatus: string); + procedure StressTestWorker; + procedure EnableControls(aEnabled: Boolean); + public + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.dfm} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + FStressTestRunning := False; + FStressTestLock := TCriticalSection.Create; + FRequestCount := 0; + FResponseCount := 0; + FErrorCount := 0; + + // Create TncClient + FClient := TncTCPClientThd.Create(Self); + FClient.EventsUseMainThread := True; + FClient.OnConnected := ClientConnected; + FClient.OnDisconnected := ClientDisconnected; + FClient.OnReadData := ClientReadData; + + // Initialize UI + edtHost.Text := 'localhost'; + edtPort.Text := '8080'; + trackConcurrency.Position := 5; + lblConcurrency.Caption := IntToStr(trackConcurrency.Position); + + UpdateStatus; + LogMessage('Client initialized'); + LogMessage('Ready to connect to server...'); +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + if FStressTestRunning then + begin + FStressTestRunning := False; + if Assigned(FStressTestTask) then + FStressTestTask.Wait; + end; + + if Assigned(FClient) then + begin + FClient.Active := False; + FClient.Free; + end; + + FStressTestLock.Free; +end; + +procedure TfrmMain.btnConnectClick(Sender: TObject); +begin + if FClient.Active then + begin + // Disconnect + FClient.Active := False; + btnConnect.Caption := 'Connect'; + LogMessage('Disconnecting from server...'); + end + else + begin + // Connect + try + FClient.Host := edtHost.Text; + FClient.Port := StrToInt(edtPort.Text); + FClient.Active := True; + btnConnect.Caption := 'Disconnect'; + LogMessage('Connecting to ' + edtHost.Text + ':' + edtPort.Text + '...'); + except + on E: Exception do + begin + LogMessage('Error connecting: ' + E.Message); + ShowMessage('Error connecting: ' + E.Message); + end; + end; + end; +end; + +procedure TfrmMain.btnPingClick(Sender: TObject); +begin + SendCommand('PING'); +end; + +procedure TfrmMain.btnEchoClick(Sender: TObject); +begin + if Trim(edtEcho.Text) = '' then + begin + ShowMessage('Please enter text to echo'); + edtEcho.SetFocus; + Exit; + end; + SendCommand('ECHO ' + edtEcho.Text); +end; + +procedure TfrmMain.btnReverseClick(Sender: TObject); +begin + if Trim(edtReverse.Text) = '' then + begin + ShowMessage('Please enter text to reverse'); + edtReverse.SetFocus; + Exit; + end; + SendCommand('REVERSE ' + edtReverse.Text); +end; + +procedure TfrmMain.btnHashClick(Sender: TObject); +begin + if Trim(edtHash.Text) = '' then + begin + ShowMessage('Please enter text to hash'); + edtHash.SetFocus; + Exit; + end; + SendCommand('HASH ' + edtHash.Text); +end; + +procedure TfrmMain.btnComputeClick(Sender: TObject); +begin + SendCommand('COMPUTE'); +end; + +procedure TfrmMain.btnTimeClick(Sender: TObject); +begin + SendCommand('TIME'); +end; + +procedure TfrmMain.btnClearLogClick(Sender: TObject); +begin + memoLog.Clear; +end; + +procedure TfrmMain.trackConcurrencyChange(Sender: TObject); +begin + lblConcurrency.Caption := IntToStr(trackConcurrency.Position); +end; + +procedure TfrmMain.btnStressTestClick(Sender: TObject); +begin + if not FClient.Active then + begin + ShowMessage('Please connect to server first'); + Exit; + end; + + FStressTestRunning := True; + FRequestCount := 0; + FResponseCount := 0; + FErrorCount := 0; + + EnableControls(False); + btnStopStress.Enabled := True; + progressStress.Position := 0; + + // Disable event synchronization for better performance during stress test + FClient.EventsUseMainThread := False; + + LogMessage('Starting stress test with ' + IntToStr(trackConcurrency.Position) + ' concurrent tasks...'); + + // Start stress test in background task + FStressTestTask := TTask.Create(StressTestWorker); + FStressTestTask.Start; +end; + +procedure TfrmMain.btnStopStressClick(Sender: TObject); +begin + FStressTestRunning := False; + // Restore event synchronization + FClient.EventsUseMainThread := True; + LogMessage('Stopping stress test...'); +end; + +procedure TfrmMain.edtEchoKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + begin + btnEchoClick(nil); + Key := #0; + end; +end; + +procedure TfrmMain.edtReverseKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + begin + btnReverseClick(nil); + Key := #0; + end; +end; + +procedure TfrmMain.edtHashKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #13 then + begin + btnHashClick(nil); + Key := #0; + end; +end; + +procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); +begin + LogMessage('Connected to server at ' + aLine.PeerIP); + UpdateStatus; + EnableControls(True); +end; + +procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); +begin + LogMessage('Disconnected from server'); + UpdateStatus; + EnableControls(False); + btnConnect.Caption := 'Connect'; +end; + +procedure TfrmMain.ClientReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); +var + Response: string; +begin + Response := TEncoding.UTF8.GetString(aBuf, 0, aBufCount); + Response := Trim(Response); + + if Response <> '' then + begin + LogMessage('Response: ' + Response); + + // Update stress test counter + if FStressTestRunning then + begin + FStressTestLock.Acquire; + try + Inc(FResponseCount); + finally + FStressTestLock.Release; + end; + end; + end; +end; + +procedure TfrmMain.LogMessage(const aMessage: string); +begin + if memoLog.Lines.Count > 1000 then + memoLog.Clear; + + memoLog.Lines.Add(FormatDateTime('hh:nn:ss.zzz', Now) + ' - ' + aMessage); + + // Auto-scroll to bottom + SendMessage(memoLog.Handle, WM_VSCROLL, SB_BOTTOM, 0); +end; + +procedure TfrmMain.UpdateStatus; +begin + if FClient.Active then + begin + lblStatus.Caption := 'Connected to ' + FClient.Host + ':' + IntToStr(FClient.Port); + lblStatus.Font.Color := clGreen; + end + else + begin + lblStatus.Caption := 'Disconnected'; + lblStatus.Font.Color := clRed; + end; +end; + +procedure TfrmMain.SendCommand(const aCommand: string); +var + CommandBytes: TBytes; +begin + if not FClient.Active then + begin + ShowMessage('Not connected to server'); + Exit; + end; + + try + // Only log individual commands when not stress testing to avoid UI blocking + if not FStressTestRunning then + LogMessage('Sending: ' + aCommand); + + CommandBytes := TEncoding.UTF8.GetBytes(aCommand + #13#10); + FClient.Send(CommandBytes); + + // Update stress test counter + if FStressTestRunning then + begin + FStressTestLock.Acquire; + try + Inc(FRequestCount); + finally + FStressTestLock.Release; + end; + end; + + except + on E: Exception do + begin + // Only log individual errors when not stress testing + if not FStressTestRunning then + LogMessage('Error sending command: ' + E.Message); + + // Update stress test error counter + if FStressTestRunning then + begin + FStressTestLock.Acquire; + try + Inc(FErrorCount); + finally + FStressTestLock.Release; + end; + end; + end; + end; +end; + +procedure TfrmMain.UpdateStressTestProgress(aProgress: Integer; const aStatus: string); +begin + TThread.Synchronize(nil, procedure + begin + progressStress.Position := aProgress; + lblStressStatus.Caption := aStatus; + end); +end; + +procedure TfrmMain.StressTestWorker; +var + i, j: Integer; + Tasks: array of ITask; + Commands: array[0..5] of string; + TotalRequests: Integer; + StartTime: TStopwatch; +begin + // Initialize the commands array + Commands[0] := 'PING'; + Commands[1] := 'ECHO StressTest'; + Commands[2] := 'REVERSE Hello'; + Commands[3] := 'HASH TestData'; + Commands[4] := 'COMPUTE'; + Commands[5] := 'TIME'; + try + TotalRequests := 100; // Total requests to send + SetLength(Tasks, trackConcurrency.Position); + StartTime := TStopwatch.StartNew; + + // Create concurrent tasks with shared counter approach + for i := 0 to trackConcurrency.Position - 1 do + begin + Tasks[i] := TTask.Create(procedure + var + LocalRequestCount: Integer; + begin + LocalRequestCount := 0; + + // Keep sending until we reach total or test stops + while FStressTestRunning and (LocalRequestCount < TotalRequests) do + begin + // Check if we should send another request + FStressTestLock.Acquire; + try + if FRequestCount < TotalRequests then + begin + Inc(LocalRequestCount); + end + else + Break; // Total reached, exit + finally + FStressTestLock.Release; + end; + + // Send random command directly from background thread + SendCommand(Commands[Random(Length(Commands))]); + + // Small delay to prevent overwhelming + Sleep(50 + Random(100)); + end; + end); + end; + + // Start all tasks + for i := 0 to High(Tasks) do + Tasks[i].Start; + + // Monitor progress + while FStressTestRunning do + begin + Sleep(100); + + FStressTestLock.Acquire; + try + if FRequestCount > 0 then + begin + UpdateStressTestProgress( + Min(100, (FRequestCount * 100) div TotalRequests), + Format('Requests: %d, Responses: %d, Errors: %d, Time: %ds', + [FRequestCount, FResponseCount, FErrorCount, StartTime.ElapsedMilliseconds div 1000]) + ); + end; + + // Check if all requests completed + if FRequestCount >= TotalRequests then + Break; + finally + FStressTestLock.Release; + end; + end; + + // Wait for all tasks to complete + for i := 0 to High(Tasks) do + Tasks[i].Wait; + + // Final update + TThread.Synchronize(nil, procedure + begin + // Restore event synchronization + FClient.EventsUseMainThread := True; + + UpdateStressTestProgress(100, + Format('Completed! Requests: %d, Responses: %d, Errors: %d, Time: %ds', + [FRequestCount, FResponseCount, FErrorCount, StartTime.ElapsedMilliseconds div 1000])); + + LogMessage('Stress test completed'); + LogMessage(Format('Total time: %d seconds', [StartTime.ElapsedMilliseconds div 1000])); + LogMessage(Format('Requests per second: %.2f', [FRequestCount / (StartTime.ElapsedMilliseconds / 1000)])); + + EnableControls(True); + btnStopStress.Enabled := False; + end); + + except + on E: Exception do + begin + TThread.Synchronize(nil, procedure + begin + // Restore event synchronization + FClient.EventsUseMainThread := True; + LogMessage('Stress test error: ' + E.Message); + EnableControls(True); + btnStopStress.Enabled := False; + end); + end; + end; + + FStressTestRunning := False; +end; + +procedure TfrmMain.EnableControls(aEnabled: Boolean); +begin + btnPing.Enabled := aEnabled; + btnEcho.Enabled := aEnabled; + btnReverse.Enabled := aEnabled; + btnHash.Enabled := aEnabled; + btnCompute.Enabled := aEnabled; + btnTime.Enabled := aEnabled; + btnStressTest.Enabled := aEnabled; + edtEcho.Enabled := aEnabled; + edtReverse.Enabled := aEnabled; + edtHash.Enabled := aEnabled; + trackConcurrency.Enabled := aEnabled; +end; + +end. \ No newline at end of file diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dpr b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dpr new file mode 100644 index 0000000..aa49683 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dpr @@ -0,0 +1,14 @@ +program ThreadedServer; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TfrmMain, frmMain); + Application.Run; +end. \ No newline at end of file diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dproj b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dproj new file mode 100644 index 0000000..cdd351f --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dproj @@ -0,0 +1,190 @@ + + + {6901B784-E921-432D-A63A-5F77E2A991CD} + ThreadedServer.dpr + True + Release + ThreadedServer + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + ThreadedServer + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + + MainSource + + +
frmMain
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + ThreadedServer.dpr + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dproj.local b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.identcache b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.identcache new file mode 100644 index 0000000..547e629 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.identcache differ diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.res b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.res new file mode 100644 index 0000000..49a440c Binary files /dev/null and b/Demos/TCP/ncSocketsThd_Benchmark/Server/ThreadedServer.res differ diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server/ufrmMain.dfm b/Demos/TCP/ncSocketsThd_Benchmark/Server/ufrmMain.dfm new file mode 100644 index 0000000..418d4dc --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server/ufrmMain.dfm @@ -0,0 +1,328 @@ +object frmMain: TfrmMain + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'NetCom7 Threaded Server Demo' + ClientHeight = 600 + ClientWidth = 800 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 800 + Height = 89 + Align = alTop + TabOrder = 0 + object Label1: TLabel + Left = 16 + Top = 16 + Width = 24 + Height = 13 + Caption = 'Port:' + end + object btnStartStop: TButton + Left = 16 + Top = 48 + Width = 121 + Height = 25 + Caption = 'Start Server' + TabOrder = 0 + OnClick = btnStartStopClick + end + object edtPort: TEdit + Left = 46 + Top = 13 + Width = 91 + Height = 21 + TabOrder = 1 + Text = '8080' + end + object btnClearLog: TButton + Left = 168 + Top = 48 + Width = 75 + Height = 25 + Caption = 'Clear Log' + TabOrder = 2 + OnClick = btnClearLogClick + end + end + object Panel2: TPanel + Left = 0 + Top = 89 + Width = 800 + Height = 320 + Align = alClient + TabOrder = 1 + DesignSize = ( + 800 + 320) + object Label2: TLabel + Left = 16 + Top = 8 + Width = 52 + Height = 13 + Caption = 'Server Log' + end + object memoLog: TMemo + Left = 16 + Top = 27 + Width = 769 + Height = 281 + Anchors = [akLeft, akTop, akRight, akBottom] + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Consolas' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + end + end + object Panel3: TPanel + Left = 0 + Top = 409 + Width = 800 + Height = 191 + Align = alBottom + TabOrder = 2 + object Label3: TLabel + Left = 16 + Top = 16 + Width = 63 + Height = 13 + Caption = 'Connections:' + end + object lblConnections: TLabel + Left = 86 + Top = 16 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object Label4: TLabel + Left = 16 + Top = 40 + Width = 85 + Height = 13 + Caption = 'Threads per CPU:' + end + object lblThreadsPerCPU: TLabel + Left = 105 + Top = 40 + Width = 7 + Height = 13 + Caption = '4' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object Label5: TLabel + Left = 16 + Top = 64 + Width = 66 + Height = 13 + Caption = 'Max Threads:' + end + object lblMaxThreads: TLabel + Left = 89 + Top = 64 + Width = 14 + Height = 13 + Caption = '32' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object Label6: TLabel + Left = 200 + Top = 16 + Width = 76 + Height = 13 + Caption = 'Total Requests:' + end + object lblTotalRequests: TLabel + Left = 283 + Top = 16 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object Label7: TLabel + Left = 200 + Top = 40 + Width = 88 + Height = 13 + Caption = 'Requests/Second:' + end + object lblRequestsPerSecond: TLabel + Left = 288 + Top = 40 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object Label8: TLabel + Left = 200 + Top = 64 + Width = 76 + Height = 13 + Caption = 'Active Threads:' + end + object lblActiveThreads: TLabel + Left = 283 + Top = 64 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clMaroon + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblLastTestResults: TLabel + Left = 400 + Top = 16 + Width = 100 + Height = 13 + Caption = 'Last Test Results:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clNavy + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestTotalRequests: TLabel + Left = 400 + Top = 40 + Width = 76 + Height = 13 + Caption = 'Total Requests:' + end + object lblTestTotalRequestsValue: TLabel + Left = 490 + Top = 40 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestPeakReqSec: TLabel + Left = 400 + Top = 64 + Width = 70 + Height = 13 + Caption = 'Peak Req/Sec:' + end + object lblTestPeakReqSecValue: TLabel + Left = 490 + Top = 64 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestDuration: TLabel + Left = 400 + Top = 88 + Width = 69 + Height = 13 + Caption = 'Test Duration:' + end + object lblTestDurationValue: TLabel + Left = 490 + Top = 88 + Width = 13 + Height = 13 + Caption = '0s' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestAvgReqSec: TLabel + Left = 400 + Top = 112 + Width = 66 + Height = 13 + Caption = 'Avg Req/Sec:' + end + object lblTestAvgReqSecValue: TLabel + Left = 490 + Top = 112 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object btnResetStats: TButton + Left = 400 + Top = 144 + Width = 75 + Height = 25 + Caption = 'Reset Stats' + TabOrder = 0 + OnClick = btnResetStatsClick + end + end + object Timer1: TTimer + OnTimer = Timer1Timer + Left = 720 + Top = 48 + end +end diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server/ufrmMain.pas b/Demos/TCP/ncSocketsThd_Benchmark/Server/ufrmMain.pas new file mode 100644 index 0000000..2adc2fd --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server/ufrmMain.pas @@ -0,0 +1,452 @@ +unit ufrmMain; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, + System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, + Vcl.StdCtrls, Vcl.ExtCtrls, System.StrUtils, System.DateUtils, + System.Diagnostics, System.SyncObjs, System.Math, + ncSocketsThd, ncLines, ncThreads; + +type + TfrmMain = class(TForm) + Panel1: TPanel; + btnStartStop: TButton; + edtPort: TEdit; + Label1: TLabel; + Panel2: TPanel; + memoLog: TMemo; + Label2: TLabel; + Panel3: TPanel; + Label3: TLabel; + lblConnections: TLabel; + Label4: TLabel; + lblThreadsPerCPU: TLabel; + Label5: TLabel; + lblMaxThreads: TLabel; + Label6: TLabel; + lblTotalRequests: TLabel; + btnClearLog: TButton; + Label7: TLabel; + lblRequestsPerSecond: TLabel; + Timer1: TTimer; + Label8: TLabel; + lblActiveThreads: TLabel; + lblLastTestResults: TLabel; + lblTestTotalRequests: TLabel; + lblTestTotalRequestsValue: TLabel; + lblTestPeakReqSec: TLabel; + lblTestPeakReqSecValue: TLabel; + lblTestDuration: TLabel; + lblTestDurationValue: TLabel; + lblTestAvgReqSec: TLabel; + lblTestAvgReqSecValue: TLabel; + btnResetStats: TButton; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnStartStopClick(Sender: TObject); + procedure btnClearLogClick(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + procedure btnResetStatsClick(Sender: TObject); + private + FServer: TncTCPServerThd; + FRequestCount: Integer; + FLastRequestCount: Integer; + FRequestCountLock: TCriticalSection; + FConnectionCount: Integer; + FConnectionCountLock: TCriticalSection; + FMaxRequestsPerSecond: Integer; + FTestStartTime: TDateTime; + FTestStartRequestCount: Integer; + FTestInProgress: Boolean; + + procedure ServerConnected(Sender: TObject; aLine: TncLine); + procedure ServerDisconnected(Sender: TObject; aLine: TncLine); + procedure ServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); + procedure LogMessage(const aMessage: string); + procedure ProcessDataRequest(aLine: TncLine; const aRequest: string); + procedure UpdateConnectionCount(aDelta: Integer); + procedure UpdateRequestCount; + procedure UpdateStatistics; + procedure DisplayFinalTestResults(CurrentRequestCount: Integer); + public + end; + +var + frmMain: TfrmMain; + +implementation + +{$R *.dfm} + +procedure TfrmMain.FormCreate(Sender: TObject); +begin + FRequestCount := 0; + FLastRequestCount := 0; + FConnectionCount := 0; + FMaxRequestsPerSecond := 0; + FTestStartTime := 0; + FTestStartRequestCount := 0; + FTestInProgress := False; + FRequestCountLock := TCriticalSection.Create; + FConnectionCountLock := TCriticalSection.Create; + + // Create TncServer with optimal thread pool settings + FServer := TncTCPServerThd.Create(Self); + + // Configure thread pool for demonstration + FServer.DataProcessorThreadsPerCPU := 4; // 4 threads per CPU core + FServer.DataProcessorThreadsGrowUpto := 32; // Maximum 32 threads + FServer.DataProcessorThreadPriority := ntpNormal; + FServer.EventsUseMainThread := False; // Use thread pool for processing - UI updates handled separately + + // Configure socket properties + FServer.NoDelay := True; + FServer.KeepAlive := True; + FServer.ReadBufferLen := 8192; + + // Set event handlers + FServer.OnConnected := ServerConnected; + FServer.OnDisconnected := ServerDisconnected; + FServer.OnReadData := ServerReadData; + + // Initialize UI + edtPort.Text := '8080'; + lblThreadsPerCPU.Caption := IntToStr(FServer.DataProcessorThreadsPerCPU); + lblMaxThreads.Caption := IntToStr(FServer.DataProcessorThreadsGrowUpto); + + UpdateStatistics; + + LogMessage('Server initialized with thread pool configuration'); + LogMessage('Threads per CPU: ' + IntToStr(FServer.DataProcessorThreadsPerCPU)); + LogMessage('Max threads: ' + IntToStr(FServer.DataProcessorThreadsGrowUpto)); +end; + +procedure TfrmMain.FormDestroy(Sender: TObject); +begin + if Assigned(FServer) then + begin + FServer.Active := False; + FServer.Free; + end; + + FRequestCountLock.Free; + FConnectionCountLock.Free; +end; + +procedure TfrmMain.btnStartStopClick(Sender: TObject); +begin + if FServer.Active then + begin + // Stop server + FServer.Active := False; + btnStartStop.Caption := 'Start Server'; + LogMessage('Server stopped'); + end + else + begin + // Start server + try + FServer.Port := StrToInt(edtPort.Text); + FServer.Active := True; + btnStartStop.Caption := 'Stop Server'; + LogMessage('Server started on port ' + edtPort.Text); + LogMessage('Ready to accept connections...'); + except + on E: Exception do + begin + LogMessage('Error starting server: ' + E.Message); + ShowMessage('Error starting server: ' + E.Message); + end; + end; + end; +end; + +procedure TfrmMain.btnClearLogClick(Sender: TObject); +begin + memoLog.Clear; +end; + +procedure TfrmMain.Timer1Timer(Sender: TObject); +begin + UpdateStatistics; +end; + +procedure TfrmMain.ServerConnected(Sender: TObject; aLine: TncLine); +begin + UpdateConnectionCount(1); + LogMessage('Client connected: ' + aLine.PeerIP); +end; + +procedure TfrmMain.ServerDisconnected(Sender: TObject; aLine: TncLine); +begin + UpdateConnectionCount(-1); + LogMessage('Client disconnected: ' + aLine.PeerIP); +end; + +// This runs in a processing thread from the thread pool +procedure TfrmMain.ServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); +var + Request: string; + ThreadID: TThreadID; +begin + try + ThreadID := GetCurrentThreadId; + + // Convert received data to string + Request := TEncoding.UTF8.GetString(aBuf, 0, aBufCount); + Request := Trim(Request); + + if Request <> '' then + begin + UpdateRequestCount; + + // Only log occasionally to avoid UI bottleneck during stress tests + if (ThreadID mod 7 = 0) then // Log roughly 1 in 7 requests based on thread ID + begin + TThread.Synchronize(nil, procedure + begin + LogMessage(Format('Processing request from %s in thread %d: %s', + [aLine.PeerIP, ThreadID, Copy(Request, 1, 50)])); + end); + end; + + // Process the request (this can be CPU-intensive) + ProcessDataRequest(aLine, Request); + end; + + except + on E: Exception do + begin + TThread.Synchronize(nil, procedure + begin + LogMessage('Error processing request: ' + E.Message); + end); + end; + end; +end; + +procedure TfrmMain.ProcessDataRequest(aLine: TncLine; const aRequest: string); +var + Response: string; + ResponseBytes: TBytes; + ProcessingTime: Integer; + StartTime: TStopwatch; + ThreadID: TThreadID; + Command, Data: string; + Parts: TArray; +begin + ThreadID := GetCurrentThreadId; + StartTime := TStopwatch.StartNew; + + try + // Parse command from request + Parts := aRequest.Split([' '], 2); + Command := UpperCase(Parts[0]); + + if Length(Parts) > 1 then + Data := Parts[1] + else + Data := ''; + + // Process different commands + case IndexText(Command, ['PING', 'ECHO', 'REVERSE', 'HASH', 'COMPUTE', 'TIME']) of + 0: // PING + begin + Response := 'PONG'; + end; + 1: // ECHO + begin + Response := 'ECHO: ' + Data; + end; + 2: // REVERSE + begin + Response := 'REVERSED: ' + ReverseString(Data); + end; + 3: // HASH + begin + // Simulate CPU-intensive hashing + Sleep(100 + Random(200)); // Variable processing time + Response := 'HASH: ' + IntToStr(Data.GetHashCode); + end; + 4: // COMPUTE + begin + // Simulate heavy computation + Sleep(500 + Random(1000)); // 0.5-1.5 seconds + Response := 'COMPUTED: ' + IntToStr(Random(1000000)); + end; + 5: // TIME + begin + Response := 'TIME: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', Now); + end; + else + Response := 'ERROR: Unknown command. Available: PING, ECHO , REVERSE , HASH , COMPUTE, TIME'; + end; + + // Add thread and timing information + ProcessingTime := StartTime.ElapsedMilliseconds; + Response := Response + #13#10 + Format('Thread: %d, Processing time: %dms', [ThreadID, ProcessingTime]); + + // Send response + ResponseBytes := TEncoding.UTF8.GetBytes(Response + #13#10); + FServer.Send(aLine, ResponseBytes); + + except + on E: Exception do + begin + Response := 'ERROR: ' + E.Message; + ResponseBytes := TEncoding.UTF8.GetBytes(Response + #13#10); + FServer.Send(aLine, ResponseBytes); + end; + end; +end; + +procedure TfrmMain.LogMessage(const aMessage: string); +begin + if memoLog.Lines.Count > 1000 then + memoLog.Clear; + + memoLog.Lines.Add(FormatDateTime('hh:nn:ss.zzz', Now) + ' - ' + aMessage); + + // Auto-scroll to bottom + SendMessage(memoLog.Handle, WM_VSCROLL, SB_BOTTOM, 0); +end; + +procedure TfrmMain.UpdateConnectionCount(aDelta: Integer); +begin + FConnectionCountLock.Acquire; + try + FConnectionCount := FConnectionCount + aDelta; + finally + FConnectionCountLock.Release; + end; +end; + +procedure TfrmMain.UpdateRequestCount; +begin + FRequestCountLock.Acquire; + try + Inc(FRequestCount); + finally + FRequestCountLock.Release; + end; +end; + +procedure TfrmMain.UpdateStatistics; +var + CurrentRequests: Integer; + RequestsPerSecond: Integer; +begin + // Update connection count + FConnectionCountLock.Acquire; + try + lblConnections.Caption := IntToStr(FConnectionCount); + finally + FConnectionCountLock.Release; + end; + + // Update request statistics + FRequestCountLock.Acquire; + try + CurrentRequests := FRequestCount; + lblTotalRequests.Caption := IntToStr(CurrentRequests); + + // Calculate requests per second + RequestsPerSecond := CurrentRequests - FLastRequestCount; + lblRequestsPerSecond.Caption := IntToStr(RequestsPerSecond); + FLastRequestCount := CurrentRequests; + finally + FRequestCountLock.Release; + end; + + // Detect test start (first time we see incoming requests) + if not FTestInProgress and (RequestsPerSecond > 0) then + begin + FTestInProgress := True; + FTestStartTime := Now; + FTestStartRequestCount := CurrentRequests - RequestsPerSecond; + FMaxRequestsPerSecond := RequestsPerSecond; + LogMessage('Test started - tracking performance...'); + end; + + // Track peak performance during test + if FTestInProgress and (RequestsPerSecond > FMaxRequestsPerSecond) then + begin + FMaxRequestsPerSecond := RequestsPerSecond; + end; + + // Detect test end (no requests for 2 seconds after test was active) + if FTestInProgress and (RequestsPerSecond = 0) then + begin + // Wait for a confirmation period (2 more timer ticks = 2 seconds) + if Timer1.Tag = 0 then + Timer1.Tag := GetTickCount; + + if (GetTickCount - Cardinal(Timer1.Tag)) >= 2000 then + begin + // Test ended - calculate final results + FTestInProgress := False; + Timer1.Tag := 0; + DisplayFinalTestResults(CurrentRequests); + LogMessage('Test completed - final results calculated'); + end; + end + else + begin + // Reset the end-test timer if we're still getting requests + Timer1.Tag := 0; + end; + + // Update active threads info - show thread pool threads (not connections) + var ThreadPoolThreads := FServer.GetThreadPoolThreadCount; + var ActiveProcessingThreads := FServer.GetThreadPoolActiveThreadCount; + var ConnectionCount := FServer.Lines.LockList.Count; + FServer.Lines.UnlockList; + + lblActiveThreads.Caption := Format('%d pool (%d active)', [ThreadPoolThreads, ActiveProcessingThreads]); +end; + +procedure TfrmMain.DisplayFinalTestResults(CurrentRequestCount: Integer); +var + TotalTestRequests: Integer; + TestDuration: Double; + AvgRequestsPerSecond: Double; +begin + TotalTestRequests := CurrentRequestCount - FTestStartRequestCount; + TestDuration := (Now - FTestStartTime) * 24 * 60 * 60; // Convert to seconds + + if TestDuration > 0 then + AvgRequestsPerSecond := TotalTestRequests / TestDuration + else + AvgRequestsPerSecond := 0; + + // Display final test results + lblTestTotalRequestsValue.Caption := Format('%d', [TotalTestRequests]); + lblTestPeakReqSecValue.Caption := Format('%d', [FMaxRequestsPerSecond]); + lblTestDurationValue.Caption := Format('%.1fs', [TestDuration]); + lblTestAvgReqSecValue.Caption := Format('%.1f', [AvgRequestsPerSecond]); + + LogMessage(Format('Final Results: %d requests, %.1fs duration, %d peak req/sec, %.1f avg req/sec', + [TotalTestRequests, TestDuration, FMaxRequestsPerSecond, AvgRequestsPerSecond])); +end; + +procedure TfrmMain.btnResetStatsClick(Sender: TObject); +begin + // Reset final test results display + lblTestTotalRequestsValue.Caption := '0'; + lblTestPeakReqSecValue.Caption := '0'; + lblTestDurationValue.Caption := '0s'; + lblTestAvgReqSecValue.Caption := '0'; + + // Reset internal tracking variables + FMaxRequestsPerSecond := 0; + FTestStartTime := 0; + FTestStartRequestCount := 0; + FTestInProgress := False; + Timer1.Tag := 0; + + LogMessage('Test statistics reset'); +end; + +end. \ No newline at end of file diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dpr b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dpr new file mode 100644 index 0000000..1d7548a --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dpr @@ -0,0 +1,14 @@ +program TCPServerComparison; + +uses + Vcl.Forms, + ufrmTCPServer in 'ufrmTCPServer.pas' {frmTCPServer}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TfrmTCPServer, frmTCPServer); + Application.Run; +end. \ No newline at end of file diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dproj b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dproj new file mode 100644 index 0000000..b23c98d --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dproj @@ -0,0 +1,1139 @@ + + + {252F2870-DA5D-4BFD-AFF0-496E121AFCC0} + TCPServerComparison.dpr + True + Debug + TCPServerComparison + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + TCPServerComparison + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + + MainSource + + +
frmTCPServer
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + TCPServerComparison.dpr + + + + True + True + True + True + True + True + True + False + + + + + TCPServerComparison.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + 12 + + + + + diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dproj.local b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.identcache b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.identcache new file mode 100644 index 0000000..11b7479 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.identcache differ diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.res b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.res new file mode 100644 index 0000000..169fc58 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_Benchmark/Server2/TCPServerComparison.res differ diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server2/ufrmTCPServer.dfm b/Demos/TCP/ncSocketsThd_Benchmark/Server2/ufrmTCPServer.dfm new file mode 100644 index 0000000..baed1f9 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server2/ufrmTCPServer.dfm @@ -0,0 +1,274 @@ +object frmTCPServer: TfrmTCPServer + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'NetCom7 TncTCPServer Demo - Raw Socket (No Thread Pool)' + ClientHeight = 600 + ClientWidth = 800 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object pnlTop: TPanel + Left = 0 + Top = 0 + Width = 800 + Height = 89 + Align = alTop + TabOrder = 0 + object lblPort: TLabel + Left = 16 + Top = 16 + Width = 24 + Height = 13 + Caption = 'Port:' + end + object btnStartStop: TButton + Left = 16 + Top = 48 + Width = 121 + Height = 25 + Caption = 'Start Server' + TabOrder = 0 + OnClick = btnStartStopClick + end + object edtPort: TEdit + Left = 46 + Top = 13 + Width = 91 + Height = 21 + TabOrder = 1 + Text = '8080' + end + end + object memoLog: TMemo + Left = 0 + Top = 89 + Width = 800 + Height = 320 + Align = alClient + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Consolas' + Font.Style = [] + ParentFont = False + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + end + object pnlStats: TPanel + Left = 0 + Top = 409 + Width = 800 + Height = 191 + Align = alBottom + TabOrder = 2 + object lblConnections: TLabel + Left = 16 + Top = 16 + Width = 63 + Height = 13 + Caption = 'Connections:' + end + object lblRequests: TLabel + Left = 16 + Top = 40 + Width = 76 + Height = 13 + Caption = 'Total Requests:' + end + object lblRequestsPerSec: TLabel + Left = 16 + Top = 64 + Width = 88 + Height = 13 + Caption = 'Requests/Second:' + end + object lblThreads: TLabel + Left = 16 + Top = 88 + Width = 76 + Height = 13 + Caption = 'Active Threads:' + end + object lblConnectionsValue: TLabel + Left = 120 + Top = 16 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clBlue + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblRequestsValue: TLabel + Left = 120 + Top = 40 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblRequestsPerSecValue: TLabel + Left = 120 + Top = 64 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblThreadsValue: TLabel + Left = 120 + Top = 88 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clRed + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblLastTestResults: TLabel + Left = 400 + Top = 16 + Width = 100 + Height = 13 + Caption = 'Last Test Results:' + Font.Charset = DEFAULT_CHARSET + Font.Color = clNavy + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestTotalRequests: TLabel + Left = 400 + Top = 40 + Width = 76 + Height = 13 + Caption = 'Total Requests:' + end + object lblTestTotalRequestsValue: TLabel + Left = 490 + Top = 40 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestPeakReqSec: TLabel + Left = 400 + Top = 64 + Width = 70 + Height = 13 + Caption = 'Peak Req/Sec:' + end + object lblTestPeakReqSecValue: TLabel + Left = 490 + Top = 64 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestDuration: TLabel + Left = 400 + Top = 88 + Width = 69 + Height = 13 + Caption = 'Test Duration:' + end + object lblTestDurationValue: TLabel + Left = 490 + Top = 88 + Width = 13 + Height = 13 + Caption = '0s' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblTestAvgReqSec: TLabel + Left = 400 + Top = 112 + Width = 66 + Height = 13 + Caption = 'Avg Req/Sec:' + end + object lblTestAvgReqSecValue: TLabel + Left = 490 + Top = 112 + Width = 7 + Height = 13 + Caption = '0' + Font.Charset = DEFAULT_CHARSET + Font.Color = clGreen + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object lblLog: TLabel + Left = 16 + Top = 152 + Width = 161 + Height = 13 + Caption = 'Raw Socket - No Thread Pool' + Font.Charset = DEFAULT_CHARSET + Font.Color = clMaroon + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object btnResetStats: TButton + Left = 400 + Top = 144 + Width = 75 + Height = 25 + Caption = 'Reset Stats' + TabOrder = 0 + OnClick = btnResetStatsClick + end + end + object tmrStats: TTimer + OnTimer = tmrStatsTimer + Left = 720 + Top = 48 + end +end diff --git a/Demos/TCP/ncSocketsThd_Benchmark/Server2/ufrmTCPServer.pas b/Demos/TCP/ncSocketsThd_Benchmark/Server2/ufrmTCPServer.pas new file mode 100644 index 0000000..eefbf7d --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/Server2/ufrmTCPServer.pas @@ -0,0 +1,352 @@ +unit ufrmTCPServer; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, System.Math, + System.Hash, System.DateUtils, System.Diagnostics, System.Types, System.SyncObjs, System.StrUtils, + ncSockets, ncLines; + +type + TfrmTCPServer = class(TForm) + pnlTop: TPanel; + btnStartStop: TButton; + edtPort: TEdit; + lblPort: TLabel; + memoLog: TMemo; + lblLog: TLabel; + pnlStats: TPanel; + lblConnections: TLabel; + lblRequests: TLabel; + lblRequestsPerSec: TLabel; + lblThreads: TLabel; + lblConnectionsValue: TLabel; + lblRequestsValue: TLabel; + lblRequestsPerSecValue: TLabel; + lblThreadsValue: TLabel; + lblLastTestResults: TLabel; + lblTestTotalRequests: TLabel; + lblTestTotalRequestsValue: TLabel; + lblTestPeakReqSec: TLabel; + lblTestPeakReqSecValue: TLabel; + lblTestDuration: TLabel; + lblTestDurationValue: TLabel; + lblTestAvgReqSec: TLabel; + lblTestAvgReqSecValue: TLabel; + btnResetStats: TButton; + tmrStats: TTimer; + procedure btnStartStopClick(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure tmrStatsTimer(Sender: TObject); + procedure btnResetStatsClick(Sender: TObject); + private + FServer: TncTCPServer; + FStartTime: TDateTime; + FRequestCount: Integer; + FLastRequestCount: Integer; + FMaxRequestsPerSecond: Integer; + FRequestCountLock: TCriticalSection; + FTestStartTime: TDateTime; + FTestStartRequestCount: Integer; + FTestInProgress: Boolean; + + procedure ServerConnected(Sender: TObject; aLine: TncLine); + procedure ServerDisconnected(Sender: TObject; aLine: TncLine); + procedure ServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); + procedure ProcessCommandDirectly(aLine: TncLine; const aCommand: string); + procedure LogMessage(const aMessage: string); + procedure IncrementRequestCount; + procedure DisplayFinalTestResults(CurrentRequestCount: Integer); + public + { Public declarations } + end; + +var + frmTCPServer: TfrmTCPServer; + +implementation + +{$R *.dfm} + +procedure TfrmTCPServer.FormCreate(Sender: TObject); +begin + FRequestCountLock := TCriticalSection.Create; + FRequestCount := 0; + FLastRequestCount := 0; + FMaxRequestsPerSecond := 0; + FStartTime := Now; + FTestStartTime := 0; + FTestStartRequestCount := 0; + FTestInProgress := False; + + // Create TncTCPServer (raw socket without any thread pool) + FServer := TncTCPServer.Create(Self); + FServer.Port := 8080; + FServer.EventsUseMainThread := False; // Process in reader thread - no thread pool + FServer.OnConnected := ServerConnected; + FServer.OnDisconnected := ServerDisconnected; + FServer.OnReadData := ServerReadData; + + edtPort.Text := '8080'; + + LogMessage('TncTCPServer Demo - RAW Socket (No Thread Pool)'); + LogMessage('All processing happens directly in reader thread'); + LogMessage('Ready to start server...'); +end; + +procedure TfrmTCPServer.FormDestroy(Sender: TObject); +begin + if Assigned(FServer) then + FServer.Active := False; + + FRequestCountLock.Free; +end; + +procedure TfrmTCPServer.btnStartStopClick(Sender: TObject); +begin + if not FServer.Active then + begin + // Start server + FServer.Port := StrToIntDef(edtPort.Text, 8080); + FServer.Active := True; + FStartTime := Now; + FRequestCount := 0; + FLastRequestCount := 0; + + btnStartStop.Caption := 'Stop Server'; + edtPort.Enabled := False; + tmrStats.Enabled := True; + + LogMessage(Format('Server started on port %d', [FServer.Port])); + LogMessage('Using TncTCPServer - RAW socket processing'); + end + else + begin + // Stop server + FServer.Active := False; + + btnStartStop.Caption := 'Start Server'; + edtPort.Enabled := True; + tmrStats.Enabled := False; + + LogMessage('Server stopped'); + end; +end; + +procedure TfrmTCPServer.ServerConnected(Sender: TObject; aLine: TncLine); +begin + LogMessage(Format('Client connected: %s', [aLine.PeerIP])); +end; + +procedure TfrmTCPServer.ServerDisconnected(Sender: TObject; aLine: TncLine); +begin + LogMessage(Format('Client disconnected: %s', [aLine.PeerIP])); +end; + +procedure TfrmTCPServer.ServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); +var + Command: string; +begin + // This runs directly in the reader thread - NO thread pool involved + try + Command := TEncoding.UTF8.GetString(aBuf, 0, aBufCount).Trim; + + // Process command directly in reader thread (this is the RAW approach) + ProcessCommandDirectly(aLine, Command); + except + on E: Exception do + LogMessage(Format('Error processing data: %s', [E.Message])); + end; +end; + +procedure TfrmTCPServer.ProcessCommandDirectly(aLine: TncLine; const aCommand: string); +var + Response: string; + ThreadID: Cardinal; +begin + // This runs directly in reader thread - no thread pool queuing + ThreadID := GetCurrentThreadId; + IncrementRequestCount; + + try + if aCommand = 'PING' then + begin + Response := 'PONG'; + end + else if aCommand = 'TIME' then + begin + Response := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now); + end + else if StartsText('ECHO:', aCommand) then + begin + Response := Copy(aCommand, 6, Length(aCommand)); + end + else if StartsText('REVERSE:', aCommand) then + begin + Response := ReverseString(Copy(aCommand, 9, Length(aCommand))); + end + else if StartsText('HASH:', aCommand) then + begin + Response := THashMD5.GetHashString(Copy(aCommand, 6, Length(aCommand))); + end + else if aCommand = 'COMPUTE' then + begin + // Simulate CPU-intensive work + Sleep(Random(1000) + 500); // 0.5-1.5 seconds + Response := Format('COMPUTED[%d]', [ThreadID]); + end + else + begin + Response := 'UNKNOWN_COMMAND'; + end; + + // Send response + Response := Response + Format('[T:%d]', [ThreadID]); + FServer.Send(aLine, TEncoding.UTF8.GetBytes(Response)); + + // Log approximately 1 in 7 requests to avoid spam + if (FRequestCount mod 7) = 0 then + LogMessage(Format('Processed: %s -> %s', [aCommand, Response])); + except + on E: Exception do + begin + LogMessage(Format('Error processing command "%s": %s', [aCommand, E.Message])); + try + FServer.Send(aLine, TEncoding.UTF8.GetBytes('ERROR: ' + E.Message)); + except + // Ignore send errors + end; + end; + end; +end; + +procedure TfrmTCPServer.LogMessage(const aMessage: string); +begin + if memoLog.Lines.Count > 1000 then + memoLog.Lines.Delete(0); + memoLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss', Now), aMessage])); +end; + +procedure TfrmTCPServer.IncrementRequestCount; +begin + FRequestCountLock.Acquire; + try + Inc(FRequestCount); + finally + FRequestCountLock.Release; + end; +end; + +procedure TfrmTCPServer.tmrStatsTimer(Sender: TObject); +var + CurrentRequestCount: Integer; + RequestsPerSecond: Integer; +begin + // Get current request count + FRequestCountLock.Acquire; + try + CurrentRequestCount := FRequestCount; + finally + FRequestCountLock.Release; + end; + + // Calculate requests per second (same method as thread pool demo) + RequestsPerSecond := CurrentRequestCount - FLastRequestCount; + FLastRequestCount := CurrentRequestCount; + + // Detect test start (first time we see incoming requests) + if not FTestInProgress and (RequestsPerSecond > 0) then + begin + FTestInProgress := True; + FTestStartTime := Now; + FTestStartRequestCount := CurrentRequestCount - RequestsPerSecond; + FMaxRequestsPerSecond := RequestsPerSecond; + LogMessage('Test started - tracking performance...'); + end; + + // Track peak performance during test + if FTestInProgress and (RequestsPerSecond > FMaxRequestsPerSecond) then + begin + FMaxRequestsPerSecond := RequestsPerSecond; + end; + + // Detect test end (no requests for 2 seconds after test was active) + if FTestInProgress and (RequestsPerSecond = 0) then + begin + // Wait for a confirmation period (2 more timer ticks = 2 seconds) + if tmrStats.Tag = 0 then + tmrStats.Tag := GetTickCount; + + if (GetTickCount - Cardinal(tmrStats.Tag)) >= 2000 then + begin + // Test ended - calculate final results + FTestInProgress := False; + tmrStats.Tag := 0; + DisplayFinalTestResults(CurrentRequestCount); + LogMessage('Test completed - final results calculated'); + end; + end + else + begin + // Reset the end-test timer if we're still getting requests + tmrStats.Tag := 0; + end; + + // Get connection count safely with thread-safe locking + var SocketList := FServer.Lines.LockList; + try + lblConnectionsValue.Caption := Format('%d', [SocketList.Count]); + finally + FServer.Lines.UnlockList; + end; + + lblRequestsValue.Caption := Format('%d', [CurrentRequestCount]); + lblRequestsPerSecValue.Caption := Format('%d', [RequestsPerSecond]); + lblThreadsValue.Caption := '1 (Reader Only)'; // No thread pool - just reader thread +end; + +procedure TfrmTCPServer.DisplayFinalTestResults(CurrentRequestCount: Integer); +var + TotalTestRequests: Integer; + TestDuration: Double; + AvgRequestsPerSecond: Double; +begin + TotalTestRequests := CurrentRequestCount - FTestStartRequestCount; + TestDuration := (Now - FTestStartTime) * 24 * 60 * 60; // Convert to seconds + + if TestDuration > 0 then + AvgRequestsPerSecond := TotalTestRequests / TestDuration + else + AvgRequestsPerSecond := 0; + + // Display final test results + lblTestTotalRequestsValue.Caption := Format('%d', [TotalTestRequests]); + lblTestPeakReqSecValue.Caption := Format('%d', [FMaxRequestsPerSecond]); + lblTestDurationValue.Caption := Format('%.1fs', [TestDuration]); + lblTestAvgReqSecValue.Caption := Format('%.1f', [AvgRequestsPerSecond]); + + LogMessage(Format('Final Results: %d requests, %.1fs duration, %d peak req/sec, %.1f avg req/sec', + [TotalTestRequests, TestDuration, FMaxRequestsPerSecond, AvgRequestsPerSecond])); +end; + +procedure TfrmTCPServer.btnResetStatsClick(Sender: TObject); +begin + // Reset final test results display + lblTestTotalRequestsValue.Caption := '0'; + lblTestPeakReqSecValue.Caption := '0'; + lblTestDurationValue.Caption := '0s'; + lblTestAvgReqSecValue.Caption := '0'; + + // Reset internal tracking variables + FMaxRequestsPerSecond := 0; + FTestStartTime := 0; + FTestStartRequestCount := 0; + FTestInProgress := False; + tmrStats.Tag := 0; + + LogMessage('Test statistics reset'); +end; + +end. \ No newline at end of file diff --git a/Demos/TCP/ncSocketsThd_Benchmark/ncSocketsThd_Benchmark.groupproj b/Demos/TCP/ncSocketsThd_Benchmark/ncSocketsThd_Benchmark.groupproj new file mode 100644 index 0000000..24ab1be --- /dev/null +++ b/Demos/TCP/ncSocketsThd_Benchmark/ncSocketsThd_Benchmark.groupproj @@ -0,0 +1,60 @@ + + + {344BDD54-D641-46CD-A8CE-D73D6EB92681} + + + + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Demos/TCP/ncSocketsThd_TLS/Client/Client.dpr b/Demos/TCP/ncSocketsThd_TLS/Client/Client.dpr new file mode 100644 index 0000000..aa89c08 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Client/Client.dpr @@ -0,0 +1,17 @@ +program Client; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/TCP/ncSocketsThd_TLS/Client/Client.dproj b/Demos/TCP/ncSocketsThd_TLS/Client/Client.dproj new file mode 100644 index 0000000..e682265 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Client/Client.dproj @@ -0,0 +1,236 @@ + + + {A7946007-4A7F-492A-BC3D-79264B590A5A} + Client.dpr + True + Release + Client + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + Client + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + $(BDS)\bin\delphi_PROJECTICON.ico + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + Client.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/TCP/ncSocketsThd_TLS/Client/Client.dproj.local b/Demos/TCP/ncSocketsThd_TLS/Client/Client.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Client/Client.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/ncSocketsThd_TLS/Client/Client.identcache b/Demos/TCP/ncSocketsThd_TLS/Client/Client.identcache new file mode 100644 index 0000000..6de9c7b Binary files /dev/null and b/Demos/TCP/ncSocketsThd_TLS/Client/Client.identcache differ diff --git a/Demos/TCP/ncSocketsThd_TLS/Client/Client.res b/Demos/TCP/ncSocketsThd_TLS/Client/Client.res new file mode 100644 index 0000000..cb6ea46 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_TLS/Client/Client.res differ diff --git a/Demos/TCP/ncSocketsThd_TLS/Client/ufrmMain.dfm b/Demos/TCP/ncSocketsThd_TLS/Client/ufrmMain.dfm new file mode 100644 index 0000000..88de4d4 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Client/ufrmMain.dfm @@ -0,0 +1,172 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + ActiveControl = edtDataToSend + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'TCPClient' + ClientHeight = 243 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 169 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start TCP Client' + TabOrder = 0 + OnClick = btnActivateClick + end + object pnlAddress: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtHost: TEdit + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 281 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + TextHint = 'Enter host address' + OnChange = edtHostChange + end + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 291 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 211 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object btnSendData: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send' + Default = True + TabOrder = 0 + OnClick = btnSendDataClick + end + object Panel2: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtDataToSend: TEdit + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 407 + Height = 21 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = 'This is some text data' + TextHint = 'Enter data to send here' + OnEnter = edtDataToSendEnter + OnExit = edtDataToSendExit + end + end + end + object ClientSocket: TncTCPClientThd + OnConnected = TCPClientConnected + OnDisconnected = TCPClientDisconnected + OnReadData = TCPClientReadData + Left = 160 + Top = 88 + end +end diff --git a/Demos/TCP/ncSocketsThd_TLS/Client/ufrmMain.pas b/Demos/TCP/ncSocketsThd_TLS/Client/ufrmMain.pas new file mode 100644 index 0000000..545cc2e --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Client/ufrmMain.pas @@ -0,0 +1,247 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, + System.Diagnostics, ncLines, ncSockets, ncSocketsThd; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pnlAddress: TPanel; + edtHost: TEdit; + edtPort: TSpinEdit; + Panel1: TPanel; + btnSendData: TButton; + Panel2: TPanel; + edtDataToSend: TEdit; + ClientSocket: TncTCPClientThd; + procedure btnActivateClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure TCPClientConnected(Sender: TObject; aLine: TncLine); + procedure TCPClientDisconnected(Sender: TObject; aLine: TncLine); + procedure TCPClientReconnected(Sender: TObject; aLine: TncLine); + procedure edtHostChange(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure btnSendDataClick(Sender: TObject); + procedure edtDataToSendEnter(Sender: TObject); + procedure edtDataToSendExit(Sender: TObject); + procedure TCPClientReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure FormCreate(Sender: TObject); + private + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + // Configure TLS settings for the client + ClientSocket.UseTLS := True; // Enable TLS encryption + ClientSocket.TlsProvider := tpSChannel; // Use Windows SChannel (Windows built-in TLS) + ClientSocket.IgnoreCertificateErrors := True; // For demo purposes with self-signed certificates + + // Set initial button caption + btnActivate.Caption := 'Start TLS Client'; + + Log('TLS Client configured with SChannel provider'); + Log('Note: Certificate errors are ignored for demo purposes'); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + ClientSocket.Active := False; + Log('TLS Client shutdown complete'); +end; + +// ***************************************************************************** +// Start/Stop Main CLient +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if ClientSocket.Active then + begin + // Deactivate the TCP client + ClientSocket.Active := False; + btnActivate.Caption := 'Start TLS Client'; + Log('TLS Client Deactivated'); + end + else + begin + // Check if the host field is blank + if Trim(edtHost.Text) = '' then + begin + Log('Host field cannot be blank.'); + Exit; // Exit the procedure if the host field is blank + end; + + try + // Set the host from the text field + ClientSocket.Host := edtHost.Text; + + // Activate the TCP client + ClientSocket.Port := edtPort.Value; + ClientSocket.Active := True; + btnActivate.Caption := 'Stop TLS Client'; + Log('TLS Client Activated - attempting secure connection...'); + except + on E: Exception do + Log('Failed to activate TLS Client: ' + E.Message); + end; + end; +end; + +// ***************************************************************************** +// Change host (server) +// ***************************************************************************** +procedure TForm1.edtHostChange(Sender: TObject); +begin + try + ClientSocket.Host := edtHost.Text; + except + edtHost.OnChange := nil; + try + edtHost.Text := ClientSocket.Host; + finally + edtHost.OnChange := edtHostChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Change Main Client port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + ClientSocket.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := ClientSocket.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Data to send +// ***************************************************************************** +procedure TForm1.edtDataToSendEnter(Sender: TObject); +begin + btnSendData.Default := True; +end; + +procedure TForm1.edtDataToSendExit(Sender: TObject); +begin + btnSendData.Default := False; +end; + +procedure TForm1.btnSendDataClick(Sender: TObject); +begin + // Check if the data field is blank + if Trim(edtDataToSend.Text) = '' then + begin + Log('Cannot send - Data field cannot be blank.'); + Exit; // Exit the procedure if the data field is blank + end; + + try + // Send the data + ClientSocket.Send(edtDataToSend.Text); + Log('Data sent via TLS: ' + edtDataToSend.Text); + except + on E: Exception do + Log('Failed to send data via TLS: ' + E.Message); + end; +end; + +// ***************************************************************************** +// TCPClientConnected +// ***************************************************************************** +procedure TForm1.TCPClientConnected(Sender: TObject; aLine: TncLine); +begin + if ClientSocket.UseTLS then + Log('Connected with TLS encryption (SChannel)') + else + Log('Connected without encryption'); + btnActivate.Caption := 'Deactivate'; +end; + +// ***************************************************************************** +// TCPClientDisconnected +// ***************************************************************************** +procedure TForm1.TCPClientDisconnected(Sender: TObject; aLine: TncLine); +begin + Log('TLS Connection Disconnected'); + btnActivate.Caption := 'Start TLS Client'; +end; + +// ***************************************************************************** +// TCPClientReconnected +// ***************************************************************************** +procedure TForm1.TCPClientReconnected(Sender: TObject; aLine: TncLine); +begin + Log('TLS Connection Reconnected'); +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.TCPClientReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + BytesReceived: TBytes; +begin + BytesReceived := Copy(aBuf, 0, aBufCount); + + Log('Received via TLS: ' + StringOf(BytesReceived)); + +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/Server.dpr b/Demos/TCP/ncSocketsThd_TLS/Server/Server.dpr new file mode 100644 index 0000000..63d6f38 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Server/Server.dpr @@ -0,0 +1,17 @@ +program Server; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/Server.dproj b/Demos/TCP/ncSocketsThd_TLS/Server/Server.dproj new file mode 100644 index 0000000..65e5b01 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Server/Server.dproj @@ -0,0 +1,236 @@ + + + {0B2EB3CC-F54E-41A8-A712-8771BC0FC4AD} + Server.dpr + True + Release + Server + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + Server + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + true + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + $(BDS)\bin\delphi_PROJECTICON.ico + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + Server.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/Server.dproj.local b/Demos/TCP/ncSocketsThd_TLS/Server/Server.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Server/Server.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/Server.identcache b/Demos/TCP/ncSocketsThd_TLS/Server/Server.identcache new file mode 100644 index 0000000..090a4c4 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_TLS/Server/Server.identcache differ diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/Server.res b/Demos/TCP/ncSocketsThd_TLS/Server/Server.res new file mode 100644 index 0000000..9f173a9 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_TLS/Server/Server.res differ diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/server.key b/Demos/TCP/ncSocketsThd_TLS/Server/server.key new file mode 100644 index 0000000..be9053f --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Server/server.key @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIIEvQIBADANBgkqhkiG9w0BAQEFAASCBKcwggSjAgEAAoIBAQCZF6wX9HCEqm0K +yByBjMqIzbN9dpOc9kX5tJSMF2TLuSFxjQqL8qiTJsY5lFevpZ6OvA7kI+X5u5AV +Fu15Epl9GSdSuYxVYj33NGWTyLUEb4ctwF5ado86D+ezQP8Dnlg5bhPPimhBQTpv +/Fl/FptrcyzzYEBWCyeSbzy8hPQLEomJc8A5OX7l+wm5dhFM6tWTHRR0gV1ZXIIk +1nQgXdF+HcUeamHY2+xpF0wLdCSTTj/em21blPmEE7JtmxYuAXFqo3H9YPlTNwJv +6Ztsl59XRJFOFiWm8PINB23oDwDI+yTqXbzSRIX0BpZs3B/TSSneVjKOFZVxYdnM +lr1UMeefAgMBAAECggEANbCfoicP7vb2FvnnRWfi/+dkM3QKgNm94Lz7+8WYi/n5 +SKF2OW54wGKw0jC8L9WdreE2N7x/Qv4ModjQn81uFvljWRfJp4g0wyWVGichlNSo +S9tTO9aolGxPjgYVaWd2+W0pdXfM6FW/8NZHbNK43w4djZ0L8yEmV6y7WEIodFkY +8jDmU3OBjdJ0/bdh5zQe/g+IY2RF6+JIYUM4qsxWiWWvtLXIL5npVo0oMOAlNI+/ +iR6i3fXrvR3HvHBK9n/aLeXg4Qei2buNVSbVhM7zOjf1ziDypb7/VGJLf/Kkv8wB +qrHTNa5d8N6JsmDNRNhtw01TmezHFMrGmEDrMQBXwQKBgQDPOwqPBUAD4/1rAp9/ +QvZQAiU443E+20I9eQlewCNc+/vbNHF9N8lqNm03LR0o/JIHCbU+w+POFXqyvoRG +3Zj3j3lfpR3kO8ED3qy2o3LRi3/Rdu10XyAC6DCTc5HDtY26SGiM4LMSiYJKcxyT +AA0BPi7RuaEEdAByFnTfUwbFzQKBgQC9Hvx6T2YLWAWbrsUcKwkJPWdYjI5HH3hn +vTnFSsmLKpV4olwDT4R2yYlk0Wpt29Nu0ePSI5QxAwfKuwdmt701LkyRsErhZS29 +gzOvo2cCRB1R59Xnpj/nLQTVQw5tnHaT/fb+I6C8lIZRT8vZv9Xs+PUijbONf0aL +8ZIw2ew3GwKBgQCEY2efbu8yjRh8oLRcjN7mxjgZW9QhH9n1g7mkuoLdCG4h4CMQ +p+8Y16R2N3AFmzV/IYiUjHigU8CLKINA8piirxoPLGEoSbRJUJxuIYVcsQ37N0sD +qTG+Ka++w3o/2WCtvUxtk69TDF4cSeXbU5D7Vkp62WgwfBs8x3PqqBQPkQKBgEM/ +qXe0lAykmBnr45tIkkX+16jdEhqoTiBVYR2OomwiEFR9J0rmE6xJrdlzveyipmRZ +rjEjBacH9NVZ/B/CZj1q4T9M+NN9Lu6coNxrtk1P+z0MuztMGp0RnQ5YceD4KhIl +1JY6BQYJqllvjoU3edJyFHjc+mPuRh+tHtbQJvbRAoGAR1T9fGCYn+uDwBq2B9Jt +wMMXDD6homo+OiqEALAjUt2dOxCDH84IhGnSYP27M/pAwsMI416oskPXXEPV4nB+ +GNxbI9eKnAwiWkktbY610j6pSmHu1T0Z1GBm5HnXYrtFUHi9k+1LU/iuj2mouNus +XpqwE8eeQQeaqJP7BmuwJXk= +-----END PRIVATE KEY----- diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/server.pfx b/Demos/TCP/ncSocketsThd_TLS/Server/server.pfx new file mode 100644 index 0000000..0b1ad11 Binary files /dev/null and b/Demos/TCP/ncSocketsThd_TLS/Server/server.pfx differ diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/ufrmMain.dfm b/Demos/TCP/ncSocketsThd_TLS/Server/ufrmMain.dfm new file mode 100644 index 0000000..730387d --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Server/ufrmMain.dfm @@ -0,0 +1,122 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'TCPServer' + ClientHeight = 243 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 182 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Activate' + TabOrder = 0 + OnClick = btnActivateClick + end + object pblPort: TPanel + AlignWithMargins = True + Left = 115 + Top = 3 + Width = 412 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 0 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 16233 + OnChange = edtPortChange + end + object btnShutdownAllClients: TButton + AlignWithMargins = True + Left = 256 + Top = 5 + Width = 151 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + Caption = 'Shutdown all clients' + TabOrder = 1 + OnClick = btnShutdownAllClientsClick + end + end + end + object StatusBar1: TStatusBar + Left = 0 + Top = 224 + Width = 527 + Height = 19 + Panels = < + item + Text = 'Connections: 0' + Width = 150 + end> + end + object ServerSocket: TncTCPServerThd + OnConnected = TCPServerConnected + OnDisconnected = TCPServerDisconnected + OnReadData = TCPServerReadData + Left = 216 + Top = 80 + end +end diff --git a/Demos/TCP/ncSocketsThd_TLS/Server/ufrmMain.pas b/Demos/TCP/ncSocketsThd_TLS/Server/ufrmMain.pas new file mode 100644 index 0000000..0e66f84 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/Server/ufrmMain.pas @@ -0,0 +1,294 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, Vcl.ComCtrls, + System.Diagnostics, ncLines, ncSocketList, ncSockets, ncSocketsThd; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pblPort: TPanel; + edtPort: TSpinEdit; + btnShutdownAllClients: TButton; + StatusBar1: TStatusBar; + ServerSocket: TncTCPServerThd; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure TCPServerConnected(Sender: TObject; aLine: TncLine); + procedure TCPServerDisconnected(Sender: TObject; aLine: TncLine); + procedure btnActivateClick(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure btnShutdownAllClientsClick(Sender: TObject); + procedure TCPServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + private + FConnectionCount: Integer; + procedure UpdateConnectionCount; + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +function FileSize(const AFilename: string): Int64; +var + FileStream: TFileStream; +begin + Result := 0; + if FileExists(AFilename) then + try + FileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyNone); + try + Result := FileStream.Size; + finally + FileStream.Free; + end; + except + Result := 0; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +var + CertPath: string; +begin + FConnectionCount := 0; + UpdateConnectionCount; + + // Configure TLS settings for the server + ServerSocket.UseTLS := True; // Enable TLS encryption + ServerSocket.TlsProvider := tpSChannel; // Use Windows SChannel (Windows built-in TLS) + + // Verify certificate file exists + CertPath := ExtractFilePath(Application.ExeName) + 'server.pfx'; + if FileExists(CertPath) then + begin + ServerSocket.CertificateFile := CertPath; // Certificate file path + ServerSocket.PrivateKeyPassword := 'test'; // Certificate password + ServerSocket.IgnoreCertificateErrors := True; // For demo purposes + + Log('Certificate file found: ' + CertPath); + Log('Certificate file size: ' + IntToStr(FileSize(CertPath)) + ' bytes'); + end + else + begin + Log('ERROR: Certificate file not found: ' + CertPath); + Log('Please ensure server.pfx is in the same directory as the executable'); + // Still configure TLS but it will fail + ServerSocket.CertificateFile := CertPath; + ServerSocket.PrivateKeyPassword := 'test'; + ServerSocket.IgnoreCertificateErrors := False; + end; + + // Set initial button caption + btnActivate.Caption := 'Start TLS Server'; + + Log('TLS Server configured with SChannel provider'); + Log('Note: Certificate errors are ignored for demo purposes'); +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + ServerSocket.Active := False; + Log('TLS Server shutdown complete'); +end; + +// ***************************************************************************** +// Start/Stop Main Server +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if ServerSocket.Active then + begin + // Deactivate the TCP Server + ServerSocket.Active := False; + btnActivate.Caption := 'Start TLS Server'; + Log('TLS Server Deactivated'); + end + else + begin + try + // Validate TLS configuration before starting + if not FileExists(ServerSocket.CertificateFile) then + begin + Log('ERROR: Certificate file not found: ' + ServerSocket.CertificateFile); + Log('Cannot start TLS server without valid certificate'); + Exit; + end; + + Log('Starting TLS server with configuration:'); + Log(' UseTLS: ' + BoolToStr(ServerSocket.UseTLS, True)); + Log(' TlsProvider: ' + IntToStr(Ord(ServerSocket.TlsProvider))); + Log(' Certificate: ' + ServerSocket.CertificateFile); + Log(' IgnoreCertErrors: ' + BoolToStr(ServerSocket.IgnoreCertificateErrors, True)); + + // Activate the TCP Server + ServerSocket.Port := edtPort.Value; + ServerSocket.Active := True; + btnActivate.Caption := 'Stop TLS Server'; + Log('TLS Server Activated at port: ' + IntToStr(ServerSocket.Port)); + Log('Server ready to accept TLS connections'); + + except + on E: Exception do + begin + Log('Failed to activate TLS Server: ' + E.Message); + Log('Exception class: ' + E.ClassName); + end; + end; + end; +end; + +// ***************************************************************************** +// Change Main Client port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + ServerSocket.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := ServerSocket.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Shutdown all Clients +// ***************************************************************************** +procedure TForm1.btnShutdownAllClientsClick(Sender: TObject); +var + SocketList: TSocketList; + i: Integer; +begin + SocketList := ServerSocket.Lines.LockList; + try + Log('Shutting down all TLS clients...'); + for i := 0 to SocketList.Count - 1 do + ServerSocket.ShutDownLine(SocketList.Lines[i]); + Log('All TLS clients shutdown requested'); + finally + ServerSocket.Lines.UnlockList; + end; +end; + +procedure TForm1.UpdateConnectionCount; +begin + StatusBar1.Panels[0].Text := 'TLS Connections: ' + IntToStr(FConnectionCount); +end; + +// ***************************************************************************** +// TCPServerConnected +// ***************************************************************************** +procedure TForm1.TCPServerConnected(Sender: TObject; aLine: TncLine); +begin + Inc(FConnectionCount); + UpdateConnectionCount; + + Log('TLS Client Connected: ' + aLine.PeerIP + ' (Handle: ' + IntToStr(aLine.Handle) + ')'); + Log('Starting TLS handshake...'); + + try + // Send welcome message + ServerSocket.Send(aLine, BytesOf('Hello mr. ' + IntToStr(aLine.Handle) + ' - TLS connection established')); + Log('Welcome message sent to: ' + aLine.PeerIP); + Log('TLS handshake completed successfully'); + except + on E: Exception do + begin + Log('ERROR during TLS handshake with ' + aLine.PeerIP + ': ' + E.Message); + Log('Exception class: ' + E.ClassName); + // Don't re-raise - let the connection continue to see what happens + end; + end; +end; + +// ***************************************************************************** +// TCPServerDisconnected +// ***************************************************************************** +procedure TForm1.TCPServerDisconnected(Sender: TObject; aLine: TncLine); +begin + Dec(FConnectionCount); + UpdateConnectionCount; + + Log('TLS Client Disconnected: ' + aLine.PeerIP + ' (Handle: ' + IntToStr(aLine.Handle) + ')'); + Log('Connection duration: Client was connected'); + +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.TCPServerReadData(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + BytesReceived: TBytes; + ReceivedText: string; +begin + try + BytesReceived := Copy(aBuf, 0, aBufCount); + + // Convert bytes to string using proper UTF-8 decoding + ReceivedText := TEncoding.UTF8.GetString(BytesReceived); + + Log('Received via TLS: "' + ReceivedText + '" from: ' + aLine.PeerIP + ' (Handle: ' + IntToStr(aLine.Handle) + ')'); + + // Send back the buffer received + ServerSocket.Send(aLine, BytesReceived); + + Log('Data sent via TLS: ' + ReceivedText + ' to: ' + aLine.PeerIP); + except + on E: Exception do + begin + Log('ERROR in TLS data handling with ' + aLine.PeerIP + ': ' + E.Message); + Log('Exception class: ' + E.ClassName); + end; + end; +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/TCP/ncSocketsThd_TLS/SimpleThreadedSockets_TLS.groupproj b/Demos/TCP/ncSocketsThd_TLS/SimpleThreadedSockets_TLS.groupproj new file mode 100644 index 0000000..3122a45 --- /dev/null +++ b/Demos/TCP/ncSocketsThd_TLS/SimpleThreadedSockets_TLS.groupproj @@ -0,0 +1,48 @@ + + + {A9A55D39-6A58-48E9-AA5F-4DED5B38E8A8} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Demos/UDP/ncUDPSockets/Client/Client.dpr b/Demos/UDP/ncUDPSockets/Client/Client.dpr new file mode 100644 index 0000000..aa89c08 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Client/Client.dpr @@ -0,0 +1,17 @@ +program Client; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/Demos/UDP/ncUDPSockets/Client/Client.dproj b/Demos/UDP/ncUDPSockets/Client/Client.dproj new file mode 100644 index 0000000..2a5f98a --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Client/Client.dproj @@ -0,0 +1,1165 @@ + + + {2F2F33BE-2A99-4B2A-A206-E1E4DE8915A3} + 20.2 + Client.dpr + Release + DCC32 + VCL + True + Win64 + 3 + Application + Client + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + Client.exe + off + vclx;vcl;vclimg;dbrtl;Rave77VCL;bdertl;rtl;vclactnband;xmlrtl;vcldb;vcldbx;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dclOfficeXP;$(DCC_UsePackage) + $(BDSCOMMONDIR)\DCP + $(BDSCOMMONDIR)\DCU + x86 + 00400000 + Client + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + true + 1032 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + + + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\delphi_PROJECTICON.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\default_app.manifest + $(BDS)\bin\delphi_PROJECTICON.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + DEBUG;$(DCC_Define) + + + Debug + + + true + PerMonitorV2 + + + true + PerMonitorV2 + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + + Delphi.Personality.12 + + + + + Client.dpr + + + False + True + False + + + True + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1032 + 1253 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + + + + False + True + True + + + + + Client.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + 12 + + + + diff --git a/Demos/UDP/ncUDPSockets/Client/Client.dproj.local b/Demos/UDP/ncUDPSockets/Client/Client.dproj.local new file mode 100644 index 0000000..8b0113d --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Client/Client.dproj.local @@ -0,0 +1,11 @@ + + + + + + + 2025/01/14 21:49:41.000.186,=D:\_Delphi\_Library\Netcom7\Demos\SimpleSockets_UDP\Client\Unit1.pas + 2025/01/14 21:49:56.000.966,D:\_Delphi\_Library\Netcom7\Demos\SimpleSockets_UDP\Client\uMainClient.pas=D:\_Delphi\_Library\Netcom7\Demos\SimpleSockets_UDP\Client\Unit1.pas + 2025/01/16 20:06:27.000.079,D:\_Delphi\_Library\NetCom7\Demos\SimpleSockets_UDP_v2\Client\uMainClient.pas= + + diff --git a/Demos/SimpleSockets/Client.dsk b/Demos/UDP/ncUDPSockets/Client/Client.dsk similarity index 94% rename from Demos/SimpleSockets/Client.dsk rename to Demos/UDP/ncUDPSockets/Client/Client.dsk index 50e13fa..38e48cb 100644 --- a/Demos/SimpleSockets/Client.dsk +++ b/Demos/UDP/ncUDPSockets/Client/Client.dsk @@ -1,769 +1,769 @@ -[Closed Files] -File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.Forms.pas',0,1,1,6,10,0,0,{{1755,4} -File_1=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas',0,1,9,1,59,0,0,, -File_2=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPIHelpers.pas',0,1,1,1,5,0,0,,{1 -File_3=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncThreads.pas',0,1,88,13,95,0,0,, -File_4=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPI.pas',0,1,1,1,1,0,0,,{1 -File_5=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectX9\uD3DX9.pas',0,1,5404,1,5435,0,0,, -File_6=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectX9\uDirect3D9.pas',0,1,3093,1,3112,0,0,, -File_7=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpTypes.pas',0,1,404,1,417,0,0,, -File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDirectPanel.pas',0,1,2514,5,2533,0,0,,{1 -File_9=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\Forms.pas',0,1,9739,51,9749,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dproj -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas] -ModuleType=TSourceModule - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dproj] -ModuleType=TBaseProject - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dpr -CursorX=11 -CursorY=12 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas -CursorX=35 -CursorY=130 -TopLine=118 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=1 -Breakpoint0='C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncSources.pas',973,'',0,1,'',1,0,0,'',1,'','','',0,'' - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[PropInspDesignerSelection] -ArrangeBy=Name -SelectedItem=Action, -ExpandedItems=LiveBindings=0,"LiveBindings Designer=0",Margins=0,ActiveControl=0,Anchors=0,BorderIcons=0 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-318 -Top=-363 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.Forms.pas',0,1,1,6,10,0,0,{{1755,4} +File_1=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas',0,1,9,1,59,0,0,, +File_2=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPIHelpers.pas',0,1,1,1,5,0,0,,{1 +File_3=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncThreads.pas',0,1,88,13,95,0,0,, +File_4=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPI.pas',0,1,1,1,1,0,0,,{1 +File_5=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectX9\uD3DX9.pas',0,1,5404,1,5435,0,0,, +File_6=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectX9\uDirect3D9.pas',0,1,3093,1,3112,0,0,, +File_7=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpTypes.pas',0,1,404,1,417,0,0,, +File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDirectPanel.pas',0,1,2514,5,2533,0,0,,{1 +File_9=TSourceModule,'c:\program files (x86)\embarcadero\rad studio\7.0\SOURCE\WIN32\VCL\Forms.pas',0,1,9739,51,9749,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dproj +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas] +ModuleType=TSourceModule + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dproj] +ModuleType=TBaseProject + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dpr +CursorX=11 +CursorY=12 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas +CursorX=35 +CursorY=130 +TopLine=118 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=1 +Breakpoint0='C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncSources.pas',973,'',0,1,'',1,0,0,'',1,'','','',0,'' + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[PropInspDesignerSelection] +ArrangeBy=Name +SelectedItem=Action, +ExpandedItems=LiveBindings=0,"LiveBindings Designer=0",Margins=0,ActiveControl=0,Anchors=0,BorderIcons=0 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-318 +Top=-363 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/UDP/ncUDPSockets/Client/Client.identcache b/Demos/UDP/ncUDPSockets/Client/Client.identcache new file mode 100644 index 0000000..732fa09 Binary files /dev/null and b/Demos/UDP/ncUDPSockets/Client/Client.identcache differ diff --git a/Demos/UDP/ncUDPSockets/Client/Client.res b/Demos/UDP/ncUDPSockets/Client/Client.res new file mode 100644 index 0000000..d4b6e46 Binary files /dev/null and b/Demos/UDP/ncUDPSockets/Client/Client.res differ diff --git a/Demos/SimpleSockets/Client.skincfg b/Demos/UDP/ncUDPSockets/Client/Client.skincfg similarity index 94% rename from Demos/SimpleSockets/Client.skincfg rename to Demos/UDP/ncUDPSockets/Client/Client.skincfg index 9e7a05b..0f00ce7 100644 --- a/Demos/SimpleSockets/Client.skincfg +++ b/Demos/UDP/ncUDPSockets/Client/Client.skincfg @@ -1,33 +1,33 @@ -[ExpressSkins] -Default=1 -ShowNotifications=1 -Enabled=1 -dxSkinBlack=1 -dxSkinBlue=0 -dxSkinCaramel=0 -dxSkinCoffee=0 -dxSkinDarkRoom=0 -dxSkinDarkSide=1 -dxSkinFoggy=0 -dxSkinGlassOceans=0 -dxSkiniMaginary=0 -dxSkinLilian=0 -dxSkinLiquidSky=0 -dxSkinLondonLiquidSky=0 -dxSkinMcSkin=0 -dxSkinMoneyTwins=0 -dxSkinOffice2007Black=1 -dxSkinOffice2007Blue=0 -dxSkinOffice2007Green=0 -dxSkinOffice2007Pink=0 -dxSkinOffice2007Silver=1 -dxSkinPumpkin=0 -dxSkinSeven=0 -dxSkinSharp=0 -dxSkinSilver=0 -dxSkinSpringTime=0 -dxSkinStardust=0 -dxSkinSummer2008=0 -dxSkinsDefaultPainters=0 -dxSkinValentine=0 -dxSkinXmas2008Blue=0 +[ExpressSkins] +Default=1 +ShowNotifications=1 +Enabled=1 +dxSkinBlack=1 +dxSkinBlue=0 +dxSkinCaramel=0 +dxSkinCoffee=0 +dxSkinDarkRoom=0 +dxSkinDarkSide=1 +dxSkinFoggy=0 +dxSkinGlassOceans=0 +dxSkiniMaginary=0 +dxSkinLilian=0 +dxSkinLiquidSky=0 +dxSkinLondonLiquidSky=0 +dxSkinMcSkin=0 +dxSkinMoneyTwins=0 +dxSkinOffice2007Black=1 +dxSkinOffice2007Blue=0 +dxSkinOffice2007Green=0 +dxSkinOffice2007Pink=0 +dxSkinOffice2007Silver=1 +dxSkinPumpkin=0 +dxSkinSeven=0 +dxSkinSharp=0 +dxSkinSilver=0 +dxSkinSpringTime=0 +dxSkinStardust=0 +dxSkinSummer2008=0 +dxSkinsDefaultPainters=0 +dxSkinValentine=0 +dxSkinXmas2008Blue=0 diff --git a/Demos/SimpleSockets/Client_Icon.ico b/Demos/UDP/ncUDPSockets/Client/Client_Icon.ico similarity index 100% rename from Demos/SimpleSockets/Client_Icon.ico rename to Demos/UDP/ncUDPSockets/Client/Client_Icon.ico diff --git a/Demos/UDP/ncUDPSockets/Client/ufrmMain.dfm b/Demos/UDP/ncUDPSockets/Client/ufrmMain.dfm new file mode 100644 index 0000000..7c429a6 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Client/ufrmMain.dfm @@ -0,0 +1,171 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + ActiveControl = edtDataToSend + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'UDPClient' + ClientHeight = 243 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 169 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start UDP Client' + TabOrder = 0 + OnClick = btnActivateClick + end + object pnlAddress: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtHost: TEdit + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 281 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + TextHint = 'Enter host address' + OnChange = edtHostChange + end + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 291 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 211 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object btnSendData: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send' + Default = True + TabOrder = 0 + OnClick = btnSendDataClick + end + object Panel2: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtDataToSend: TEdit + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 407 + Height = 21 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = 'This is some text data' + TextHint = 'Enter data to send here' + OnEnter = edtDataToSendEnter + OnExit = edtDataToSendExit + end + end + end + object UDPClient: TncUDPClient + Broadcast = True + OnReadDatagram = UDPClientReadDatagram + Left = 216 + Top = 96 + end +end diff --git a/Demos/UDP/ncUDPSockets/Client/ufrmMain.pas b/Demos/UDP/ncUDPSockets/Client/ufrmMain.pas new file mode 100644 index 0000000..64a8645 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Client/ufrmMain.pas @@ -0,0 +1,225 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, + System.Diagnostics, ncLines, ncUDPSockets, ncIPUtils; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pnlAddress: TPanel; + edtHost: TEdit; + edtPort: TSpinEdit; + Panel1: TPanel; + btnSendData: TButton; + Panel2: TPanel; + edtDataToSend: TEdit; + UDPClient: TncUDPClient; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnActivateClick(Sender: TObject); + procedure edtHostChange(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure edtDataToSendEnter(Sender: TObject); + procedure edtDataToSendExit(Sender: TObject); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure btnSendDataClick(Sender: TObject); + procedure UDPClientReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; + const SenderAddr: TSockAddrStorage); + + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + // +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + UDPClient.Active := False; +end; + +// ***************************************************************************** +// Start/Stop Main CLient +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if UDPClient.Active then + begin + // Deactivate the UDP client + UDPClient.Active := False; + btnActivate.Caption := 'Start UDP Client'; + Log('UDP Client Deactivated'); + end + else + begin + // Check if the host field is blank + if Trim(edtHost.Text) = '' then + begin + Log('Host field cannot be blank.'); + Exit; // Exit the procedure if the host field is blank + end; + + try + // Set the host from the text field + UDPClient.Host := edtHost.Text; + + // Activate the UDP client + UDPClient.Active := True; + btnActivate.Caption := 'Stop UDP Client'; + Log('UDP Client Activated'); + except + on E: Exception do + Log('Failed to activate UDP Client: ' + E.Message); + end; + end; +end; + +// ***************************************************************************** +// Change host (server) +// ***************************************************************************** +procedure TForm1.edtHostChange(Sender: TObject); +begin + try + UDPClient.Host := edtHost.Text; + except + edtHost.OnChange := nil; + try + edtHost.Text := UDPClient.Host; + finally + edtHost.OnChange := edtHostChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Change Main Client port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + UDPClient.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := UDPClient.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// Data to send +// ***************************************************************************** +procedure TForm1.edtDataToSendEnter(Sender: TObject); +begin + btnSendData.Default := True; +end; + +procedure TForm1.edtDataToSendExit(Sender: TObject); +begin + btnSendData.Default := False; +end; + +procedure TForm1.btnSendDataClick(Sender: TObject); +begin + try + // Ensure the client is active + if not UDPClient.Active then + begin + Log('Cannot send - client not active'); + Exit; + end; + + // Ensure the input field is not empty + if Trim(edtDataToSend.Text) = '' then + begin + Log('Cannot send - Data field cannot be blank.'); + Exit; + end; + + // Send the data if all conditions are met + UDPClient.Send(edtDataToSend.Text); + Log(Format('Data sent: %s', [edtDataToSend.Text])); + except + on E: Exception do + Log('Error sending: ' + E.Message); + end; +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.UDPClientReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; const SenderAddr: TSockAddrStorage); +var + ReceivedData: string; + BytesReceived: TBytes; + SenderIP: string; +begin + // Convert received data to string + ReceivedData := StringOf(Copy(aBuf, 0, aBufCount)); + + // Get sender IP address using our utils + try + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + except + on E: EIPError do + SenderIP := Format('Invalid Address: %s', [E.Message]); + end; + + Form1.Log(Format('Received from %s: %s', [SenderIP, ReceivedData])); +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; +Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/SimpleSockets/Srv/Server.dpr b/Demos/UDP/ncUDPSockets/Server/Server.dpr similarity index 80% rename from Demos/SimpleSockets/Srv/Server.dpr rename to Demos/UDP/ncUDPSockets/Server/Server.dpr index 2ea1536..5062c31 100644 --- a/Demos/SimpleSockets/Srv/Server.dpr +++ b/Demos/UDP/ncUDPSockets/Server/Server.dpr @@ -1,17 +1,19 @@ -program Server; - -uses - Vcl.Forms, - ufrmMain in 'ufrmMain.pas' {frmMain}; - -{$R *.res} - -begin - {$IFDEF DEBUG} - ReportMemoryLeaksOnShutdown := True; - {$ENDIF} - Application.Initialize; - Application.MainFormOnTaskbar := True; - Application.CreateForm(TfrmMain, frmMain); - Application.Run; -end. +program Server; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {frmMain}; + +{$R *.res} + +begin + {$IFDEF DEBUG} + ReportMemoryLeaksOnShutdown := True; + {$ENDIF} + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + + diff --git a/Demos/UDP/ncUDPSockets/Server/Server.dproj b/Demos/UDP/ncUDPSockets/Server/Server.dproj new file mode 100644 index 0000000..5dca099 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Server/Server.dproj @@ -0,0 +1,1170 @@ + + + {B76A70BC-BC2B-42B3-990D-FEC6939EAFD9} + 20.2 + Server.dpr + Release + DCC32 + VCL + True + Win64 + 3 + Application + Server + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + Server.exe + off + vclx;vcl;vclimg;dbrtl;Rave77VCL;bdertl;rtl;vclactnband;xmlrtl;vcldb;vcldbx;vcltouch;dsnap;dsnapcon;TeeUI;TeeDB;Tee;vclib;ibxpress;adortl;IndyCore;IndySystem;IndyProtocols;inet;intrawebdb_100_140;Intraweb_100_140;VclSmp;vclie;websnap;webdsnap;inetdb;inetdbbde;inetdbxpress;soaprtl;vclribbon;dbexpress;DbxCommonDriver;DataSnapIndy10ServerTransport;DataSnapProviderClient;DbxClientDriver;DataSnapServer;DBXInterBaseDriver;DBXMySQLDriver;dbxcds;DBXFirebirdDriver;DBXSybaseASEDriver;DBXSybaseASADriver;DBXOracleDriver;DBXMSSQLDriver;DBXInformixDriver;DBXDb2Driver;dclOfficeXP;$(DCC_UsePackage) + $(BDSCOMMONDIR)\DCP + $(BDSCOMMONDIR)\DCU + x86 + 00400000 + Server + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + true + 1032 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + EUREKALOG;$(DCC_Define) + 3 + true + + + android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + + + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\delphi_PROJECTICON.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\default_app.manifest + $(BDS)\bin\delphi_PROJECTICON.ico + true + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + true + PerMonitorV2 + + + true + PerMonitorV2 + 1033 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + $(BDS)\bin\delphi_PROJECTICON.ico + + + false + DEBUG;$(DCC_Define) + + + Debug + + + true + PerMonitorV2 + + + true + PerMonitorV2 + + + + MainSource + + +
frmMain
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + + Delphi.Personality.12 + + + + + False + True + False + + + True + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 1032 + 1253 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + Microsoft Office 2000 Sample Automation Server Wrapper Components + + + Server.dpr + + + + False + True + True + + + + + Server.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + + + + + + + + + + + + + 12 + + + + diff --git a/Demos/UDP/ncUDPSockets/Server/Server.dproj.local b/Demos/UDP/ncUDPSockets/Server/Server.dproj.local new file mode 100644 index 0000000..c6ab0d5 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Server/Server.dproj.local @@ -0,0 +1,11 @@ + + + + + + + 2025/01/14 22:17:15.000.403,=D:\_Delphi\_Library\Netcom7\Demos\SimpleSockets_UDP\Server\Unit1.pas + 2025/01/14 22:17:30.000.252,D:\_Delphi\_Library\Netcom7\Demos\SimpleSockets_UDP\Server\uMainServer.pas=D:\_Delphi\_Library\Netcom7\Demos\SimpleSockets_UDP\Server\Unit1.pas + 2025/01/16 20:08:59.000.762,D:\_Delphi\_Library\NetCom7\Demos\SimpleSockets_UDP_v2\Server\uMainServer.pas= + + diff --git a/Demos/UDP/ncUDPSockets/Server/Server.drc b/Demos/UDP/ncUDPSockets/Server/Server.drc new file mode 100644 index 0000000..599b1e6 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Server/Server.drc @@ -0,0 +1,769 @@ +/* VER360 + Generated by the Embarcadero Delphi Pascal Compiler + because -GD or --drc was supplied to the compiler. + + This file contains compiler-generated resources that + were bound to the executable. + If this file is empty, then no compiler-generated + resources were bound to the produced executable. +*/ + +#define System_Win_ComConst_SVarNotObject 65152 +#define System_Win_ComConst_STooManyParams 65153 +#define ncUDPSockets_ECannotSetPortWhileSocketActiveStr 65154 +#define ncUDPSockets_ECannotSendWhileSocketInactiveStr 65155 +#define ncUDPSockets_ECannotSetUseReaderThreadWhileSocketActiveStr 65156 +#define ncUDPSockets_ECannotSetFamilyWhileConnectionIsActiveStr 65157 +#define Vcl_Consts_SStyleRegisterError 65168 +#define Vcl_Consts_SStyleClassRegisterError 65169 +#define Vcl_Consts_SStyleNotFound 65170 +#define Vcl_Consts_SStyleClassNotFound 65171 +#define Vcl_Consts_SStyleInvalidHandle 65172 +#define Vcl_Consts_SStyleFormatError 65173 +#define Vcl_Consts_SStyleHookClassRegistered 65174 +#define Vcl_Consts_SStyleHookClassNotRegistered 65175 +#define Vcl_Consts_SStyleInvalidParameter 65176 +#define Vcl_Consts_SStyleFeatureNotSupported 65177 +#define Vcl_Consts_SStyleNotRegistered 65178 +#define Vcl_Consts_SStyleUnregisterError 65179 +#define Vcl_Consts_SStyleNotRegisteredNoName 65180 +#define Vcl_Consts_sBeginInvokeNoHandle 65181 +#define System_Win_ComConst_SOleError 65182 +#define System_Win_ComConst_SNoMethod 65183 +#define Vcl_Consts_SDockZoneNotFound 65184 +#define Vcl_Consts_SDockZoneHasNoCtl 65185 +#define Vcl_Consts_SDockZoneVersionConflict 65186 +#define Vcl_Consts_SPromptArrayTooShort 65187 +#define Vcl_Consts_SPromptArrayEmpty 65188 +#define Vcl_Consts_SUsername 65189 +#define Vcl_Consts_SPassword 65190 +#define Vcl_Consts_SDomain 65191 +#define Vcl_Consts_SLogin 65192 +#define Vcl_Consts_STrayIconRemoveError 65193 +#define Vcl_Consts_SWindowsVistaRequired 65194 +#define Vcl_Consts_STaskDlgButtonCaption 65195 +#define Vcl_Consts_STaskDlgRadioButtonCaption 65196 +#define Vcl_Consts_SInvalidTaskDlgButtonCaption 65197 +#define Vcl_Consts_SStyleLoadError 65198 +#define Vcl_Consts_SStyleLoadErrors 65199 +#define Vcl_Consts_SmkcDown 65200 +#define Vcl_Consts_SmkcIns 65201 +#define Vcl_Consts_SmkcDel 65202 +#define Vcl_Consts_SmkcShift 65203 +#define Vcl_Consts_SmkcCtrl 65204 +#define Vcl_Consts_SmkcAlt 65205 +#define Vcl_Consts_SOutOfRange 65206 +#define Vcl_Consts_sAllFilter 65207 +#define Vcl_Consts_SIconToClipboard 65208 +#define Vcl_Consts_SCannotOpenClipboard 65209 +#define Vcl_Consts_SInvalidMemoSize 65210 +#define Vcl_Consts_SInvalidPrinterOp 65211 +#define Vcl_Consts_SNoDefaultPrinter 65212 +#define Vcl_Consts_SDuplicateMenus 65213 +#define Vcl_Consts_SDockedCtlNeedsName 65214 +#define Vcl_Consts_SDockTreeRemoveError 65215 +#define Vcl_Consts_SMsgDlgAll 65216 +#define Vcl_Consts_SMsgDlgNoToAll 65217 +#define Vcl_Consts_SMsgDlgYesToAll 65218 +#define Vcl_Consts_SMsgDlgClose 65219 +#define Vcl_Consts_SmkcBkSp 65220 +#define Vcl_Consts_SmkcTab 65221 +#define Vcl_Consts_SmkcEsc 65222 +#define Vcl_Consts_SmkcEnter 65223 +#define Vcl_Consts_SmkcSpace 65224 +#define Vcl_Consts_SmkcPgUp 65225 +#define Vcl_Consts_SmkcPgDn 65226 +#define Vcl_Consts_SmkcEnd 65227 +#define Vcl_Consts_SmkcHome 65228 +#define Vcl_Consts_SmkcLeft 65229 +#define Vcl_Consts_SmkcUp 65230 +#define Vcl_Consts_SmkcRight 65231 +#define Vcl_Consts_SVEnhMetafiles 65232 +#define Vcl_Consts_SVIcons 65233 +#define Vcl_Consts_SVBitmaps 65234 +#define Vcl_Consts_SVTIFFImages 65235 +#define Vcl_Consts_SMsgDlgWarning 65236 +#define Vcl_Consts_SMsgDlgError 65237 +#define Vcl_Consts_SMsgDlgInformation 65238 +#define Vcl_Consts_SMsgDlgConfirm 65239 +#define Vcl_Consts_SMsgDlgYes 65240 +#define Vcl_Consts_SMsgDlgNo 65241 +#define Vcl_Consts_SMsgDlgOK 65242 +#define Vcl_Consts_SMsgDlgCancel 65243 +#define Vcl_Consts_SMsgDlgHelp 65244 +#define Vcl_Consts_SMsgDlgAbort 65245 +#define Vcl_Consts_SMsgDlgRetry 65246 +#define Vcl_Consts_SMsgDlgIgnore 65247 +#define Vcl_Consts_SNoMDIForm 65248 +#define Vcl_Consts_SImageCanvasNeedsBitmap 65249 +#define Vcl_Consts_SControlParentSetToSelf 65250 +#define Vcl_Consts_SControlNonMainThreadUsage 65251 +#define Vcl_Consts_SOKButton 65252 +#define Vcl_Consts_SCancelButton 65253 +#define Vcl_Consts_SYesButton 65254 +#define Vcl_Consts_SNoButton 65255 +#define Vcl_Consts_SHelpButton 65256 +#define Vcl_Consts_SCloseButton 65257 +#define Vcl_Consts_SIgnoreButton 65258 +#define Vcl_Consts_SRetryButton 65259 +#define Vcl_Consts_SAbortButton 65260 +#define Vcl_Consts_SAllButton 65261 +#define Vcl_Consts_SCannotDragForm 65262 +#define Vcl_Consts_SVMetafiles 65263 +#define Vcl_Consts_SParentGivenNotAParent 65264 +#define Vcl_Consts_SMDIChildNotVisible 65265 +#define Vcl_Consts_SVisibleChanged 65266 +#define Vcl_Consts_SCannotShowModal 65267 +#define Vcl_Consts_SScrollBarRange 65268 +#define Vcl_Consts_SPropertyOutOfRange 65269 +#define Vcl_Consts_SMenuIndexError 65270 +#define Vcl_Consts_SMenuReinserted 65271 +#define Vcl_Consts_SMenuNotFound 65272 +#define Vcl_Consts_SNoTimers 65273 +#define Vcl_Consts_SNotPrinting 65274 +#define Vcl_Consts_SPrinting 65275 +#define Vcl_Consts_SPrinterIndexError 65276 +#define Vcl_Consts_SInvalidPrinter 65277 +#define Vcl_Consts_SDeviceOnPort 65278 +#define Vcl_Consts_SGroupIndexTooLow 65279 +#define Vcl_Consts_SOutOfResources 65280 +#define Vcl_Consts_SNoCanvasHandle 65281 +#define Vcl_Consts_SInvalidTextFormatFlag 65282 +#define Vcl_Consts_SInvalidFrameIndex 65283 +#define Vcl_Consts_SInvalidImageSize 65284 +#define Vcl_Consts_SInvalidImageList 65285 +#define Vcl_Consts_SReplaceImage 65286 +#define Vcl_Consts_SInsertImage 65287 +#define Vcl_Consts_SImageIndexError 65288 +#define Vcl_Consts_SImageReadFail 65289 +#define Vcl_Consts_SImageWriteFail 65290 +#define Vcl_Consts_SWindowDCError 65291 +#define Vcl_Consts_SWindowClass 65292 +#define Vcl_Consts_SCannotFocus 65293 +#define Vcl_Consts_SParentRequired 65294 +#define Vcl_Consts_SControlPath 65295 +#define System_RTLConsts_sObserverNoSinglecastFound 65296 +#define System_RTLConsts_sObserverNoMulticastFound 65297 +#define System_RTLConsts_sObserverNotAvailable 65298 +#define System_RTLConsts_sMustWaitOnOneEvent 65299 +#define System_RTLConsts_sBeginInvokeDestroying 65300 +#define Vcl_Consts_SInvalidBitmap 65301 +#define Vcl_Consts_SInvalidIcon 65302 +#define Vcl_Consts_SInvalidMetafile 65303 +#define Vcl_Consts_SInvalidPixelFormat 65304 +#define Vcl_Consts_SInvalidImage 65305 +#define Vcl_Consts_SScanLine 65306 +#define Vcl_Consts_SChangeIconSize 65307 +#define Vcl_Consts_SChangeWicSize 65308 +#define Vcl_Consts_SUnknownExtension 65309 +#define Vcl_Consts_SUnknownClipboardFormat 65310 +#define Vcl_Consts_SUnknownStreamFormat 65311 +#define System_RTLConsts_SWindowsXP 65312 +#define System_RTLConsts_SWindowsServer2003 65313 +#define System_RTLConsts_SWindowsServer2003R2 65314 +#define System_RTLConsts_SWindowsServer2012 65315 +#define System_RTLConsts_SWindowsServer2012R2 65316 +#define System_RTLConsts_SWindowsServer2016 65317 +#define System_RTLConsts_SWindowsServer2019 65318 +#define System_RTLConsts_SWindowsServer2022 65319 +#define System_RTLConsts_SWindows8 65320 +#define System_RTLConsts_SWindows8Point1 65321 +#define System_RTLConsts_SWindows10 65322 +#define System_RTLConsts_SWindows11 65323 +#define System_RTLConsts_SWinRTInstanceError 65324 +#define System_RTLConsts_sObserverUnsupported 65325 +#define System_RTLConsts_sObserverMultipleSingleCast 65326 +#define System_RTLConsts_sObserverNoInterface 65327 +#define System_RTLConsts_SNonPublicType 65328 +#define System_RTLConsts_SByRefArgMismatch 65329 +#define System_RTLConsts_SPropIsReadOnly 65330 +#define System_RTLConsts_SPropIsWriteOnly 65331 +#define System_RTLConsts_SInvalidRttiDestroy 65332 +#define System_RTLConsts_SServiceNotFound 65333 +#define System_RTLConsts_SVersionStr 65334 +#define System_RTLConsts_SSPVersionStr 65335 +#define System_RTLConsts_SVersion32 65336 +#define System_RTLConsts_SVersion64 65337 +#define System_RTLConsts_SWindows 65338 +#define System_RTLConsts_SWindowsVista 65339 +#define System_RTLConsts_SWindowsServer2008 65340 +#define System_RTLConsts_SWindows7 65341 +#define System_RTLConsts_SWindowsServer2008R2 65342 +#define System_RTLConsts_SWindows2000 65343 +#define System_RTLConsts_sInvalidTimespanFormat 65344 +#define System_RTLConsts_sTimespanElementTooLong 65345 +#define System_RTLConsts_SNoContext 65346 +#define System_RTLConsts_SNoContextFound 65347 +#define System_RTLConsts_SNoIndex 65348 +#define System_RTLConsts_SNoSearch 65349 +#define System_RTLConsts_SNoTableOfContents 65350 +#define System_RTLConsts_SNoTopics 65351 +#define System_RTLConsts_SNothingFound 65352 +#define System_RTLConsts_SArgumentOutOfRange 65353 +#define System_RTLConsts_SArgumentNil 65354 +#define System_RTLConsts_SGenericItemNotFound 65355 +#define System_RTLConsts_SGenericDuplicateItem 65356 +#define System_RTLConsts_SInsufficientRtti 65357 +#define System_RTLConsts_SParameterCountMismatch 65358 +#define System_RTLConsts_SParameterCountExceeded 65359 +#define System_RTLConsts_SThreadExternalSetReturnValue 65360 +#define System_RTLConsts_SParamIsNil 65361 +#define System_RTLConsts_SParamIsNegative 65362 +#define System_RTLConsts_SInputBufferExceed 65363 +#define System_RTLConsts_SInvalidCharsInPath 65364 +#define System_RTLConsts_hNoFilterViewer 65365 +#define System_RTLConsts_sArgumentInvalid 65366 +#define System_RTLConsts_sInvalidStringAndObjectArrays 65367 +#define System_RTLConsts_sSameArrays 65368 +#define System_RTLConsts_sNoConstruct 65369 +#define System_RTLConsts_sInvalidTimeoutValue 65370 +#define System_RTLConsts_sSpinCountOutOfRange 65371 +#define System_RTLConsts_sTimespanTooLong 65372 +#define System_RTLConsts_sInvalidTimespanDuration 65373 +#define System_RTLConsts_sTimespanValueCannotBeNan 65374 +#define System_RTLConsts_sCannotNegateTimespan 65375 +#define System_RTLConsts_SReadOnlyProperty 65376 +#define System_RTLConsts_SRegCreateFailed 65377 +#define System_RTLConsts_SRegGetDataFailed 65378 +#define System_RTLConsts_SRegSetDataFailed 65379 +#define System_RTLConsts_SResNotFound 65380 +#define System_RTLConsts_SSeekNotImplemented 65381 +#define System_RTLConsts_SSortedListError 65382 +#define System_RTLConsts_SUnknownGroup 65383 +#define System_RTLConsts_SUnknownProperty 65384 +#define System_RTLConsts_SWriteError 65385 +#define System_RTLConsts_SThreadCreateError 65386 +#define System_RTLConsts_SThreadError 65387 +#define System_RTLConsts_SThreadExternalTerminate 65388 +#define System_RTLConsts_SThreadExternalWait 65389 +#define System_RTLConsts_SThreadStartError 65390 +#define System_RTLConsts_SThreadExternalCheckTerminated 65391 +#define System_RTLConsts_SFOpenErrorEx 65392 +#define System_RTLConsts_SInvalidImage 65393 +#define System_RTLConsts_SInvalidName 65394 +#define System_RTLConsts_SInvalidProperty 65395 +#define System_RTLConsts_SInvalidPropertyPath 65396 +#define System_RTLConsts_SInvalidPropertyValue 65397 +#define System_RTLConsts_SInvalidRegType 65398 +#define System_RTLConsts_SListCapacityError 65399 +#define System_RTLConsts_SListCountError 65400 +#define System_RTLConsts_SListIndexError 65401 +#define System_RTLConsts_SListIndexErrorRangeReason 65402 +#define System_RTLConsts_SListIndexErrorEmptyReason 65403 +#define System_RTLConsts_SMemoryStreamError 65404 +#define System_RTLConsts_SNoComSupport 65405 +#define System_RTLConsts_SPropertyException 65406 +#define System_RTLConsts_SReadError 65407 +#define System_SysConst_SInvalidDestinationIndex 65408 +#define System_SysConst_SInvalidCodePage 65409 +#define System_SysConst_SInvalidEncodingName 65410 +#define System_SysConst_SNoMappingForUnicodeCharacter 65411 +#define System_SysConst_SInvalidStringBaseIndex 65412 +#define System_RTLConsts_SAncestorNotFound 65413 +#define System_RTLConsts_SAssignError 65414 +#define System_RTLConsts_SBitsIndexError 65415 +#define System_RTLConsts_SCantWriteResourceStreamError 65416 +#define System_RTLConsts_SCheckSynchronizeError 65417 +#define System_RTLConsts_SClassNotFound 65418 +#define System_RTLConsts_SDuplicateClass 65419 +#define System_RTLConsts_SDuplicateItem 65420 +#define System_RTLConsts_SDuplicateName 65421 +#define System_RTLConsts_SDuplicateString 65422 +#define System_RTLConsts_SFCreateErrorEx 65423 +#define System_SysConst_SShortDayNameWed 65424 +#define System_SysConst_SShortDayNameThu 65425 +#define System_SysConst_SShortDayNameFri 65426 +#define System_SysConst_SShortDayNameSat 65427 +#define System_SysConst_SLongDayNameSun 65428 +#define System_SysConst_SLongDayNameMon 65429 +#define System_SysConst_SLongDayNameTue 65430 +#define System_SysConst_SLongDayNameWed 65431 +#define System_SysConst_SLongDayNameThu 65432 +#define System_SysConst_SLongDayNameFri 65433 +#define System_SysConst_SLongDayNameSat 65434 +#define System_SysConst_SInvalidSourceArray 65435 +#define System_SysConst_SInvalidDestinationArray 65436 +#define System_SysConst_SCharIndexOutOfBounds 65437 +#define System_SysConst_SByteIndexOutOfBounds 65438 +#define System_SysConst_SInvalidCharCount 65439 +#define System_SysConst_SShortMonthNameDec 65440 +#define System_SysConst_SLongMonthNameJan 65441 +#define System_SysConst_SLongMonthNameFeb 65442 +#define System_SysConst_SLongMonthNameMar 65443 +#define System_SysConst_SLongMonthNameApr 65444 +#define System_SysConst_SLongMonthNameMay 65445 +#define System_SysConst_SLongMonthNameJun 65446 +#define System_SysConst_SLongMonthNameJul 65447 +#define System_SysConst_SLongMonthNameAug 65448 +#define System_SysConst_SLongMonthNameSep 65449 +#define System_SysConst_SLongMonthNameOct 65450 +#define System_SysConst_SLongMonthNameNov 65451 +#define System_SysConst_SLongMonthNameDec 65452 +#define System_SysConst_SShortDayNameSun 65453 +#define System_SysConst_SShortDayNameMon 65454 +#define System_SysConst_SShortDayNameTue 65455 +#define System_SysConst_SAssertError 65456 +#define System_SysConst_SAbstractError 65457 +#define System_SysConst_SModuleAccessViolation 65458 +#define System_SysConst_SOSError 65459 +#define System_SysConst_SUnkOSError 65460 +#define System_SysConst_SShortMonthNameJan 65461 +#define System_SysConst_SShortMonthNameFeb 65462 +#define System_SysConst_SShortMonthNameMar 65463 +#define System_SysConst_SShortMonthNameApr 65464 +#define System_SysConst_SShortMonthNameMay 65465 +#define System_SysConst_SShortMonthNameJun 65466 +#define System_SysConst_SShortMonthNameJul 65467 +#define System_SysConst_SShortMonthNameAug 65468 +#define System_SysConst_SShortMonthNameSep 65469 +#define System_SysConst_SShortMonthNameOct 65470 +#define System_SysConst_SShortMonthNameNov 65471 +#define System_SysConst_SVarTypeTooManyCustom 65472 +#define System_SysConst_SVarTypeCouldNotConvert 65473 +#define System_SysConst_SVarTypeConvertOverflow 65474 +#define System_SysConst_SVarOverflow 65475 +#define System_SysConst_SVarInvalid 65476 +#define System_SysConst_SVarBadType 65477 +#define System_SysConst_SVarNotImplemented 65478 +#define System_SysConst_SVarUnexpected 65479 +#define System_SysConst_SExternalException 65480 +#define System_SysConst_SAssertionFailed 65481 +#define System_SysConst_SIntfCastError 65482 +#define System_SysConst_SSafecallException 65483 +#define System_SysConst_SMonitorLockException 65484 +#define System_SysConst_SNoMonitorSupportException 65485 +#define System_SysConst_SNotImplemented 65486 +#define System_SysConst_SObjectDisposed 65487 +#define System_SysConst_SArgumentMissing 65488 +#define System_SysConst_SDispatchError 65489 +#define System_SysConst_SReadAccess 65490 +#define System_SysConst_SWriteAccess 65491 +#define System_SysConst_SExecuteAccess 65492 +#define System_SysConst_SInvalidAccess 65493 +#define System_SysConst_SVarArrayCreate 65494 +#define System_SysConst_SVarArrayBounds 65495 +#define System_SysConst_SVarArrayLocked 65496 +#define System_SysConst_SInvalidVarCast 65497 +#define System_SysConst_SInvalidVarOp 65498 +#define System_SysConst_SInvalidVarNullOp 65499 +#define System_SysConst_SInvalidVarOpWithHResultWithPrefix 65500 +#define System_SysConst_SVarTypeOutOfRangeWithPrefix 65501 +#define System_SysConst_SVarTypeAlreadyUsedWithPrefix 65502 +#define System_SysConst_SVarTypeNotUsableWithPrefix 65503 +#define System_SysConst_SRangeError 65504 +#define System_SysConst_SIntOverflow 65505 +#define System_SysConst_SInvalidOp 65506 +#define System_SysConst_SZeroDivide 65507 +#define System_SysConst_SOverflow 65508 +#define System_SysConst_SUnderflow 65509 +#define System_SysConst_SInvalidPointer 65510 +#define System_SysConst_SInvalidCast 65511 +#define System_SysConst_SAccessViolationArg3 65512 +#define System_SysConst_SAccessViolationNoArg 65513 +#define System_SysConst_SStackOverflow 65514 +#define System_SysConst_SControlC 65515 +#define System_SysConst_SPrivilege 65516 +#define System_SysConst_SException 65517 +#define System_SysConst_SExceptTitle 65518 +#define System_SysConst_SInvalidFormat 65519 +#define System_SysConst_SUnknown 65520 +#define System_SysConst_SInvalidInteger 65521 +#define System_SysConst_SInvalidTimeStamp 65522 +#define System_SysConst_SInvalidGUID 65523 +#define System_SysConst_STimeEncodeError 65524 +#define System_SysConst_SDateEncodeError 65525 +#define System_SysConst_SOutOfMemory 65526 +#define System_SysConst_SInOutError 65527 +#define System_SysConst_SFileNotFound 65528 +#define System_SysConst_SInvalidUnknownFilename 65529 +#define System_SysConst_STooManyOpenFiles 65530 +#define System_SysConst_SAccessDenied 65531 +#define System_SysConst_SEndOfFile 65532 +#define System_SysConst_SDiskFull 65533 +#define System_SysConst_SInvalidInput 65534 +#define System_SysConst_SDivByZero 65535 +STRINGTABLE +BEGIN + System_Win_ComConst_SVarNotObject, L"Variant does not reference an automation object" + System_Win_ComConst_STooManyParams, L"Dispatch methods do not support more than 64 parameters" + ncUDPSockets_ECannotSetPortWhileSocketActiveStr, L"Cannot set Port property while socket is active" + ncUDPSockets_ECannotSendWhileSocketInactiveStr, L"Cannot send data while socket is inactive" + ncUDPSockets_ECannotSetUseReaderThreadWhileSocketActiveStr, L"Cannot set UseReaderThread property while socket is active" + ncUDPSockets_ECannotSetFamilyWhileConnectionIsActiveStr, L"Cannot set Family property whilst the connection is active" + Vcl_Consts_SStyleRegisterError, L"Style '%s' already registered" + Vcl_Consts_SStyleClassRegisterError, L"Style class '%s' already registered" + Vcl_Consts_SStyleNotFound, L"Style '%s' not found" + Vcl_Consts_SStyleClassNotFound, L"Style class '%s' not found" + Vcl_Consts_SStyleInvalidHandle, L"Invalid style handle" + Vcl_Consts_SStyleFormatError, L"Invalid style format" + Vcl_Consts_SStyleHookClassRegistered, L"Class '%s' is already registered for '%s'" + Vcl_Consts_SStyleHookClassNotRegistered, L"Class '%s' is not registered for '%s'" + Vcl_Consts_SStyleInvalidParameter, L"%s parameter cannot be nil" + Vcl_Consts_SStyleFeatureNotSupported, L"Feature not supported by this style" + Vcl_Consts_SStyleNotRegistered, L"Style '%s' is not registered" + Vcl_Consts_SStyleUnregisterError, L"Cannot unregister the system style" + Vcl_Consts_SStyleNotRegisteredNoName, L"Style not registered" + Vcl_Consts_sBeginInvokeNoHandle, L"Cannot call BeginInvoke on a control with no parent or window handle" + System_Win_ComConst_SOleError, L"OLE error %.8x" + System_Win_ComConst_SNoMethod, L"Method '%s' not supported by automation object" + Vcl_Consts_SDockZoneNotFound, L" - Dock zone not found" + Vcl_Consts_SDockZoneHasNoCtl, L" - Dock zone has no control" + Vcl_Consts_SDockZoneVersionConflict, L"Error loading dock zone from the stream. Expecting version %d, but found %d." + Vcl_Consts_SPromptArrayTooShort, L"Length of value array must be >= length of prompt array" + Vcl_Consts_SPromptArrayEmpty, L"Prompt array must not be empty" + Vcl_Consts_SUsername, L"&Username" + Vcl_Consts_SPassword, L"&Password" + Vcl_Consts_SDomain, L"&Domain" + Vcl_Consts_SLogin, L"Login" + Vcl_Consts_STrayIconRemoveError, L"Cannot remove shell notification icon" + Vcl_Consts_SWindowsVistaRequired, L"%s requires Windows Vista or later" + Vcl_Consts_STaskDlgButtonCaption, L"Button%d" + Vcl_Consts_STaskDlgRadioButtonCaption, L"RadioButton%d" + Vcl_Consts_SInvalidTaskDlgButtonCaption, L"Caption cannot be empty" + Vcl_Consts_SStyleLoadError, L"Unable to load style '%s'" + Vcl_Consts_SStyleLoadErrors, L"Unable to load styles: %s" + Vcl_Consts_SmkcDown, L"Down" + Vcl_Consts_SmkcIns, L"Ins" + Vcl_Consts_SmkcDel, L"Del" + Vcl_Consts_SmkcShift, L"Shift+" + Vcl_Consts_SmkcCtrl, L"Ctrl+" + Vcl_Consts_SmkcAlt, L"Alt+" + Vcl_Consts_SOutOfRange, L"Value must be between %d and %d" + Vcl_Consts_sAllFilter, L"All" + Vcl_Consts_SIconToClipboard, L"Clipboard does not support Icons" + Vcl_Consts_SCannotOpenClipboard, L"Cannot open clipboard: %s" + Vcl_Consts_SInvalidMemoSize, L"Text exceeds memo capacity" + Vcl_Consts_SInvalidPrinterOp, L"Operation not supported on selected printer" + Vcl_Consts_SNoDefaultPrinter, L"There is no default printer currently selected" + Vcl_Consts_SDuplicateMenus, L"Menu '%s' is already being used by another form" + Vcl_Consts_SDockedCtlNeedsName, L"Docked control must have a name" + Vcl_Consts_SDockTreeRemoveError, L"Error removing control from dock tree" + Vcl_Consts_SMsgDlgAll, L"&All" + Vcl_Consts_SMsgDlgNoToAll, L"N&o to All" + Vcl_Consts_SMsgDlgYesToAll, L"Yes to &All" + Vcl_Consts_SMsgDlgClose, L"&Close" + Vcl_Consts_SmkcBkSp, L"BkSp" + Vcl_Consts_SmkcTab, L"Tab" + Vcl_Consts_SmkcEsc, L"Esc" + Vcl_Consts_SmkcEnter, L"Enter" + Vcl_Consts_SmkcSpace, L"Space" + Vcl_Consts_SmkcPgUp, L"PgUp" + Vcl_Consts_SmkcPgDn, L"PgDn" + Vcl_Consts_SmkcEnd, L"End" + Vcl_Consts_SmkcHome, L"Home" + Vcl_Consts_SmkcLeft, L"Left" + Vcl_Consts_SmkcUp, L"Up" + Vcl_Consts_SmkcRight, L"Right" + Vcl_Consts_SVEnhMetafiles, L"Enhanced Metafiles" + Vcl_Consts_SVIcons, L"Icons" + Vcl_Consts_SVBitmaps, L"Bitmaps" + Vcl_Consts_SVTIFFImages, L"TIFF Images" + Vcl_Consts_SMsgDlgWarning, L"Warning" + Vcl_Consts_SMsgDlgError, L"Error" + Vcl_Consts_SMsgDlgInformation, L"Information" + Vcl_Consts_SMsgDlgConfirm, L"Confirm" + Vcl_Consts_SMsgDlgYes, L"&Yes" + Vcl_Consts_SMsgDlgNo, L"&No" + Vcl_Consts_SMsgDlgOK, L"OK" + Vcl_Consts_SMsgDlgCancel, L"Cancel" + Vcl_Consts_SMsgDlgHelp, L"&Help" + Vcl_Consts_SMsgDlgAbort, L"&Abort" + Vcl_Consts_SMsgDlgRetry, L"&Retry" + Vcl_Consts_SMsgDlgIgnore, L"&Ignore" + Vcl_Consts_SNoMDIForm, L"Cannot create form. No MDI forms are currently active" + Vcl_Consts_SImageCanvasNeedsBitmap, L"Can only modify an image if it contains a bitmap" + Vcl_Consts_SControlParentSetToSelf, L"A control cannot have itself as its parent" + Vcl_Consts_SControlNonMainThreadUsage, L"Control '%s' is used on a not main thread" + Vcl_Consts_SOKButton, L"OK" + Vcl_Consts_SCancelButton, L"Cancel" + Vcl_Consts_SYesButton, L"&Yes" + Vcl_Consts_SNoButton, L"&No" + Vcl_Consts_SHelpButton, L"&Help" + Vcl_Consts_SCloseButton, L"&Close" + Vcl_Consts_SIgnoreButton, L"&Ignore" + Vcl_Consts_SRetryButton, L"&Retry" + Vcl_Consts_SAbortButton, L"Abort" + Vcl_Consts_SAllButton, L"&All" + Vcl_Consts_SCannotDragForm, L"Cannot drag a form" + Vcl_Consts_SVMetafiles, L"Metafiles" + Vcl_Consts_SParentGivenNotAParent, L"Parent given is not a parent of '%s'" + Vcl_Consts_SMDIChildNotVisible, L"Cannot hide an MDI Child Form" + Vcl_Consts_SVisibleChanged, L"Cannot change Visible in OnShow or OnHide" + Vcl_Consts_SCannotShowModal, L"Cannot make a visible window modal" + Vcl_Consts_SScrollBarRange, L"Scrollbar property out of range" + Vcl_Consts_SPropertyOutOfRange, L"%s property out of range" + Vcl_Consts_SMenuIndexError, L"Menu index out of range" + Vcl_Consts_SMenuReinserted, L"Menu inserted twice" + Vcl_Consts_SMenuNotFound, L"Sub-menu is not in menu" + Vcl_Consts_SNoTimers, L"Not enough timers available" + Vcl_Consts_SNotPrinting, L"Printer is not currently printing" + Vcl_Consts_SPrinting, L"Printing in progress" + Vcl_Consts_SPrinterIndexError, L"Printer index out of range" + Vcl_Consts_SInvalidPrinter, L"Printer selected is not valid" + Vcl_Consts_SDeviceOnPort, L"%s on %s" + Vcl_Consts_SGroupIndexTooLow, L"GroupIndex cannot be less than a previous menu item's GroupIndex" + Vcl_Consts_SOutOfResources, L"Out of system resources" + Vcl_Consts_SNoCanvasHandle, L"Canvas does not allow drawing" + Vcl_Consts_SInvalidTextFormatFlag, L"Text format flag '%s' not supported" + Vcl_Consts_SInvalidFrameIndex, L"Invalid image frame index %d: there are %d frames (0-%d)" + Vcl_Consts_SInvalidImageSize, L"Invalid image size" + Vcl_Consts_SInvalidImageList, L"Invalid ImageList" + Vcl_Consts_SReplaceImage, L"Unable to Replace Image" + Vcl_Consts_SInsertImage, L"Unable to Insert Image" + Vcl_Consts_SImageIndexError, L"Invalid ImageList Index" + Vcl_Consts_SImageReadFail, L"Failed to read ImageList data from stream" + Vcl_Consts_SImageWriteFail, L"Failed to write ImageList data to stream" + Vcl_Consts_SWindowDCError, L"Error creating window device context" + Vcl_Consts_SWindowClass, L"Error creating window class" + Vcl_Consts_SCannotFocus, L"Cannot focus a disabled or invisible window" + Vcl_Consts_SParentRequired, L"Control '%s' has no parent window" + Vcl_Consts_SControlPath, L". Path:\r\n%s" + System_RTLConsts_sObserverNoSinglecastFound, L"No single cast observer with ID %d was added to the observer collection" + System_RTLConsts_sObserverNoMulticastFound, L"No multi cast observer with ID %d was added to the observer collection" + System_RTLConsts_sObserverNotAvailable, L"Observer is not available" + System_RTLConsts_sMustWaitOnOneEvent, L"Must wait on at least one event" + System_RTLConsts_sBeginInvokeDestroying, L"Cannot call BeginInvoke on a TComponent in the process of destruction" + Vcl_Consts_SInvalidBitmap, L"Bitmap image is not valid" + Vcl_Consts_SInvalidIcon, L"Icon image is not valid" + Vcl_Consts_SInvalidMetafile, L"Metafile is not valid" + Vcl_Consts_SInvalidPixelFormat, L"Invalid pixel format" + Vcl_Consts_SInvalidImage, L"Invalid image" + Vcl_Consts_SScanLine, L"Scan line index out of range" + Vcl_Consts_SChangeIconSize, L"Cannot change the size of an icon" + Vcl_Consts_SChangeWicSize, L"Cannot change the size of a WIC Image" + Vcl_Consts_SUnknownExtension, L"Unknown picture file extension (.%s)" + Vcl_Consts_SUnknownClipboardFormat, L"Unsupported clipboard format" + Vcl_Consts_SUnknownStreamFormat, L"Unsupported stream format" + System_RTLConsts_SWindowsXP, L"Windows XP" + System_RTLConsts_SWindowsServer2003, L"Windows Server 2003" + System_RTLConsts_SWindowsServer2003R2, L"Windows Server 2003 R2" + System_RTLConsts_SWindowsServer2012, L"Windows Server 2012" + System_RTLConsts_SWindowsServer2012R2, L"Windows Server 2012 R2" + System_RTLConsts_SWindowsServer2016, L"Windows Server 2016" + System_RTLConsts_SWindowsServer2019, L"Windows Server 2019" + System_RTLConsts_SWindowsServer2022, L"Windows Server 2022" + System_RTLConsts_SWindows8, L"Windows 8" + System_RTLConsts_SWindows8Point1, L"Windows 8.1" + System_RTLConsts_SWindows10, L"Windows 10" + System_RTLConsts_SWindows11, L"Windows 11" + System_RTLConsts_SWinRTInstanceError, L"Cannot create instance of class %s" + System_RTLConsts_sObserverUnsupported, L"Observer is not supported" + System_RTLConsts_sObserverMultipleSingleCast, L"Cannot have multiple single cast observers added to the observers collection" + System_RTLConsts_sObserverNoInterface, L"The object does not implement the observer interface" + System_RTLConsts_SNonPublicType, L"Type '%s' is not declared in the interface section of a unit" + System_RTLConsts_SByRefArgMismatch, L"VAR and OUT arguments must match parameter type exactly" + System_RTLConsts_SPropIsReadOnly, L"Property '%s' is read-only" + System_RTLConsts_SPropIsWriteOnly, L"Property '%s' is write-only" + System_RTLConsts_SInvalidRttiDestroy, L"RTTI objects cannot be manually destroyed by application code" + System_RTLConsts_SServiceNotFound, L"Specified Login Credential Service not found" + System_RTLConsts_SVersionStr, L"%s (Version %d.%d, Build %d, %5:s)" + System_RTLConsts_SSPVersionStr, L"%s Service Pack %4:d (Version %1:d.%2:d, Build %3:d, %5:s)" + System_RTLConsts_SVersion32, L"32-bit Edition" + System_RTLConsts_SVersion64, L"64-bit Edition" + System_RTLConsts_SWindows, L"Windows" + System_RTLConsts_SWindowsVista, L"Windows Vista" + System_RTLConsts_SWindowsServer2008, L"Windows Server 2008" + System_RTLConsts_SWindows7, L"Windows 7" + System_RTLConsts_SWindowsServer2008R2, L"Windows Server 2008 R2" + System_RTLConsts_SWindows2000, L"Windows 2000" + System_RTLConsts_sInvalidTimespanFormat, L"Invalid Timespan format" + System_RTLConsts_sTimespanElementTooLong, L"Timespan element too long" + System_RTLConsts_SNoContext, L"No context-sensitive help installed" + System_RTLConsts_SNoContextFound, L"No help found for context %d" + System_RTLConsts_SNoIndex, L"Unable to open Index" + System_RTLConsts_SNoSearch, L"Unable to open Search" + System_RTLConsts_SNoTableOfContents, L"Unable to find a Table of Contents" + System_RTLConsts_SNoTopics, L"No topic-based help system installed" + System_RTLConsts_SNothingFound, L"No help found for %s" + System_RTLConsts_SArgumentOutOfRange, L"Argument out of range" + System_RTLConsts_SArgumentNil, L"Argument must not be nil" + System_RTLConsts_SGenericItemNotFound, L"Item not found" + System_RTLConsts_SGenericDuplicateItem, L"Duplicates not allowed" + System_RTLConsts_SInsufficientRtti, L"Insufficient RTTI available to support this operation" + System_RTLConsts_SParameterCountMismatch, L"Parameter count mismatch" + System_RTLConsts_SParameterCountExceeded, L"Parameter count exceeded" + System_RTLConsts_SThreadExternalSetReturnValue, L"Cannot call SetReturnValue on an externally create thread" + System_RTLConsts_SParamIsNil, L"Parameter %s cannot be nil" + System_RTLConsts_SParamIsNegative, L"Parameter %s cannot be a negative value" + System_RTLConsts_SInputBufferExceed, L"Input buffer exceeded for %s = %d, %s = %d" + System_RTLConsts_SInvalidCharsInPath, L"Invalid characters in path" + System_RTLConsts_hNoFilterViewer, L"No help viewer that supports filters" + System_RTLConsts_sArgumentInvalid, L"Invalid argument" + System_RTLConsts_sInvalidStringAndObjectArrays, L"Length of Strings and Objects arrays must be equal" + System_RTLConsts_sSameArrays, L"Source and Destination arrays must not be the same" + System_RTLConsts_sNoConstruct, L"Class %s is not intended to be constructed" + System_RTLConsts_sInvalidTimeoutValue, L"Invalid Timeout value: %s" + System_RTLConsts_sSpinCountOutOfRange, L"SpinCount out of range. Must be between 0 and %d" + System_RTLConsts_sTimespanTooLong, L"Timespan too long" + System_RTLConsts_sInvalidTimespanDuration, L"The duration cannot be returned because the absolute value exceeds the value of TTimeSpan.MaxValue" + System_RTLConsts_sTimespanValueCannotBeNan, L"Value cannot be NaN" + System_RTLConsts_sCannotNegateTimespan, L"Negating the minimum value of a Timespan is invalid" + System_RTLConsts_SReadOnlyProperty, L"Property is read-only" + System_RTLConsts_SRegCreateFailed, L"Failed to create key %s" + System_RTLConsts_SRegGetDataFailed, L"Failed to get data for '%s'" + System_RTLConsts_SRegSetDataFailed, L"Failed to set data for '%s'" + System_RTLConsts_SResNotFound, L"Resource %s not found" + System_RTLConsts_SSeekNotImplemented, L"%s.Seek not implemented" + System_RTLConsts_SSortedListError, L"Operation not allowed on sorted list" + System_RTLConsts_SUnknownGroup, L"%s not in a class registration group" + System_RTLConsts_SUnknownProperty, L"Property %s does not exist" + System_RTLConsts_SWriteError, L"Stream write error" + System_RTLConsts_SThreadCreateError, L"Thread creation error: %s" + System_RTLConsts_SThreadError, L"Thread Error: %s (%d)" + System_RTLConsts_SThreadExternalTerminate, L"Cannot terminate an externally created thread" + System_RTLConsts_SThreadExternalWait, L"Cannot wait for an externally created thread" + System_RTLConsts_SThreadStartError, L"Cannot call Start on a running or suspended thread" + System_RTLConsts_SThreadExternalCheckTerminated, L"Cannot call CheckTerminated on an externally created thread" + System_RTLConsts_SFOpenErrorEx, L"Cannot open file \"%s\". %s" + System_RTLConsts_SInvalidImage, L"Invalid stream format" + System_RTLConsts_SInvalidName, L"''%s'' is not a valid component name" + System_RTLConsts_SInvalidProperty, L"Invalid property value" + System_RTLConsts_SInvalidPropertyPath, L"Invalid property path" + System_RTLConsts_SInvalidPropertyValue, L"Invalid property value" + System_RTLConsts_SInvalidRegType, L"Invalid data type for '%s'" + System_RTLConsts_SListCapacityError, L"List capacity out of bounds (%d)" + System_RTLConsts_SListCountError, L"List count out of bounds (%d)" + System_RTLConsts_SListIndexError, L"List index out of bounds (%d)" + System_RTLConsts_SListIndexErrorRangeReason, L". %s range is 0..%d" + System_RTLConsts_SListIndexErrorEmptyReason, L". %s is empty" + System_RTLConsts_SMemoryStreamError, L"Out of memory while expanding memory stream" + System_RTLConsts_SNoComSupport, L"%s has not been registered as a COM class" + System_RTLConsts_SPropertyException, L"Error reading %s%s%s: %s" + System_RTLConsts_SReadError, L"Stream read error" + System_SysConst_SInvalidDestinationIndex, L"Invalid destination index (%d)" + System_SysConst_SInvalidCodePage, L"Invalid code page" + System_SysConst_SInvalidEncodingName, L"Invalid encoding name" + System_SysConst_SNoMappingForUnicodeCharacter, L"No mapping for the Unicode character exists in the target multi-byte code page" + System_SysConst_SInvalidStringBaseIndex, L"Invalid StringBaseIndex" + System_RTLConsts_SAncestorNotFound, L"Ancestor for '%s' not found" + System_RTLConsts_SAssignError, L"Cannot assign a %s to a %s" + System_RTLConsts_SBitsIndexError, L"Bits index out of range" + System_RTLConsts_SCantWriteResourceStreamError, L"Can't write to a read-only resource stream" + System_RTLConsts_SCheckSynchronizeError, L"CheckSynchronize called from thread $%x, which is NOT the main thread" + System_RTLConsts_SClassNotFound, L"Class %s not found" + System_RTLConsts_SDuplicateClass, L"A class named %s already exists" + System_RTLConsts_SDuplicateItem, L"List does not allow duplicates ($0%x)" + System_RTLConsts_SDuplicateName, L"A component named %s already exists" + System_RTLConsts_SDuplicateString, L"String list does not allow duplicates" + System_RTLConsts_SFCreateErrorEx, L"Cannot create file \"%s\". %s" + System_SysConst_SShortDayNameWed, L"Wed" + System_SysConst_SShortDayNameThu, L"Thu" + System_SysConst_SShortDayNameFri, L"Fri" + System_SysConst_SShortDayNameSat, L"Sat" + System_SysConst_SLongDayNameSun, L"Sunday" + System_SysConst_SLongDayNameMon, L"Monday" + System_SysConst_SLongDayNameTue, L"Tuesday" + System_SysConst_SLongDayNameWed, L"Wednesday" + System_SysConst_SLongDayNameThu, L"Thursday" + System_SysConst_SLongDayNameFri, L"Friday" + System_SysConst_SLongDayNameSat, L"Saturday" + System_SysConst_SInvalidSourceArray, L"Invalid source array" + System_SysConst_SInvalidDestinationArray, L"Invalid destination array" + System_SysConst_SCharIndexOutOfBounds, L"Character index out of bounds (%d)" + System_SysConst_SByteIndexOutOfBounds, L"Start index out of bounds (%d)" + System_SysConst_SInvalidCharCount, L"Invalid count (%d)" + System_SysConst_SShortMonthNameDec, L"Dec" + System_SysConst_SLongMonthNameJan, L"January" + System_SysConst_SLongMonthNameFeb, L"February" + System_SysConst_SLongMonthNameMar, L"March" + System_SysConst_SLongMonthNameApr, L"April" + System_SysConst_SLongMonthNameMay, L"May" + System_SysConst_SLongMonthNameJun, L"June" + System_SysConst_SLongMonthNameJul, L"July" + System_SysConst_SLongMonthNameAug, L"August" + System_SysConst_SLongMonthNameSep, L"September" + System_SysConst_SLongMonthNameOct, L"October" + System_SysConst_SLongMonthNameNov, L"November" + System_SysConst_SLongMonthNameDec, L"December" + System_SysConst_SShortDayNameSun, L"Sun" + System_SysConst_SShortDayNameMon, L"Mon" + System_SysConst_SShortDayNameTue, L"Tue" + System_SysConst_SAssertError, L"%s (%s, line %d)" + System_SysConst_SAbstractError, L"Abstract Error" + System_SysConst_SModuleAccessViolation, L"Access violation at address %p in module '%s' (offset %x). %s of address %p" + System_SysConst_SOSError, L"System Error. Code: %d.\r\n%s%s" + System_SysConst_SUnkOSError, L"A call to an OS function failed" + System_SysConst_SShortMonthNameJan, L"Jan" + System_SysConst_SShortMonthNameFeb, L"Feb" + System_SysConst_SShortMonthNameMar, L"Mar" + System_SysConst_SShortMonthNameApr, L"Apr" + System_SysConst_SShortMonthNameMay, L"May" + System_SysConst_SShortMonthNameJun, L"Jun" + System_SysConst_SShortMonthNameJul, L"Jul" + System_SysConst_SShortMonthNameAug, L"Aug" + System_SysConst_SShortMonthNameSep, L"Sep" + System_SysConst_SShortMonthNameOct, L"Oct" + System_SysConst_SShortMonthNameNov, L"Nov" + System_SysConst_SVarTypeTooManyCustom, L"Too many custom variant types have been registered" + System_SysConst_SVarTypeCouldNotConvert, L"Could not convert variant of type (%s) into type (%s)" + System_SysConst_SVarTypeConvertOverflow, L"Overflow while converting variant of type (%s) into type (%s)" + System_SysConst_SVarOverflow, L"Variant overflow" + System_SysConst_SVarInvalid, L"Invalid argument" + System_SysConst_SVarBadType, L"Invalid variant type" + System_SysConst_SVarNotImplemented, L"Operation not supported" + System_SysConst_SVarUnexpected, L"Unexpected variant error" + System_SysConst_SExternalException, L"External exception %x" + System_SysConst_SAssertionFailed, L"Assertion failed" + System_SysConst_SIntfCastError, L"Interface not supported" + System_SysConst_SSafecallException, L"Exception in safecall method" + System_SysConst_SMonitorLockException, L"Object lock not owned" + System_SysConst_SNoMonitorSupportException, L"Monitor support function not initialized" + System_SysConst_SNotImplemented, L"Feature not implemented" + System_SysConst_SObjectDisposed, L"Method called on disposed object" + System_SysConst_SArgumentMissing, L"No argument for format '%s'" + System_SysConst_SDispatchError, L"Variant method calls not supported" + System_SysConst_SReadAccess, L"Read" + System_SysConst_SWriteAccess, L"Write" + System_SysConst_SExecuteAccess, L"Execution" + System_SysConst_SInvalidAccess, L"Invalid access" + System_SysConst_SVarArrayCreate, L"Error creating variant or safe array" + System_SysConst_SVarArrayBounds, L"Variant or safe array index out of bounds" + System_SysConst_SVarArrayLocked, L"Variant or safe array is locked" + System_SysConst_SInvalidVarCast, L"Invalid variant type conversion" + System_SysConst_SInvalidVarOp, L"Invalid variant operation" + System_SysConst_SInvalidVarNullOp, L"Invalid NULL variant operation" + System_SysConst_SInvalidVarOpWithHResultWithPrefix, L"Invalid variant operation (%s%.8x)\n%s" + System_SysConst_SVarTypeOutOfRangeWithPrefix, L"Custom variant type (%s%.4x) is out of range" + System_SysConst_SVarTypeAlreadyUsedWithPrefix, L"Custom variant type (%s%.4x) already used by %s" + System_SysConst_SVarTypeNotUsableWithPrefix, L"Custom variant type (%s%.4x) is not usable" + System_SysConst_SRangeError, L"Range check error" + System_SysConst_SIntOverflow, L"Integer overflow" + System_SysConst_SInvalidOp, L"Invalid floating point operation" + System_SysConst_SZeroDivide, L"Floating point division by zero" + System_SysConst_SOverflow, L"Floating point overflow" + System_SysConst_SUnderflow, L"Floating point underflow" + System_SysConst_SInvalidPointer, L"Invalid pointer operation" + System_SysConst_SInvalidCast, L"Invalid class typecast" + System_SysConst_SAccessViolationArg3, L"Access violation at address %p. %s of address %p" + System_SysConst_SAccessViolationNoArg, L"Access violation" + System_SysConst_SStackOverflow, L"Stack overflow" + System_SysConst_SControlC, L"Control-C hit" + System_SysConst_SPrivilege, L"Privileged instruction" + System_SysConst_SException, L"Exception %s in module %s at %p.\r\n%s%s\r\n" + System_SysConst_SExceptTitle, L"Application Error" + System_SysConst_SInvalidFormat, L"Format '%s' invalid or incompatible with argument" + System_SysConst_SUnknown, L"" + System_SysConst_SInvalidInteger, L"'%s' is not a valid integer value" + System_SysConst_SInvalidTimeStamp, L"'%d.%d' is not a valid timestamp" + System_SysConst_SInvalidGUID, L"'%s' is not a valid GUID value" + System_SysConst_STimeEncodeError, L"Invalid argument to time encode" + System_SysConst_SDateEncodeError, L"Invalid argument to date encode" + System_SysConst_SOutOfMemory, L"Out of memory" + System_SysConst_SInOutError, L"I/O error %d" + System_SysConst_SFileNotFound, L"File not found" + System_SysConst_SInvalidUnknownFilename, L"Invalid filename" + System_SysConst_STooManyOpenFiles, L"Too many open files" + System_SysConst_SAccessDenied, L"File access denied" + System_SysConst_SEndOfFile, L"Read beyond end of file" + System_SysConst_SDiskFull, L"Disk full" + System_SysConst_SInvalidInput, L"Invalid numeric input" + System_SysConst_SDivByZero, L"Division by zero" +END + +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win64\release\Controls.res */ +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win64\release\Dialogs.res */ +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win64\release\Buttons.res */ +/* c:\program files (x86)\embarcadero\studio\23.0\lib\Win64\release\SPIN.RES */ +/* D:\_Delphi\_Library\Netcom7\Demos\UDP\ncUDPSockets\Server\ufrmMain.dfm */ +/* D:\_Delphi\_Library\Netcom7\Demos\UDP\ncUDPSockets\Server\Server.res */ +/* D:\_Delphi\_Library\Netcom7\Demos\UDP\ncUDPSockets\Server\Server.drf */ diff --git a/Demos/SimpleSockets/Srv/Server.dsk b/Demos/UDP/ncUDPSockets/Server/Server.dsk similarity index 94% rename from Demos/SimpleSockets/Srv/Server.dsk rename to Demos/UDP/ncUDPSockets/Server/Server.dsk index 1fc1133..78670b2 100644 --- a/Demos/SimpleSockets/Srv/Server.dsk +++ b/Demos/UDP/ncUDPSockets/Server/Server.dsk @@ -1,768 +1,768 @@ -[Closed Files] -File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,1081,1,1097,0,0,, -File_1=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.Forms.pas',0,1,1,15,10,0,0,{{1755,4} -File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.StdCtrls.pas',0,1,1,6,10,0,0,{{1657,4} -File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,1,6,10,0,0,, -File_4=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\RTL\SYS\System.SysUtils.pas',0,1,1,6,16,0,0,, -File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Messages.pas',0,1,1,6,19,0,0,, -File_6=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncSockets.pas',0,1,1241,1,1260,0,0,,{1 -File_7=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncSources.pas',0,1,738,3,762,0,0,,{1 -File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPIHelpers.pas',0,1,1,1,5,0,0,,{1 -File_9=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncThreads.pas',0,1,88,13,95,0,0,, - -[Modules] -Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas -Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dproj -Count=2 -EditWindowCount=1 - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas] -ModuleType=TSourceModule - -[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dproj] -ModuleType=TBaseProject - -[EditWindow0] -ViewCount=2 -CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas -View0=0 -View1=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=9900 -Height=8837 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=9900 -ClientHeight=8837 -DockedToMainForm=1 -BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 -TopPanelSize=0 -LeftPanelSize=1894 -LeftPanelClients=PropertyInspector,DockSite3 -LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF -RightPanelSize=1525 -RightPanelClients=DockSite2,DockSite4 -RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF -BottomPanelSize=0 -BottomPanelClients=DockSite1,MessageView -BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF -BottomMiddlePanelSize=0 -BottomMiddlePanelClients=DockSite0,GraphDrawingModel -BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF - -[View0] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dpr -CursorX=20 -CursorY=5 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dpr - -[View1] -CustomEditViewType=TEditView -Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas -CursorX=11 -CursorY=6 -TopLine=1 -LeftCol=1 -Elisions= -Bookmarks= -EditViewName=Borland.FormDesignerView - -[UndockedDesigner] -Count=0 - -[Watches] -Count=0 - -[WatchWindow] -WatchColumnWidth=120 -WatchShowColumnHeaders=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=13600 -Dockable=1 -StayOnTop=0 - -[Breakpoints] -Count=0 - -[EmbarcaderoWin32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoWin64Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid32Debugger_AddressBreakpoints] -Count=0 - -[EmbarcaderoAndroid64Debugger_AddressBreakpoints] -Count=0 - -[Main Window] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=0 -State=2 -Left=144 -Top=279 -Width=8931 -Height=8523 -MaxLeft=-6 -MaxTop=-12 -MaxWidth=8931 -MaxHeight=8523 -ClientWidth=10025 -ClientHeight=9744 -BottomPanelSize=8444 -BottomPanelClients=EditWindow0 -BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF - -[ProjectManager] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5895 -LRDockWidth=2350 -Dockable=1 -StayOnTop=0 - -[MessageView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2769 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2769 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=2769 -Dockable=1 -StayOnTop=0 - -[ToolForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=7151 -LRDockWidth=2000 -Dockable=1 -StayOnTop=0 - -[ClipboardHistory] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2338 -Height=5174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2262 -ClientHeight=4733 -TBDockHeight=5174 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 - -[PropertyInspector] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=358 -Width=1894 -Height=4674 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=4674 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -SplitPos=111 - -[PropInspDesignerSelection] -ArrangeBy=Name -SelectedItem=Action, -ExpandedItems=LiveBindings=0,"LiveBindings Designer=0",Margins=0,ActiveControl=0,Anchors=0,BorderIcons=0 - -[frmDesignPreview] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=5953 -LRDockWidth=2512 -Dockable=1 -StayOnTop=0 - -[TemplateView] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=275 -Height=360 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=275 -ClientHeight=360 -TBDockHeight=360 -LRDockWidth=275 -Dockable=1 -StayOnTop=0 -Name=120 -Description=334 -filter=1 - -[DebugLogView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=407 -LRDockWidth=4950 -Dockable=1 -StayOnTop=0 - -[ThreadStatusWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=209 -LRDockWidth=7406 -Dockable=1 -StayOnTop=0 -Column0Width=145 -Column1Width=100 -Column2Width=115 -Column3Width=252 - -[LocalVarsWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1535 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[CallStackWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=2070 -LRDockWidth=3481 -Dockable=1 -StayOnTop=0 - -[PatchForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2500 -LRDockWidth=3400 -Dockable=1 -StayOnTop=0 - -[FindReferencsForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=2314 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[RefactoringForm] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1151 -TBDockHeight=3209 -LRDockWidth=2825 -Dockable=1 -StayOnTop=0 - -[ToDo List] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1140 -TBDockHeight=1151 -LRDockWidth=3675 -Dockable=1 -StayOnTop=0 -Column0Width=314 -Column1Width=30 -Column2Width=150 -Column3Width=172 -Column4Width=129 -SortOrder=4 -ShowHints=1 -ShowChecked=1 - -[DataExplorerContainer] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=7150 -Dockable=1 -StayOnTop=0 - -[GraphDrawingModel] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2856 -Height=3209 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2856 -ClientHeight=3209 -TBDockHeight=3209 -LRDockWidth=2856 -Dockable=1 -StayOnTop=0 - -[ClassBrowserTool] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=-318 -Top=-363 -Width=1850 -Height=3140 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1850 -ClientHeight=3140 -TBDockHeight=3140 -LRDockWidth=1850 -Dockable=1 -StayOnTop=0 - -[MetricsView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[QAView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=2338 -Height=1163 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1163 -TBDockHeight=4837 -LRDockWidth=3562 -Dockable=1 -StayOnTop=0 - -[BreakpointWindow] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=3825 -Height=1093 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1093 -TBDockHeight=1547 -LRDockWidth=8744 -Dockable=1 -StayOnTop=0 -Column0Width=200 -Column1Width=75 -Column2Width=200 -Column3Width=200 -Column4Width=200 -Column5Width=75 -Column6Width=75 - -[StructureView] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=3674 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 - -[fmGrepResults] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=2575 -Height=4372 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=2475 -ClientHeight=3919 -TBDockHeight=4372 -LRDockWidth=2575 -Dockable=1 -StayOnTop=0 - -[ModelViewTool] -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=0 -Width=1525 -Height=4151 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4151 -TBDockHeight=4884 -LRDockWidth=5306 -Dockable=1 -StayOnTop=0 - -[BorlandEditorCodeExplorer@EditWindow0] -PercentageSizes=1 -Create=1 -Visible=0 -Docked=0 -State=0 -Left=0 -Top=0 -Width=1825 -Height=6174 -MaxLeft=-6 -MaxTop=-12 -ClientWidth=1725 -ClientHeight=5721 -TBDockHeight=6174 -LRDockWidth=1825 -Dockable=1 -StayOnTop=0 - -[DockHosts] -DockHostCount=5 - -[DockSite0] -HostDockSite=DockBottomCenterPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=2338 -Height=1477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=2338 -ClientHeight=1477 -TBDockHeight=1477 -LRDockWidth=2338 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=RefactoringForm -TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView - -[DockSite1] -HostDockSite=DockBottomPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=0 -Docked=1 -State=0 -Left=8 -Top=8 -Width=3825 -Height=1419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=3825 -ClientHeight=1419 -TBDockHeight=1419 -LRDockWidth=3825 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=DebugLogView -TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow - -[DockSite2] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1525 -Height=4477 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=4477 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ProjectManager -TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview - -[DockSite3] -HostDockSite=DockLeftPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=28 -Width=1894 -Height=3419 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1894 -ClientHeight=3419 -TBDockHeight=9012 -LRDockWidth=1894 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=StructureView -TabDockClients=StructureView,ClassBrowserTool - -[DockSite4] -HostDockSite=DockRightPanel -DockSiteType=1 -PercentageSizes=1 -Create=1 -Visible=1 -Docked=1 -State=0 -Left=0 -Top=449 -Width=1525 -Height=3616 -MaxLeft=-1 -MaxTop=-1 -ClientWidth=1525 -ClientHeight=3616 -TBDockHeight=9012 -LRDockWidth=1525 -Dockable=1 -StayOnTop=0 -TabPosition=1 -ActiveTabID=ToolForm -TabDockClients=ToolForm,TemplateView - +[Closed Files] +File_0=TSourceModule,'C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSockets.pas',0,1,1081,1,1097,0,0,, +File_1=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.Forms.pas',0,1,1,15,10,0,0,{{1755,4} +File_2=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\VCL\Vcl.StdCtrls.pas',0,1,1,6,10,0,0,{{1657,4} +File_3=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pas',0,1,1,6,10,0,0,, +File_4=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\SOURCE\RTL\SYS\System.SysUtils.pas',0,1,1,6,16,0,0,, +File_5=TSourceModule,'c:\program files (x86)\embarcadero\studio\20.0\source\rtl\win\Winapi.Messages.pas',0,1,1,6,19,0,0,, +File_6=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncSockets.pas',0,1,1241,1,1260,0,0,,{1 +File_7=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncSources.pas',0,1,738,3,762,0,0,,{1 +File_8=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\DirectPanel\dpDXAPIHelpers.pas',0,1,1,1,5,0,0,,{1 +File_9=TSourceModule,'C:\Users\BDemos\Documents\RAD Studio\Components\NetCom7\Source\ncThreads.pas',0,1,88,13,95,0,0,, + +[Modules] +Module0=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas +Module1=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dproj +Count=2 +EditWindowCount=1 + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas] +ModuleType=TSourceModule + +[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dproj] +ModuleType=TBaseProject + +[EditWindow0] +ViewCount=2 +CurrentEditView=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas +View0=0 +View1=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=9900 +Height=8837 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=9900 +ClientHeight=8837 +DockedToMainForm=1 +BorlandEditorCodeExplorer=BorlandEditorCodeExplorer@EditWindow0 +TopPanelSize=0 +LeftPanelSize=1894 +LeftPanelClients=PropertyInspector,DockSite3 +LeftPanelData=000008000101000000008E120000000000000166070000000000000100000000530E000009000000446F636B53697465330100000000FC2000001100000050726F7065727479496E73706563746F72FFFFFFFF +RightPanelSize=1525 +RightPanelClients=DockSite2,DockSite4 +RightPanelData=000008000101000000008E1200000000000001F50500000000000001000000004612000009000000446F636B53697465320100000000FC20000009000000446F636B5369746534FFFFFFFF +BottomPanelSize=0 +BottomPanelClients=DockSite1,MessageView +BottomPanelData=0000080001020200000009000000446F636B53697465310F0000004D65737361676556696577466F726D1534000000000000022A06000000000000FFFFFFFF +BottomMiddlePanelSize=0 +BottomMiddlePanelClients=DockSite0,GraphDrawingModel +BottomMiddelPanelData=0000080001020200000009000000446F636B536974653010000000477261706844726177696E67566965779A1D00000000000002F206000000000000FFFFFFFF + +[View0] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dpr +CursorX=20 +CursorY=5 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dpr + +[View1] +CustomEditViewType=TEditView +Module=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas +CursorX=11 +CursorY=6 +TopLine=1 +LeftCol=1 +Elisions= +Bookmarks= +EditViewName=Borland.FormDesignerView + +[UndockedDesigner] +Count=0 + +[Watches] +Count=0 + +[WatchWindow] +WatchColumnWidth=120 +WatchShowColumnHeaders=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=13600 +Dockable=1 +StayOnTop=0 + +[Breakpoints] +Count=0 + +[EmbarcaderoWin32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoWin64Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid32Debugger_AddressBreakpoints] +Count=0 + +[EmbarcaderoAndroid64Debugger_AddressBreakpoints] +Count=0 + +[Main Window] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=0 +State=2 +Left=144 +Top=279 +Width=8931 +Height=8523 +MaxLeft=-6 +MaxTop=-12 +MaxWidth=8931 +MaxHeight=8523 +ClientWidth=10025 +ClientHeight=9744 +BottomPanelSize=8444 +BottomPanelClients=EditWindow0 +BottomPanelData=0000080000000000000000000000000000000000000000000000000100000000000000000C0000004564697457696E646F775F30FFFFFFFF + +[ProjectManager] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5895 +LRDockWidth=2350 +Dockable=1 +StayOnTop=0 + +[MessageView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2769 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2769 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=2769 +Dockable=1 +StayOnTop=0 + +[ToolForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=7151 +LRDockWidth=2000 +Dockable=1 +StayOnTop=0 + +[ClipboardHistory] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2338 +Height=5174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2262 +ClientHeight=4733 +TBDockHeight=5174 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 + +[PropertyInspector] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=358 +Width=1894 +Height=4674 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=4674 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +SplitPos=111 + +[PropInspDesignerSelection] +ArrangeBy=Name +SelectedItem=Action, +ExpandedItems=LiveBindings=0,"LiveBindings Designer=0",Margins=0,ActiveControl=0,Anchors=0,BorderIcons=0 + +[frmDesignPreview] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=5953 +LRDockWidth=2512 +Dockable=1 +StayOnTop=0 + +[TemplateView] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=275 +Height=360 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=275 +ClientHeight=360 +TBDockHeight=360 +LRDockWidth=275 +Dockable=1 +StayOnTop=0 +Name=120 +Description=334 +filter=1 + +[DebugLogView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=407 +LRDockWidth=4950 +Dockable=1 +StayOnTop=0 + +[ThreadStatusWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=209 +LRDockWidth=7406 +Dockable=1 +StayOnTop=0 +Column0Width=145 +Column1Width=100 +Column2Width=115 +Column3Width=252 + +[LocalVarsWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1535 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[CallStackWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=2070 +LRDockWidth=3481 +Dockable=1 +StayOnTop=0 + +[PatchForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2500 +LRDockWidth=3400 +Dockable=1 +StayOnTop=0 + +[FindReferencsForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=2314 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[RefactoringForm] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1151 +TBDockHeight=3209 +LRDockWidth=2825 +Dockable=1 +StayOnTop=0 + +[ToDo List] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1140 +TBDockHeight=1151 +LRDockWidth=3675 +Dockable=1 +StayOnTop=0 +Column0Width=314 +Column1Width=30 +Column2Width=150 +Column3Width=172 +Column4Width=129 +SortOrder=4 +ShowHints=1 +ShowChecked=1 + +[DataExplorerContainer] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=7150 +Dockable=1 +StayOnTop=0 + +[GraphDrawingModel] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2856 +Height=3209 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2856 +ClientHeight=3209 +TBDockHeight=3209 +LRDockWidth=2856 +Dockable=1 +StayOnTop=0 + +[ClassBrowserTool] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=-318 +Top=-363 +Width=1850 +Height=3140 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1850 +ClientHeight=3140 +TBDockHeight=3140 +LRDockWidth=1850 +Dockable=1 +StayOnTop=0 + +[MetricsView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[QAView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=2338 +Height=1163 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1163 +TBDockHeight=4837 +LRDockWidth=3562 +Dockable=1 +StayOnTop=0 + +[BreakpointWindow] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=3825 +Height=1093 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1093 +TBDockHeight=1547 +LRDockWidth=8744 +Dockable=1 +StayOnTop=0 +Column0Width=200 +Column1Width=75 +Column2Width=200 +Column3Width=200 +Column4Width=200 +Column5Width=75 +Column6Width=75 + +[StructureView] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=3674 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 + +[fmGrepResults] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=2575 +Height=4372 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=2475 +ClientHeight=3919 +TBDockHeight=4372 +LRDockWidth=2575 +Dockable=1 +StayOnTop=0 + +[ModelViewTool] +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=0 +Width=1525 +Height=4151 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4151 +TBDockHeight=4884 +LRDockWidth=5306 +Dockable=1 +StayOnTop=0 + +[BorlandEditorCodeExplorer@EditWindow0] +PercentageSizes=1 +Create=1 +Visible=0 +Docked=0 +State=0 +Left=0 +Top=0 +Width=1825 +Height=6174 +MaxLeft=-6 +MaxTop=-12 +ClientWidth=1725 +ClientHeight=5721 +TBDockHeight=6174 +LRDockWidth=1825 +Dockable=1 +StayOnTop=0 + +[DockHosts] +DockHostCount=5 + +[DockSite0] +HostDockSite=DockBottomCenterPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=2338 +Height=1477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=2338 +ClientHeight=1477 +TBDockHeight=1477 +LRDockWidth=2338 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=RefactoringForm +TabDockClients=RefactoringForm,PatchForm,FindReferencsForm,ToDo List,MetricsView,QAView + +[DockSite1] +HostDockSite=DockBottomPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=0 +Docked=1 +State=0 +Left=8 +Top=8 +Width=3825 +Height=1419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=3825 +ClientHeight=1419 +TBDockHeight=1419 +LRDockWidth=3825 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=DebugLogView +TabDockClients=DebugLogView,BreakpointWindow,ThreadStatusWindow,CallStackWindow,WatchWindow,LocalVarsWindow + +[DockSite2] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1525 +Height=4477 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=4477 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ProjectManager +TabDockClients=ProjectManager,ModelViewTool,DataExplorerContainer,frmDesignPreview + +[DockSite3] +HostDockSite=DockLeftPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=28 +Width=1894 +Height=3419 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1894 +ClientHeight=3419 +TBDockHeight=9012 +LRDockWidth=1894 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=StructureView +TabDockClients=StructureView,ClassBrowserTool + +[DockSite4] +HostDockSite=DockRightPanel +DockSiteType=1 +PercentageSizes=1 +Create=1 +Visible=1 +Docked=1 +State=0 +Left=0 +Top=449 +Width=1525 +Height=3616 +MaxLeft=-1 +MaxTop=-1 +ClientWidth=1525 +ClientHeight=3616 +TBDockHeight=9012 +LRDockWidth=1525 +Dockable=1 +StayOnTop=0 +TabPosition=1 +ActiveTabID=ToolForm +TabDockClients=ToolForm,TemplateView + diff --git a/Demos/UDP/ncUDPSockets/Server/Server.identcache b/Demos/UDP/ncUDPSockets/Server/Server.identcache new file mode 100644 index 0000000..3ab5b2f Binary files /dev/null and b/Demos/UDP/ncUDPSockets/Server/Server.identcache differ diff --git a/Demos/UDP/ncUDPSockets/Server/Server.res b/Demos/UDP/ncUDPSockets/Server/Server.res new file mode 100644 index 0000000..0af1ebd Binary files /dev/null and b/Demos/UDP/ncUDPSockets/Server/Server.res differ diff --git a/Demos/SimpleSockets/Srv/Server.skincfg b/Demos/UDP/ncUDPSockets/Server/Server.skincfg similarity index 94% rename from Demos/SimpleSockets/Srv/Server.skincfg rename to Demos/UDP/ncUDPSockets/Server/Server.skincfg index 9e7a05b..0f00ce7 100644 --- a/Demos/SimpleSockets/Srv/Server.skincfg +++ b/Demos/UDP/ncUDPSockets/Server/Server.skincfg @@ -1,33 +1,33 @@ -[ExpressSkins] -Default=1 -ShowNotifications=1 -Enabled=1 -dxSkinBlack=1 -dxSkinBlue=0 -dxSkinCaramel=0 -dxSkinCoffee=0 -dxSkinDarkRoom=0 -dxSkinDarkSide=1 -dxSkinFoggy=0 -dxSkinGlassOceans=0 -dxSkiniMaginary=0 -dxSkinLilian=0 -dxSkinLiquidSky=0 -dxSkinLondonLiquidSky=0 -dxSkinMcSkin=0 -dxSkinMoneyTwins=0 -dxSkinOffice2007Black=1 -dxSkinOffice2007Blue=0 -dxSkinOffice2007Green=0 -dxSkinOffice2007Pink=0 -dxSkinOffice2007Silver=1 -dxSkinPumpkin=0 -dxSkinSeven=0 -dxSkinSharp=0 -dxSkinSilver=0 -dxSkinSpringTime=0 -dxSkinStardust=0 -dxSkinSummer2008=0 -dxSkinsDefaultPainters=0 -dxSkinValentine=0 -dxSkinXmas2008Blue=0 +[ExpressSkins] +Default=1 +ShowNotifications=1 +Enabled=1 +dxSkinBlack=1 +dxSkinBlue=0 +dxSkinCaramel=0 +dxSkinCoffee=0 +dxSkinDarkRoom=0 +dxSkinDarkSide=1 +dxSkinFoggy=0 +dxSkinGlassOceans=0 +dxSkiniMaginary=0 +dxSkinLilian=0 +dxSkinLiquidSky=0 +dxSkinLondonLiquidSky=0 +dxSkinMcSkin=0 +dxSkinMoneyTwins=0 +dxSkinOffice2007Black=1 +dxSkinOffice2007Blue=0 +dxSkinOffice2007Green=0 +dxSkinOffice2007Pink=0 +dxSkinOffice2007Silver=1 +dxSkinPumpkin=0 +dxSkinSeven=0 +dxSkinSharp=0 +dxSkinSilver=0 +dxSkinSpringTime=0 +dxSkinStardust=0 +dxSkinSummer2008=0 +dxSkinsDefaultPainters=0 +dxSkinValentine=0 +dxSkinXmas2008Blue=0 diff --git a/Demos/SimpleSockets/Srv/Server_Icon.ico b/Demos/UDP/ncUDPSockets/Server/Server_Icon.ico similarity index 100% rename from Demos/SimpleSockets/Srv/Server_Icon.ico rename to Demos/UDP/ncUDPSockets/Server/Server_Icon.ico diff --git a/Demos/UDP/ncUDPSockets/Server/ufrmMain.dfm b/Demos/UDP/ncUDPSockets/Server/ufrmMain.dfm new file mode 100644 index 0000000..24aaa69 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Server/ufrmMain.dfm @@ -0,0 +1,94 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'UDPServer' + ClientHeight = 244 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 202 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start UDP Server' + TabOrder = 0 + OnClick = btnActivateClick + end + object pblPort: TPanel + AlignWithMargins = True + Left = 115 + Top = 3 + Width = 412 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 0 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 16233 + OnChange = edtPortChange + end + end + end + object UDPServer: TncUDPServer + OnReadDatagram = UDPServerReadDatagram + Left = 232 + Top = 104 + end +end diff --git a/Demos/UDP/ncUDPSockets/Server/ufrmMain.pas b/Demos/UDP/ncUDPSockets/Server/ufrmMain.pas new file mode 100644 index 0000000..162f7f0 --- /dev/null +++ b/Demos/UDP/ncUDPSockets/Server/ufrmMain.pas @@ -0,0 +1,170 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, System.Diagnostics, + ncLines, ncUDPSockets, ncIPUtils; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pblPort: TPanel; + edtPort: TSpinEdit; + UDPServer: TncUDPServer; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnActivateClick(Sender: TObject); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure edtPortChange(Sender: TObject); + procedure SendToClient(const Data: string; const DestAddr: TSockAddrStorage); + procedure UDPServerReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; + const SenderAddr: TSockAddrStorage); + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin +// +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + UDPServer.Active := False; +end; + +// ***************************************************************************** +// Start/Stop Main CLient +// ***************************************************************************** +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if UDPServer.Active then + begin + // Deactivate the UDP client + UDPServer.Active := False; + btnActivate.Caption := 'Start UDP Server'; + Form1.Log('UDP Server Deactivated'); + end + else + begin + try + // Activate the UDP client + UDPServer.Active := True; + btnActivate.Caption := 'Stop UDP Server'; + Form1.Log('UDP Server Activated'); + except + on E: Exception do + Form1.Log('Failed to activate UDP Server: ' + E.Message); + end; + end; +end; + +// ***************************************************************************** +// Change Main Server port +// ***************************************************************************** +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + UDPServer.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := UDPServer.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +// ***************************************************************************** +// SendToClient +// ***************************************************************************** +procedure TForm1.SendToClient(const Data: string; const DestAddr: TSockAddrStorage); +var + SenderIP: string; +begin + if not UDPServer.Active then + Exit; + + try + // Get IP address using our utils + SenderIP := TncIPUtils.GetIPFromStorage(DestAddr); + + // Send the data - pass TSockAddrStorage directly + UDPServer.SendTo(BytesOf(Data), DestAddr); + + Form1.Log(Format('Sent to %s: %s', [SenderIP, Data])); + except + on E: Exception do + Form1.Log('Error sending data: ' + E.Message); + end; +end; + +// ***************************************************************************** +// Read Data +// ***************************************************************************** +procedure TForm1.UDPServerReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; const SenderAddr: TSockAddrStorage); +var + ReceivedData: string; + SenderIP: string; +begin + try + // Convert received data to string + ReceivedData := StringOf(Copy(aBuf, 0, aBufCount)); + + // Get sender IP address using our utils + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + + // Log and echo + Form1.Log(Format('Received from %s: %s', [SenderIP, ReceivedData])); + SendToClient('Echo: ' + ReceivedData, SenderAddr); + except + on E: Exception do + Form1.Log(Format('Error processing datagram: %s', [E.Message])); + end; +end; + +// ***************************************************************************** +// Memo Log +// ***************************************************************************** +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), + AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. diff --git a/Demos/UDP/ncUDPSockets/UDPSockets.groupproj b/Demos/UDP/ncUDPSockets/UDPSockets.groupproj new file mode 100644 index 0000000..29ca13f --- /dev/null +++ b/Demos/UDP/ncUDPSockets/UDPSockets.groupproj @@ -0,0 +1,48 @@ + + + {7EB9A25E-4A42-4DE8-919E-70124E14615F} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/Demos/UDP/ncUDPSockets/UDPSockets_UDPv4.PNG b/Demos/UDP/ncUDPSockets/UDPSockets_UDPv4.PNG new file mode 100644 index 0000000..15bb068 Binary files /dev/null and b/Demos/UDP/ncUDPSockets/UDPSockets_UDPv4.PNG differ diff --git a/Demos/UDP/ncUDPSockets/UDPSockets_UDPv6.PNG b/Demos/UDP/ncUDPSockets/UDPSockets_UDPv6.PNG new file mode 100644 index 0000000..4abb230 Binary files /dev/null and b/Demos/UDP/ncUDPSockets/UDPSockets_UDPv6.PNG differ diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dpr b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dpr new file mode 100644 index 0000000..a5d4cdd --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dpr @@ -0,0 +1,14 @@ +program UDPClient; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dproj b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dproj new file mode 100644 index 0000000..5d3cfec --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dproj @@ -0,0 +1,190 @@ + + + {97EFB123-834A-4EA4-8F07-796EBFAC98FC} + UDPClient.dpr + True + Debug + UDPClient + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + UDPClient + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + UDPClient.dpr + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dproj.local b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.identcache b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.identcache new file mode 100644 index 0000000..9ae2096 Binary files /dev/null and b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.identcache differ diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.res b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.res new file mode 100644 index 0000000..9c1433c Binary files /dev/null and b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/UDPClient.res differ diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/ufrmMain.dfm b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/ufrmMain.dfm new file mode 100644 index 0000000..95ccc00 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/ufrmMain.dfm @@ -0,0 +1,264 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + ActiveControl = edtDataToSend + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'UDP Client - Image Transfer' + ClientHeight = 307 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 169 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start UDP Client' + TabOrder = 0 + OnClick = btnActivateClick + end + object pnlAddress: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtHost: TEdit + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 281 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = '127.0.0.1' + TextHint = 'Enter host address' + OnChange = edtHostChange + end + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 291 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 211 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object btnSendData: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send Raw Data' + Default = True + TabOrder = 0 + OnClick = btnSendDataClick + end + object Panel2: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtDataToSend: TEdit + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 407 + Height = 21 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = 'This is some text data' + TextHint = 'Enter data to send here' + OnEnter = edtDataToSendEnter + OnExit = edtDataToSendExit + end + end + end + object Panel3: TPanel + Left = 0 + Top = 243 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 3 + object btnSendCommand: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send Command' + TabOrder = 0 + OnClick = btnSendCommandClick + end + object Panel4: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtCommandData: TEdit + AlignWithMargins = True + Left = 5 + Top = 2 + Width = 407 + Height = 21 + Margins.Left = 0 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + TabOrder = 0 + Text = 'Hello Server!' + TextHint = 'Enter command data here' + end + end + end + object Panel6: TPanel + Left = 0 + Top = 275 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 4 + object btnSendScreenshot: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 517 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + Caption = 'Send Screenshot' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 0 + OnClick = btnSendScreenshotClick + end + end + object UDPClient: TncUDPClientDual + Broadcast = True + OnReadDatagram = UDPClientReadDatagram + OnCommand = UDPClientCommand + Left = 208 + Top = 104 + end +end diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/ufrmMain.pas b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/ufrmMain.pas new file mode 100644 index 0000000..91f8066 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Client/ufrmMain.pas @@ -0,0 +1,379 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, Vcl.Graphics, Vcl.Imaging.jpeg, + System.Diagnostics, System.SyncObjs, ncLines, ncUDPSocketsDual, ncIPUtils; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pnlAddress: TPanel; + edtHost: TEdit; + edtPort: TSpinEdit; + Panel1: TPanel; + btnSendData: TButton; + Panel2: TPanel; + edtDataToSend: TEdit; + Panel3: TPanel; + btnSendCommand: TButton; + Panel4: TPanel; + edtCommandData: TEdit; + Panel6: TPanel; + btnSendScreenshot: TButton; + UDPClient: TncUDPClientDual; + + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnActivateClick(Sender: TObject); + procedure edtHostChange(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure edtDataToSendEnter(Sender: TObject); + procedure edtDataToSendExit(Sender: TObject); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure btnSendDataClick(Sender: TObject); + procedure btnSendCommandClick(Sender: TObject); + procedure btnSendScreenshotClick(Sender: TObject); + procedure UDPClientReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; + const SenderAddr: TSockAddrStorage); + procedure UDPClientCommand(Sender: TObject; aLine: TncLine; + const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; + aFlags: Byte; aSequence: UInt16); + + private + FCommandParser: TStringList; + FCommandLock: TCriticalSection; + function CaptureScreenshot: TBytes; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +function TForm1.CaptureScreenshot: TBytes; +var + DC: HDC; + ScreenBMP: TBitmap; + jpgImage: TJPEGImage; + MS: TMemoryStream; +begin + Result := nil; + + // Create required objects for screen capture + ScreenBMP := TBitmap.Create; + jpgImage := TJPEGImage.Create; + MS := TMemoryStream.Create; + try + // Set bitmap dimensions to match screen resolution + ScreenBMP.Width := Screen.Width; + ScreenBMP.Height := Screen.Height; + + // Get device context for the entire screen (0 = desktop window) + DC := GetDC(0); + try + // Copy screen pixels to bitmap using BitBlt + BitBlt(ScreenBMP.Canvas.Handle, 0, 0, Screen.Width, + Screen.Height, DC, 0, 0, SRCCOPY); + finally + ReleaseDC(0, DC); + end; + + // Convert to JPEG with 30% quality for network efficiency + jpgImage.Assign(ScreenBMP); + jpgImage.CompressionQuality := 30; + jpgImage.SaveToStream(MS); + + // Return JPEG data + MS.Position := 0; + SetLength(Result, MS.Size); + if MS.Size > 0 then + MS.ReadBuffer(Result[0], MS.Size); + + Log(Format('Screenshot captured: %d bytes', [Length(Result)])); + + finally + ScreenBMP.Free; + jpgImage.Free; + MS.Free; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + // Initialize command parsing structures + FCommandParser := TStringList.Create; + FCommandParser.Delimiter := '|'; + FCommandParser.StrictDelimiter := True; + FCommandLock := TCriticalSection.Create; + + // Initialize controls + edtCommandData.Text := 'Hello Server!'; + edtHost.Text := '127.0.0.1'; + edtPort.Value := 16233; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + UDPClient.Active := False; + + if Assigned(FCommandParser) then + FCommandParser.Free; + if Assigned(FCommandLock) then + FCommandLock.Free; +end; + +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if UDPClient.Active then + begin + UDPClient.Active := False; + btnActivate.Caption := 'Start UDP Client'; + Log('UDP Client Deactivated'); + end + else + begin + if Trim(edtHost.Text) = '' then + begin + Log('Host field cannot be blank.'); + Exit; + end; + + try + UDPClient.Host := edtHost.Text; + UDPClient.Port := edtPort.Value; + UDPClient.Active := True; + btnActivate.Caption := 'Stop UDP Client'; + Log('UDP Client Activated'); + except + on E: Exception do + Log('Failed to activate UDP Client: ' + E.Message); + end; + end; +end; + +procedure TForm1.edtHostChange(Sender: TObject); +begin + try + UDPClient.Host := edtHost.Text; + except + edtHost.OnChange := nil; + try + edtHost.Text := UDPClient.Host; + finally + edtHost.OnChange := edtHostChange; + end; + raise; + end; +end; + +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + UDPClient.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := UDPClient.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +procedure TForm1.edtDataToSendEnter(Sender: TObject); +begin + btnSendData.Default := True; +end; + +procedure TForm1.edtDataToSendExit(Sender: TObject); +begin + btnSendData.Default := False; +end; + +procedure TForm1.btnSendDataClick(Sender: TObject); +begin + try + if not UDPClient.Active then + begin + Log('Cannot send - client not active'); + Exit; + end; + + if Trim(edtDataToSend.Text) = '' then + begin + Log('Cannot send - Data field cannot be blank.'); + Exit; + end; + + UDPClient.Send(edtDataToSend.Text); + Log(Format('[RAW DATA] Sent: %s', [edtDataToSend.Text])); + except + on E: Exception do + Log('Error sending: ' + E.Message); + end; +end; + +procedure TForm1.btnSendCommandClick(Sender: TObject); +var + CommandData: TBytes; +begin + try + if not UDPClient.Active then + begin + Log('Cannot send command - client not active'); + Exit; + end; + + if Trim(edtCommandData.Text) <> '' then + CommandData := BytesOf(edtCommandData.Text) + else + SetLength(CommandData, 0); + + UDPClient.SendCommand(0, BytesOf('MSG|') + CommandData); + + except + on E: Exception do + Log('Error sending command: ' + E.Message); + end; +end; + +procedure TForm1.btnSendScreenshotClick(Sender: TObject); +var + ScreenshotData: TBytes; +begin + try + if not UDPClient.Active then + begin + Log('Cannot send screenshot - client not active'); + Exit; + end; + + Log('Capturing screenshot...'); + ScreenshotData := CaptureScreenshot; + + if Length(ScreenshotData) = 0 then + begin + Log('Failed to capture screenshot'); + Exit; + end; + + UDPClient.SendCommand(0, BytesOf('ScreenShot|') + ScreenshotData); + + Log('SEND SCREENSHOT') + + except + on E: Exception do + Log('Error sending screenshot: ' + E.Message); + end; +end; + +procedure TForm1.UDPClientCommand(Sender: TObject; aLine: TncLine; + const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; + aFlags: Byte; aSequence: UInt16); +var + SenderIP: string; + DataStr: string; + CommandName: string; +begin + try + SenderIP := TncIPUtils.GetIPFromStorage(aSenderAddr); + except + on E: EIPError do + SenderIP := Format('Invalid Address: %s', [E.Message]); + end; + + if Length(aData) > 0 then + DataStr := StringOf(aData) + else + DataStr := '(no data)'; + + // Parse command using same logic as TCP demo + FCommandLock.Enter; + try + FCommandParser.Clear; + FCommandParser.DelimitedText := DataStr; + + if FCommandParser.Count > 0 then + begin + CommandName := FCommandParser[0]; + + // Handle different commands + if CommandName = 'TITLE' then + begin + if FCommandParser.Count > 1 then + begin + Self.Caption := FCommandParser[1]; + Log(Format('[COMMAND] Title changed to: %s', [FCommandParser[1]])); + end; + end + else + begin + Log(Format('[COMMAND] Received from %s: %s', [SenderIP, CommandName])); + end; + end + else + begin + Log(Format('[COMMAND] Received from %s: ID=%d, Data=%s, Flags=%d, Seq=%d', + [SenderIP, aCmd, DataStr, aFlags, aSequence])); + end; + finally + FCommandLock.Leave; + end; +end; + +procedure TForm1.UDPClientReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; const SenderAddr: TSockAddrStorage); +var + ReceivedData: string; + SenderIP: string; +begin + ReceivedData := StringOf(Copy(aBuf, 0, aBufCount)); + + try + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + except + on E: EIPError do + SenderIP := Format('Invalid Address: %s', [E.Message]); + end; + + Log(Format('[RAW DATA] Received from %s: %s', [SenderIP, ReceivedData])); +end; + +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dpr b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dpr new file mode 100644 index 0000000..eb591f7 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dpr @@ -0,0 +1,14 @@ +program UDPServer; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dproj b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dproj new file mode 100644 index 0000000..21976cb --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dproj @@ -0,0 +1,190 @@ + + + {E2EAC035-B027-4E62-A982-B19AE5F74BA3} + UDPServer.dpr + True + Debug + UDPServer + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + UDPServer + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + UDPServer.dpr + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dproj.local b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.identcache b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.identcache new file mode 100644 index 0000000..a2d7b63 Binary files /dev/null and b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.identcache differ diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.res b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.res new file mode 100644 index 0000000..4acd4e7 Binary files /dev/null and b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/UDPServer.res differ diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/ufrmMain.dfm b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/ufrmMain.dfm new file mode 100644 index 0000000..8d0d360 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/ufrmMain.dfm @@ -0,0 +1,170 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'UDP Server - Image Display' + ClientHeight = 231 + ClientWidth = 802 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object Image1: TImage + Left = 600 + Top = 72 + Width = 192 + Height = 145 + end + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 69 + Width = 587 + Height = 157 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 802 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start UDP Server' + TabOrder = 0 + OnClick = btnActivateClick + end + object pblPort: TPanel + AlignWithMargins = True + Left = 115 + Top = 3 + Width = 687 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 0 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 37 + Width = 802 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object btnSendCommand: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send Command' + TabOrder = 0 + OnClick = btnSendCommandClick + end + object Panel2: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 692 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object Label1: TLabel + AlignWithMargins = True + Left = 3 + Top = 6 + Width = 51 + Height = 17 + Margins.Top = 6 + Align = alLeft + Caption = 'Command:' + ExplicitHeight = 13 + end + object edtCommandData: TEdit + AlignWithMargins = True + Left = 57 + Top = 0 + Width = 630 + Height = 21 + Margins.Left = 0 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = 'TITLE|New Window Title' + TextHint = 'Enter command to send to last client' + end + end + end + object UDPServer: TncUDPServerDual + Broadcast = True + OnReadDatagram = UDPServerReadDatagram + OnCommand = UDPServerCommand + Left = 240 + Top = 128 + end +end diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/ufrmMain.pas b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/ufrmMain.pas new file mode 100644 index 0000000..48eb0f7 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/Server/ufrmMain.pas @@ -0,0 +1,360 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.Math, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, Vcl.Graphics, Vcl.Imaging.jpeg, + System.Diagnostics, System.SyncObjs, ncLines, ncUDPSocketsDual, ncIPUtils; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pblPort: TPanel; + edtPort: TSpinEdit; + Panel1: TPanel; + btnSendCommand: TButton; + Panel2: TPanel; + edtCommandData: TEdit; + Label1: TLabel; + Image1: TImage; + UDPServer: TncUDPServerDual; + + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnActivateClick(Sender: TObject); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure edtPortChange(Sender: TObject); + procedure btnSendCommandClick(Sender: TObject); + procedure UDPServerReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; + const SenderAddr: TSockAddrStorage); + procedure UDPServerCommand(Sender: TObject; aLine: TncLine; + const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; + aFlags: Byte; aSequence: UInt16); + + private + FCommandParser: TStringList; + FCommandLock: TCriticalSection; + FLastClientAddr: TSockAddrStorage; + FHasLastClient: Boolean; + + procedure DisplayScreenShot(const aData: TBytes); + procedure SendCommandToLastClient(const AMessage: string); + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + // Initialize command parsing structures + FCommandParser := TStringList.Create; + FCommandParser.Delimiter := '|'; + FCommandParser.StrictDelimiter := True; + FCommandLock := TCriticalSection.Create; + + // Initialize client tracking + FHasLastClient := False; + + // Initialize image display + Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height); + Image1.Picture.Bitmap.Canvas.Brush.Color := clBlack; + Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height)); + + edtCommandData.Text := 'TITLE|New Window Title'; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + UDPServer.Active := False; + + if Assigned(FCommandParser) then + FCommandParser.Free; + if Assigned(FCommandLock) then + FCommandLock.Free; +end; + +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if UDPServer.Active then + begin + UDPServer.Active := False; + btnActivate.Caption := 'Start UDP Server'; + Log('UDP Server Deactivated'); + end + else + begin + try + UDPServer.Port := edtPort.Value; + UDPServer.Active := True; + btnActivate.Caption := 'Stop UDP Server'; + Log('UDP Server Activated on port ' + IntToStr(edtPort.Value)); + except + on E: Exception do + Log('Failed to activate UDP Server: ' + E.Message); + end; + end; +end; + +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + UDPServer.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := UDPServer.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +procedure TForm1.btnSendCommandClick(Sender: TObject); +begin + if not FHasLastClient then + begin + Log('No client available - receive a packet from a client first'); + Exit; + end; + + if Trim(edtCommandData.Text) = '' then + begin + Log('Command data cannot be blank'); + Exit; + end; + + SendCommandToLastClient(edtCommandData.Text); +end; + +procedure TForm1.SendCommandToLastClient(const AMessage: string); +var + ClientIP: string; +begin + if not UDPServer.Active then + Exit; + + if not FHasLastClient then + begin + Log('No client address available'); + Exit; + end; + + try + ClientIP := TncIPUtils.GetIPFromStorage(FLastClientAddr); + UDPServer.SendCommand(FLastClientAddr, 0, BytesOf(AMessage)); + Log(Format('[COMMAND] Sent to %s: %s', [ClientIP, AMessage])); + except + on E: Exception do + Log('Error sending command: ' + E.Message); + end; +end; + +procedure TForm1.UDPServerReadDatagram(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer; const SenderAddr: TSockAddrStorage); +var + ReceivedData: string; + SenderIP: string; +begin + try + ReceivedData := StringOf(Copy(aBuf, 0, aBufCount)); + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + + // Remember last client for sending responses + FLastClientAddr := SenderAddr; + FHasLastClient := True; + + Log(Format('[RAW DATA] Received from %s: %s', [SenderIP, ReceivedData])); + + // Echo back the data + UDPServer.SendTo(BytesOf('Echo: ' + ReceivedData), SenderAddr); + Log(Format('[RAW DATA] Sent echo to %s', [SenderIP])); + except + on E: Exception do + Log(Format('Error processing datagram: %s', [E.Message])); + end; +end; + +procedure TForm1.UDPServerCommand(Sender: TObject; aLine: TncLine; const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + SenderIP: string; +begin + try + // Get sender IP for logging + SenderIP := TncIPUtils.GetIPFromStorage(aSenderAddr); + + // Store last client info for sending commands back + FLastClientAddr := aSenderAddr; + FHasLastClient := True; + + // Log command reception with size info + Log(Format('[COMMAND] Received from %s: Cmd=%d, DataSize=%d bytes, Flags=%d, Seq=%d', + [SenderIP, aCmd, Length(aData), aFlags, aSequence])); + + // Parse command data as string for processing + var DataStr: string; + if Length(aData) > 0 then + DataStr := StringOf(aData) + else + DataStr := ''; + + FCommandLock.Enter; + try + FCommandParser.Clear; + FCommandParser.DelimitedText := DataStr; + + if FCommandParser.Count > 0 then + begin + var CommandName := FCommandParser[0]; + + //////////////////////////////////////////////////////////////////////////////// + /// Handle command ScreenShot (client sending image) + //////////////////////////////////////////////////////////////////////////////// + if CommandName = 'ScreenShot' then + begin + + if FCommandParser.Count > 1 then + begin + + TThread.Queue(nil, + procedure + var + imageData: TBytes; + begin + try + // Extract image data from command - skip "ScreenShot|" (10 bytes) + // aData contains: "ScreenShot|" + JPEG binary data + imageData := Copy(aData, 11, Length(aData)); + + Form1.DisplayScreenShot(imageData); + + Log('RECEIVE SCREENSHOT'); + + // Send acknowledgment back to client + UDPServer.SendCommand(aSenderAddr, 0, BytesOf('TITLE|Screenshot Received!')); + + except + on E: Exception do + begin + Log(Format('[%s] Error processing screenshot: %s', [TimeToStr(Now), E.Message])); + end; + end; + end); + end + end + //////////////////////////////////////////////////////////////////////////////// + /// Handle command TITLE (changing client window title) + //////////////////////////////////////////////////////////////////////////////// + else if CommandName = 'TITLE' then + begin + if FCommandParser.Count > 1 then + begin + Log(Format('[TITLE] Setting title from %s: %s', [SenderIP, FCommandParser[1]])); + TThread.Queue(nil, procedure + begin + Caption := FCommandParser[1]; + end); + end; + end + //////////////////////////////////////////////////////////////////////////////// + /// Handle command MSG (general message) + //////////////////////////////////////////////////////////////////////////////// + else if CommandName = 'MSG' then + begin + if FCommandParser.Count > 1 then + begin + Log(Format('[MSG] Message from %s: %s', [SenderIP, FCommandParser[1]])); + end; + end + //////////////////////////////////////////////////////////////////////////////// + /// Handle unknown commands + //////////////////////////////////////////////////////////////////////////////// + else + begin + Log(Format('[COMMAND] Unknown command from %s: %s', [SenderIP, CommandName])); + + // Echo the command back to the client + UDPServer.SendCommand(aSenderAddr, 100, BytesOf('Echo: ' + DataStr)); + end; + end + else + begin + Log(Format('[COMMAND] Raw command from %s: %s', [SenderIP, DataStr])); + + // Send response for unstructured commands + UDPServer.SendCommand(aSenderAddr, 101, BytesOf('Received: ' + DataStr)); + end; + finally + FCommandLock.Leave; + end; + except + on E: Exception do + Log(Format('Error processing command: %s', [E.Message])); + end; +end; + +procedure TForm1.DisplayScreenShot(const aData: TBytes); +var + MS: TMemoryStream; + jpgImage: TJPEGImage; +begin + // Create streams for JPEG loading + MS := TMemoryStream.Create; + jpgImage := TJPEGImage.Create; + try + // Load JPEG data directly into stream + MS.WriteBuffer(aData[0], Length(aData)); + MS.Position := 0; + + // Load JPEG from data stream + jpgImage.LoadFromStream(MS); + + // Display in TImage component + if Assigned(Form1) and Assigned(Form1.Image1) then + begin + Form1.Image1.Picture.Assign(jpgImage); + Form1.Image1.Stretch := True; + end; + + finally + MS.Free; + jpgImage.Free; + end; +end; + +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsDual_ImageDisplay/UDPSocketsDual_ImageDisplay.groupproj b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/UDPSocketsDual_ImageDisplay.groupproj new file mode 100644 index 0000000..d92f069 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsDual_ImageDisplay/UDPSocketsDual_ImageDisplay.groupproj @@ -0,0 +1,48 @@ + + + {E7EA7F9E-9B7A-4F4D-9B5C-8F4B6A5E2D1C} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dpr b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dpr new file mode 100644 index 0000000..a5d4cdd --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dpr @@ -0,0 +1,14 @@ +program UDPClient; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dproj b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dproj new file mode 100644 index 0000000..5d3cfec --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dproj @@ -0,0 +1,190 @@ + + + {97EFB123-834A-4EA4-8F07-796EBFAC98FC} + UDPClient.dpr + True + Debug + UDPClient + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + UDPClient + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + UDPClient.dpr + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dproj.local b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.identcache b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.identcache new file mode 100644 index 0000000..6ecc560 Binary files /dev/null and b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.identcache differ diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.res b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.res new file mode 100644 index 0000000..9c1433c Binary files /dev/null and b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/UDPClient.res differ diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/ufrmMain.dfm b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/ufrmMain.dfm new file mode 100644 index 0000000..cd2050a --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/ufrmMain.dfm @@ -0,0 +1,229 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'UDP Client - Image Transfer' + ClientHeight = 307 + ClientWidth = 527 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 37 + Width = 517 + Height = 169 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 1 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 527 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start UDP Client' + TabOrder = 0 + OnClick = btnActivateClick + end + object pnlAddress: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtHost: TEdit + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 281 + Height = 21 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = '127.0.0.1' + TextHint = 'Enter host address' + OnChange = edtHostChange + end + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 291 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alRight + MaxValue = 0 + MinValue = 0 + TabOrder = 1 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 211 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object Panel2: TPanel + AlignWithMargins = True + Left = 0 + Top = 3 + Width = 527 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 0 + end + end + object Panel3: TPanel + Left = 0 + Top = 243 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 3 + object btnSendCommand: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send Command' + TabOrder = 0 + OnClick = btnSendCommandClick + end + object Panel4: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 417 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtCommandData: TEdit + AlignWithMargins = True + Left = 5 + Top = 2 + Width = 407 + Height = 21 + Margins.Left = 0 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + TabOrder = 0 + Text = 'Hello Server!' + TextHint = 'Enter command data here' + end + end + end + object Panel6: TPanel + Left = 0 + Top = 275 + Width = 527 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alBottom + BevelOuter = bvNone + FullRepaint = False + TabOrder = 4 + object btnSendScreenshot: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 517 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + Caption = 'Send Screenshot' + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + TabOrder = 0 + OnClick = btnSendScreenshotClick + end + end + object UDPClient: TncUDPClientLCP + Broadcast = True + OnCommand = UDPClientCommand + Left = 200 + Top = 96 + end +end diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/ufrmMain.pas b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/ufrmMain.pas new file mode 100644 index 0000000..187a48b --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Client/ufrmMain.pas @@ -0,0 +1,323 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, Vcl.Graphics, Vcl.Imaging.jpeg, + System.Diagnostics, System.SyncObjs, ncLines, ncIPUtils, + ncUDPSocketsLCP; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pnlAddress: TPanel; + edtHost: TEdit; + edtPort: TSpinEdit; + Panel1: TPanel; + Panel2: TPanel; + Panel3: TPanel; + btnSendCommand: TButton; + Panel4: TPanel; + edtCommandData: TEdit; + Panel6: TPanel; + btnSendScreenshot: TButton; + UDPClient: TncUDPClientLCP; + + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnActivateClick(Sender: TObject); + procedure edtHostChange(Sender: TObject); + procedure edtPortChange(Sender: TObject); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure btnSendCommandClick(Sender: TObject); + procedure btnSendScreenshotClick(Sender: TObject); + procedure UDPClientCommand(Sender: TObject; aLine: TncLine; + const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; + aFlags: Byte; aSequence: UInt16); + + private + FCommandParser: TStringList; + FCommandLock: TCriticalSection; + function CaptureScreenshot: TBytes; + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +function TForm1.CaptureScreenshot: TBytes; +var + DC: HDC; + ScreenBMP: TBitmap; + jpgImage: TJPEGImage; + MS: TMemoryStream; +begin + Result := nil; + + // Create required objects for screen capture + ScreenBMP := TBitmap.Create; + jpgImage := TJPEGImage.Create; + MS := TMemoryStream.Create; + try + // Set bitmap dimensions to match screen resolution + ScreenBMP.Width := Screen.Width; + ScreenBMP.Height := Screen.Height; + + // Get device context for the entire screen (0 = desktop window) + DC := GetDC(0); + try + // Copy screen pixels to bitmap using BitBlt + BitBlt(ScreenBMP.Canvas.Handle, 0, 0, Screen.Width, + Screen.Height, DC, 0, 0, SRCCOPY); + finally + ReleaseDC(0, DC); + end; + + // Convert to JPEG with 30% quality for network efficiency + jpgImage.Assign(ScreenBMP); + jpgImage.CompressionQuality := 30; + jpgImage.SaveToStream(MS); + + // Return JPEG data + MS.Position := 0; + SetLength(Result, MS.Size); + if MS.Size > 0 then + MS.ReadBuffer(Result[0], MS.Size); + + Log(Format('Screenshot captured: %d bytes', [Length(Result)])); + + finally + ScreenBMP.Free; + jpgImage.Free; + MS.Free; + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + // Initialize command parsing structures + FCommandParser := TStringList.Create; + FCommandParser.Delimiter := '|'; + FCommandParser.StrictDelimiter := True; + FCommandLock := TCriticalSection.Create; + + // Initialize controls + edtCommandData.Text := 'Hello Server!'; + edtHost.Text := '127.0.0.1'; + edtPort.Value := 16233; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + UDPClient.Active := False; + + if Assigned(FCommandParser) then + FCommandParser.Free; + if Assigned(FCommandLock) then + FCommandLock.Free; +end; + +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if UDPClient.Active then + begin + UDPClient.Active := False; + btnActivate.Caption := 'Start UDP Client'; + Log('UDP Client Deactivated'); + end + else + begin + if Trim(edtHost.Text) = '' then + begin + Log('Host field cannot be blank.'); + Exit; + end; + + try + UDPClient.Host := edtHost.Text; + UDPClient.Port := edtPort.Value; + UDPClient.Active := True; + btnActivate.Caption := 'Stop UDP Client'; + Log('UDP Client Activated'); + except + on E: Exception do + Log('Failed to activate UDP Client: ' + E.Message); + end; + end; +end; + +procedure TForm1.edtHostChange(Sender: TObject); +begin + try + UDPClient.Host := edtHost.Text; + except + edtHost.OnChange := nil; + try + edtHost.Text := UDPClient.Host; + finally + edtHost.OnChange := edtHostChange; + end; + raise; + end; +end; + +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + UDPClient.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := UDPClient.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + + + +procedure TForm1.btnSendCommandClick(Sender: TObject); +var + CommandData: TBytes; +begin + try + if not UDPClient.Active then + begin + Log('Cannot send command - client not active'); + Exit; + end; + + if Trim(edtCommandData.Text) <> '' then + CommandData := BytesOf(edtCommandData.Text) + else + SetLength(CommandData, 0); + + UDPClient.SendCommand(0, BytesOf('MSG|') + CommandData); + + except + on E: Exception do + Log('Error sending command: ' + E.Message); + end; +end; + +procedure TForm1.btnSendScreenshotClick(Sender: TObject); +var + ScreenshotData: TBytes; +begin + try + if not UDPClient.Active then + begin + Log('Cannot send screenshot - client not active'); + Exit; + end; + + Log('Capturing screenshot...'); + ScreenshotData := CaptureScreenshot; + + if Length(ScreenshotData) = 0 then + begin + Log('Failed to capture screenshot'); + Exit; + end; + + UDPClient.SendCommand(0, BytesOf('ScreenShot|') + ScreenshotData); + + Log('SEND SCREENSHOT') + + except + on E: Exception do + Log('Error sending screenshot: ' + E.Message); + end; +end; + +procedure TForm1.UDPClientCommand(Sender: TObject; aLine: TncLine; + const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; + aFlags: Byte; aSequence: UInt16); +var + SenderIP: string; + DataStr: string; + CommandName: string; +begin + try + SenderIP := TncIPUtils.GetIPFromStorage(aSenderAddr); + except + on E: EIPError do + SenderIP := Format('Invalid Address: %s', [E.Message]); + end; + + if Length(aData) > 0 then + DataStr := StringOf(aData) + else + DataStr := '(no data)'; + + // Parse command using same logic as TCP demo + FCommandLock.Enter; + try + FCommandParser.Clear; + FCommandParser.DelimitedText := DataStr; + + if FCommandParser.Count > 0 then + begin + CommandName := FCommandParser[0]; + + // Handle different commands + if CommandName = 'TITLE' then + begin + if FCommandParser.Count > 1 then + begin + Self.Caption := FCommandParser[1]; + Log(Format('[COMMAND] Title changed to: %s', [FCommandParser[1]])); + end; + end + else + begin + Log(Format('[COMMAND] Received from %s: %s', [SenderIP, CommandName])); + end; + end + else + begin + Log(Format('[COMMAND] Received from %s: ID=%d, Data=%s, Flags=%d, Seq=%d', + [SenderIP, aCmd, DataStr, aFlags, aSequence])); + end; + finally + FCommandLock.Leave; + end; +end; + +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dpr b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dpr new file mode 100644 index 0000000..eb591f7 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dpr @@ -0,0 +1,14 @@ +program UDPServer; + +uses + Vcl.Forms, + ufrmMain in 'ufrmMain.pas' {Form1}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dproj b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dproj new file mode 100644 index 0000000..21976cb --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dproj @@ -0,0 +1,190 @@ + + + {E2EAC035-B027-4E62-A982-B19AE5F74BA3} + UDPServer.dpr + True + Debug + UDPServer + 693377 + Application + VCL + 20.2 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + true + Cfg_2 + true + true + + + false + false + false + false + false + 00400000 + UDPServer + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) + 1036 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= + + + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + activity-1.7.2.dex.jar;annotation-experimental-1.3.0.dex.jar;annotation-jvm-1.6.0.dex.jar;annotations-13.0.dex.jar;appcompat-1.2.0.dex.jar;appcompat-resources-1.2.0.dex.jar;billing-6.0.1.dex.jar;biometric-1.1.0.dex.jar;browser-1.4.0.dex.jar;cloud-messaging.dex.jar;collection-1.1.0.dex.jar;concurrent-futures-1.1.0.dex.jar;core-1.10.1.dex.jar;core-common-2.2.0.dex.jar;core-ktx-1.10.1.dex.jar;core-runtime-2.2.0.dex.jar;cursoradapter-1.0.0.dex.jar;customview-1.0.0.dex.jar;documentfile-1.0.0.dex.jar;drawerlayout-1.0.0.dex.jar;error_prone_annotations-2.9.0.dex.jar;exifinterface-1.3.6.dex.jar;firebase-annotations-16.2.0.dex.jar;firebase-common-20.3.1.dex.jar;firebase-components-17.1.0.dex.jar;firebase-datatransport-18.1.7.dex.jar;firebase-encoders-17.0.0.dex.jar;firebase-encoders-json-18.0.0.dex.jar;firebase-encoders-proto-16.0.0.dex.jar;firebase-iid-interop-17.1.0.dex.jar;firebase-installations-17.1.3.dex.jar;firebase-installations-interop-17.1.0.dex.jar;firebase-measurement-connector-19.0.0.dex.jar;firebase-messaging-23.1.2.dex.jar;fmx.dex.jar;fragment-1.2.5.dex.jar;google-play-licensing.dex.jar;interpolator-1.0.0.dex.jar;javax.inject-1.dex.jar;kotlin-stdlib-1.8.22.dex.jar;kotlin-stdlib-common-1.8.22.dex.jar;kotlin-stdlib-jdk7-1.8.22.dex.jar;kotlin-stdlib-jdk8-1.8.22.dex.jar;kotlinx-coroutines-android-1.6.4.dex.jar;kotlinx-coroutines-core-jvm-1.6.4.dex.jar;legacy-support-core-utils-1.0.0.dex.jar;lifecycle-common-2.6.1.dex.jar;lifecycle-livedata-2.6.1.dex.jar;lifecycle-livedata-core-2.6.1.dex.jar;lifecycle-runtime-2.6.1.dex.jar;lifecycle-service-2.6.1.dex.jar;lifecycle-viewmodel-2.6.1.dex.jar;lifecycle-viewmodel-savedstate-2.6.1.dex.jar;listenablefuture-1.0.dex.jar;loader-1.0.0.dex.jar;localbroadcastmanager-1.0.0.dex.jar;okio-jvm-3.4.0.dex.jar;play-services-ads-22.2.0.dex.jar;play-services-ads-base-22.2.0.dex.jar;play-services-ads-identifier-18.0.0.dex.jar;play-services-ads-lite-22.2.0.dex.jar;play-services-appset-16.0.1.dex.jar;play-services-base-18.1.0.dex.jar;play-services-basement-18.1.0.dex.jar;play-services-cloud-messaging-17.0.1.dex.jar;play-services-location-21.0.1.dex.jar;play-services-maps-18.1.0.dex.jar;play-services-measurement-base-20.1.2.dex.jar;play-services-measurement-sdk-api-20.1.2.dex.jar;play-services-stats-17.0.2.dex.jar;play-services-tasks-18.0.2.dex.jar;print-1.0.0.dex.jar;profileinstaller-1.3.0.dex.jar;room-common-2.2.5.dex.jar;room-runtime-2.2.5.dex.jar;savedstate-1.2.1.dex.jar;sqlite-2.1.0.dex.jar;sqlite-framework-2.1.0.dex.jar;startup-runtime-1.1.1.dex.jar;tracing-1.0.0.dex.jar;transport-api-3.0.0.dex.jar;transport-backend-cct-3.1.8.dex.jar;transport-runtime-3.1.8.dex.jar;user-messaging-platform-2.0.0.dex.jar;vectordrawable-1.1.0.dex.jar;vectordrawable-animated-1.1.0.dex.jar;versionedparcelable-1.1.1.dex.jar;viewpager-1.0.0.dex.jar;work-runtime-2.7.0.dex.jar + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + + + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) + 1033 + $(BDS)\bin\default_app.manifest + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + PerMonitorV2 + + + DEBUG;$(DCC_Define) + false + true + true + true + + + Debug + + + Debug + + + Debug + + + Debug + + + PerMonitorV2 + + + + MainSource + + +
Form1
+ + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + + + + + UDPServer.dpr + + + + True + True + True + True + True + True + True + False + + + 12 + + + + diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dproj.local b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dproj.local new file mode 100644 index 0000000..b3811b7 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.dproj.local @@ -0,0 +1,2 @@ + + diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.identcache b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.identcache new file mode 100644 index 0000000..9360d5f Binary files /dev/null and b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.identcache differ diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.res b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.res new file mode 100644 index 0000000..4acd4e7 Binary files /dev/null and b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/UDPServer.res differ diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/ufrmMain.dfm b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/ufrmMain.dfm new file mode 100644 index 0000000..cbaf777 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/ufrmMain.dfm @@ -0,0 +1,169 @@ +object Form1: TForm1 + Left = 0 + Top = 0 + BorderIcons = [biSystemMenu, biMinimize] + Caption = 'UDP Server - Image Display' + ClientHeight = 231 + ClientWidth = 802 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + Position = poScreenCenter + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 13 + object Image1: TImage + Left = 600 + Top = 72 + Width = 192 + Height = 145 + end + object memLog: TMemo + AlignWithMargins = True + Left = 5 + Top = 69 + Width = 587 + Height = 157 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + ReadOnly = True + ScrollBars = ssVertical + TabOrder = 0 + OnKeyDown = memLogKeyDown + end + object pnlToolbar: TPanel + Left = 0 + Top = 0 + Width = 802 + Height = 37 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object btnActivate: TButton + AlignWithMargins = True + Left = 5 + Top = 5 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Start UDP Server' + TabOrder = 0 + OnClick = btnActivateClick + end + object pblPort: TPanel + AlignWithMargins = True + Left = 115 + Top = 3 + Width = 687 + Height = 31 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object edtPort: TSpinEdit + AlignWithMargins = True + Left = 0 + Top = 5 + Width = 121 + Height = 22 + Margins.Left = 0 + Margins.Top = 5 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alLeft + MaxValue = 0 + MinValue = 0 + TabOrder = 0 + Value = 16233 + OnChange = edtPortChange + end + end + end + object Panel1: TPanel + Left = 0 + Top = 37 + Width = 802 + Height = 32 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alTop + BevelOuter = bvNone + FullRepaint = False + TabOrder = 2 + object btnSendCommand: TButton + AlignWithMargins = True + Left = 5 + Top = 0 + Width = 105 + Height = 27 + Margins.Left = 5 + Margins.Top = 0 + Margins.Right = 0 + Margins.Bottom = 5 + Align = alLeft + Caption = 'Send Command' + TabOrder = 0 + OnClick = btnSendCommandClick + end + object Panel2: TPanel + AlignWithMargins = True + Left = 110 + Top = 3 + Width = 692 + Height = 26 + Margins.Left = 0 + Margins.Right = 0 + Align = alClient + BevelOuter = bvNone + FullRepaint = False + TabOrder = 1 + object Label1: TLabel + AlignWithMargins = True + Left = 3 + Top = 6 + Width = 51 + Height = 17 + Margins.Top = 6 + Align = alLeft + Caption = 'Command:' + ExplicitHeight = 13 + end + object edtCommandData: TEdit + AlignWithMargins = True + Left = 57 + Top = 0 + Width = 630 + Height = 21 + Margins.Left = 0 + Margins.Top = 0 + Margins.Right = 5 + Margins.Bottom = 5 + Align = alClient + TabOrder = 0 + Text = 'TITLE|New Window Title' + TextHint = 'Enter command to send to last client' + end + end + end + object UDPServer: TncUDPServerLCP + Broadcast = True + OnCommand = UDPServerCommand + Left = 224 + Top = 120 + end +end diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/ufrmMain.pas b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/ufrmMain.pas new file mode 100644 index 0000000..8c3ebd2 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/Server/ufrmMain.pas @@ -0,0 +1,333 @@ +unit ufrmMain; + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.Math, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, + Vcl.ExtCtrls, Vcl.Samples.Spin, Vcl.Graphics, Vcl.Imaging.jpeg, + System.Diagnostics, System.SyncObjs, ncLines, ncIPUtils, + ncUDPSocketsLCP; + +type + TForm1 = class(TForm) + memLog: TMemo; + pnlToolbar: TPanel; + btnActivate: TButton; + pblPort: TPanel; + edtPort: TSpinEdit; + Panel1: TPanel; + btnSendCommand: TButton; + Panel2: TPanel; + edtCommandData: TEdit; + Label1: TLabel; + Image1: TImage; + UDPServer: TncUDPServerLCP; + + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure btnActivateClick(Sender: TObject); + procedure Log(const AMessage: string); + procedure memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + procedure edtPortChange(Sender: TObject); + procedure btnSendCommandClick(Sender: TObject); + procedure UDPServerCommand(Sender: TObject; aLine: TncLine; + const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; + aFlags: Byte; aSequence: UInt16); + + private + FCommandParser: TStringList; + FCommandLock: TCriticalSection; + FLastClientAddr: TSockAddrStorage; + FHasLastClient: Boolean; + + procedure DisplayScreenShot(const aData: TBytes); + procedure SendCommandToLastClient(const AMessage: string); + public + end; + +var + Form1: TForm1; + +implementation + +{$R *.dfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + // Initialize command parsing structures + FCommandParser := TStringList.Create; + FCommandParser.Delimiter := '|'; + FCommandParser.StrictDelimiter := True; + FCommandLock := TCriticalSection.Create; + + // Initialize client tracking + FHasLastClient := False; + + // Initialize image display + Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height); + Image1.Picture.Bitmap.Canvas.Brush.Color := clBlack; + Image1.Picture.Bitmap.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height)); + + edtCommandData.Text := 'TITLE|New Window Title'; +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + UDPServer.Active := False; + + if Assigned(FCommandParser) then + FCommandParser.Free; + if Assigned(FCommandLock) then + FCommandLock.Free; +end; + +procedure TForm1.btnActivateClick(Sender: TObject); +begin + if UDPServer.Active then + begin + UDPServer.Active := False; + btnActivate.Caption := 'Start UDP Server'; + Log('UDP Server Deactivated'); + end + else + begin + try + UDPServer.Port := edtPort.Value; + UDPServer.Active := True; + btnActivate.Caption := 'Stop UDP Server'; + Log('UDP Server Activated on port ' + IntToStr(edtPort.Value)); + except + on E: Exception do + Log('Failed to activate UDP Server: ' + E.Message); + end; + end; +end; + +procedure TForm1.edtPortChange(Sender: TObject); +begin + try + UDPServer.Port := edtPort.Value; + except + edtPort.OnChange := nil; + try + edtPort.Value := UDPServer.Port; + finally + edtPort.OnChange := edtPortChange; + end; + raise; + end; +end; + +procedure TForm1.btnSendCommandClick(Sender: TObject); +begin + if not FHasLastClient then + begin + Log('No client available - receive a packet from a client first'); + Exit; + end; + + if Trim(edtCommandData.Text) = '' then + begin + Log('Command data cannot be blank'); + Exit; + end; + + SendCommandToLastClient(edtCommandData.Text); +end; + +procedure TForm1.SendCommandToLastClient(const AMessage: string); +var + ClientIP: string; +begin + if not UDPServer.Active then + Exit; + + if not FHasLastClient then + begin + Log('No client address available'); + Exit; + end; + + try + ClientIP := TncIPUtils.GetIPFromStorage(FLastClientAddr); + UDPServer.SendCommand(FLastClientAddr, 0, BytesOf(AMessage)); + Log(Format('[COMMAND] Sent to %s: %s', [ClientIP, AMessage])); + except + on E: Exception do + Log('Error sending command: ' + E.Message); + end; +end; + +procedure TForm1.UDPServerCommand(Sender: TObject; aLine: TncLine; const aSenderAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + SenderIP: string; +begin + try + // Get sender IP for logging + SenderIP := TncIPUtils.GetIPFromStorage(aSenderAddr); + + // Store last client info for sending commands back + FLastClientAddr := aSenderAddr; + FHasLastClient := True; + + // Log command reception with size info + Log(Format('[COMMAND] Received from %s: Cmd=%d, DataSize=%d bytes, Flags=%d, Seq=%d', + [SenderIP, aCmd, Length(aData), aFlags, aSequence])); + + // Parse command data as string for processing + var DataStr: string; + if Length(aData) > 0 then + DataStr := StringOf(aData) + else + DataStr := ''; + + FCommandLock.Enter; + try + FCommandParser.Clear; + FCommandParser.DelimitedText := DataStr; + + if FCommandParser.Count > 0 then + begin + var CommandName := FCommandParser[0]; + + //////////////////////////////////////////////////////////////////////////////// + /// Handle command ScreenShot (client sending image) + //////////////////////////////////////////////////////////////////////////////// + if CommandName = 'ScreenShot' then + begin + + if FCommandParser.Count > 1 then + begin + + TThread.Queue(nil, + procedure + var + imageData: TBytes; + begin + try + // Extract image data from command - skip "ScreenShot|" (10 bytes) + // aData contains: "ScreenShot|" + JPEG binary data + imageData := Copy(aData, 11, Length(aData)); + + Form1.DisplayScreenShot(imageData); + + Log('RECEIVE SCREENSHOT'); + + // Send acknowledgment back to client + UDPServer.SendCommand(aSenderAddr, 0, BytesOf('TITLE|Screenshot Received!')); + + except + on E: Exception do + begin + Log(Format('[%s] Error processing screenshot: %s', [TimeToStr(Now), E.Message])); + end; + end; + end); + end + end + //////////////////////////////////////////////////////////////////////////////// + /// Handle command TITLE (changing client window title) + //////////////////////////////////////////////////////////////////////////////// + else if CommandName = 'TITLE' then + begin + if FCommandParser.Count > 1 then + begin + Log(Format('[TITLE] Setting title from %s: %s', [SenderIP, FCommandParser[1]])); + TThread.Queue(nil, procedure + begin + Caption := FCommandParser[1]; + end); + end; + end + //////////////////////////////////////////////////////////////////////////////// + /// Handle command MSG (general message) + //////////////////////////////////////////////////////////////////////////////// + else if CommandName = 'MSG' then + begin + if FCommandParser.Count > 1 then + begin + Log(Format('[MSG] Message from %s: %s', [SenderIP, FCommandParser[1]])); + end; + end + //////////////////////////////////////////////////////////////////////////////// + /// Handle unknown commands + //////////////////////////////////////////////////////////////////////////////// + else + begin + Log(Format('[COMMAND] Unknown command from %s: %s', [SenderIP, CommandName])); + + // Echo the command back to the client + UDPServer.SendCommand(aSenderAddr, 100, BytesOf('Echo: ' + DataStr)); + end; + end + else + begin + Log(Format('[COMMAND] Raw command from %s: %s', [SenderIP, DataStr])); + + // Send response for unstructured commands + UDPServer.SendCommand(aSenderAddr, 101, BytesOf('Received: ' + DataStr)); + end; + finally + FCommandLock.Leave; + end; + except + on E: Exception do + Log(Format('Error processing command: %s', [E.Message])); + end; +end; + +procedure TForm1.DisplayScreenShot(const aData: TBytes); +var + MS: TMemoryStream; + jpgImage: TJPEGImage; +begin + // Create streams for JPEG loading + MS := TMemoryStream.Create; + jpgImage := TJPEGImage.Create; + try + // Load JPEG data directly into stream + MS.WriteBuffer(aData[0], Length(aData)); + MS.Position := 0; + + // Load JPEG from data stream + jpgImage.LoadFromStream(MS); + + // Display in TImage component + if Assigned(Form1) and Assigned(Form1.Image1) then + begin + Form1.Image1.Picture.Assign(jpgImage); + Form1.Image1.Stretch := True; + end; + + finally + MS.Free; + jpgImage.Free; + end; +end; + +procedure TForm1.Log(const AMessage: string); +begin + TThread.Queue(nil, + procedure + begin + try + memLog.Lines.Add(Format('[%s] %s', [FormatDateTime('hh:nn:ss.zzz', Now), AMessage])); + finally + end; + end); +end; + +procedure TForm1.memLogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +begin + if (Shift = [ssCtrl]) and (Key = Ord('A')) then + memLog.SelectAll + else if (Shift = [ssCtrl]) and (Key = Ord('C')) then + memLog.CopyToClipboard; +end; + +end. \ No newline at end of file diff --git a/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/UDPSocketsLCP_ImageDisplay.groupproj b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/UDPSocketsLCP_ImageDisplay.groupproj new file mode 100644 index 0000000..d92f069 --- /dev/null +++ b/Demos/UDP/ncUDPSocketsLCP_ImageDisplay/UDPSocketsLCP_ImageDisplay.groupproj @@ -0,0 +1,48 @@ + + + {E7EA7F9E-9B7A-4F4D-9B5C-8F4B6A5E2D1C} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/NetCom7.dpk b/NetCom7.dpk index 6dccda7..58de86d 100644 --- a/NetCom7.dpk +++ b/NetCom7.dpk @@ -42,6 +42,7 @@ contains ncLines in 'Source\ncLines.pas', ncSocketList in 'Source\ncSocketList.pas', ncSockets in 'Source\ncSockets.pas', + ncSocketsThd in 'Source\ncSocketsThd.pas', ncCommandPacking in 'Source\ncCommandPacking.pas', ncCommandHandlers in 'Source\ncCommandHandlers.pas', ncSources in 'Source\ncSources.pas', @@ -78,7 +79,13 @@ contains ncEncTea in 'Source\Encryption\ncEncTea.pas', ncEncTiger in 'Source\Encryption\ncEncTiger.pas', ncEncTwofish in 'Source\Encryption\ncEncTwofish.pas', - ncPendingCommandsList in 'Source\ncPendingCommandsList.pas'; + ncPendingCommandsList in 'Source\ncPendingCommandsList.pas', + ncUDPSockets in 'Source\ncUDPSockets.pas', + ncUDPSocketsLCP in 'Source\ncUDPSocketsLCP.pas', + ncUDPSocketsDual in 'Source\ncUDPSocketsDual.pas', + ncIPUtils in 'Source\ncIPUtils.pas', + ncSChannel in 'Source\ncSChannel.pas', + ncSocketsDual in 'Source\ncSocketsDual.pas'; end. diff --git a/NetCom7.dproj b/NetCom7.dproj index 5dfc635..32d07cc 100644 --- a/NetCom7.dproj +++ b/NetCom7.dproj @@ -2,14 +2,15 @@ {57C69AC0-7B5F-43DD-957C-8CC07D9D9092} NetCom7.dpk - 19.5 + 20.2 Release DCC32 None True Win32 - 693267 + 1741843 Package + NetCom7 true @@ -54,6 +55,11 @@ Base true + + true + Base + true + true Base @@ -142,13 +148,13 @@ android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar rtl;dbrtl;$(DCC_UsePackage) - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=;minSdkVersion=23;targetSdkVersion=34 $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png Debug false - package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= + package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=;minSdkVersion=23;targetSdkVersion=34 Debug false true @@ -172,12 +178,12 @@ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png - CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSCameraUsageDescription=The reason for accessing the camera;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSMotionUsageDescription=The reason for accessing the accelerometer;NSDesktopFolderUsageDescription=The reason for accessing the Desktop folder;NSDocumentsFolderUsageDescription=The reason for accessing the Documents folder;NSDownloadsFolderUsageDescription=The reason for accessing the Downloads folder;NSNetworkVolumesUsageDescription=The reason for accessing files on a network volume;NSRemovableVolumesUsageDescription=The reason for accessing files on a removable volume;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers;ITSAppUsesNonExemptEncryption=false + CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSCameraUsageDescription=The reason for accessing the camera;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSMotionUsageDescription=The reason for accessing the accelerometer;NSDesktopFolderUsageDescription=The reason for accessing the Desktop folder;NSDocumentsFolderUsageDescription=The reason for accessing the Documents folder;NSDownloadsFolderUsageDescription=The reason for accessing the Downloads folder;NSNetworkVolumesUsageDescription=The reason for accessing files on a network volume;NSRemovableVolumesUsageDescription=The reason for accessing files on a removable volume;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing the Bluetooth interface Debug false - CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSCameraUsageDescription=The reason for accessing the camera;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSMotionUsageDescription=The reason for accessing the accelerometer;NSDesktopFolderUsageDescription=The reason for accessing the Desktop folder;NSDocumentsFolderUsageDescription=The reason for accessing the Documents folder;NSDownloadsFolderUsageDescription=The reason for accessing the Downloads folder;NSNetworkVolumesUsageDescription=The reason for accessing files on a network volume;NSRemovableVolumesUsageDescription=The reason for accessing files on a removable volume;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers;ITSAppUsesNonExemptEncryption=false + CFBundleName=$(MSBuildProjectName);CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);NSHighResolutionCapable=true;LSApplicationCategoryType=public.app-category.utilities;NSLocationUsageDescription=The reason for accessing the location information of the user;NSContactsUsageDescription=The reason for accessing the contacts;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSCameraUsageDescription=The reason for accessing the camera;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSMotionUsageDescription=The reason for accessing the accelerometer;NSDesktopFolderUsageDescription=The reason for accessing the Desktop folder;NSDocumentsFolderUsageDescription=The reason for accessing the Documents folder;NSDownloadsFolderUsageDescription=The reason for accessing the Downloads folder;NSNetworkVolumesUsageDescription=The reason for accessing files on a network volume;NSRemovableVolumesUsageDescription=The reason for accessing files on a removable volume;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing the Bluetooth interface Debug false @@ -204,6 +210,13 @@ false true + + Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + true + false false @@ -221,8 +234,8 @@ 1033 - CompanyName=;FileVersion=7.2.0.577;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=7.2;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) - 577 + CompanyName=;FileVersion=7.2.0.636;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=7.2;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + 636 2 false true @@ -275,6 +288,7 @@ + @@ -312,10 +326,56 @@ + + + + + + BITMAP TNCICON + + BITMAP + TNCUDPCLIENT + + + BITMAP + TNCUDPSERVER + + + BITMAP + TNCTCPCLIENTDUAL + + + BITMAP + TNCTCPCLIENTTHD + + + BITMAP + TNCTCPSERVERDUAL + + + BITMAP + TNCTCPSERVERTHD + + + BITMAP + TNCUDPCLIENTDUAL + + + BITMAP + TNCUDPCLIENTLCP + + + BITMAP + TNCUDPSERVERDUAL + + + BITMAP + TNCUDPSERVERLCP + Base @@ -367,7 +427,10 @@ - Microsoft Office 2000 Sample Automation Server Wrapper Components + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components NetCom7.dpk @@ -378,12 +441,14 @@ True True True + False True True True True + True - + true @@ -400,6 +465,12 @@ + + + NetCom7.bpl + true + + 1 @@ -408,16 +479,6 @@ 0 - - - classes - 64 - - - classes - 64 - - res\xml @@ -428,12 +489,6 @@ 1 - - - library\lib\armeabi-v7a - 1 - - library\lib\armeabi @@ -486,6 +541,16 @@ 1 + + + res\drawable-anydpi-v21 + 1 + + + res\drawable-anydpi-v21 + 1 + + res\values @@ -506,6 +571,66 @@ 1 + + + res\values-v31 + 1 + + + res\values-v31 + 1 + + + + + res\drawable-anydpi-v26 + 1 + + + res\drawable-anydpi-v26 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-anydpi-v33 + 1 + + + res\drawable-anydpi-v33 + 1 + + res\values @@ -516,6 +641,16 @@ 1 + + + res\values-night-v21 + 1 + + + res\values-night-v21 + 1 + + res\drawable @@ -686,6 +821,56 @@ 1 + + + res\drawable-anydpi-v24 + 1 + + + res\drawable-anydpi-v24 + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-night-anydpi-v21 + 1 + + + res\drawable-night-anydpi-v21 + 1 + + + + + res\drawable-anydpi-v31 + 1 + + + res\drawable-anydpi-v31 + 1 + + + + + res\drawable-night-anydpi-v31 + 1 + + + res\drawable-night-anydpi-v31 + 1 + + 1 @@ -863,6 +1048,9 @@ 1 + + 1 + @@ -1124,6 +1312,7 @@ + 12 diff --git a/NetCom7.dproj.local b/NetCom7.dproj.local index 6a2e1d7..d576f03 100644 --- a/NetCom7.dproj.local +++ b/NetCom7.dproj.local @@ -1,19 +1,2 @@  - - - - - - 2020/08/08 06:05:23.000.402,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSocketList.pas - 2020/08/08 06:14:41.000.027,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Unit1.pas - 2020/08/08 06:15:03.000.683,C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLine.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Unit1.pas - 2020/08/08 07:50:30.000.380,C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLine.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas - 2020/08/10 13:33:07.000.316,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png - 2020/08/10 13:45:09.000.739,C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png= - 2020/08/10 13:45:27.000.192,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png - 2020/08/10 13:48:53.000.848,C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png= - 2020/08/10 13:50:07.000.192,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncIcon.bmp - 2020/08/10 14:10:53.000.681,=C:\Users\Programmer\Documents\Development\Components\NetCom7\PaletteIcons\TncIcon.bmp - 2020/08/11 19:21:43.000.342,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncPendingCommandsList.pas - - + diff --git a/NetCom7.dres b/NetCom7.dres index 42500fd..0bf391e 100644 Binary files a/NetCom7.dres and b/NetCom7.dres differ diff --git a/NetCom7.identcache b/NetCom7.identcache index ae7acea..2afdd9a 100644 Binary files a/NetCom7.identcache and b/NetCom7.identcache differ diff --git a/NetCom7.otares b/NetCom7.otares new file mode 100644 index 0000000..0e321c6 Binary files /dev/null and b/NetCom7.otares differ diff --git a/NetCom7.res b/NetCom7.res index 762c09e..f4e99c1 100644 Binary files a/NetCom7.res and b/NetCom7.res differ diff --git a/NetCom7Resource.rc b/NetCom7Resource.rc index 5ccefa7..68e5906 100644 --- a/NetCom7Resource.rc +++ b/NetCom7Resource.rc @@ -1 +1,11 @@ TNCICON BITMAP "PaletteIcons\\TncIcon.bmp" +TNCUDPCLIENT BITMAP "PaletteIcons\\tncudpclient.bmp" +TNCUDPSERVER BITMAP "PaletteIcons\\tncudpserver.bmp" +TNCTCPCLIENTDUAL BITMAP "PaletteIcons\\tnctcpclientdual.bmp" +TNCTCPCLIENTTHD BITMAP "PaletteIcons\\tnctcpclientthd.bmp" +TNCTCPSERVERDUAL BITMAP "PaletteIcons\\tnctcpserverdual.bmp" +TNCTCPSERVERTHD BITMAP "PaletteIcons\\tnctcpserverthd.bmp" +TNCUDPCLIENTDUAL BITMAP "PaletteIcons\\tncudpclientdual.bmp" +TNCUDPCLIENTLCP BITMAP "PaletteIcons\\tncudpclientlcp.bmp" +TNCUDPSERVERDUAL BITMAP "PaletteIcons\\tncudpserverdual.bmp" +TNCUDPSERVERLCP BITMAP "PaletteIcons\\tncudpserverlcp.bmp" diff --git a/PaletteIcons/tnctcpclientdual.bmp b/PaletteIcons/tnctcpclientdual.bmp new file mode 100644 index 0000000..d66b1fb Binary files /dev/null and b/PaletteIcons/tnctcpclientdual.bmp differ diff --git a/PaletteIcons/tnctcpclientthd.bmp b/PaletteIcons/tnctcpclientthd.bmp new file mode 100644 index 0000000..13a2763 Binary files /dev/null and b/PaletteIcons/tnctcpclientthd.bmp differ diff --git a/PaletteIcons/tnctcpserverdual.bmp b/PaletteIcons/tnctcpserverdual.bmp new file mode 100644 index 0000000..8a63a8f Binary files /dev/null and b/PaletteIcons/tnctcpserverdual.bmp differ diff --git a/PaletteIcons/tnctcpserverthd.bmp b/PaletteIcons/tnctcpserverthd.bmp new file mode 100644 index 0000000..0c68ca5 Binary files /dev/null and b/PaletteIcons/tnctcpserverthd.bmp differ diff --git a/PaletteIcons/tncudpclient.bmp b/PaletteIcons/tncudpclient.bmp new file mode 100644 index 0000000..e7b7e39 Binary files /dev/null and b/PaletteIcons/tncudpclient.bmp differ diff --git a/PaletteIcons/tncudpclientdual.bmp b/PaletteIcons/tncudpclientdual.bmp new file mode 100644 index 0000000..dbc10bf Binary files /dev/null and b/PaletteIcons/tncudpclientdual.bmp differ diff --git a/PaletteIcons/tncudpclientlcp.bmp b/PaletteIcons/tncudpclientlcp.bmp new file mode 100644 index 0000000..4dc5408 Binary files /dev/null and b/PaletteIcons/tncudpclientlcp.bmp differ diff --git a/PaletteIcons/tncudpserver.bmp b/PaletteIcons/tncudpserver.bmp new file mode 100644 index 0000000..aa3e078 Binary files /dev/null and b/PaletteIcons/tncudpserver.bmp differ diff --git a/PaletteIcons/tncudpserverdual.bmp b/PaletteIcons/tncudpserverdual.bmp new file mode 100644 index 0000000..11ffb02 Binary files /dev/null and b/PaletteIcons/tncudpserverdual.bmp differ diff --git a/PaletteIcons/tncudpserverlcp.bmp b/PaletteIcons/tncudpserverlcp.bmp new file mode 100644 index 0000000..668ffaa Binary files /dev/null and b/PaletteIcons/tncudpserverlcp.bmp differ diff --git a/README.md b/README.md index 3daf62b..22d8949 100644 --- a/README.md +++ b/README.md @@ -1,84 +1,44 @@ # NetCom7 -The fastest communications possible. -This is version 7.2 of the NetCom package. In this version, the NetCom package is now multi-platform! -You can compile your apps under all platforms in FireMonkey! +**The fastest communications possible.** -This set of components is the fastest possible implementation of socket communications, in any language; this is an extremely optimised code on TCP/IP sockets. Forget using a thread per connection: With this suite you can have as many concurrent connections to your server as you like. Threads are used per request and not per connection, and are maintained in a very fast thread pool class. +This is an updated version of NetCom7 with **IPv6 support**, **TLS/SSL security**, **new UDP components**, **threaded socket support**, and **dual protocol capabilities**. The library now offers a complete range of networking solutions while maintaining full backward compatibility with existing code. -The implementation begins with TncTCPServer and TncTCPClient which implements the basic socket communications. -You can use TncTCPClient and TncTCPServer if all you want is to implement standard (but very fast) socket comms. +## 🎯 **Latest Updates** +- **New UDP Support**: Complete UDP component family with three specialized types +- **Threaded Components**: High-performance TCP components with thread pool processing +- **Dual Protocol**: Universal components supporting both raw data and structured commands +- **TLS/SSL Support**: Secure communications across all component types (Windows) +- **IPv6 Support**: Full IPv4/IPv6 compatibility (client and server must use same family) +- **New Demos**: Added comprehensive examples showcasing all new features and components -On top of the TCP/IP sockets, a lightweight protocol is implemented to be able to pack and unpack buffers (simple TCP/IP is streaming and has no notion of a well defined buffer). The set of components implementing this functionality is TncServerSource and TncClientSource. Both of these components implement an ExecCommand (aCmd, aData) which triggers an OnHandleCommand event on the other side (a client can ExecCommand to a server, or a server can ExecCommand to any client). ExecCommand can be blocking or non-blocking (async) depending on how you set its aRequiresResult parameter. If you use the blocking behaviour, the component still handles incoming requests from its peer(s). For example, a ClientSource could be waiting on an ExecCommand to the server, but while waiting it can serve ExecCommand requests from the server! +## 📋 **Component Overview** -Simple senario: - Server: - - - You put a TncServerSource on your form. - If you want you can change the port it is listening to via the - Port property. - - - You implement an OnHandleCommand event handler and, - depending on aCmd parameter (integer), you respond the result of - the command via setting the Result of the OnHandleCommand to - anything you like (TBytes). If an exception is raised while in - HandleCommand, it is trapped, packed, transfered accross to the - calling peer, and raised at the peer's issued ExecCommand. - This way exceptions can be handled as if they were raised locally. - - - You set the Active property to true. Your server is ready. - - Client: - - - You put a TncClientSource on your form. - You can set Host and Port to whatever you want. - - - You set Active property to true. - Your client is now connected to the server. - - - You call ExecCommand (on your TncClientSource), with any - command number and data that you like. This will send your - command and data over to the server, call its OnHandleCommand, - pack the response, and return it as a result to your ExecCommand. - - - ExecCommand is blocking (if aRequiresResult parameter is set to true), - but only for the current command issued. - The TncClientSource's OnHandleCommand still executes, so, - while waiting for a command to return, your client socket may be - processing requests from your server (a server can also - ExecCommand to a client). - - - If you have forgotten to set Active to true and call ExecCommand, - the TncClientSource will first try to connect, so you can ommit - setting this property. It will also try to connect if it knows - it has been disconnected (and the Reconnect property is set to true). - -This set of components promises unrivalled speed and that is not just in words: +### **TCP Components** -A simple timing test with the NetComVSIndy demo gives the following results: +| Component | Classes | Description | Best For | +|-----------|---------|-------------|----------| +| **Raw TCP** | `TncTCPServer`
`TncTCPClient` | Basic socket functionality | Simple protocols, learning, full control | +| **Threaded TCP** 🆕 | `TncTCPServerThd`
`TncTCPClientThd` | Raw sockets + thread pool processing | High-performance custom protocols | +| **Dual TCP** 🆕 | `TncTCPServerDual`
`TncTCPClientDual` | Raw data + command protocol support | Universal applications, maximum flexibility | +| **Command Sources** | `TncServerSource`
`TncClientSource` | Command-based communication | RPC systems, legacy applications | +| **Database** | `TncDBServer`
`TncDBDataset` | Database connectivity | Data synchronization, legacy support | -* Testing Indy... Time taken: 32468 msec -* Testing NetCom... Time taken: 25109 msec +### **UDP Components** -Starting with the base unit, ncSockets.pas, you will see that the implementation does not suffer from slack code, it is rather immediate. The **inline** calling convention has been used wherever deemed appropriate. The very core functions have been tested and optimised by monitoring the performance via timing of large loops and assembly inspection to squeeze out every last bit of performance. +| Component | Classes | Description | Best For | +|-----------|---------|-------------|----------| +| **Raw UDP** 🆕 | `TncUDPServer`
`TncUDPClient` | Basic UDP functionality | Custom protocols, maximum performance | +| **LCP UDP** 🆕 | `TncUDPServerLCP`
`TncUDPClientLCP` | Command protocol only | RPC systems, structured communication | +| **Dual UDP** 🆕 | `TncUDPServerDual`
`TncUDPClientDual` | Raw data + command protocol support | Universal UDP applications | -The biggest difference though in speed gain is due to the architecture. Unlike most typical sockets: +**Legend:** 🆕 New in this version -**this set of sockets does neither spawn nor use a thread per connection.** -This means **you can have as many live connections as you like and you will see NO difference in performance!** A thread pool just waits for any requests; if a thread was to be created per request or per connection, the speed would suffer a lot, as creating a thread is quite heavy time-wise. If the number of requests per second cannot be handled by the thread pool, the thread pool grows up to a maximum defined size, and if it still cannot cope, the client just waits until the server gets a ready thread to process its request. - -Particular attention has been given to connection issues also. For example, the disconnects are picked up immediately, and if a line is so bad that the disconnect cannot be picked up, it tackles this by a keep alive packet by which it gets to know the actual status. There is a **Reconnect property** and a KeepAlive property. When a client gets disconnected, for whatever reason, it tries to reconnect transparently and without affecting the main application's performance. This way you do not have to worry about keeping your clients connected. - -Compression and encryption are also standard with these components with no extra libraries required. Ofcourse you can use your own compression or encryption if you prefer, but it is rather handy to have just a property you can set on the component. - -This set of components can also deal with garbage data thrown at them, they have been used and tested in huge, country-wide projects where all sorts of attacks can be seen. - -The effort a programmer has to make to use these components is minimal compared to other frameworks. Please refer to the demos for a better understanding on how to use these components. - -Written by Bill Anastasios Demos. -Special thanks to Daniel Mauric, Tommi Prami, Roland Bengtsson for the extensive testing and suggestions. Thank you so much! - -VasDemos[at]yahoo[dot]co[dot]uk - -** Delphi RULES ** +## âš¡ **Key Features** +- **Auto-chunking**: Large data automatically split and reassembled +- **TLS/SSL**: Secure communications with certificate support +- **Thread pools**: High-performance concurrent processing +- **Protocol detection**: Automatic routing of raw vs command data +- **IPv4/IPv6**: Full IPv4 and IPv6 support (client/server must use same family, no dual-stack sockets) +- **Cross-platform**: Windows, macOS, Linux compatibility \ No newline at end of file diff --git a/Source/NetComRegister.pas b/Source/NetComRegister.pas index e341655..c9604e1 100644 --- a/Source/NetComRegister.pas +++ b/Source/NetComRegister.pas @@ -1,168 +1,239 @@ -unit NetComRegister; - -// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -// -// NetCom7 Package -// 13 Dec 2010, 12/8/2020 -// -// Written by Demos Bill -// VasDemos@yahoo.co.uk -// -// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - -interface - -uses - WinApi.Windows, System.Classes, System.SysUtils, ToolsAPI, DesignIntf, DesignEditors, - - ncSockets, ncSources, ncCommandHandlers, ncDBSrv, ncDBCnt; - -type - TncTCPSocketDefaultEditor = class(TDefaultEditor) - public - procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; - end; - - TncSourceDefaultEditor = class(TDefaultEditor) - public - procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; - end; - -procedure Register; - -implementation - -procedure Register; -begin - RegisterComponents('NetCom7', [TncTCPServer, TncTCPClient, TncServerSource, TncClientSource, TncCommandHandler, TncDBServer, TncDBDataset]); - - RegisterComponentEditor(TncTCPServer, TncTCPSocketDefaultEditor); - RegisterComponentEditor(TncTCPClient, TncTCPSocketDefaultEditor); - RegisterComponentEditor(TncServerSource, TncSourceDefaultEditor); - RegisterComponentEditor(TncClientSource, TncSourceDefaultEditor); - - UnlistPublishedProperty(TncDBDataset, 'Connection'); - UnlistPublishedProperty(TncDBDataset, 'ConnectionString'); - RegisterPropertyEditor(TypeInfo(string), TncDBDataset, 'ConnectionString', nil); - - ForceDemandLoadState(dlDisable); -end; - -function GetVersion(aMinor: Boolean = True; aRelease: Boolean = True; aBuild: Boolean = True): string; -var - VerInfoSize: DWORD; - VerInfo: Pointer; - VerValueSize: DWORD; - VerValue: PVSFixedFileInfo; - Dummy: DWORD; - strBuffer: array [0 .. MAX_PATH] of Char; -begin - GetModuleFileName(hInstance, strBuffer, MAX_PATH); - VerInfoSize := GetFileVersionInfoSize(strBuffer, Dummy); - if VerInfoSize <> 0 then - begin - GetMem(VerInfo, VerInfoSize); - try - GetFileVersionInfo(strBuffer, 0, VerInfoSize, VerInfo); - VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); - with VerValue^ do - begin - Result := IntToStr(dwFileVersionMS shr 16); // Major always there - if aMinor then - Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF); - if aRelease then - Result := Result + '.' + IntToStr(dwFileVersionLS shr 16); - if aBuild then - Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF); - end; - finally - FreeMem(VerInfo, VerInfoSize); - end; - end - else - Result := '1.0.0.0'; -end; - -const - ICON_SPLASH = 'TNCICON'; - ICON_ABOUT = 'TNCICON'; - -var - AboutBoxServices: IOTAAboutBoxServices = nil; - AboutBoxIndex: Integer = 0; - -resourcestring - resPackageName = 'NetCom7 Network Communications Framework'; - resLicence = 'Full Edition for RAD Studio'; - resAboutCopyright = 'Copyright © 2020 Bill Demos (VasDemos@yahoo.co.uk)'; - resAboutDescription = - 'Netcom7 Communicatios Framework enables you to use communication components with the ease of use of the Delphi programming language. Create and handle client/server sockets, sources and DB elements with no single line of API calls.'; - -procedure RegisterSplashScreen; -var - SplashScreenHandle: HBitmap; -begin - SplashScreenHandle := LoadBitmap(hInstance, ICON_SPLASH); - try - SplashScreenServices.AddPluginBitmap(resPackageName + ' ' + GetVersion, SplashScreenHandle, False, resLicence); - finally - DeleteObject(SplashScreenHandle); - end; -end; - -procedure RegisterAboutBox; -var - ProductImage: HBitmap; -begin - Supports(BorlandIDEServices, IOTAAboutBoxServices, AboutBoxServices); - ProductImage := LoadBitmap(FindResourceHInstance(hInstance), ICON_ABOUT); - AboutBoxIndex := AboutBoxServices.AddPluginInfo(resPackageName + GetVersion, - resAboutCopyright + #13#10 + resAboutDescription, ProductImage, False, resLicence); -end; - -procedure UnregisterAboutBox; -begin - if (AboutBoxIndex <> 0) and Assigned(AboutBoxServices) then - begin - AboutBoxServices.RemovePluginInfo(AboutBoxIndex); - AboutBoxIndex := 0; - AboutBoxServices := nil; - end; -end; - -{ TncTCPSocketDefaultEditor } - -procedure TncTCPSocketDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); -begin - if CompareText(Prop.GetName, 'ONREADDATA') = 0 then - begin - Prop.Edit; - Continue := False; - end - else - inherited; -end; - -{ TncCustomPeerSourceDefaultEditor } - -procedure TncSourceDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); -begin - if CompareText(Prop.GetName, 'ONHANDLECOMMAND') = 0 then - begin - Prop.Edit; - Continue := False; - end - else - inherited; -end; - -initialization - -RegisterSplashScreen; -RegisterAboutBox; - -finalization - -UnregisterAboutBox; - -end. +unit NetComRegister; + +interface + +uses + WinApi.Windows, System.Classes, System.SysUtils, ToolsAPI, DesignIntf, DesignEditors, + ncSockets, ncSocketsDual, ncSources, ncSocketsThd, ncCommandHandlers, ncDBSrv, ncDBCnt, + ncUDPSockets, ncUDPSocketsLCP, ncUDPSocketsDual; + +type + TncTCPSocketDefaultEditor = class(TDefaultEditor) + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncUDPSocketDefaultEditor = class(TDefaultEditor) // Added UDP editor + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncUDPSocketLCPDefaultEditor = class(TDefaultEditor) // Added UDP LCP editor + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncUDPSocketDualDefaultEditor = class(TDefaultEditor) // Added UDP Dual editor + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncSourceDefaultEditor = class(TDefaultEditor) + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('NetCom7', [ + TncTCPServer, + TncTCPClient, + TncTCPServerDual, // Dual enhanced socket components + TncTCPClientDual, + TncTCPServerThd, // Threaded socket components + TncTCPClientThd, + TncUDPServer, // Raw UDP components + TncUDPClient, + TncUDPServerLCP, // LCP-only UDP components + TncUDPClientLCP, + TncUDPServerDual, // Dual-mode UDP components + TncUDPClientDual, + TncServerSource, + TncClientSource, + TncCommandHandler, + TncDBServer, + TncDBDataset + ]); + + RegisterComponentEditor(TncTCPServer, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncTCPClient, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncTCPServerDual, TncTCPSocketDefaultEditor); // Dual enhanced socket editors + RegisterComponentEditor(TncTCPClientDual, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncTCPServerThd, TncTCPSocketDefaultEditor); // Threaded socket editors + RegisterComponentEditor(TncTCPClientThd, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncUDPServer, TncUDPSocketDefaultEditor); // Raw UDP editors + RegisterComponentEditor(TncUDPClient, TncUDPSocketDefaultEditor); + RegisterComponentEditor(TncUDPServerLCP, TncUDPSocketLCPDefaultEditor); // LCP UDP editors + RegisterComponentEditor(TncUDPClientLCP, TncUDPSocketLCPDefaultEditor); + RegisterComponentEditor(TncUDPServerDual, TncUDPSocketDualDefaultEditor); // Dual UDP editors + RegisterComponentEditor(TncUDPClientDual, TncUDPSocketDualDefaultEditor); + RegisterComponentEditor(TncServerSource, TncSourceDefaultEditor); + RegisterComponentEditor(TncClientSource, TncSourceDefaultEditor); + + UnlistPublishedProperty(TncDBDataset, 'Connection'); + UnlistPublishedProperty(TncDBDataset, 'ConnectionString'); + RegisterPropertyEditor(TypeInfo(string), TncDBDataset, 'ConnectionString', nil); + + ForceDemandLoadState(dlDisable); +end; + +function GetVersion(aMinor: Boolean = True; aRelease: Boolean = True; aBuild: Boolean = True): string; +var + VerInfoSize: DWORD; + VerInfo: Pointer; + VerValueSize: DWORD; + VerValue: PVSFixedFileInfo; + Dummy: DWORD; + strBuffer: array [0 .. MAX_PATH] of Char; +begin + GetModuleFileName(hInstance, strBuffer, MAX_PATH); + VerInfoSize := GetFileVersionInfoSize(strBuffer, Dummy); + if VerInfoSize <> 0 then + begin + GetMem(VerInfo, VerInfoSize); + try + GetFileVersionInfo(strBuffer, 0, VerInfoSize, VerInfo); + VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); + with VerValue^ do + begin + Result := IntToStr(dwFileVersionMS shr 16); // Major always there + if aMinor then + Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF); + if aRelease then + Result := Result + '.' + IntToStr(dwFileVersionLS shr 16); + if aBuild then + Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF); + end; + finally + FreeMem(VerInfo, VerInfoSize); + end; + end + else + Result := '1.0.0.0'; +end; + +const + ICON_SPLASH = 'TNCICON'; + ICON_ABOUT = 'TNCICON'; + +var + AboutBoxServices: IOTAAboutBoxServices = nil; + AboutBoxIndex: Integer = 0; + +resourcestring + resPackageName = 'NetCom7 Network Communications Framework'; + resLicence = 'Full Edition for RAD Studio'; + resAboutCopyright = 'Copyright @ 2020 Bill Demos (VasDemos@yahoo.co.uk)'; + resAboutDescription = + 'Netcom7 Communicatios Framework enables you to use communication components with the ease of use of the Delphi programming language. Create and handle client/server sockets, sources and DB elements with no single line of API calls.'; + +procedure RegisterSplashScreen; +var + SplashScreenHandle: HBitmap; +begin + SplashScreenHandle := LoadBitmap(hInstance, ICON_SPLASH); + try + SplashScreenServices.AddPluginBitmap(resPackageName + ' ' + GetVersion, SplashScreenHandle, False, resLicence); + finally + DeleteObject(SplashScreenHandle); + end; +end; + +procedure RegisterAboutBox; +var + ProductImage: HBitmap; +begin + Supports(BorlandIDEServices, IOTAAboutBoxServices, AboutBoxServices); + ProductImage := LoadBitmap(FindResourceHInstance(hInstance), ICON_ABOUT); + AboutBoxIndex := AboutBoxServices.AddPluginInfo(resPackageName + GetVersion, + resAboutCopyright + #13#10 + resAboutDescription, ProductImage, False, resLicence); +end; + +procedure UnregisterAboutBox; +begin + if (AboutBoxIndex <> 0) and Assigned(AboutBoxServices) then + begin + AboutBoxServices.RemovePluginInfo(AboutBoxIndex); + AboutBoxIndex := 0; + AboutBoxServices := nil; + end; +end; + +{ TncTCPSocketDefaultEditor } + +procedure TncTCPSocketDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONREADDATA') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncUDPSocketDefaultEditor } // Added UDP editor implementation + +procedure TncUDPSocketDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONREADDATAGRAM') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncUDPSocketLCPDefaultEditor } // Added UDP LCP editor implementation + +procedure TncUDPSocketLCPDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONCOMMAND') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncUDPSocketDualDefaultEditor } // Added UDP Dual editor implementation + +procedure TncUDPSocketDualDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if (CompareText(Prop.GetName, 'ONREADDATAGRAM') = 0) or + (CompareText(Prop.GetName, 'ONCOMMAND') = 0) then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncSourceDefaultEditor } + +procedure TncSourceDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONHANDLECOMMAND') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +initialization + RegisterSplashScreen; + RegisterAboutBox; + +finalization + UnregisterAboutBox; + +end. diff --git a/Source/ncIPUtils.pas b/Source/ncIPUtils.pas new file mode 100644 index 0000000..08d3802 --- /dev/null +++ b/Source/ncIPUtils.pas @@ -0,0 +1,284 @@ +unit ncIPUtils; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - IP Address utils +// +// +// +// 21/01/2025 +// - Initial creation +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +interface + +uses + {$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, + {$ELSE} + Posix.SysSocket, Posix.NetDB, Posix.NetIf, Posix.ArpaInet, + {$ENDIF} + System.SysUtils, System.Classes; + +const + IPV6_ADDR_LEN = 16; // IPv6 address length in bytes + IPV6_STR_MAX_LEN = 46; // Maximum string length for IPv6 address including null terminator + SOCKADDR_STORAGE_SIZE = 128; // Size of sockaddr_storage structure + + {$IFDEF MSWINDOWS} + AF_INET6 = 23; + {$ENDIF} + +type + TIn6Addr = record + case Integer of + 0: (s6_bytes: array[0..15] of Byte); + 1: (s6_words: array[0..7] of Word); + end; + PIn6Addr = ^TIn6Addr; + + TSockAddrIn6 = record + sin6_family: Word; // AF_INET6 + sin6_port: Word; // Transport layer port # + sin6_flowinfo: Cardinal; // IPv6 flow information + sin6_addr: TIn6Addr; // IPv6 address + sin6_scope_id: Cardinal; // Set of interfaces for scope + end; + PSockAddrIn6 = ^TSockAddrIn6; + + // Socket storage structure - used for both IPv4 and IPv6 + TSockAddrStorage = record + ss_family: Word; // Address family + __ss_pad1: array [0..5] of Byte; // 6 bytes of padding + __ss_align: Int64; // Force alignment + __ss_pad2: array [0..111] of Byte; // 112 bytes of padding + end; + PSockAddrStorage = ^TSockAddrStorage; + + EIPError = class(Exception); + + // Function types for dynamic loading + {$IFDEF MSWINDOWS} + TInetPton = function(Family: Integer; const pszAddrString: PAnsiChar; + pAddrBuf: Pointer): Integer; stdcall; + TInetNtop = function(Family: Integer; pAddr: Pointer; + pStringBuf: PAnsiChar; StringBufSize: size_t): PAnsiChar; stdcall; + {$ENDIF} + + TncIPUtils = class + private + {$IFDEF MSWINDOWS} + class var + InetPton: TInetPton; + InetNtop: TInetNtop; + class function LoadIPv6Functions: Boolean; + {$ENDIF} + public + class constructor Create; + + // SockAddrStorage methods + class function StorageToString(const Storage: TSockAddrStorage): string; + class function IsIPv6Storage(const Storage: TSockAddrStorage): Boolean; + class function GetStorageFamily(const Storage: TSockAddrStorage): Word; + class function StorageToIPv6Address(const Storage: TSockAddrStorage; + out Addr: TSockAddrIn6): Boolean; + class function GetIPFromStorage(const Storage: TSockAddrStorage): string; + class function GetPortFromStorage(const Storage: TSockAddrStorage): Word; + + // Existing IPv6 methods + class function IsIPv6ValidAddress(const AddrStr: string): Boolean; + class function AddressToString(const Addr: TIn6Addr): string; + class function StringToAddress(const AddrStr: string; out Addr: TIn6Addr): Boolean; + class function IsLinkLocal(const AddrStr: string): Boolean; + class function NormalizeAddress(const AddrStr: string): string; + class function AddressToPresentation(const Addr: TIn6Addr): string; + class function PresentationToAddress(const Present: string; var Addr: TIn6Addr): Boolean; + end; + +implementation + +{$IFDEF MSWINDOWS} +var + Ws2_32DllHandle: THandle; + + +class function TncIPUtils.LoadIPv6Functions: Boolean; +begin + Result := False; + + if Ws2_32DllHandle = 0 then + Ws2_32DllHandle := LoadLibrary('ws2_32.dll'); + + if Ws2_32DllHandle <> 0 then + begin + InetPton := GetProcAddress(Ws2_32DllHandle, 'inet_pton'); + InetNtop := GetProcAddress(Ws2_32DllHandle, 'inet_ntop'); + Result := Assigned(InetPton) and Assigned(InetNtop); + end; +end; +{$ENDIF} + +class constructor TncIPUtils.Create; +begin + {$IFDEF MSWINDOWS} + if not LoadIPv6Functions then + raise EIPError.Create('Failed to load IPv6 functions from ws2_32.dll'); + {$ENDIF} +end; + +class function TncIPUtils.StorageToString(const Storage: TSockAddrStorage): string; +begin + case Storage.ss_family of + AF_INET: + begin + var addr_in := PSockAddrIn(@Storage)^; + with addr_in.sin_addr.S_un_b do + Result := Format('%d.%d.%d.%d', [s_b1, s_b2, s_b3, s_b4]); + end; + + AF_INET6: + begin + var addr_in6 := PSockAddrIn6(@Storage)^; + Result := AddressToString(addr_in6.sin6_addr); + if IsLinkLocal(Result) then + Result := Format('%s%%%d', [Result, addr_in6.sin6_scope_id]); + end; + else + Result := ''; + end; +end; + +class function TncIPUtils.IsIPv6Storage(const Storage: TSockAddrStorage): Boolean; +begin + Result := Storage.ss_family = AF_INET6; +end; + +class function TncIPUtils.GetStorageFamily(const Storage: TSockAddrStorage): Word; +begin + Result := Storage.ss_family; +end; + +class function TncIPUtils.StorageToIPv6Address(const Storage: TSockAddrStorage; + out Addr: TSockAddrIn6): Boolean; +begin + Result := Storage.ss_family = AF_INET6; + if Result then + Addr := PSockAddrIn6(@Storage)^; +end; + +class function TncIPUtils.GetIPFromStorage(const Storage: TSockAddrStorage): string; +begin + Result := StorageToString(Storage); +end; + +class function TncIPUtils.GetPortFromStorage(const Storage: TSockAddrStorage): Word; +begin + case Storage.ss_family of + AF_INET: Result := ntohs(PSockAddrIn(@Storage)^.sin_port); + AF_INET6: Result := ntohs(PSockAddrIn6(@Storage)^.sin6_port); + else + Result := 0; + end; +end; + +class function TncIPUtils.IsIPv6ValidAddress(const AddrStr: string): Boolean; +var + Addr: TIn6Addr; +begin + Result := StringToAddress(AddrStr, Addr); +end; + +class function TncIPUtils.AddressToString(const Addr: TIn6Addr): string; +var + StringBuffer: array[0..IPV6_STR_MAX_LEN-1] of AnsiChar; +begin + {$IFDEF MSWINDOWS} + if InetNtop(AF_INET6, @Addr, StringBuffer, IPV6_STR_MAX_LEN) = nil then + raise EIPError.Create('Failed to convert IPv6 address to string: ' + + SysErrorMessage(WSAGetLastError)); + {$ELSE} + if Posix.ArpaInet.inet_ntop(AF_INET6, @Addr, StringBuffer, IPV6_STR_MAX_LEN) = nil then + raise EIPv6Error.Create('Failed to convert IPv6 address to string: ' + + SysErrorMessage(GetLastError)); + {$ENDIF} + + Result := string(AnsiString(StringBuffer)); +end; + +class function TncIPUtils.StringToAddress(const AddrStr: string; out Addr: TIn6Addr): Boolean; +var + AnsiAddr: AnsiString; +begin + AnsiAddr := AnsiString(AddrStr); + {$IFDEF MSWINDOWS} + Result := InetPton(AF_INET6, PAnsiChar(AnsiAddr), @Addr) = 1; + {$ELSE} + Result := Posix.ArpaInet.inet_pton(AF_INET6, PAnsiChar(AnsiAddr), @Addr) = 1; + {$ENDIF} +end; + +class function TncIPUtils.IsLinkLocal(const AddrStr: string): Boolean; +begin + // Link-local addresses start with fe80::/10 + Result := (Length(AddrStr) >= 4) and + (LowerCase(Copy(AddrStr, 1, 4)) = 'fe80'); +end; + +class function TncIPUtils.NormalizeAddress(const AddrStr: string): string; +var + Addr: TIn6Addr; +begin + if StringToAddress(AddrStr, Addr) then + Result := AddressToString(Addr) + else + raise EIPError.CreateFmt('Invalid IPv6 address: %s', [AddrStr]); +end; + +class function TncIPUtils.AddressToPresentation(const Addr: TIn6Addr): string; +var + i: Integer; + NonZeroFound: Boolean; +begin + Result := ''; + NonZeroFound := False; + + // Convert words to hex representation + for i := 0 to 7 do + begin + if (Addr.s6_words[i] <> 0) or NonZeroFound then + begin + if Result <> '' then + Result := Result + ':'; + Result := Result + IntToHex(Addr.s6_words[i], 1); + NonZeroFound := True; + end; + end; + + // Handle all-zero case + if Result = '' then + Result := '::' + else if not NonZeroFound then + Result := Result + ':'; +end; + +class function TncIPUtils.PresentationToAddress(const Present: string; + var Addr: TIn6Addr): Boolean; +begin + FillChar(Addr, SizeOf(Addr), 0); + Result := StringToAddress(Present, Addr); +end; + +initialization + {$IFDEF MSWINDOWS} + Ws2_32DllHandle := 0; + {$ENDIF} + +finalization + {$IFDEF MSWINDOWS} + if Ws2_32DllHandle <> 0 then + FreeLibrary(Ws2_32DllHandle); + {$ENDIF} + +end. + diff --git a/Source/ncLines.pas b/Source/ncLines.pas index d6bf8d7..c0c0470 100644 --- a/Source/ncLines.pas +++ b/Source/ncLines.pas @@ -6,6 +6,18 @@ // socket, organised in an object which contains the handle of the socket, // and also makes sure it checks every API command for errors // +// 13/07/2025 - by J.Pauwels +// - Added TLS handshake callback integration through OnBeforeConnected architecture +// - Integrated TLS support into line-level socket operations +// - Added secure communication layer for both server and client connections +// +// 14/01/2025 - by J.Pauwels +// - Fix Linux compilation +// - Added UDP support +// - Added IPV6 support +// - Removed problematic threading approach from CreateClientHandle +// - Implemented socket-level timeout control for more reliable connection handling +// // 9/8/2020 // - Completed multiplatform support, now NetCom can be compiled in all // platforms @@ -33,27 +45,56 @@ interface Winapi.Windows, Winapi.Winsock2, {$ELSE} Posix.SysTypes, Posix.SysSelect, Posix.SysSocket, Posix.NetDB, Posix.SysTime, - Posix.Unistd, {Posix.ArpaInet,} + Posix.Unistd, Posix.Errno, {$ENDIF} System.SyncObjs, System.Math, System.SysUtils, System.Diagnostics, - ncThreads; + System.IOUtils, + System.Classes, + ncIPUtils; const // Flag that indicates that the socket is intended for bind() + listen() when constructing it AI_PASSIVE = 1; + IPV6_V6ONLY = 27; + AI_ADDRCONFIG = $0020; // Return only if local system configured + AI_NUMERICHOST = $0004; // Don't use name resolution + INET6_ADDRSTRLEN = 46; + // Maximum length of IPv6 address string including null terminator {$IFDEF MSWINDOWS} InvalidSocket = Winapi.Winsock2.INVALID_SOCKET; SocketError = SOCKET_ERROR; + WSAETIMEDOUT = 10060; {$ELSE} InvalidSocket = -1; SocketError = -1; IPPROTO_TCP = 6; TCP_NODELAY = $0001; + ETIMEDOUT = 110; + ECONNREFUSED = 111; {$ENDIF} +type + TSocketType = (stUDP, stTCP); + +const + CSocketTypeNames: array [TSocketType] of string = ('UDP', 'TCP'); + + CRawSocketTypes: array [TSocketType] of Integer = (SOCK_DGRAM, // UDP datagram + SOCK_STREAM // TCP stream + ); + + CRawProtocolTypes: array [TSocketType] of Integer = (IPPROTO_UDP, + IPPROTO_TCP); + +type + TAddressType = (afIPv4, afIPv6); + +const + CAddressTypeNames: array [TAddressType] of string = ('IPv4', 'IPv6'); + type {$IFDEF MSWINDOWS} TSocketHandle = Winapi.Winsock2.TSocket; @@ -72,7 +113,8 @@ TAddrInfoW = record ai_next: PAddrInfoW; end; - TGetAddrInfoW = function(NodeName: PWideChar; ServiceName: PWideChar; Hints: PAddrInfoW; ppResult: PPAddrInfoW): Integer; stdcall; + TGetAddrInfoW = function(NodeName: PWideChar; ServiceName: PWideChar; + Hints: PAddrInfoW; ppResult: PPAddrInfoW): Integer; stdcall; TFreeAddrInfoW = procedure(ai: PAddrInfoW); stdcall; {$ELSE} TSocketHandle = Integer; @@ -85,12 +127,6 @@ TncLine = class; // Forward declaration TncLineOnConnectDisconnect = procedure(aLine: TncLine) of object; - TConnectThread = class(TncReadyThread) - public - Line: TncLine; - ConnectResult: Integer; - procedure ProcessEvent; override; - end; // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// // TncLine // Bring in all functionality from WinSock API, with appropriate exception raising on errors @@ -99,6 +135,9 @@ TncLine = class(TObject) private const DefaultConnectTimeout = 100; // msec private + FKind: TSocketType; + FFamily: TAddressType; + FMaxPort: Integer; FActive: Boolean; FLastSent: Int64; FLastReceived: Int64; @@ -106,15 +145,19 @@ TncLine = class(TObject) FDataObject: TObject; FOnConnected: TncLineOnConnectDisconnect; FOnDisconnected: TncLineOnConnectDisconnect; + FOnBeforeConnected: TncLineOnConnectDisconnect; // Called before OnConnected for TLS setup + FOnBeforeDisconnected: TncLineOnConnectDisconnect; // Called before OnDisconnected for TLS cleanup private PropertyLock: TCriticalSection; FHandle: TSocketHandle; FConnectTimeout: Integer; + {$IFDEF MSWINDOWS} AddrResult: PAddrInfoW; {$ELSE} AddrResult: Paddrinfo; {$ENDIF} + function IsConnectionBased: Boolean; procedure SetConnected; procedure SetDisconnected; function GetReceiveTimeout: Integer; @@ -125,12 +168,20 @@ TncLine = class(TObject) procedure SetLastReceived(const Value: Int64); function GetLastSent: Int64; procedure SetLastSent(const Value: Int64); + protected const + DefaultKind = stTCP; + + const + DefaultFamily = afIPv4; protected + procedure SetKind(const AKind: TSocketType); + procedure SetFamily(const Value: TAddressType); function CreateLineObject: TncLine; virtual; procedure Check(aCmdRes: Integer); inline; // API functions - procedure CreateClientHandle(const aHost: string; const aPort: Integer); + procedure CreateClientHandle(const aHost: string; const aPort: Integer; + const aBroadcast: Boolean = False); procedure CreateServerHandle(const aPort: Integer); procedure DestroyHandle; @@ -141,35 +192,51 @@ TncLine = class(TObject) procedure EnableNoDelay; inline; procedure EnableKeepAlive; inline; + procedure EnableBroadcast; inline; + procedure EnableIPv6Only; inline; + procedure EnableReuseAddress; inline; procedure SetReceiveSize(const aBufferSize: Integer); procedure SetWriteSize(const aBufferSize: Integer); - property OnConnected: TncLineOnConnectDisconnect read FOnConnected write FOnConnected; - property OnDisconnected: TncLineOnConnectDisconnect read FOnDisconnected write FOnDisconnected; + property OnConnected: TncLineOnConnectDisconnect read FOnConnected + write FOnConnected; + property OnDisconnected: TncLineOnConnectDisconnect read FOnDisconnected + write FOnDisconnected; + property OnBeforeConnected: TncLineOnConnectDisconnect read FOnBeforeConnected + write FOnBeforeConnected; + property OnBeforeDisconnected: TncLineOnConnectDisconnect read FOnBeforeDisconnected + write FOnBeforeDisconnected; public constructor Create; overload; virtual; destructor Destroy; override; + property Kind: TSocketType read FKind; + property Family: TAddressType read FFamily; property Handle: TSocketHandle read FHandle; property Active: Boolean read FActive; property LastSent: Int64 read GetLastSent write SetLastSent; property LastReceived: Int64 read GetLastReceived write SetLastReceived; property PeerIP: string read FPeerIP; property DataObject: TObject read FDataObject write FDataObject; - property ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout default DefaultConnectTimeout; - property ReceiveTimeout: Integer read GetReceiveTimeout write SetReceiveTimeout; + property ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout + default DefaultConnectTimeout; + property ReceiveTimeout: Integer read GetReceiveTimeout + write SetReceiveTimeout; property SendTimeout: Integer read GetSendTimeout write SetSendTimeout; end; -function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): TSocketHandleArray; -function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): Boolean; inline; +function Readable(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): TSocketHandleArray; +function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): Boolean; inline; implementation // Readable checks to see if any socket handles have data // and if so, overwrites aReadFDS with the data -function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): TSocketHandleArray; +function Readable(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): TSocketHandleArray; {$IFDEF MSWINDOWS} var TimeoutValue: timeval; @@ -193,7 +260,8 @@ function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: if FDSetPtr^.fd_count > 0 then begin SetLength(Result, FDSetPtr^.fd_count); - move(FDSetPtr^.fd_array[0], Result[0], FDSetPtr^.fd_count * SizeOf(TSocketHandle)); + move(FDSetPtr^.fd_array[0], Result[0], FDSetPtr^.fd_count * + SizeOf(TSocketHandle)); end else SetLength(Result, 0); // This is needed with newer compilers @@ -201,6 +269,7 @@ function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: FreeMem(FDSetPtr); end; end; + {$ELSE} var @@ -228,10 +297,12 @@ function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: begin SocketHandle := aSocketHandleArray[i]; FDNdx := SocketHandle div NFDBITS; - FDSetPtr.fds_bits[FDNdx] := FDSetPtr.fds_bits[FDNdx] or (1 shl (SocketHandle mod NFDBITS)); + FDSetPtr.fds_bits[FDNdx] := FDSetPtr.fds_bits[FDNdx] or + (1 shl (SocketHandle mod NFDBITS)); end; - ReadySockets := Select(FDArrayLen * NFDBITS, FDSetPtr, nil, nil, @TimeoutValue); + ReadySockets := Select(FDArrayLen * NFDBITS, FDSetPtr, nil, nil, + @TimeoutValue); if ReadySockets > 0 then begin @@ -242,7 +313,8 @@ function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: begin SocketHandle := aSocketHandleArray[i]; FDNdx := SocketHandle div NFDBITS; - if FDSetPtr.fds_bits[FDNdx] and (1 shl (SocketHandle mod NFDBITS)) <> 0 then + if FDSetPtr.fds_bits[FDNdx] and (1 shl (SocketHandle mod NFDBITS)) <> 0 + then begin Result[ResultNdx] := SocketHandle; ResultNdx := ResultNdx + 1; @@ -257,7 +329,8 @@ function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: end; {$ENDIF} -function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): Boolean; +function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): Boolean; begin Result := Length(Readable(aSocketHandleArray, aTimeout)) > 0; end; @@ -268,7 +341,8 @@ function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; const a DllGetAddrInfo: TGetAddrInfoW = nil; DllFreeAddrInfo: TFreeAddrInfoW = nil; -procedure GetAddressInfo(NodeName: PWideChar; ServiceName: PWideChar; Hints: PAddrInfoW; ppResult: PPAddrInfoW); +procedure GetAddressInfo(NodeName: PWideChar; ServiceName: PWideChar; + Hints: PAddrInfoW; ppResult: PPAddrInfoW); var iRes: Integer; begin @@ -285,6 +359,31 @@ procedure FreeAddressInfo(ai: PAddrInfoW); DllFreeAddrInfo(ai); end; +function IsBroadcastAddress(const aHost: string): Boolean; +var + Octets: TArray; + LastOctet: Integer; +begin + // Split the IP into octets + Octets := aHost.Split(['.']); + + // Basic validation + if Length(Octets) <> 4 then + Exit(False); + + // Try to parse last octet + if not TryStrToInt(Octets[3], LastOctet) then + Exit(False); + + Result := + // Global broadcast + (aHost = '255.255.255.255') or + // Limited broadcast + (aHost = '0.0.0.0') or + // Subnet broadcast (last octet is 255) + (LastOctet = 255); +end; + {$ENDIF} // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { TncLine } @@ -295,8 +394,9 @@ constructor TncLine.Create; inherited Create; PropertyLock := TCriticalSection.Create; - FHandle := InvalidSocket; + FKind := DefaultKind; + FFamily := DefaultFamily; FConnectTimeout := DefaultConnectTimeout; FActive := False; @@ -307,6 +407,8 @@ constructor TncLine.Create; FOnConnected := nil; FOnDisconnected := nil; + FOnBeforeConnected := nil; + FOnBeforeDisconnected := nil; end; destructor TncLine.Destroy; @@ -315,13 +417,14 @@ destructor TncLine.Destroy; DestroyHandle; PropertyLock.Free; - inherited Destroy; end; function TncLine.CreateLineObject: TncLine; begin Result := TncLine.Create; + Result.SetKind(Kind); + Result.SetFamily(Family); end; /// ///////////////////////////////////////////////////////////////////////////// @@ -336,30 +439,76 @@ procedure TncLine.Check(aCmdRes: Integer); {$ENDIF} end; -procedure TncLine.CreateClientHandle(const aHost: string; const aPort: Integer); +procedure TncLine.CreateClientHandle(const aHost: string; const aPort: Integer; + const aBroadcast: Boolean = False); var - ConnectThread: TConnectThread; {$IFDEF MSWINDOWS} Hints: TAddrInfoW; + ErrorCode: Integer; {$ELSE} Hints: addrinfo; AnsiHost, AnsiPort: RawByteString; {$ENDIF} + ResolveHost: string; + ConnectResult: Integer; begin try + // Validate host for IPv6 if applicable + if (FFamily = afIPv6) and (aHost <> '') and (LowerCase(aHost) <> 'localhost') then + begin + // Validate IPv6 address format if it looks like an IPv6 address + if (Pos(':', aHost) > 0) and not TncIPUtils.IsIPv6ValidAddress(aHost) then + raise EIPError.CreateFmt('Invalid IPv6 address format: %s', [aHost]); + end; + + if IsBroadcastAddress(aHost) and not aBroadcast then + raise Exception.Create('Cannot use broadcast address when Broadcast is False'); + FillChar(Hints, SizeOf(Hints), 0); - Hints.ai_family := AF_INET; - Hints.ai_socktype := SOCK_STREAM; - Hints.ai_protocol := IPPROTO_TCP; + + // Set address family and related flags based on FFamily + case FFamily of + afIPv4: + begin + Hints.ai_family := AF_INET; + if LowerCase(aHost) = 'localhost' then + ResolveHost := '127.0.0.1' + else + ResolveHost := aHost; + end; + afIPv6: + begin + Hints.ai_family := AF_INET6; + Hints.ai_flags := AI_ADDRCONFIG; + // If it's a valid IPv6 address, normalize it + if (Pos(':', aHost) > 0) and TncIPUtils.IsIPv6ValidAddress(aHost) then + ResolveHost := TncIPUtils.NormalizeAddress(aHost) + else + ResolveHost := aHost; + + // Handle link-local addresses correctly + if TncIPUtils.IsLinkLocal(ResolveHost) then + begin + // Extract scope ID if present in the address + var ScopePos := Pos('%', ResolveHost); + if ScopePos > 0 then + ResolveHost := Copy(ResolveHost, 1, ScopePos - 1); + end; + end; + end; + + Hints.ai_socktype := CRawSocketTypes[FKind]; + Hints.ai_protocol := CRawProtocolTypes[FKind]; // Resolve the server address and port {$IFDEF MSWINDOWS} - GetAddressInfo(PChar(aHost), PChar(IntToStr(aPort)), @Hints, @AddrResult); + GetAddressInfo(PChar(ResolveHost), PChar(IntToStr(aPort)), @Hints, + @AddrResult); {$ELSE} - AnsiHost := RawByteString(aHost); + AnsiHost := RawByteString(ResolveHost); AnsiPort := RawByteString(IntToStr(aPort)); - - GetAddrInfo(MarshaledAString(AnsiHost), MarshaledAString(AnsiPort), Hints, AddrResult); + GetAddrInfo(MarshaledAString(AnsiHost), MarshaledAString(AnsiPort), Hints, + AddrResult); {$ENDIF} try // Create a SOCKET for connecting to server @@ -369,27 +518,62 @@ procedure TncLine.CreateClientHandle(const aHost: string; const aPort: Integer); {$IFNDEF MSWINDOWS} EnableReuseAddress; {$ENDIF} - ConnectThread := TConnectThread.Create; - try - ConnectThread.Line := Self; - ConnectThread.ConnectResult := -1; - - // Connect to server - ConnectThread.ReadyEvent.WaitFor; - ConnectThread.ReadyEvent.ResetEvent; - ConnectThread.WakeupEvent.SetEvent; - ConnectThread.WaitForReady(FConnectTimeout); - - if ConnectThread.ConnectResult = -1 then + if IsConnectionBased then + begin + ConnectResult := Connect(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen); + if ConnectResult = -1 then raise EncLineException.Create('Connect timeout'); - - Check(ConnectThread.ConnectResult); - SetConnected; - finally - ConnectThread.FreeOnTerminate := True; - ConnectThread.Terminate; - ConnectThread.WakeupEvent.SetEvent; + Check(ConnectResult); + + // For TLS connections, perform handshake BEFORE triggering OnConnected + if Assigned(FOnBeforeConnected) then + begin + try + FOnBeforeConnected(Self); // This will do TLS handshake + except + on E: Exception do + begin + DestroyHandle; + raise EncLineException.CreateFmt('TLS handshake failed: %s', [E.Message]); + end; + end; + end; + + SetConnected; // Only triggers OnConnected AFTER TLS is ready + end + else + begin + // For UDP, handle IPv4 and IPv6 differently + case FFamily of + afIPv4: + begin + // IPv4 UDP: connect if not broadcast mode + if not aBroadcast then + begin + ConnectResult := Connect(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen); + Check(ConnectResult); + end + else + begin + // Enable broadcast option for UDP broadcast + EnableBroadcast; + end; + SetConnected; + end; + afIPv6: + begin + // For IPv6 UDP with link-local addresses, ensure scope ID is set + if TncIPUtils.IsLinkLocal(ResolveHost) then + begin + var AddrIn6 := PSockAddrIn6(AddrResult^.ai_addr)^; + // Set appropriate scope ID if needed + // This could be enhanced with interface detection + end; + SetConnected; + end; + end; end; + except DestroyHandle; raise; @@ -417,9 +601,18 @@ procedure TncLine.CreateServerHandle(const aPort: Integer); {$ENDIF} begin FillChar(Hints, SizeOf(Hints), 0); - Hints.ai_family := AF_INET; - Hints.ai_socktype := SOCK_STREAM; - Hints.ai_protocol := IPPROTO_TCP; + case FFamily of + afIPv4: + begin + Hints.ai_family := AF_INET; + end; + afIPv6: + begin + Hints.ai_family := AF_INET6; + end; + end; + Hints.ai_socktype := CRawSocketTypes[FKind]; + Hints.ai_protocol := CRawProtocolTypes[FKind]; Hints.ai_flags := AI_PASSIVE; // Inform GetAddrInfo to return a server socket // Resolve the server address and port @@ -431,15 +624,22 @@ procedure TncLine.CreateServerHandle(const aPort: Integer); {$ENDIF} try // Create a server listener socket - FHandle := Socket(AddrResult^.ai_family, AddrResult^.ai_socktype, AddrResult^.ai_protocol); + FHandle := Socket(AddrResult^.ai_family, AddrResult^.ai_socktype, + AddrResult^.ai_protocol); Check(FHandle); try + EnableIPv6Only; + {$IFNDEF MSWINDOWS} EnableReuseAddress; {$ENDIF} - // Setup the TCP listening socket - Check(Bind(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen)); - Check(Listen(FHandle, SOMAXCONN)); + // Bind the socket + Check(bind(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen)); + + // For TCP, we need to listen for incoming connections + if IsConnectionBased then + Check(Listen(FHandle, SOMAXCONN)); + SetConnected; except DestroyHandle; @@ -458,6 +658,17 @@ procedure TncLine.DestroyHandle; begin if FActive then begin + // CRITICAL: Call TLS cleanup BEFORE destroying socket + if Assigned(FOnBeforeDisconnected) then + begin + try + FOnBeforeDisconnected(Self); // TLS cleanup while socket is still active + except + on E: Exception do + // Continue with socket cleanup even if TLS cleanup fails + end; + end; + try {$IFDEF MSWINDOWS} Shutdown(FHandle, SD_BOTH); @@ -467,12 +678,15 @@ procedure TncLine.DestroyHandle; Posix.Unistd.__Close(FHandle); {$ENDIF} except + on E: Exception do + // end; try SetDisconnected; except + on E: Exception do + // end; - FHandle := InvalidSocket; end; end; @@ -481,14 +695,14 @@ function TncLine.AcceptLine: TncLine; var NewHandle: TSocketHandle; {$IFNDEF MSWINDOWS} - Addr: sockaddr; + addr: sockaddr; AddrLen: socklen_t; {$ENDIF} begin {$IFDEF MSWINDOWS} NewHandle := Accept(FHandle, nil, nil); {$ELSE} - NewHandle := Accept(FHandle, Addr, AddrLen); + NewHandle := Accept(FHandle, addr, AddrLen); {$ENDIF} if NewHandle = InvalidSocket then Abort; // raise silent exception @@ -498,36 +712,66 @@ function TncLine.AcceptLine: TncLine; Result.FHandle := NewHandle; Result.OnConnected := OnConnected; Result.OnDisconnected := OnDisconnected; + Result.OnBeforeConnected := OnBeforeConnected; + Result.OnBeforeDisconnected := OnBeforeDisconnected; + + // For server-side TLS connections, perform handshake BEFORE triggering OnConnected + if Assigned(Result.OnBeforeConnected) then + begin + try + Result.OnBeforeConnected(Result); // This will do TLS handshake for server + except + on E: Exception do + begin + Result.DestroyHandle; + Result.Free; + raise EncLineException.CreateFmt('Server TLS handshake failed: %s', [E.Message]); + end; + end; + end; + Result.SetConnected; end; function TncLine.SendBuffer(const aBuf; aLen: Integer): Integer; begin - // Send all buffer in one go, the most optimal by far Result := Send(FHandle, aBuf, aLen, 0); - try - if Result = SocketError then - Abort; // raise silent exception instead of Check + if Result = SocketError then + begin + if IsConnectionBased then + try + Abort; // TCP: raise silent exception + except + DestroyHandle; + raise; + end + else + Check(Result); // UDP: normal error check + end + else LastSent := TStopWatch.GetTimeStamp; - except - DestroyHandle; - raise; - end; end; function TncLine.RecvBuffer(var aBuf; aLen: Integer): Integer; begin Result := recv(FHandle, aBuf, aLen, 0); - try - if (Result = SocketError) or (Result = 0) then - Abort; // raise silent exception instead of Check, something has disconnected + if (Result = SocketError) or + (IsConnectionBased and (Result = 0)) then // TCP: 0 means disconnected + begin + if IsConnectionBased then + try + Abort; // TCP: raise silent exception + except + DestroyHandle; + raise; + end + else + Check(Result); // UDP: normal error check + end + else LastReceived := TStopWatch.GetTimeStamp; - except - DestroyHandle; - raise; - end; end; procedure TncLine.EnableNoDelay; @@ -536,7 +780,8 @@ procedure TncLine.EnableNoDelay; begin optval := 1; {$IFDEF MSWINDOWS} - Check(SetSockOpt(FHandle, IPPROTO_TCP, TCP_NODELAY, PAnsiChar(@optval), SizeOf(optval))); + Check(SetSockOpt(FHandle, IPPROTO_TCP, TCP_NODELAY, PAnsiChar(@optval), + SizeOf(optval))); {$ELSE} Check(SetSockOpt(FHandle, IPPROTO_TCP, TCP_NODELAY, optval, SizeOf(optval))); {$ENDIF} @@ -548,73 +793,150 @@ procedure TncLine.EnableKeepAlive; begin optval := 1; // any non zero indicates true {$IFDEF MSWINDOWS} - Check(SetSockOpt(FHandle, SOL_SOCKET, SO_KEEPALIVE, PAnsiChar(@optval), SizeOf(optval))); + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_KEEPALIVE, PAnsiChar(@optval), + SizeOf(optval))); {$ELSE} Check(SetSockOpt(FHandle, SOL_SOCKET, SO_KEEPALIVE, optval, SizeOf(optval))); {$ENDIF} end; +procedure TncLine.EnableBroadcast; +var + optval: Integer; +begin + optval := 1; +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@optval), + SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, optval, SizeOf(optval))); +{$ENDIF} +end; + +procedure TncLine.EnableIPv6Only; +var + optval: Integer; +begin + if FFamily = afIPv6 then + begin + optval := 1; +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, IPPROTO_IPV6, IPV6_V6ONLY, PAnsiChar(@optval), + SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, IPPROTO_IPV6, IPV6_V6ONLY, optval, + SizeOf(optval))); +{$ENDIF} + end; +end; + procedure TncLine.EnableReuseAddress; var optval: Integer; begin optval := 1; {$IFDEF MSWINDOWS} - Check(SetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, PAnsiChar(@optval), SizeOf(optval))); + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, PAnsiChar(@optval), + SizeOf(optval))); {$ELSE} Check(SetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, optval, SizeOf(optval))); {$ENDIF} end; +procedure TncLine.SetKind(const AKind: TSocketType); +begin + if FHandle = InvalidSocket then // TODO: Raise exception otherwise??? + begin + FKind := AKind; + end; +end; + +procedure TncLine.SetFamily(const Value: TAddressType); +begin + if FHandle = InvalidSocket then + // Only allow changing family when socket is not active + begin + FFamily := Value; + end + else + // Form1.Log('WARNING: Attempted to change Family while socket is active'); +end; + +function TncLine.IsConnectionBased: Boolean; +begin + Result := FKind = stTCP; +end; + procedure TncLine.SetReceiveSize(const aBufferSize: Integer); begin // min is 512 bytes, max is 1048576 {$IFDEF MSWINDOWS} - Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, PAnsiChar(@aBufferSize), SizeOf(aBufferSize))); + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, PAnsiChar(@aBufferSize), + SizeOf(aBufferSize))); {$ELSE} - Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, aBufferSize, SizeOf(aBufferSize))); + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, aBufferSize, + SizeOf(aBufferSize))); {$ENDIF} end; procedure TncLine.SetWriteSize(const aBufferSize: Integer); begin {$IFDEF MSWINDOWS} - Check(SetSockOpt(FHandle, SOL_SOCKET, SO_SNDBUF, PAnsiChar(@aBufferSize), SizeOf(aBufferSize))); + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_SNDBUF, PAnsiChar(@aBufferSize), + SizeOf(aBufferSize))); {$ELSE} - Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, aBufferSize, SizeOf(aBufferSize))); + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, aBufferSize, + SizeOf(aBufferSize))); {$ENDIF} end; procedure TncLine.SetConnected; var - Addr: sockaddr; -{$IFDEF MSWINDOWS} - AddrSize: Integer; -{$ELSE} - AddrSize: socklen_t; -{$ENDIF} + addr: TSockAddrStorage; + AddrSize: {$IFDEF MSWINDOWS}Integer{$ELSE}socklen_t{$ENDIF}; begin if not FActive then begin FActive := True; - LastSent := TStopWatch.GetTimeStamp; LastReceived := LastSent; - AddrSize := SizeOf(Addr); - if GetPeerName(FHandle, Addr, AddrSize) <> SocketError then + if IsConnectionBased then begin - // FPeerIP := IntToStr(Ord(addr.sin_addr.S_un_b.s_b1)) + '.' + IntToStr(Ord(addr.sin_addr.S_un_b.s_b2)) + '.' + IntToStr(Ord(addr.sin_addr.S_un_b.s_b3)) + - // '.' + IntToStr(Ord(addr.sin_addr.S_un_b.s_b4)); - FPeerIP := - - IntToStr(Ord(Addr.sa_data[2])) + '.' + + // Get peer information + AddrSize := SizeOf(TSockAddrStorage); - IntToStr(Ord(Addr.sa_data[3])) + '.' + - - IntToStr(Ord(Addr.sa_data[4])) + '.' + + if GetPeerName(FHandle, PSOCKADDR(@addr)^, AddrSize) = 0 then + begin + try + FPeerIP := TncIPUtils.GetIPFromStorage(addr); + except + on E: EIPError do + FPeerIP := ''; + end; - IntToStr(Ord(Addr.sa_data[5])); + // If we got an empty string, set default values based on family + if FPeerIP = '' then + begin + case FFamily of + afIPv4: FPeerIP := '0.0.0.0'; + afIPv6: FPeerIP := '::'; + end; + end; + end + else + begin + var ErrorCode := {$IFDEF MSWINDOWS}WSAGetLastError(){$ELSE}GetLastError(){$ENDIF}; + FPeerIP := ''; + end; + end + else + begin + // For UDP, we're always "connected" but might not have peer info yet + case FFamily of + afIPv4: FPeerIP := '0.0.0.0'; + afIPv6: FPeerIP := '::'; + end; end; if Assigned(OnConnected) then @@ -641,8 +963,8 @@ procedure TncLine.SetDisconnected; function TncLine.GetReceiveTimeout: Integer; var - Opt: DWord; - OptSize: Integer; + Opt: Cardinal; + OptSize: {$IFDEF MSWINDOWS}Integer{$ELSE}socklen_t{$ENDIF}; begin OptSize := SizeOf(Opt); {$IFDEF MSWINDOWS} @@ -655,7 +977,7 @@ function TncLine.GetReceiveTimeout: Integer; procedure TncLine.SetReceiveTimeout(const Value: Integer); var - Opt: DWord; + Opt: Cardinal; OptSize: Integer; begin Opt := Value; @@ -669,8 +991,8 @@ procedure TncLine.SetReceiveTimeout(const Value: Integer); function TncLine.GetSendTimeout: Integer; var - Opt: DWord; - OptSize: Integer; + Opt: Cardinal; + OptSize: {$IFDEF MSWINDOWS}Integer{$ELSE}socklen_t{$ENDIF}; begin OptSize := SizeOf(Opt); {$IFDEF MSWINDOWS} @@ -683,7 +1005,7 @@ function TncLine.GetSendTimeout: Integer; procedure TncLine.SetSendTimeout(const Value: Integer); var - Opt: DWord; + Opt: Cardinal; OptSize: Integer; begin Opt := Value; @@ -737,11 +1059,11 @@ procedure TncLine.SetLastSent(const Value: Int64); {$IFDEF MSWINDOWS} +// Windows-specific types and variables var ExtDllHandle: THandle = 0; procedure AttachAddrInfo; - procedure SafeLoadFrom(aDll: string); begin if not Assigned(DllGetAddrInfo) then @@ -761,33 +1083,30 @@ procedure AttachAddrInfo; end; begin - SafeLoadFrom('ws2_32.dll'); // WinSock2 dll - SafeLoadFrom('wship6.dll'); // WshIp6 dll + SafeLoadFrom('ws2_32.dll'); + SafeLoadFrom('wship6.dll'); end; +{$ENDIF} -var - WSAData: TWSAData; +initialization - { TConnectThread } +{$IFDEF MSWINDOWS} -procedure TConnectThread.ProcessEvent; +var + WSAData: TWSAData; begin - ConnectResult := Connect(Line.FHandle, Line.AddrResult^.ai_addr^, Line.AddrResult^.ai_addrlen); + WSAStartup(MakeWord(2, 2), WSAData); + AttachAddrInfo; end; - -initialization - -WSAStartup(MakeWord(2, 2), WSAData); // Require WinSock 2 version - -AttachAddrInfo; +{$ENDIF} finalization +{$IFDEF MSWINDOWS} if ExtDllHandle <> 0 then FreeLibrary(ExtDllHandle); - WSACleanup; - {$ENDIF} end. + diff --git a/Source/ncSChannel.pas b/Source/ncSChannel.pas new file mode 100644 index 0000000..5f612e0 --- /dev/null +++ b/Source/ncSChannel.pas @@ -0,0 +1,1544 @@ +unit ncSChannel; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// +// This unit implements TLS/SSL support for NetCom7 through Windows SChannel +// (Secure Channel) API integration. Provides secure communication capabilities +// for both TCP servers and clients using native Windows cryptographic services. +// +// 13/07/2025 - by J.Pauwels +// - Initial creation +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +interface + +uses + SysUtils, + Classes, + Windows; + +//****************************************************************************** +// CryptoAPI +//****************************************************************************** +const + CERT_STORE_PROV_FILENAME = 8; + CERT_STORE_PROV_MEMORY = 2; + CERT_STORE_OPEN_EXISTING_FLAG = $00004000; + CERT_STORE_READONLY_FLAG = $00008000; + PKCS12_NO_PERSIST_KEY = $00008000; + PKCS12_INCLUDE_EXTENDED_PROPERTIES = $00000010; + + CERT_FIND_ANY = 0; + // no check is made to determine whether memory for contexts remains allocated + CERT_CLOSE_STORE_DEFAULT = 0; + // force freeing all contexts associated with the store + CERT_CLOSE_STORE_FORCE_FLAG = 1; + // checks for nonfreed certificate, CRL, and CTL context to report an error on leak + CERT_CLOSE_STORE_CHECK_FLAG = 2; + + CRYPT_ASN_ENCODING = $00000001; + CRYPT_NDR_ENCODING = $00000002; + X509_ASN_ENCODING = $00000001; + X509_NDR_ENCODING = $00000002; + PKCS_7_ASN_ENCODING = $00010000; + PKCS_7_NDR_ENCODING = $00020000; + // TCryptCertUsage mormot.crypt.secure + CERT_OFFLINE_CRL_SIGN_KEY_USAGE = $02; // cuCrlSign + CERT_KEY_CERT_SIGN_KEY_USAGE = $04; // cuKeyCertSign + CERT_KEY_AGREEMENT_KEY_USAGE = $08; // cuKeyAgreement + CERT_DATA_ENCIPHERMENT_KEY_USAGE = $10; // cuDataEncipherment + CERT_KEY_ENCIPHERMENT_KEY_USAGE = $20; // cuKeyEncipherment + CERT_NON_REPUDIATION_KEY_USAGE = $40; // cuNonRepudiation + CERT_DIGITAL_SIGNATURE_KEY_USAGE = $80; // cuDigitalSignature + + CERT_KEY_PROV_INFO_PROP_ID = 2; + CERT_HASH_PROP_ID = 3; + CERT_FRIENDLY_NAME_PROP_ID = 11; + + CERT_SIMPLE_NAME_STR = 1; + CERT_OID_NAME_STR = 2; + CERT_X500_NAME_STR = 3; + + CRYPT_OID_INFO_OID_KEY = 1; + +type + HCRYPTPROV = pointer; + HCRYPTKEY = pointer; + HCRYPTHASH = pointer; + HCERTSTORE = pointer; + + CRYPTOAPI_BLOB = record + cbData: DWORD; + pbData: PByteArray; + end; + CRYPT_INTEGER_BLOB = CRYPTOAPI_BLOB; + CERT_NAME_BLOB = CRYPTOAPI_BLOB; + CRYPT_OBJID_BLOB = CRYPTOAPI_BLOB; + CRYPT_DATA_BLOB = CRYPTOAPI_BLOB; + PCRYPT_DATA_BLOB = ^CRYPT_DATA_BLOB; + + CRYPT_BIT_BLOB = record + cbData: DWORD; + pbData: PByteArray; + cUnusedBits: DWORD; + end; + + CRYPT_ALGORITHM_IDENTIFIER = record + pszObjId: PAnsiChar; + Parameters: CRYPT_OBJID_BLOB; + end; + + CERT_PUBLIC_KEY_INFO = record + Algorithm: CRYPT_ALGORITHM_IDENTIFIER; + PublicKey: CRYPT_BIT_BLOB; + end; + + CERT_EXTENSION = record + pszObjId: PAnsiChar; + fCritical: BOOL; + Blob: CRYPT_OBJID_BLOB; + end; + PCERT_EXTENSION = ^CERT_EXTENSION; + CERT_EXTENSIONS = array[word] of CERT_EXTENSION; + PCERT_EXTENSIONS = ^CERT_EXTENSIONS; + + CERT_INFO = record + dwVersion: DWORD; + SerialNumber: CRYPT_INTEGER_BLOB; + SignatureAlgorithm: CRYPT_ALGORITHM_IDENTIFIER; + Issuer: CERT_NAME_BLOB; + NotBefore: TFileTime; + NotAfter: TFileTime; + Subject: CERT_NAME_BLOB; + SubjectPublicKeyInfo: CERT_PUBLIC_KEY_INFO; + IssuerUniqueId: CRYPT_BIT_BLOB; + SubjectUniqueId: CRYPT_BIT_BLOB; + cExtension: DWORD; + rgExtension: PCERT_EXTENSIONS; + end; + PCERT_INFO = ^CERT_INFO; + + CERT_CONTEXT = record + dwCertEncodingType: DWORD; + pbCertEncoded: PByte; + cbCertEncoded: DWORD; + pCertInfo: PCERT_INFO; + hCertStore: HCERTSTORE; + end; + PCCERT_CONTEXT = ^CERT_CONTEXT; + PPCCERT_CONTEXT = ^PCCERT_CONTEXT; + +CRYPT_KEY_PROV_PARAM = record + dwParam: DWORD; + pbData: PByte; + cbData: DWORD; + dwFlags: DWORD; + end; + PCRYPT_KEY_PROV_PARAM = ^CRYPT_KEY_PROV_PARAM; + + CRYPT_KEY_PROV_INFO = record + pwszContainerName: PWideChar; + pwszProvName: PWideChar; + dwProvType: DWORD; + dwFlags: DWORD; + cProvParam: DWORD; + rgProvParam: PCRYPT_KEY_PROV_PARAM; + dwKeySpec: DWORD; + end; + PCRYPT_KEY_PROV_INFO = ^CRYPT_KEY_PROV_INFO; + + CRYPT_OID_INFO = record + cbSize: DWORD; + pszOID: PAnsiChar; + pwszName: PWideChar; + dwGroupId: DWORD; + Union: record + case integer of + 0: (dwValue: DWORD); + 1: (Algid: DWORD); + 2: (dwLength: DWORD); + end; + ExtraInfo: CRYPTOAPI_BLOB; + end; + PCRYPT_OID_INFO = ^CRYPT_OID_INFO; + + PCCRL_CONTEXT = pointer; + PPCCRL_CONTEXT = ^PCCRL_CONTEXT; + PCRYPT_ATTRIBUTE = pointer; + + CRYPT_SIGN_MESSAGE_PARA = record + cbSize: DWORD; + dwMsgEncodingType: DWORD; + pSigningCert: PCCERT_CONTEXT; + HashAlgorithm: CRYPT_ALGORITHM_IDENTIFIER; + pvHashAuxInfo: pointer; + cMsgCert: DWORD; + rgpMsgCert: PPCCERT_CONTEXT; + cMsgCrl: DWORD; + rgpMsgCrl: PPCCRL_CONTEXT; + cAuthAttr: DWORD; + rgAuthAttr: PCRYPT_ATTRIBUTE; + cUnauthAttr: DWORD; + rgUnauthAttr: PCRYPT_ATTRIBUTE; + dwFlags: DWORD; + dwInnerContentType: DWORD; + HashEncryptionAlgorithm: CRYPT_ALGORITHM_IDENTIFIER; + pvHashEncryptionAuxInfo: pointer; + end; + + PFN_CRYPT_GET_SIGNER_CERTIFICATE = function(pvGetArg: pointer; + dwCertEncodingType: DWORD; pSignerId: PCERT_INFO; + hMsgCertStore: HCERTSTORE): PCCERT_CONTEXT; stdcall; + CRYPT_VERIFY_MESSAGE_PARA = record + cbSize: DWORD; + dwMsgAndCertEncodingType: DWORD; + hCryptProv: HCRYPTPROV; + pfnGetSignerCertificate: PFN_CRYPT_GET_SIGNER_CERTIFICATE; + pvGetArg: pointer; + end; + +//****************************************************************************** +// Low-Level SSPI/SChannel +//****************************************************************************** +const + SECBUFFER_VERSION = 0; + + SECBUFFER_EMPTY = 0; + SECBUFFER_DATA = 1; + SECBUFFER_TOKEN = 2; + SECBUFFER_EXTRA = 5; + SECBUFFER_STREAM_TRAILER = 6; + SECBUFFER_STREAM_HEADER = 7; + SECBUFFER_PADDING = 9; + SECBUFFER_STREAM = 10; + SECBUFFER_ALERT = 17; + + SECPKG_CRED_INBOUND = 1; + SECPKG_CRED_OUTBOUND = 2; + + SECPKG_ATTR_SIZES = 0; + SECPKG_ATTR_NAMES = 1; + SECPKG_ATTR_STREAM_SIZES = 4; + SECPKG_ATTR_NEGOTIATION_INFO = 12; + SECPKG_ATTR_ACCESS_TOKEN = 13; + SECPKG_ATTR_REMOTE_CERT_CONTEXT = $53; + SECPKG_ATTR_CONNECTION_INFO = $5a; + SECPKG_ATTR_CIPHER_INFO = $64; // Vista+ new API + SECPKG_ATTR_C_ACCESS_TOKEN = $80000012; + SECPKG_ATTR_C_FULL_ACCESS_TOKEN = $80000082; + + SECPKGCONTEXT_CIPHERINFO_V1 = 1; + + SECURITY_NETWORK_DREP = 0; + SECURITY_NATIVE_DREP = $10; + + ISC_REQ_DELEGATE = $00000001; + ISC_REQ_MUTUAL_AUTH = $00000002; + ISC_REQ_REPLAY_DETECT = $00000004; + ISC_REQ_SEQUENCE_DETECT = $00000008; + ISC_REQ_CONFIDENTIALITY = $00000010; + ISC_REQ_USE_SESSION_KEY = $00000020; + ISC_REQ_PROMPT_FOR_CREDS = $00000040; + ISC_REQ_USE_SUPPLIED_CREDS = $00000080; + ISC_REQ_ALLOCATE_MEMORY = $00000100; + ISC_REQ_USE_DCE_STYLE = $00000200; + ISC_REQ_DATAGRAM = $00000400; + ISC_REQ_CONNECTION = $00000800; + ISC_REQ_CALL_LEVEL = $00001000; + ISC_REQ_FRAGMENT_SUPPLIED = $00002000; + ISC_REQ_EXTENDED_ERROR = $00004000; + ISC_REQ_STREAM = $00008000; + ISC_REQ_INTEGRITY = $00010000; + ISC_REQ_IDENTIFY = $00020000; + ISC_REQ_NULL_SESSION = $00040000; + ISC_REQ_MANUAL_CRED_VALIDATION = $00080000; + ISC_REQ_RESERVED1 = $00100000; + ISC_REQ_FRAGMENT_TO_FIT = $00200000; + ISC_REQ_FLAGS = ISC_REQ_SEQUENCE_DETECT or + ISC_REQ_REPLAY_DETECT or + ISC_REQ_CONFIDENTIALITY or + ISC_REQ_EXTENDED_ERROR or + ISC_REQ_ALLOCATE_MEMORY or + ISC_REQ_STREAM; + + ASC_REQ_REPLAY_DETECT = $00000004; + ASC_REQ_SEQUENCE_DETECT = $00000008; + ASC_REQ_CONFIDENTIALITY = $00000010; + ASC_REQ_ALLOCATE_MEMORY = $00000100; + ASC_REQ_EXTENDED_ERROR = $00008000; + ASC_REQ_STREAM = $00010000; + ASC_REQ_FLAGS = ASC_REQ_SEQUENCE_DETECT or + ASC_REQ_REPLAY_DETECT or + ASC_REQ_CONFIDENTIALITY or + ASC_REQ_EXTENDED_ERROR or + ASC_REQ_ALLOCATE_MEMORY or + ASC_REQ_STREAM; + + SEC_E_OK = 0; + + SEC_I_CONTINUE_NEEDED = $00090312; + SEC_I_COMPLETE_NEEDED = $00090313; + SEC_I_COMPLETE_AND_CONTINUE = $00090314; + SEC_I_CONTEXT_EXPIRED = $00090317; + SEC_I_INCOMPLETE_CREDENTIALS = $00090320; + SEC_I_RENEGOTIATE = $00090321; + + SEC_E_UNSUPPORTED_FUNCTION = $80090302; + SEC_E_INVALID_TOKEN = $80090308; + SEC_E_MESSAGE_ALTERED = $8009030F; + SEC_E_CONTEXT_EXPIRED = $80090317; + SEC_E_INCOMPLETE_MESSAGE = $80090318; + SEC_E_BUFFER_TOO_SMALL = $80090321; + SEC_E_ILLEGAL_MESSAGE = $80090326; + SEC_E_CERT_UNKNOWN = $80090327; + SEC_E_CERT_EXPIRED = $80090328; + SEC_E_ENCRYPT_FAILURE = $80090329; + SEC_E_DECRYPT_FAILURE = $80090330; + SEC_E_ALGORITHM_MISMATCH = $80090331; + + SEC_WINNT_AUTH_IDENTITY_UNICODE = $02; + + SCHANNEL_SHUTDOWN = 1; + + SCHANNEL_CRED_VERSION = 4; + SCH_CREDENTIALS_VERSION = 5; + + SCH_CRED_NO_SYSTEM_MAPPER = $00000002; + SCH_CRED_NO_SERVERNAME_CHECK = $00000004; + SCH_CRED_MANUAL_CRED_VALIDATION = $00000008; + SCH_CRED_NO_DEFAULT_CREDS = $00000010; + SCH_CRED_AUTO_CRED_VALIDATION = $00000020; + SCH_CRED_USE_DEFAULT_CREDS = $00000040; + SCH_CRED_DISABLE_RECONNECTS = $00000080; + SCH_CRED_REVOCATION_CHECK_END_CERT = $00000100; + SCH_CRED_REVOCATION_CHECK_CHAIN = $00000200; + SCH_CRED_REVOCATION_CHECK_CHAIN_EXCLUDE_ROOT = $00000400; + SCH_CRED_IGNORE_NO_REVOCATION_CHECK = $00000800; + SCH_CRED_IGNORE_REVOCATION_OFFLINE = $00001000; + SCH_CRED_RESTRICTED_ROOTS = $00002000; + SCH_CRED_REVOCATION_CHECK_CACHE_ONLY = $00004000; + SCH_CRED_CACHE_ONLY_URL_RETRIEVAL = $00008000; + SCH_CRED_MEMORY_STORE_CERT = $00010000; + SCH_CRED_CACHE_ONLY_URL_RETRIEVAL_ON_CREATE = $00020000; + SCH_SEND_ROOT_CERT = $00040000; + SCH_USE_STRONG_CRYPTO = $00400000; + + UNISP_NAME = 'Microsoft Unified Security Protocol Provider'; + + SP_PROT_TLS1_0_SERVER = $0040; + SP_PROT_TLS1_0_CLIENT = $0080; + SP_PROT_TLS1_1_SERVER = $0100; + SP_PROT_TLS1_1_CLIENT = $0200; + SP_PROT_TLS1_2_SERVER = $0400; // first SP_PROT_TLS_SAFE protocol + SP_PROT_TLS1_2_CLIENT = $0800; + SP_PROT_TLS1_3_SERVER = $1000; // Windows 11 or Windows Server 2022 ;) + SP_PROT_TLS1_3_CLIENT = $2000; + // SSL 2/3 protocols ($04,$08,$10,$20) are just not defined at all + SP_PROT_TLS1_0 = SP_PROT_TLS1_0_CLIENT or SP_PROT_TLS1_0_SERVER; + SP_PROT_TLS1_1 = SP_PROT_TLS1_1_CLIENT or SP_PROT_TLS1_1_SERVER; + SP_PROT_TLS1_2 = SP_PROT_TLS1_2_CLIENT or SP_PROT_TLS1_2_SERVER; + SP_PROT_TLS1_3 = SP_PROT_TLS1_3_CLIENT or SP_PROT_TLS1_3_SERVER; + // TLS 1.0 and TLS 1.1 are universally deprecated + SP_PROT_TLS_SAFE = SP_PROT_TLS1_2 or SP_PROT_TLS1_3; + SP_PROT_TLS_UNSAFE = pred(SP_PROT_TLS1_2_SERVER); + + +type + {$ifdef WIN64} + LONG_PTR = Int64; + {$else} + LONG_PTR = integer; + {$endif} + + ALG_ID = cardinal; + TALG_IDs = array[word] of ALG_ID; + PALG_IDs = ^TALG_IDs; + + _HMAPPER = pointer; + + /// SSPI context handle + TSecHandle = record + dwLower: LONG_PTR; + dwUpper: LONG_PTR; + end; + PSecHandle = ^TSecHandle; + + // some context aliases, as defined in SSPI headers + TCredHandle = type TSecHandle; + PCredHandle = type PSecHandle; + TCtxtHandle = type TSecHandle; + PCtxtHandle = type PSecHandle; + + TSChannelCred = record + dwVersion: cardinal; + cCreds: cardinal; + paCred: PPCCERT_CONTEXT; + hRootStore: HCERTSTORE; + cMappers: cardinal; + aphMappers: _HMAPPER; + cSupportedAlgs: cardinal; + palgSupportedAlgs: PALG_IDs; + grbitEnabledProtocols: cardinal; + dwMinimumCipherStrength: cardinal; + dwMaximumCipherStrength: cardinal; + dwSessionLifespan: cardinal; + dwFlags: cardinal; + dwCredFormat: cardinal; + end; + PSChannelCred = ^TSChannelCred; + + TSecBuffer = record + cbBuffer: cardinal; + BufferType: cardinal; + pvBuffer: pointer; + end; + PSecBuffer = ^TSecBuffer; + + TSecBufferDesc = record + ulVersion: cardinal; + cBuffers: cardinal; + pBuffers: PSecBuffer; + end; + PSecBufferDesc = ^TSecBufferDesc; + + TTimeStamp = record + dwLowDateTime: cardinal; + dwHighDateTime: cardinal; + end; + PTimeStamp = ^TTimeStamp; + + TSecPkgContextStreamSizes = record + cbHeader: cardinal; + cbTrailer: cardinal; + cbMaximumMessage: cardinal; + cBuffers: cardinal; + cbBlockSize: cardinal; + end; + PSecPkgContextStreamSizes = ^TSecPkgContextStreamSizes; + + /// store information about a SSPI package + TSecPkgInfoW = record + fCapabilities: Cardinal; + wVersion: Word; + wRPCID: Word; + cbMaxToken: Cardinal; + Name: PWideChar; + Comment: PWideChar; + end; + /// pointer to information about a SSPI package + PSecPkgInfoW = ^TSecPkgInfoW; + + ESChannel = class(Exception); + + + {$ifdef USERECORDWITHMETHODS}TSChannelClient = record + {$else}TSChannelClient = object{$endif} + private + Cred: TCredHandle; + Ctxt: TCtxtHandle; + Sizes: TSecPkgContextStreamSizes; + Data, Input: AnsiString; + InputSize, DataPos, DataCount, InputCount: integer; + SessionClosed: boolean; + procedure HandshakeLoop(aLine: TObject); + procedure AppendData(const aBuffer: TSecBuffer); + public + Initialized: boolean; + procedure AfterConnection(aLine: TObject; const aTargetHost: AnsiString; aIgnoreCertificateErrors: boolean); + procedure BeforeDisconnection(aLine: TObject); + function Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + function Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + end; + + // Server-side SChannel implementation + {$ifdef USERECORDWITHMETHODS}TSChannelServer = record + {$else}TSChannelServer = object{$endif} + private + Cred: TCredHandle; + Ctxt: TCtxtHandle; + Sizes: TSecPkgContextStreamSizes; + Data, Input: AnsiString; + InputSize, DataPos, DataCount, InputCount: integer; + SessionClosed: boolean; + procedure HandshakeLoop(aLine: TObject); + procedure AppendData(const aBuffer: TSecBuffer); + public + Initialized: boolean; + HandshakeCompleted: boolean; + procedure AfterConnection(aLine: TObject; const aCertificateFile, aPrivateKeyPassword: AnsiString); + procedure BeforeDisconnection(aLine: TObject); + function Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + function Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + end; + + +// crypt32.dll API calls + +function CertOpenStore(lpszStoreProvider: PAnsiChar; dwEncodingType: cardinal; + hCryptProv: HCRYPTPROV; dwFlags: cardinal; pvPara: pointer): HCERTSTORE; stdcall; + external 'crypt32.dll'; + +function CertCloseStore(hCertStore: HCERTSTORE; dwFlags: cardinal): BOOL; stdcall; + external 'crypt32.dll'; + +function CertEnumCertificatesInStore(hCertStore: HCERTSTORE; + pPrevCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall; + external 'crypt32.dll'; + +function CertFreeCertificateContext(pCertContext: PCCERT_CONTEXT): BOOL; stdcall; + external 'crypt32.dll'; + +function PFXImportCertStore(pPFX: pointer; szPassword: PWideChar; + dwFlags: cardinal): HCERTSTORE; stdcall; + external 'crypt32.dll'; + +// secur32.dll API calls + +function AcquireCredentialsHandleW(pszPrincipal, pszPackage: PWideChar; + fCredentialUse: cardinal; pvLogonId: pointer; pAuthData: PSChannelCred; + pGetKeyFn: pointer; pvGetKeyArgument: pointer; phCredential: PCredHandle; + ptsExpiry: PTimeStamp): cardinal; stdcall; + external 'secur32.dll'; + +function QuerySecurityPackageInfoW(pszPackageName: PWideChar; + var ppPackageInfo: PSecPkgInfoW): cardinal; stdcall; + external 'secur32.dll'; + +function FreeCredentialsHandle(phCredential: PCredHandle): cardinal; stdcall; + external 'secur32.dll'; + +function InitializeSecurityContextW(phCredential: PCredHandle; phContext: PCtxtHandle; + pszTargetName: PWideChar; fContextReq, Reserved1, TargetDataRep: cardinal; + pInput: PSecBufferDesc; Reserved2: cardinal; phNewContext: PCtxtHandle; + pOutput: PSecBufferDesc; var pfContextAttr: cardinal; + ptsExpiry: PTimeStamp): cardinal; stdcall; + external 'secur32.dll'; + +function AcceptSecurityContext(phCredential: PCredHandle; phContext: PCtxtHandle; + pInput: PSecBufferDesc; fContextReq, TargetDataRep: cardinal; + phNewContext: PCtxtHandle; pOutput: PSecBufferDesc; var pfContextAttr: cardinal; + ptsExpiry: PTimeStamp): cardinal; stdcall; + external 'secur32.dll'; + +function DeleteSecurityContext(phContext: PCtxtHandle): cardinal; stdcall; + external 'secur32.dll'; + +function ApplyControlToken(phContext: PCtxtHandle; + pInput: PSecBufferDesc): cardinal; stdcall; + external 'secur32.dll'; + +function QueryContextAttributesW(phContext: PCtxtHandle; ulAttribute: cardinal; + pBuffer: pointer): cardinal; stdcall; + external 'secur32.dll'; + +function FreeContextBuffer(pvContextBuffer: pointer): cardinal; stdcall; + external 'secur32.dll'; + +function EncryptMessage(phContext: PCtxtHandle; fQOP: cardinal; + pMessage: PSecBufferDesc; MessageSeqNo: cardinal): cardinal; stdcall; + external 'secur32.dll'; + +function DecryptMessage(phContext: PCtxtHandle; pMessage: PSecBufferDesc; + MessageSeqNo: cardinal; pfQOP: PCardinal): cardinal; stdcall; + external 'secur32.dll'; + +implementation + +// Add reference to NetCom7 lines unit +uses ncLines; + +// We make a descendant of TncLine so that we can access the protected methods +type + TncLineInternal = class(TncLine); + +{ Certificate Loading Functions } + +function LoadCertificateFromPFX(const FileName: AnsiString; const Password: AnsiString): PCCERT_CONTEXT; +var + FileHandle: THandle; + FileSize: DWORD; + PFXData: array of Byte; + BytesRead: DWORD; + PFXBlob: CRYPT_DATA_BLOB; + CertStore: HCERTSTORE; + PasswordW: WideString; +begin + Result := nil; + + // Read PFX file + FileHandle := CreateFileA(PAnsiChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if FileHandle = INVALID_HANDLE_VALUE then + begin + // Failed to open file + Exit; + end; + + try + FileSize := GetFileSize(FileHandle, nil); + if FileSize = INVALID_FILE_SIZE then + begin + // Invalid file size + Exit; + end; + + SetLength(PFXData, FileSize); + if not ReadFile(FileHandle, PFXData[0], FileSize, BytesRead, nil) or (BytesRead <> FileSize) then + begin + // Failed to read file data + Exit; + end; + finally + CloseHandle(FileHandle); + end; + + // Import PFX + PFXBlob.cbData := FileSize; + PFXBlob.pbData := @PFXData[0]; + PasswordW := WideString(string(Password)); // Convert AnsiString to WideString + + // Import with no flags to allow full private key access for TLS operations + CertStore := PFXImportCertStore(@PFXBlob, PWideChar(PasswordW), 0); + if CertStore = nil then + begin + // PFXImportCertStore failed + Exit; + end; + + try + // Get first certificate from store + Result := CertEnumCertificatesInStore(CertStore, nil); + finally + CertCloseStore(CertStore, 0); + end; +end; + +{ SChannel Simplified Cleanup Functions} + +/// Simplified cleanup for security context handles +procedure FreeSecurityContextSafe(var handle: TCtxtHandle); +begin + if (handle.dwLower <> 0) or (handle.dwUpper <> 0) then begin + DeleteSecurityContext(@handle); + FillChar(handle, SizeOf(handle), 0); + end; +end; + +/// Simplified cleanup for credential handles +procedure FreeCredentialsHandleSafe(var handle: TCredHandle); +begin + if (handle.dwLower <> 0) or (handle.dwUpper <> 0) then begin + FreeCredentialsHandle(@handle); + FillChar(handle, SizeOf(handle), 0); + end; +end; + +/// Check if credential handle is in uninitialized state +function IsCredHandleInvalid(const handle: TCredHandle): Boolean; +begin + Result := (handle.dwLower = 0) and (handle.dwUpper = 0); +end; + +{ TSChannel Helper Functions } + +procedure RaiseLastError; // not defined e.g. with Delphi 5 +var + LastError: Integer; +begin + LastError := GetLastError; + if LastError <> 0 then + raise ESChannel.CreateFmt('System Error %d [%s]', [LastError, SysErrorMessage(LastError)]) + else + raise ESChannel.Create('Unknown SChannel error'); +end; + +function CheckSEC_E_OK(res: cardinal): cardinal; +begin + if res <> SEC_E_OK then + begin + case res of + $80090318: raise ESChannel.Create('SEC_E_INCOMPLETE_MESSAGE'); + $80090308: raise ESChannel.Create('SEC_E_INVALID_TOKEN'); + $00090312: raise ESChannel.Create('SEC_I_CONTINUE_NEEDED (unexpected)'); + $00090320: raise ESChannel.Create('SEC_I_INCOMPLETE_CREDENTIALS (unexpected)'); + $00090321: raise ESChannel.Create('SEC_I_RENEGOTIATE (unexpected)'); + $00090317: raise ESChannel.Create('SEC_I_CONTEXT_EXPIRED (unexpected)'); + else + raise ESChannel.CreateFmt('SChannel error: 0x%08X', [res]); + end; + end; + result := res; +end; + +function CheckSocket(res: integer): cardinal; +begin + if res <= 0 then + raise ESChannel.CreateFmt('Socket Error %d', [res]); + result := res; +end; + +const + TLSRECMAXSIZE = 19000; // stack buffers for TSChannelClient.Receive/Send + +type + {$ifdef USERECORDWITHMETHODS}THandshakeBuf = record + {$else}THandshakeBuf = object{$endif} + public + buf: array[0..4] of TSecBuffer; + input, output: TSecBufferDesc; + procedure Init; + end; + +procedure THandshakeBuf.Init; +begin + input.ulVersion := SECBUFFER_VERSION; + input.cBuffers := 2; + input.pBuffers := @buf[0]; + buf[0].cbBuffer := 0; + buf[0].BufferType := SECBUFFER_TOKEN; + buf[0].pvBuffer := nil; + buf[1].cbBuffer := 0; + buf[1].BufferType := SECBUFFER_EMPTY; + buf[1].pvBuffer := nil; + output.ulVersion := SECBUFFER_VERSION; + output.cBuffers := 1; + output.pBuffers := @buf[2]; + buf[2].cbBuffer := 0; + buf[2].BufferType := SECBUFFER_TOKEN; + buf[2].pvBuffer := nil; +end; + +{ TSChannelClient - Client-side SChannel implementation } + +procedure TSChannelClient.AppendData(const aBuffer: TSecBuffer); +var + newlen: integer; +begin + newlen := DataCount + integer(aBuffer.cbBuffer); + if newlen > Length(Data) then + SetLength(Data, newlen); + Move(aBuffer.pvBuffer^, PByteArray(Data)[DataCount], aBuffer.cbBuffer); + inc(DataCount, aBuffer.cbBuffer); +end; + +procedure TSChannelClient.AfterConnection(aLine: TObject; const aTargetHost: AnsiString; aIgnoreCertificateErrors: boolean); +var + TargetHostString: WideString; + f: cardinal; + res: cardinal; + schannelCred: TSChannelCred; + buf: THandshakeBuf; + trial: integer; + lastError: cardinal; + +begin + trial := 0; + + // Retry loop for Windows 7/8 TLS bugs + while true do + try + // Clean up any existing TLS context from previous connection + if Initialized then + begin + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + Initialized := false; + SessionClosed := false; + DataCount := 0; + DataPos := 0; + end; + + // Setup target host for handshake + TargetHostString := WideString(string(aTargetHost)); + + // Setup SChannel credentials + FillChar(schannelCred, SizeOf(schannelCred), 0); + schannelCred.dwVersion := SCHANNEL_CRED_VERSION; + if aIgnoreCertificateErrors then + schannelCred.dwFlags := SCH_CRED_MANUAL_CRED_VALIDATION or SCH_CRED_NO_DEFAULT_CREDS + else + schannelCred.dwFlags := SCH_CRED_REVOCATION_CHECK_CHAIN or SCH_CRED_IGNORE_REVOCATION_OFFLINE; + + // Direct credential acquisition + res := AcquireCredentialsHandleW( + nil, UNISP_NAME, SECPKG_CRED_OUTBOUND, nil, @schannelCred, nil, nil, @Cred, nil); + if res <> SEC_E_OK then + raise ESChannel.CreateFmt('AcquireCredentialsHandleW failed: 0x%08X', [res]); + + // Initialize data buffers + DataPos := 0; + DataCount := 0; + SetLength(Data, TLSRECMAXSIZE); + + // Setup handshake flags - simplified approach + f := ISC_REQ_FLAGS; + if aIgnoreCertificateErrors then + f := f or ISC_REQ_MANUAL_CRED_VALIDATION or ISC_REQ_USE_SUPPLIED_CREDS; + + // Initialize handshake buffer + buf.Init; + + // Initiate client handshake + res := InitializeSecurityContextW(@Cred, nil, PWideChar(TargetHostString), + f, 0, SECURITY_NATIVE_DREP, nil, 0, @Ctxt, @buf.output, f, nil); + + if res <> SEC_I_CONTINUE_NEEDED then + raise ESChannel.CreateFmt('InitializeSecurityContext failed: 0x%08X', [res]); + + // Send initial handshake data + if (buf.buf[2].cbBuffer = 0) or (buf.buf[2].pvBuffer = nil) then + raise ESChannel.CreateFmt('Void Hello answer to %s', [string(aTargetHost)]); + + try + TncLineInternal(TncLine(aLine)).SendBuffer(buf.buf[2].pvBuffer^, buf.buf[2].cbBuffer); + finally + FreeContextBuffer(buf.buf[2].pvBuffer); + end; + + // Complete the handshake + HandshakeLoop(aLine); + + // Query stream sizes after successful handshake + res := QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes); + if res <> SEC_E_OK then + raise ESChannel.CreateFmt('QueryContextAttributes failed: 0x%08X', [res]); + + InputSize := Sizes.cbHeader + Sizes.cbMaximumMessage + Sizes.cbTrailer; + if InputSize > TLSRECMAXSIZE then + raise ESChannel.CreateFmt('InputSize=%d>%d', [InputSize, TLSRECMAXSIZE]); + + SetLength(Input, InputSize); + InputCount := 0; + Initialized := true; + + break; // Success - exit retry loop + + except + // Retry for known Windows 7/8 TLS bugs + on E: ESChannel do + begin + lastError := GetLastError; + if (trial = 0) and + ((res = SEC_E_BUFFER_TOO_SMALL) or (res = SEC_E_MESSAGE_ALTERED)) then + begin + // Cleanup and retry once for Windows TLS bug + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + inc(trial); + // Continue retry loop + end + else + raise; // Re-raise if not a retryable error or already tried + end; + end; +end; + +procedure TSChannelClient.HandshakeLoop(aLine: TObject); +var + buf: THandshakeBuf; + res, f: cardinal; + Line: TncLine; + LoopCount: Integer; + RecvResult: Integer; +begin + Line := TncLine(aLine); + res := SEC_I_CONTINUE_NEEDED; + LoopCount := 0; + + while (res = SEC_I_CONTINUE_NEEDED) or (res = SEC_E_INCOMPLETE_MESSAGE) do begin + Inc(LoopCount); + + RecvResult := TncLineInternal(Line).RecvBuffer(PByteArray(Data)[DataCount], length(Data) - DataCount); + + inc(DataCount, CheckSocket(RecvResult)); + + buf.Init; + buf.buf[0].cbBuffer := DataCount; + buf.buf[0].BufferType := SECBUFFER_TOKEN; + buf.buf[0].pvBuffer := pointer(Data); + + res := InitializeSecurityContextW(@Cred, @Ctxt, nil, ISC_REQ_FLAGS, 0, + SECURITY_NATIVE_DREP, @buf.input, 0, @Ctxt, @buf.output, f, nil); + + if res = SEC_I_INCOMPLETE_CREDENTIALS then + begin + // check https://stackoverflow.com/a/47479968/458259 + res := InitializeSecurityContextW(@Cred, @Ctxt, nil, ISC_REQ_FLAGS, 0, + SECURITY_NATIVE_DREP, @buf.input, 0, @Ctxt, @buf.output, f, nil); + end; + + if (res = SEC_E_OK) or (res = SEC_I_CONTINUE_NEEDED) or + ((f and ISC_REQ_EXTENDED_ERROR) <> 0) then begin + if (buf.buf[2].cbBuffer <> 0) and (buf.buf[2].pvBuffer <> nil) then begin + CheckSocket(TncLineInternal(Line).SendBuffer(buf.buf[2].pvBuffer^, buf.buf[2].cbBuffer)); + CheckSEC_E_OK(FreeContextBuffer(buf.buf[2].pvBuffer)); + end; + end; + + if buf.buf[1].BufferType = SECBUFFER_EXTRA then begin + // reuse pending Data bytes to avoid SEC_E_INVALID_TOKEN + Move(PByteArray(Data)[cardinal(DataCount) - buf.buf[1].cbBuffer], + PByteArray(Data)[0], buf.buf[1].cbBuffer); + DataCount := buf.buf[1].cbBuffer; + end else + if res <> SEC_E_INCOMPLETE_MESSAGE then + DataCount := 0; + end; + + CheckSEC_E_OK(res); +end; + +procedure TSChannelClient.BeforeDisconnection(aLine: TObject); +var + desc: TSecBufferDesc; + buf: TSecBuffer; + dt, f: cardinal; + Line: TncLine; +begin + if Initialized then + try + Line := TncLine(aLine); + if (Line <> nil) and Line.Active then begin + // Send TLS shutdown notification + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 1; + desc.pBuffers := @buf; + buf.cbBuffer := 4; + buf.BufferType := SECBUFFER_TOKEN; + dt := SCHANNEL_SHUTDOWN; + buf.pvBuffer := @dt; + if ApplyControlToken(@Ctxt, @desc) = SEC_E_OK then begin + buf.cbBuffer := 0; + buf.BufferType := SECBUFFER_TOKEN; + buf.pvBuffer := nil; + if InitializeSecurityContextW(@Cred, @Ctxt, nil, ISC_REQ_FLAGS, 0, + SECURITY_NATIVE_DREP, nil, 0, @Ctxt, @desc, f, nil) = SEC_E_OK then begin + TncLineInternal(Line).SendBuffer(buf.pvBuffer^, buf.cbBuffer); + FreeContextBuffer(buf.pvBuffer); + end; + end; + end; + // Simple cleanup with zero-fill + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + finally + // Simple zero-fill + FillChar(Cred, SizeOf(Cred), 0); + FillChar(Ctxt, SizeOf(Ctxt), 0); + Initialized := false; + end; +end; + +function TSChannelClient.Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res: cardinal; + read, i: integer; + needsRenegotiate: boolean; + Line: TncLine; + + function DecryptInput: cardinal; + begin + buf[0].cbBuffer := InputCount; + buf[0].BufferType := SECBUFFER_DATA; + buf[0].pvBuffer := pointer(Input); + buf[1].cbBuffer := 0; + buf[1].BufferType := SECBUFFER_EMPTY; + buf[1].pvBuffer := nil; + buf[2].cbBuffer := 0; + buf[2].BufferType := SECBUFFER_EMPTY; + buf[2].pvBuffer := nil; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + result := DecryptMessage(@Ctxt, @desc, 0, nil); + end; +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).RecvBuffer(aBuffer^, aLength); + exit; + end; + result := 0; + if not SessionClosed then + while DataCount = 0 do + try + DataPos := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + repeat + read := TncLineInternal(Line).RecvBuffer(PByteArray(Input)[InputCount], InputSize - InputCount); + if read <= 0 then begin + result := read; // return socket error + exit; + end; + inc(InputCount, read); + res := DecryptInput; + until res <> SEC_E_INCOMPLETE_MESSAGE; + needsRenegotiate := false; + repeat + case res of + SEC_I_RENEGOTIATE: + begin + needsRenegotiate := true; + end; + SEC_I_CONTEXT_EXPIRED: + begin + SessionClosed := true; + end; + SEC_E_INCOMPLETE_MESSAGE: break; + else CheckSEC_E_OK(res); + end; + InputCount := 0; + for i := 1 to 3 do + case buf[i].BufferType of + SECBUFFER_DATA: + begin + AppendData(buf[i]); + end; + SECBUFFER_EXTRA: + begin + Move(buf[i].pvBuffer^, pointer(Input)^, buf[i].cbBuffer); + InputCount := buf[i].cbBuffer; + end; + end; + if InputCount = 0 then + break; + res := DecryptInput; + until false; + if needsRenegotiate then + begin + HandshakeLoop(aLine); + end; + except + on E: Exception do + begin + exit; // shutdown the connection on ESChannel fatal error + end; + end; + result := DataCount; + if aLength < result then + result := aLength; + Move(PByteArray(Data)[DataPos], aBuffer^, result); + inc(DataPos, result); + dec(DataCount, result); +end; + +function TSChannelClient.Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res, sent, s, len, trailer, pending, templen: cardinal; + temp: array[0..TLSRECMAXSIZE] of byte; + Line: TncLine; + +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).SendBuffer(aBuffer^, aLength); + exit; + end; + + // Check if Sizes has been initialized + if Sizes.cbMaximumMessage = 0 then + begin + if QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes) <> SEC_E_OK then + begin + result := -1; + exit; + end; + end; + + result := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + pending := aLength; + while pending > 0 do begin + templen := pending; + if templen > Sizes.cbMaximumMessage then + templen := Sizes.cbMaximumMessage; + Move(aBuffer^, temp[Sizes.cbHeader], templen); + inc(PByte(aBuffer), templen); + dec(pending, templen); + trailer := Sizes.cbHeader + templen; + buf[0].cbBuffer := Sizes.cbHeader; + buf[0].BufferType := SECBUFFER_STREAM_HEADER; + buf[0].pvBuffer := @temp; + buf[1].cbBuffer := templen; + buf[1].BufferType := SECBUFFER_DATA; + buf[1].pvBuffer := @temp[Sizes.cbHeader]; + buf[2].cbBuffer := Sizes.cbTrailer; + buf[2].BufferType := SECBUFFER_STREAM_TRAILER; + buf[2].pvBuffer := @temp[trailer]; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + if EncryptMessage(@Ctxt, 0, @desc, 0) <> SEC_E_OK then + begin + exit; // shutdown the connection on SChannel error + end; + len := buf[0].cbBuffer + buf[1].cbBuffer + buf[2].cbBuffer; + sent := 0; + repeat + s := TncLineInternal(Line).SendBuffer(PByteArray(@temp)[sent], len); + if s = len then + break; // whole message sent + if s = 0 then + begin + exit; // report connection closed + end; + if integer(s) < 0 then begin + result := s; + exit; // report socket fatal error + end + else begin + dec(len, s); + inc(sent, s); + end; + Sleep(1); // try again + until false; + end; + result := aLength; +end; + +{ TSChannelServer - Server-side SChannel implementation } + +procedure TSChannelServer.AppendData(const aBuffer: TSecBuffer); +var + newlen: integer; +begin + newlen := DataCount + integer(aBuffer.cbBuffer); + if newlen > Length(Data) then + SetLength(Data, newlen); + Move(aBuffer.pvBuffer^, PByteArray(Data)[DataCount], aBuffer.cbBuffer); + inc(DataCount, aBuffer.cbBuffer); +end; + +procedure TSChannelServer.AfterConnection(aLine: TObject; const aCertificateFile, aPrivateKeyPassword: AnsiString); +var + res: cardinal; + Line: TncLine; + SchannelCred: TSChannelCred; + pCertContext: PCCERT_CONTEXT; + pCertArray: PCCERT_CONTEXT; // Array of one certificate context for paCred + +begin + // Clean up any existing TLS context from previous connection + if Initialized then + begin + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + Initialized := false; + HandshakeCompleted := false; + SessionClosed := false; + DataCount := 0; + DataPos := 0; + end; + + Line := TncLine(aLine); + + // Initialize server credentials with certificate + FillChar(SchannelCred, SizeOf(SchannelCred), 0); + SchannelCred.dwVersion := SCHANNEL_CRED_VERSION; + SchannelCred.grbitEnabledProtocols := SP_PROT_TLS1_2_SERVER or SP_PROT_TLS1_3_SERVER; + SchannelCred.dwFlags := 0; // No special flags for server + + // Load certificate from PFX file + pCertContext := nil; + if aCertificateFile <> '' then + begin + pCertContext := LoadCertificateFromPFX(aCertificateFile, aPrivateKeyPassword); + if pCertContext <> nil then + begin + pCertArray := pCertContext; // Create array element + SchannelCred.cCreds := 1; + SchannelCred.paCred := @pCertArray; // Point to the array + end + else + raise ESChannel.CreateFmt('Failed to load certificate from: %s', [string(aCertificateFile)]); + end + else + raise ESChannel.Create('Certificate file required for TLS server'); + + try + // Direct credential acquisition + res := AcquireCredentialsHandleW( + nil, UNISP_NAME, SECPKG_CRED_INBOUND, nil, @SchannelCred, nil, nil, @Cred, nil); + if res <> SEC_E_OK then + raise ESChannel.CreateFmt('AcquireCredentialsHandleW failed: 0x%08X', [res]); + + // Initialize buffers + DataPos := 0; + DataCount := 0; + SetLength(Data, TLSRECMAXSIZE); + SetLength(Input, TLSRECMAXSIZE); + InputCount := 0; + Initialized := true; // Mark as initialized but handshake not yet completed + HandshakeCompleted := false; // Handshake will be triggered when first TLS data arrives + + finally + // Free certificate context + if pCertContext <> nil then + CertFreeCertificateContext(pCertContext); + end; +end; + +procedure TSChannelServer.HandshakeLoop(aLine: TObject); +var + buf: THandshakeBuf; + res, f: cardinal; + Line: TncLine; + fDone: boolean; + fInitContext: boolean; + LoopCount: Integer; + RecvResult: Integer; + +begin + Line := TncLine(aLine); + fDone := false; + fInitContext := true; + LoopCount := 0; + + try + while not fDone do + begin + Inc(LoopCount); + + // Read client data + try + RecvResult := TncLineInternal(Line).RecvBuffer(PByteArray(Data)[DataCount], length(Data) - DataCount); + inc(DataCount, CheckSocket(RecvResult)); + except + on E: Exception do + begin + raise ESChannel.CreateFmt('Failed to receive client data: %s', [E.Message]); + end; + end; + + buf.Init; + buf.buf[0].cbBuffer := DataCount; + buf.buf[0].BufferType := SECBUFFER_TOKEN; + buf.buf[0].pvBuffer := pointer(Data); + + // Server-side handshake using AcceptSecurityContext + if fInitContext then + begin + // CRITICAL: Server must use AcceptSecurityContext, not InitializeSecurityContext + res := AcceptSecurityContext(@Cred, nil, @buf.input, + ASC_REQ_FLAGS, SECURITY_NATIVE_DREP, @Ctxt, @buf.output, f, nil); + fInitContext := false; + end + else + begin + res := AcceptSecurityContext(@Cred, @Ctxt, @buf.input, + ASC_REQ_FLAGS, SECURITY_NATIVE_DREP, @Ctxt, @buf.output, f, nil); + end; + + case res of + SEC_E_OK: + begin + fDone := true; + end; + SEC_I_CONTINUE_NEEDED: + begin + // Continue handshake + end; + SEC_I_INCOMPLETE_CREDENTIALS: + begin + // Continue with current data + end; + SEC_E_INCOMPLETE_MESSAGE: + begin + // Need more data from client + continue; + end; + else + begin + raise ESChannel.CreateFmt('AcceptSecurityContext failed: 0x%08X', [res]); + end; + end; + + // Send response to client if needed + if (buf.buf[2].cbBuffer <> 0) and (buf.buf[2].pvBuffer <> nil) then + begin + try + CheckSocket(TncLineInternal(Line).SendBuffer(buf.buf[2].pvBuffer^, buf.buf[2].cbBuffer)); + CheckSEC_E_OK(FreeContextBuffer(buf.buf[2].pvBuffer)); + except + on E: Exception do + begin + raise ESChannel.CreateFmt('Failed to send server response: %s', [E.Message]); + end; + end; + end; + + // Handle extra data + if buf.buf[1].BufferType = SECBUFFER_EXTRA then + begin + Move(PByteArray(Data)[cardinal(DataCount) - buf.buf[1].cbBuffer], + PByteArray(Data)[0], buf.buf[1].cbBuffer); + DataCount := buf.buf[1].cbBuffer; + end + else if not fDone then + begin + DataCount := 0; + end; + end; + + except + on E: Exception do + begin + raise ESChannel.CreateFmt('TLS handshake failed: %s', [E.Message]); + end; + end; +end; + +procedure TSChannelServer.BeforeDisconnection(aLine: TObject); +var + desc: TSecBufferDesc; + buf: TSecBuffer; + dt, f: cardinal; + Line: TncLine; +begin + if Initialized then + try + Line := TncLine(aLine); + if (Line <> nil) and Line.Active then begin + // Send TLS shutdown notification + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 1; + desc.pBuffers := @buf; + buf.cbBuffer := 4; + buf.BufferType := SECBUFFER_TOKEN; + dt := SCHANNEL_SHUTDOWN; + buf.pvBuffer := @dt; + if ApplyControlToken(@Ctxt, @desc) = SEC_E_OK then begin + buf.cbBuffer := 0; + buf.BufferType := SECBUFFER_TOKEN; + buf.pvBuffer := nil; + if AcceptSecurityContext(@Cred, @Ctxt, nil, ASC_REQ_FLAGS, + SECURITY_NATIVE_DREP, @Ctxt, @desc, f, nil) = SEC_E_OK then begin + TncLineInternal(Line).SendBuffer(buf.pvBuffer^, buf.cbBuffer); + FreeContextBuffer(buf.pvBuffer); + end; + end; + end; + // Simple cleanup with zero-fill + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + finally + // Simple zero-fill + FillChar(Cred, SizeOf(Cred), 0); + FillChar(Ctxt, SizeOf(Ctxt), 0); + Initialized := false; + HandshakeCompleted := false; + end; +end; + +function TSChannelServer.Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res: cardinal; + read, i: integer; + needsRenegotiate: boolean; + Line: TncLine; + + function DecryptInput: cardinal; + begin + buf[0].cbBuffer := InputCount; + buf[0].BufferType := SECBUFFER_DATA; + buf[0].pvBuffer := pointer(Input); + buf[1].cbBuffer := 0; + buf[1].BufferType := SECBUFFER_EMPTY; + buf[1].pvBuffer := nil; + buf[2].cbBuffer := 0; + buf[2].BufferType := SECBUFFER_EMPTY; + buf[2].pvBuffer := nil; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + result := DecryptMessage(@Ctxt, @desc, 0, nil); + end; +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).RecvBuffer(aBuffer^, aLength); + exit; + end; + + // Check if handshake needs to be performed + if not HandshakeCompleted then + begin + try + HandshakeLoop(aLine); + CheckSEC_E_OK(QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes)); + InputSize := Sizes.cbHeader + Sizes.cbMaximumMessage + Sizes.cbTrailer; + if InputSize > TLSRECMAXSIZE then + raise ESChannel.CreateFmt('InputSize=%d>%d', [InputSize, TLSRECMAXSIZE]); + SetLength(Input, InputSize); + HandshakeCompleted := true; + + // CRITICAL FIX: Clear any leftover handshake data to prevent it from being returned as application data + DataCount := 0; + DataPos := 0; + InputCount := 0; + + // CRITICAL: Return immediately to trigger handshake completion callback + // We'll return 0 to indicate no application data was received, + // but set a special result to indicate handshake completion + result := 0; + exit; + except + on E: Exception do + begin + result := -1; // Return error + exit; + end; + end; + end; + + result := 0; + if not SessionClosed then + while DataCount = 0 do + try + DataPos := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + repeat + read := TncLineInternal(Line).RecvBuffer(PByteArray(Input)[InputCount], InputSize - InputCount); + if read <= 0 then begin + result := read; // return socket error + exit; + end; + inc(InputCount, read); + res := DecryptInput; + until res <> SEC_E_INCOMPLETE_MESSAGE; + needsRenegotiate := false; + repeat + case res of + SEC_I_RENEGOTIATE: + begin + needsRenegotiate := true; + end; + SEC_I_CONTEXT_EXPIRED: + begin + SessionClosed := true; + end; + SEC_E_INCOMPLETE_MESSAGE: break; + else CheckSEC_E_OK(res); + end; + InputCount := 0; + for i := 1 to 3 do + case buf[i].BufferType of + SECBUFFER_DATA: AppendData(buf[i]); + SECBUFFER_EXTRA: begin + Move(buf[i].pvBuffer^, pointer(Input)^, buf[i].cbBuffer); + InputCount := buf[i].cbBuffer; + end; + end; + if InputCount = 0 then + break; + res := DecryptInput; + until false; + if needsRenegotiate then + HandshakeLoop(aLine); + except + exit; // shutdown the connection on ESChannel fatal error + end; + result := DataCount; + if aLength < result then + result := aLength; + Move(PByteArray(Data)[DataPos], aBuffer^, result); + inc(DataPos, result); + dec(DataCount, result); +end; + +function TSChannelServer.Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res, sent, s, len, trailer, pending, templen: cardinal; + temp: array[0..TLSRECMAXSIZE] of byte; + Line: TncLine; + +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).SendBuffer(aBuffer^, aLength); + exit; + end; + + // Check if Sizes has been initialized + if Sizes.cbMaximumMessage = 0 then + begin + if QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes) <> SEC_E_OK then + begin + result := -1; + exit; + end; + end; + + result := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + pending := aLength; + while pending > 0 do begin + templen := pending; + if templen > Sizes.cbMaximumMessage then + templen := Sizes.cbMaximumMessage; + Move(aBuffer^, temp[Sizes.cbHeader], templen); + inc(PByte(aBuffer), templen); + dec(pending, templen); + trailer := Sizes.cbHeader + templen; + buf[0].cbBuffer := Sizes.cbHeader; + buf[0].BufferType := SECBUFFER_STREAM_HEADER; + buf[0].pvBuffer := @temp; + buf[1].cbBuffer := templen; + buf[1].BufferType := SECBUFFER_DATA; + buf[1].pvBuffer := @temp[Sizes.cbHeader]; + buf[2].cbBuffer := Sizes.cbTrailer; + buf[2].BufferType := SECBUFFER_STREAM_TRAILER; + buf[2].pvBuffer := @temp[trailer]; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + if EncryptMessage(@Ctxt, 0, @desc, 0) <> SEC_E_OK then + begin + exit; // shutdown the connection on SChannel error + end; + len := buf[0].cbBuffer + buf[1].cbBuffer + buf[2].cbBuffer; + sent := 0; + repeat + s := TncLineInternal(Line).SendBuffer(PByteArray(@temp)[sent], len); + if s = len then + break; // whole message sent + if s = 0 then + begin + exit; // report connection closed + end; + if integer(s) < 0 then begin + result := s; + exit; // report socket fatal error + end + else begin + dec(len, s); + inc(sent, s); + end; + Sleep(1); // try again + until false; + end; + result := aLength; +end; + + +end. diff --git a/Source/ncSockets.pas b/Source/ncSockets.pas index 8d832d8..370dc55 100644 --- a/Source/ncSockets.pas +++ b/Source/ncSockets.pas @@ -7,6 +7,20 @@ // This unit creates a TCP Server and TCP Client socket, along with their // threads dealing with reading from the socket // +// 13/07/2025 - by J.Pauwels +// - Added TLS implementation support through SChannel integration +// - Added TLS properties (UseTLS, TlsProvider, CertificateFile) to TncTCPBase +// - Integrated TLS handshake callbacks in OnBeforeConnected architecture +// - Added secure communication capabilities for both server and client +// - CRITICAL FIX: Implemented per-connection TLS context storage to support multiple concurrent TLS connections +// +// 14/01/2025 - by J.Pauwels +// - Defined DefReadBufferLen as a new property +// - Ajust TncCustomTCPServer.DataSocketDisconnected +// - Explicitly set this unit to use TCP +// - Update Client Send method so data cannot be send while socket is inactive +// - Added IPV6 support +// // 9/8/2020 // - Added a ShutDownLine in the TCPServer component so as to allow to // shutdown a line even when within a read operation @@ -39,17 +53,52 @@ interface uses -{$IFDEF MSWINDOWS} - Winapi.Windows, Winapi.Winsock2, -{$ELSE} - Posix.SysSocket, Posix.Unistd, -{$ENDIF} - System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, - ncLines, ncSocketList, ncThreads; + System.SysUtils, + System.Classes, + System.Diagnostics, + System.Math, + System.TimeSpan, + System.SyncObjs, + {$IFDEF MSWINDOWS} + Winapi.Windows, + Winapi.Winsock2, + ncSChannel, + {$ELSE} + Posix.SysSocket, + Posix.Unistd, + {$ENDIF} + ncSocketList, + ncLines, + ncThreads; + +type + // TLS Provider enumeration (declared early for use in constants) + TncTlsProvider = ( + tpSChannel, // Windows SChannel (Windows only, no external dependencies) + tpOpenSSL // OpenSSL (cross-platform, requires OpenSSL DLLs) + ); + + // Forward declarations for SChannel types + PSChannelClient = ^TSChannelClient; + PSChannelServer = ^TSChannelServer; + + // Per-connection TLS context storage + TncTlsConnectionContext = class + private + FIsServer: Boolean; + FClientContext: TSChannelClient; + FServerContext: TSChannelServer; + public + constructor Create(aIsServer: Boolean); + destructor Destroy; override; + function GetClientContext: PSChannelClient; + function GetServerContext: PSChannelServer; + property IsServer: Boolean read FIsServer; + end; const DefPort = 16233; - DefHost = 'LocalHost'; + DefHost = ''; DefReadBufferLen = 1024 * 1024; // 1 MB DefReaderThreadPriority = ntpNormal; DefCntReconnectInterval = 1000; @@ -57,18 +106,40 @@ interface DefUseReaderThread = True; DefNoDelay = False; DefKeepAlive = True; + DefFamily = afIPv4; + DefUseTLS = False; + DefTlsProvider = tpSChannel; + DefIgnoreCertificateErrors = False; resourcestring ECannotSetPortWhileConnectionIsActiveStr = 'Cannot set Port property whilst the connection is active'; ECannotSetHostWhileConnectionIsActiveStr = 'Cannot set Host property whilst the connection is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; ECannotSetUseReaderThreadWhileActiveStr = 'Cannot set UseReaderThread property whilst the connection is active'; ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnReadData event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; + ETlsProviderNotSupportedStr = 'TLS provider not supported on this platform'; + EOpenSSLNotAvailableStr = 'OpenSSL libraries not available'; type EPropertySetError = class(Exception); ENonActiveSocket = class(Exception); ECannotReceiveIfUseReaderThread = class(Exception); + ETlsProviderNotSupported = class(Exception); + EOpenSSLNotAvailable = class(Exception); + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + + // Forward declarations + TncCustomTCPServer = class; // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// // TThreadLineList @@ -102,15 +173,36 @@ TThreadLineList = class TncTCPBase = class(TComponent) private FInitActive: Boolean; + FFamily: TAddressType; FPort: Integer; FEventsUseMainThread: Boolean; FNoDelay: Boolean; FKeepAlive: Boolean; + FReadBufferLen: Integer; // Update FOnConnected: TncOnConnectDisconnect; FOnDisconnected: TncOnConnectDisconnect; FOnReadData: TncOnReadData; + FLine: TncLine; + + // TLS Properties + FUseTLS: Boolean; + FTlsProvider: TncTlsProvider; + FCertificateFile: string; + FPrivateKeyFile: string; + FPrivateKeyPassword: string; + FCACertificatesFile: string; + FIgnoreCertificateErrors: Boolean; + FTlsContext: TSChannelClient; + FTlsServerContext: TSChannelServer; + FIsServer: Boolean; // Flag to determine if this is a server or client + + function GetReadBufferLen: Integer; // Update + procedure SetReadBufferLen(const Value: Integer); // Update function GetActive: Boolean; virtual; abstract; procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetPort: Integer; procedure SetPort(const Value: Integer); function GetReaderThreadPriority: TncThreadPriority; @@ -121,6 +213,23 @@ TncTCPBase = class(TComponent) procedure SetNoDelay(const Value: Boolean); function GetKeepAlive: Boolean; procedure SetKeepAlive(const Value: Boolean); + + // TLS Property Methods + function GetUseTLS: Boolean; + procedure SetUseTLS(const Value: Boolean); + function GetTlsProvider: TncTlsProvider; + procedure SetTlsProvider(const Value: TncTlsProvider); + function GetCertificateFile: string; + procedure SetCertificateFile(const Value: string); + function GetPrivateKeyFile: string; + procedure SetPrivateKeyFile(const Value: string); + function GetPrivateKeyPassword: string; + procedure SetPrivateKeyPassword(const Value: string); + function GetCACertificatesFile: string; + procedure SetCACertificatesFile(const Value: string); + function GetIgnoreCertificateErrors: Boolean; + procedure SetIgnoreCertificateErrors(const Value: Boolean); + private FUseReaderThread: Boolean; procedure DoActivate(aActivate: Boolean); virtual; abstract; @@ -130,12 +239,23 @@ TncTCPBase = class(TComponent) ReadBuf: TBytes; procedure Loaded; override; function CreateLineObject: TncLine; virtual; + function GetHost: string; virtual; // Virtual method for TLS + procedure InitializeTLS(aLine: TncLine); virtual; + procedure FinalizeTLS(aLine: TncLine); virtual; + function SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; virtual; + function ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; virtual; + procedure HandleTLSHandshake(aLine: TncLine); virtual; + procedure HandleTLSHandshakeComplete(aLine: TncLine); virtual; + property Line: TncLine read FLine; public LineProcessor: TncReadyThread; constructor Create(AOwner: TComponent); override; destructor Destroy; override; + function Kind: TSocketType; virtual; + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; property Port: Integer read GetPort write SetPort default DefPort; property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefEventsUseMainThread; @@ -145,6 +265,16 @@ TncTCPBase = class(TComponent) property OnConnected: TncOnConnectDisconnect read FOnConnected write FOnConnected; property OnDisconnected: TncOnConnectDisconnect read FOnDisconnected write FOnDisconnected; property OnReadData: TncOnReadData read FOnReadData write FOnReadData; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; // Update + + // TLS Properties + property UseTLS: Boolean read GetUseTLS write SetUseTLS default DefUseTLS; + property TlsProvider: TncTlsProvider read GetTlsProvider write SetTlsProvider default DefTlsProvider; + property CertificateFile: string read GetCertificateFile write SetCertificateFile; + property PrivateKeyFile: string read GetPrivateKeyFile write SetPrivateKeyFile; + property PrivateKeyPassword: string read GetPrivateKeyPassword write SetPrivateKeyPassword; + property CACertificatesFile: string read GetCACertificatesFile write SetCACertificatesFile; + property IgnoreCertificateErrors: Boolean read GetIgnoreCertificateErrors write SetIgnoreCertificateErrors default DefIgnoreCertificateErrors; published end; @@ -190,6 +320,7 @@ TncCustomTCPClient = class(TncTCPBase) TncTCPClient = class(TncCustomTCPClient) published property Active; + property Family; property Port; property Host; property ReaderThreadPriority; @@ -197,12 +328,21 @@ TncTCPClient = class(TncCustomTCPClient) property UseReaderThread; property NoDelay; property KeepAlive; + property ReadBufferLen; property Reconnect; property ReconnectInterval; property OnConnected; property OnDisconnected; property OnReadData; property OnReconnected; + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; end; TncClientProcessor = class(TncReadyThread) @@ -246,15 +386,25 @@ TncTCPServer = class(TncCustomTCPServer) public published property Active; + property Family; property Port; property ReaderThreadPriority; property EventsUseMainThread; property UseReaderThread; property NoDelay; property KeepAlive; + property ReadBufferLen; // Update property OnConnected; property OnDisconnected; property OnReadData; + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; end; TncServerProcessor = class(TncReadyThread) @@ -269,15 +419,6 @@ TncServerProcessor = class(TncReadyThread) procedure ProcessEvent; override; end; - // We bring in TncLine so that a form that uses our components does - // not have to reference ncLines unit to get the type - TncLine = ncLines.TncLine; - - // We make a descendant of TncLine so that we can access the API functions. - // These API functions are not made puclic in TncLine so that the user cannot - // mangle up the line - TncLineInternal = class(TncLine); - implementation // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -380,6 +521,77 @@ procedure TThreadLineList.UnlockList; end; end; +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTlsConnectionContext } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTlsConnectionContext.Create(aIsServer: Boolean); +begin + inherited Create; + FIsServer := aIsServer; + + // Initialize TLS contexts using FillChar and then set public fields + FillChar(FClientContext, SizeOf(FClientContext), 0); + FClientContext.Initialized := False; + + FillChar(FServerContext, SizeOf(FServerContext), 0); + FServerContext.Initialized := False; + FServerContext.HandshakeCompleted := False; +end; + +{ +destructor TncTlsConnectionContext.Destroy; +begin + // Clean up TLS contexts + try + if FIsServer then + begin + if FServerContext.Initialized then + begin + // Context cleanup will be handled by BeforeDisconnection call + end; + end + else + begin + if FClientContext.Initialized then + begin + // Context cleanup will be handled by BeforeDisconnection call + end; + end; + except + // Ignore cleanup errors + end; + + inherited Destroy; +end;} + +destructor TncTlsConnectionContext.Destroy; +begin + // In a perfect world, FinalizeTLS was already called + // and all cleanup is done - destructor should be nearly empty + + {$IFDEF DEBUG} + // Debug check - verify cleanup already happened + if FIsServer then + Assert(not FServerContext.Initialized, 'Server TLS context not cleaned up!') + else + Assert(not FClientContext.Initialized, 'Client TLS context not cleaned up!'); + {$ENDIF} + + inherited Destroy; +end; + +function TncTlsConnectionContext.GetClientContext: PSChannelClient; +begin + Result := @FClientContext; +end; + +function TncTlsConnectionContext.GetServerContext: PSChannelServer; +begin + Result := @FServerContext; +end; + + // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { TncTCPBase } // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -392,22 +604,54 @@ constructor TncTCPBase.Create(AOwner: TComponent); ShutDownLock := TCriticalSection.Create; FInitActive := False; + FFamily := DefFamily; FPort := DefPort; FEventsUseMainThread := DefEventsUseMainThread; FUseReaderThread := DefUseReaderThread; FNoDelay := DefNoDelay; FKeepAlive := DefKeepAlive; + FReadBufferLen := DefReadBufferLen; // Update FOnConnected := nil; FOnDisconnected := nil; FOnReadData := nil; + // Initialize TLS properties + FUseTLS := DefUseTLS; + FTlsProvider := DefTlsProvider; + FCertificateFile := ''; + FPrivateKeyFile := ''; + FPrivateKeyPassword := ''; + FCACertificatesFile := ''; + FIgnoreCertificateErrors := DefIgnoreCertificateErrors; + + // Initialize TLS contexts using FillChar and then set public fields + FillChar(FTlsContext, SizeOf(FTlsContext), 0); + FTlsContext.Initialized := False; + + FillChar(FTlsServerContext, SizeOf(FTlsServerContext), 0); + FTlsServerContext.Initialized := False; + FTlsServerContext.HandshakeCompleted := False; + + FIsServer := False; + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncTCPBase.Kind: TSocketType; +begin + Result := stTCP; end; destructor TncTCPBase.Destroy; begin - ShutDownLock.Free; + Active := False; + + // TLS contexts are now managed per-connection and cleaned up in FinalizeTLS + // No global TLS context cleanup needed + PropertyLock.Free; + ShutDownLock.Free; inherited Destroy; end; @@ -422,6 +666,12 @@ procedure TncTCPBase.Loaded; function TncTCPBase.CreateLineObject: TncLine; begin Result := TncLineInternal.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); + + // Set up TLS callback if TLS is enabled + if FUseTLS then + TncLineInternal(Result).OnBeforeConnected := HandleTLSHandshake; end; procedure TncTCPBase.SetActive(const Value: Boolean); @@ -437,6 +687,39 @@ procedure TncTCPBase.SetActive(const Value: Boolean); end; end; +function TncTCPBase.GetFamily: TAddressType; +begin + PropertyLock.Acquire; + try + Result := FFamily; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetFamily(const Value: TAddressType); +begin + if not (csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create(ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + PropertyLock.Acquire; + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + PropertyLock.Release; + end; +end; + function TncTCPBase.GetPort: Integer; begin PropertyLock.Acquire; @@ -559,6 +842,454 @@ procedure TncTCPBase.SetKeepAlive(const Value: Boolean); end; end; +// Update +function TncTCPBase.GetReadBufferLen: Integer; +begin + PropertyLock.Acquire; + try + Result := FReadBufferLen; + finally + PropertyLock.Release; + end; +end; + +// Update +procedure TncTCPBase.SetReadBufferLen(const Value: Integer); +begin + PropertyLock.Acquire; + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + PropertyLock.Release; + end; +end; + +// TLS Property Methods +function TncTCPBase.GetUseTLS: Boolean; +begin + PropertyLock.Acquire; + try + Result := FUseTLS; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetUseTLS(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set UseTLS property whilst the connection is active'); + + PropertyLock.Acquire; + try + FUseTLS := Value; + + // Add TLS callback assignment when TLS is enabled + if Value then + begin + if FIsServer and (Self is TncCustomTCPServer) then + begin + // Server callback assignment + var Server := TncCustomTCPServer(Self); + if Server.Listener <> nil then + begin + TncLineInternal(Server.Listener).OnBeforeConnected := HandleTLSHandshake; + end; + end + else if not FIsServer and (Self is TncCustomTCPClient) then + begin + // Client callback assignment + var Client := TncCustomTCPClient(Self); + if Client.Line <> nil then + begin + TncLineInternal(Client.Line).OnBeforeConnected := HandleTLSHandshake; + end; + end; + end; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBase.GetTlsProvider: TncTlsProvider; +begin + PropertyLock.Acquire; + try + Result := FTlsProvider; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetTlsProvider(const Value: TncTlsProvider); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set TlsProvider property whilst the connection is active'); + + PropertyLock.Acquire; + try + // Validate provider availability + case Value of + tpSChannel: + begin + {$IFNDEF MSWINDOWS} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL validation - for now, not supported + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + + FTlsProvider := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBase.GetCertificateFile: string; +begin + PropertyLock.Acquire; + try + Result := FCertificateFile; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetCertificateFile(const Value: string); +begin + PropertyLock.Acquire; + try + FCertificateFile := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBase.GetPrivateKeyFile: string; +begin + PropertyLock.Acquire; + try + Result := FPrivateKeyFile; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetPrivateKeyFile(const Value: string); +begin + PropertyLock.Acquire; + try + FPrivateKeyFile := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBase.GetPrivateKeyPassword: string; +begin + PropertyLock.Acquire; + try + Result := FPrivateKeyPassword; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetPrivateKeyPassword(const Value: string); +begin + PropertyLock.Acquire; + try + FPrivateKeyPassword := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBase.GetCACertificatesFile: string; +begin + PropertyLock.Acquire; + try + Result := FCACertificatesFile; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetCACertificatesFile(const Value: string); +begin + PropertyLock.Acquire; + try + FCACertificatesFile := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBase.GetIgnoreCertificateErrors: Boolean; +begin + PropertyLock.Acquire; + try + Result := FIgnoreCertificateErrors; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBase.SetIgnoreCertificateErrors(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FIgnoreCertificateErrors := Value; + finally + PropertyLock.Release; + end; +end; + +// TLS base implementation +function TncTCPBase.GetHost: string; +begin + Result := ''; // Default implementation, override in client +end; + +// TLS Functionality Methods +procedure TncTCPBase.InitializeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if not FUseTLS then + Exit; + + if aLine = nil then + Exit; + + // Get or create per-connection TLS context + if TncLineInternal(aLine).DataObject = nil then + begin + TlsContext := TncTlsConnectionContext.Create(FIsServer); + TncLineInternal(aLine).DataObject := TlsContext; + end + else + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + end; + + // Check if TLS is already initialized for this specific connection + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Exit; + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Exit; + end; + + // Initialize TLS for this specific connection + if FIsServer then + begin + TlsContext.GetServerContext^.AfterConnection(aLine, AnsiString(FCertificateFile), AnsiString(FPrivateKeyPassword)); + end + else + begin + TlsContext.GetClientContext^.AfterConnection(aLine, AnsiString(GetHost), FIgnoreCertificateErrors); + end; +end; + +procedure TncTCPBase.HandleTLSHandshake(aLine: TncLine); +begin + // This method is called automatically before OnConnected fires + // It performs the TLS handshake synchronously + if FUseTLS and (aLine <> nil) then + begin + InitializeTLS(aLine); // Perform the complete TLS handshake + end; +end; + +procedure TncTCPBase.HandleTLSHandshakeComplete(aLine: TncLine); +begin + // Call OnConnected for TLS connections after handshake completes + if FUseTLS and Assigned(OnConnected) then + begin + try + OnConnected(Self, aLine); + except + on E: Exception do + // OnConnected failed - could log this if needed + end; + end; +end; + +procedure TncTCPBase.FinalizeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (aLine <> nil) and (TncLineInternal(aLine).DataObject <> nil) then + begin + try + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + TlsContext.GetServerContext^.BeforeDisconnection(aLine); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + TlsContext.GetClientContext^.BeforeDisconnection(aLine); + end; + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL cleanup + end; + end; + + // Clean up the TLS context object + TncLineInternal(aLine).DataObject := nil; + TlsContext.Free; + except + on E: Exception do + // Log error but don't raise exception during cleanup + end; + end; +end; + +function TncTCPBase.SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Result := TlsContext.GetServerContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Result := TlsContext.GetClientContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL send implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); +end; + +function TncTCPBase.ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; + WasHandshakeCompleted: Boolean; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + begin + WasHandshakeCompleted := TlsContext.GetServerContext^.HandshakeCompleted; + + Result := TlsContext.GetServerContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and WasHandshakeCompleted then + begin + raise Exception.Create('TLS client disconnected'); + end; + + // Check if handshake just completed + if not WasHandshakeCompleted and TlsContext.GetServerContext^.HandshakeCompleted then + begin + // Handshake just completed, call OnConnected + HandleTLSHandshakeComplete(aLine); + + // CRITICAL FIX: Return -1 to prevent OnReadData from being triggered with empty data + // The handshake completion callback has already been called above + Result := -1; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + begin + // For client, handshake is complete when Initialized becomes true + // But we need to track when it JUST became initialized (not if it was already initialized) + // Since the client calls AfterConnection during OnBeforeConnected, we know that + // the first call to Receive after OnBeforeConnected is when handshake is complete + + Result := TlsContext.GetClientContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and TlsContext.GetClientContext^.Initialized then + begin + raise Exception.Create('TLS server disconnected'); + end; + + // Client-side handshake completion detection: + // The client TLS handshake is handled in OnBeforeConnected event + // So by the time we get here, handshake is already complete + // We don't need to do anything special for client handshake completion + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL receive implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); +end; + // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { TncCustomTCPClient } // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -567,6 +1298,7 @@ constructor TncCustomTCPClient.Create(AOwner: TComponent); begin inherited Create(AOwner); + FIsServer := False; // Set client flag for TLS context selection FHost := DefHost; FReconnect := True; FReconnectInterval := DefCntReconnectInterval; @@ -575,10 +1307,20 @@ constructor TncCustomTCPClient.Create(AOwner: TComponent); LastConnectAttempt := TStopWatch.GetTimeStamp; WasConnected := False; + // Create Line with correct family Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + TncLineInternal(Line).OnConnected := DataSocketConnected; TncLineInternal(Line).OnDisconnected := DataSocketDisconnected; + // Set up TLS handshake callback if TLS is enabled + if FUseTLS then + TncLineInternal(Line).OnBeforeConnected := HandleTLSHandshake; + LineProcessor := TncClientProcessor.Create(Self); try if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then @@ -589,6 +1331,7 @@ constructor TncCustomTCPClient.Create(AOwner: TComponent); LineProcessor.WaitForReady; end; + destructor TncCustomTCPClient.Destroy; begin Active := False; @@ -605,12 +1348,20 @@ destructor TncCustomTCPClient.Destroy; procedure TncCustomTCPClient.DoActivate(aActivate: Boolean); begin + if aActivate = GetActive then Exit; if aActivate then begin + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + TncLineInternal(Line).CreateClientHandle(FHost, FPort); + // if there were no exceptions, and line is still not active, // that means the user has deactivated it in the OnConnect handler if not Line.Active then @@ -641,12 +1392,15 @@ procedure TncCustomTCPClient.DataSocketConnected(aLine: TncLine); end; try - TncLineInternal(Line).SetReceiveSize(1048576); - TncLineInternal(Line).SetWriteSize(1048576); - TncLineInternal(Line).SetReceiveSize(20 * 1048576); + TncLineInternal(Line).SetReceiveSize(1048576); // 1MB + TncLineInternal(Line).SetWriteSize(1048576); // 1MB + //TncLineInternal(Line).SetReceiveSize(20 * 1048576); + except end; + // TLS initialization is now handled by OnBeforeConnected event + if Assigned(OnConnected) then try OnConnected(Self, aLine); @@ -662,6 +1416,10 @@ procedure TncCustomTCPClient.DataSocketConnected(aLine: TncLine); procedure TncCustomTCPClient.DataSocketDisconnected(aLine: TncLine); begin + // Finalize TLS if enabled + if UseTLS then + FinalizeTLS(aLine); + if Assigned(OnDisconnected) then try OnDisconnected(Self, aLine); @@ -669,10 +1427,13 @@ procedure TncCustomTCPClient.DataSocketDisconnected(aLine: TncLine); end; end; + procedure TncCustomTCPClient.Send(const aBuf; aBufSize: Integer); begin - Active := True; - TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + SendTLS(Line, aBuf, aBufSize); end; procedure TncCustomTCPClient.Send(const aBytes: TBytes); @@ -701,13 +1462,13 @@ function TncCustomTCPClient.Receive(aTimeout: Cardinal): TBytes; Exit; end; - BufRead := TncLineInternal(Line).RecvBuffer(ReadBuf[0], Length(ReadBuf)); + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); Result := Copy(ReadBuf, 0, BufRead) end; function TncCustomTCPClient.ReceiveRaw(var aBytes: TBytes): Integer; begin - Result := TncLineInternal(Line).RecvBuffer(aBytes[0], Length(aBytes)); + Result := ReceiveTLS(Line, aBytes[0], Length(aBytes)); end; function TncCustomTCPClient.GetActive: Boolean; @@ -794,8 +1555,8 @@ procedure TncClientProcessor.SocketProcess; var BufRead: Integer; begin - BufRead := TncLineInternal(FClientSocket.Line).RecvBuffer(FClientSocket.ReadBuf[0], Length(FClientSocket.ReadBuf)); - if Assigned(FClientSocket.OnReadData) then + BufRead := FClientSocket.ReceiveTLS(FClientSocket.Line, FClientSocket.ReadBuf[0], Length(FClientSocket.ReadBuf)); + if Assigned(FClientSocket.OnReadData) and (BufRead > 0) then try FClientSocket.OnReadData(FClientSocket, FClientSocket.Line, FClientSocket.ReadBuf, BufRead); except @@ -889,17 +1650,32 @@ constructor TncCustomTCPServer.Create(AOwner: TComponent); begin inherited Create(AOwner); + FIsServer := True; // Set server flag for TLS context selection + Listener := CreateLineObject; + if Listener.Family <> FFamily then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; + TncLineInternal(Listener).OnConnected := DataSocketConnected; TncLineInternal(Listener).OnDisconnected := DataSocketDisconnected; - Lines := TThreadLineList.Create; + // Set up TLS handshake callback if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Listener).OnBeforeConnected := HandleTLSHandshake; + end; + Lines := TThreadLineList.Create(); + LineProcessor := TncServerProcessor.Create(Self); try - LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); except // Some Android devices do not like this end; + LineProcessor.WaitForReady; end; destructor TncCustomTCPServer.Destroy; @@ -933,23 +1709,31 @@ procedure TncCustomTCPServer.DoActivate(aActivate: Boolean); if aActivate then begin + // Verify family setting before creating handle + if Assigned(Listener) and (Listener.Family <> FFamily) then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; TncLineInternal(Listener).CreateServerHandle(FPort); end else begin - TncLineInternal(Listener).DestroyHandle; + if Assigned(Listener) then + TncLineInternal(Listener).DestroyHandle; - // Delphi complains about the free that it does nothing except nil the variable - // That is under the mostly forgettable and thankgoodness "gotten rid off" - // ARC compilers... + // Cleanup connected sockets {$HINTS OFF} DataSockets := Lines.LockListNoCopy; try for i := 0 to DataSockets.Count - 1 do try - TncLineInternal(DataSockets.Lines[i]).DestroyHandle; - TncLineInternal(DataSockets.Lines[i]).Free; + if Assigned(DataSockets.Lines[i]) then + begin + TncLineInternal(DataSockets.Lines[i]).DestroyHandle; + DataSockets.Lines[i].Free; + end; except + // end; DataSockets.Clear; finally @@ -1018,14 +1802,27 @@ procedure TncCustomTCPServer.DataSocketConnected(aLine: TncLine); except end; - if Assigned(OnConnected) then - try - OnConnected(Self, aLine); - except - end; + // TLS initialization is now handled by OnBeforeConnected event + + // For TLS connections, delay OnConnected until after handshake completes + if not UseTLS then + begin + if Assigned(OnConnected) then + try + OnConnected(Self, aLine); + except + end; + end + else + begin + // For TLS connections, OnConnected will be called after handshake completes + // This is handled in the first successful TLS receive operation + end; end; end; +// Update : Moves the handle removal before the disconnect event handling +// This prevents other threads from trying to use the handle while the disconnect event is processing. procedure TncCustomTCPServer.DataSocketDisconnected(aLine: TncLine); var i: Integer; @@ -1034,25 +1831,36 @@ procedure TncCustomTCPServer.DataSocketDisconnected(aLine: TncLine); SetLength(ReadSocketHandles, 0) else begin + // Finalize TLS if enabled + if UseTLS then + FinalizeTLS(aLine); + + // First remove the handle to prevent further processing + PropertyLock.Acquire; + try + for i := 0 to High(ReadSocketHandles) do + if ReadSocketHandles[i] = aLine.Handle then + begin + ReadSocketHandles[i] := ReadSocketHandles[High(ReadSocketHandles)]; + SetLength(ReadSocketHandles, Length(ReadSocketHandles) - 1); + Break; + end; + finally + PropertyLock.Release; + end; + + // Then handle disconnect event if Assigned(OnDisconnected) then try OnDisconnected(Self, aLine); except end; - - for i := 0 to High(ReadSocketHandles) do - if ReadSocketHandles[i] = aLine.Handle then - begin - ReadSocketHandles[i] := ReadSocketHandles[High(ReadSocketHandles)]; - SetLength(ReadSocketHandles, Length(ReadSocketHandles) - 1); - Break; - end; end; end; procedure TncCustomTCPServer.Send(aLine: TncLine; const aBuf; aBufSize: Integer); begin - TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + SendTLS(aLine, aBuf, aBufSize); end; procedure TncCustomTCPServer.Send(aLine: TncLine; const aBytes: TBytes); @@ -1100,7 +1908,7 @@ function TncCustomTCPServer.Receive(aLine: TncLine; aTimeout: Cardinal): TBytes; try if not Line.Active then Abort; - BufRead := TncLineInternal(Line).RecvBuffer(ReadBuf[0], Length(ReadBuf)); + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); Result := Copy(ReadBuf, 0, BufRead); except // Line has disconnected, destroy the line @@ -1117,7 +1925,7 @@ function TncCustomTCPServer.Receive(aLine: TncLine; aTimeout: Cardinal): TBytes; function TncCustomTCPServer.ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; begin - Result := TncLineInternal(aLine).RecvBuffer(aBytes[0], Length(aBytes)); + Result := ReceiveTLS(aLine, aBytes[0], Length(aBytes)); end; // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -1221,8 +2029,8 @@ procedure TncServerProcessor.SocketProcess; ReadySocketsChanged := False; Exit; end; - BufRead := TncLineInternal(Line).RecvBuffer(FServerSocket.ReadBuf[0], Length(FServerSocket.ReadBuf)); - if Assigned(FServerSocket.OnReadData) then + BufRead := FServerSocket.ReceiveTLS(Line, FServerSocket.ReadBuf[0], Length(FServerSocket.ReadBuf)); + if Assigned(FServerSocket.OnReadData) and (BufRead > 0) then FServerSocket.OnReadData(FServerSocket, Line, FServerSocket.ReadBuf, BufRead); except // Line has disconnected, destroy the line @@ -1260,3 +2068,6 @@ procedure TncServerProcessor.ProcessEvent; end; end. + + + diff --git a/Source/ncSocketsDual.pas b/Source/ncSocketsDual.pas new file mode 100644 index 0000000..b6d61b2 --- /dev/null +++ b/Source/ncSocketsDual.pas @@ -0,0 +1,2721 @@ +unit ncSocketsDual; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 ncSocketsDual - Enhanced TCP Components with Dual Protocol Support +// +// This unit extends ncSockets with dual protocol capabilities, allowing both +// raw data (text/binary) and structured command protocols to coexist on the +// same connection. +// +// Key Features: +// - Automatic protocol detection via magic header ($ACF0FF00) +// - OnReadData: Handles raw data and custom protocols (like ncSockets) +// - OnCommand: Handles structured binary commands with guaranteed delivery +// - Full backward compatibility with ncSockets +// - Advanced TCP fragmentation handling with state machine +// - TLS support, IPv6, and all ncSockets features preserved +// - CRITICAL FIX: Per-connection TLS context storage for multiple concurrent TLS connections +// +// Usage: +// - Drop-in replacement for ncSockets (TncTCPClient -> TncTCPClientDual) +// - Custom protocols work exactly like ncSockets via OnReadData +// - Enhanced features available via SendCommand/OnCommand for guaranteed delivery +// +// 11/08/2025 - by J.Pauwels +// - Added original compression and encryption from ncSources +// +// 29/07/2025 - by J.Pauwels +// - CRITICAL FIX: Fixed TLS disconnection crash by changing from event-driven to direct TLS cleanup +// - Removed OnBeforeDisconnected := FinalizeTLS assignments from constructors and SetUseTLS +// - Added direct FinalizeTLS(aLine) calls in DataSocketDisconnected methods for better timing +// - This aligns ncSocketsDual TLS cleanup pattern with the proven ncSockets approach +// +// 15/07/2025 - by J.Pauwels +// - CRITICAL FIX: Implemented per-connection TLS context storage to support multiple concurrent TLS connections +// - Fixed TLS multiple client connection issue using TncTlsConnectionContext class +// +// 15/07/2025 - by J.Pauwels +// - Added OnCommand event for guaranteed delivery of commands +// - Added SendCommand method for sending commands +// - Added TncCommand type for command handling +// - Added TncCommandPacking unit for command packing/unpacking +// +// 15/07/2025 - by J.Pauwels +// - Initial creation +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON } +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.SysUtils, + System.Classes, + System.Diagnostics, + System.Math, + System.TimeSpan, + System.SyncObjs, + Generics.Collections, + {$IFDEF MSWINDOWS} + Winapi.Windows, + Winapi.Winsock2, + ncSChannel, + {$ELSE} + Posix.SysSocket, + Posix.Unistd, + {$ENDIF} + ncSocketList, + ncLines, + ncThreads, + ncCommandPacking; // For TncCommand type + +type + // TLS Provider enumeration (declared early for use in constants) + TncTlsProvider = ( + tpSChannel, // Windows SChannel (Windows only, no external dependencies) + tpOpenSSL // OpenSSL (cross-platform, requires OpenSSL DLLs) + ); + + // Forward declarations for SChannel types + PSChannelClient = ^TSChannelClient; + PSChannelServer = ^TSChannelServer; + + // Per-connection TLS context storage + TncTlsConnectionContext = class + private + FIsServer: Boolean; + FClientContext: TSChannelClient; + FServerContext: TSChannelServer; + public + constructor Create(aIsServer: Boolean); + destructor Destroy; override; + function GetClientContext: PSChannelClient; + function GetServerContext: PSChannelServer; + property IsServer: Boolean read FIsServer; + end; + + // Protocol magic header type (same as ncSources) + TMagicHeaderType = UInt32; + PMagicHeaderType = ^TMagicHeaderType; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 1024 * 1024; // 1 MB + DefReaderThreadPriority = ntpNormal; + DefCntReconnectInterval = 1000; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefNoDelay = False; + DefKeepAlive = True; + DefFamily = afIPv4; + DefUseTLS = False; + DefTlsProvider = tpSChannel; + DefIgnoreCertificateErrors = False; + + // Thread Pool Constants (from ncSources) + DefCommandProcessorThreadPriority = ntpNormal; + DefCommandProcessorThreads = 0; + DefCommandProcessorThreadsPerCPU = 4; + DefCommandProcessorThreadsGrowUpto = 32; + + // Protocol magic header (same as ncSources) + MagicHeader: TMagicHeaderType = $ACF0FF00; + +resourcestring + ECannotSetPortWhileConnectionIsActiveStr = 'Cannot set Port property whilst the connection is active'; + ECannotSetHostWhileConnectionIsActiveStr = 'Cannot set Host property whilst the connection is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileActiveStr = 'Cannot set UseReaderThread property whilst the connection is active'; + ECannotReceiveIfUseReaderThreadStr = + 'Cannot receive data if UseReaderThread is set. Use OnReadData event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; + ETlsProviderNotSupportedStr = 'TLS provider not supported on this platform'; + EOpenSSLNotAvailableStr = 'OpenSSL libraries not available'; + +type + EPropertySetError = class(Exception); + ENonActiveSocket = class(Exception); + ECannotReceiveIfUseReaderThread = class(Exception); + ETlsProviderNotSupported = class(Exception); + EOpenSSLNotAvailable = class(Exception); + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + + // Forward declarations + TncCustomTCPServerDual = class; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TThreadLineList + // Thread safe object, used by the main components + + TThreadLineList = class + private + FList: TSocketList; + FListCopy: TSocketList; + FLock: TCriticalSection; + FLockCount: Integer; + protected + procedure Add(const Item: TncLine); inline; + procedure Clear; inline; + procedure Remove(Item: TncLine); inline; + function LockListNoCopy: TSocketList; + procedure UnlockListNoCopy; + public + constructor Create; + destructor Destroy; override; + function LockList: TSocketList; + procedure UnlockList; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Base object for all TCP Sockets + TncOnConnectDisconnect = procedure(Sender: TObject; aLine: TncLine) of object; + TncOnReadData = procedure(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer) of object; + TncOnReconnected = procedure(Sender: TObject; aLine: TncLine) of object; + TncOnCommandReceived = procedure(Sender: TObject; aLine: TncLine; + aCmd: Integer; const aData: TBytes) of object; // Binary protocol event + + // Command Processing Thread for Thread Pool (from ncSources) + THandleCommandWorkType = (htwtOnCommand); + + THandleCommandThread = class(TncReadyThread) + private + FWorkType: THandleCommandWorkType; + FSource: TComponent; + FLine: TncLine; + FCmd: Integer; + FData: TBytes; + FOnCommand: TncOnCommandReceived; + FEventsUseMainThread: Boolean; + + procedure CallOnCommandEvent; + protected + procedure ProcessEvent; override; + public + property WorkType: THandleCommandWorkType read FWorkType write FWorkType; + property Source: TComponent read FSource write FSource; + property Line: TncLine read FLine write FLine; + property Cmd: Integer read FCmd write FCmd; + property Data: TBytes read FData write FData; + property OnCommand: TncOnCommandReceived read FOnCommand write FOnCommand; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread; + end; + + TncTCPBaseDual = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FNoDelay: Boolean; + FKeepAlive: Boolean; + FReadBufferLen: Integer; + FOnConnected: TncOnConnectDisconnect; + FOnDisconnected: TncOnConnectDisconnect; + FOnReadData: TncOnReadData; + FLine: TncLine; + + // Thread Pool Properties (from ncSources) + FCommandProcessorThreadPriority: TncThreadPriority; + FCommandProcessorThreads: Integer; + FCommandProcessorThreadsPerCPU: Integer; + FCommandProcessorThreadsGrowUpto: Integer; + + // TLS Properties + FUseTLS: Boolean; + FTlsProvider: TncTlsProvider; + FCertificateFile: string; + FPrivateKeyFile: string; + FPrivateKeyPassword: string; + FCACertificatesFile: string; + FIgnoreCertificateErrors: Boolean; + FIsServer: Boolean; + + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetEventsUseMainThread: Boolean; + procedure SetEventsUseMainThread(const Value: Boolean); + function GetNoDelay: Boolean; + procedure SetNoDelay(const Value: Boolean); + function GetKeepAlive: Boolean; + procedure SetKeepAlive(const Value: Boolean); + + // TLS Property Methods + function GetUseTLS: Boolean; + procedure SetUseTLS(const Value: Boolean); + function GetTlsProvider: TncTlsProvider; + procedure SetTlsProvider(const Value: TncTlsProvider); + function GetCertificateFile: string; + procedure SetCertificateFile(const Value: string); + function GetPrivateKeyFile: string; + procedure SetPrivateKeyFile(const Value: string); + function GetPrivateKeyPassword: string; + procedure SetPrivateKeyPassword(const Value: string); + function GetCACertificatesFile: string; + procedure SetCACertificatesFile(const Value: string); + function GetIgnoreCertificateErrors: Boolean; + procedure SetIgnoreCertificateErrors(const Value: Boolean); + + // Thread Pool Property Methods (from ncSources) + function GetCommandProcessorThreadPriority: TncThreadPriority; + procedure SetCommandProcessorThreadPriority(const Value: TncThreadPriority); + function GetCommandProcessorThreads: Integer; + procedure SetCommandProcessorThreads(const Value: Integer); + function GetCommandProcessorThreadsPerCPU: Integer; + procedure SetCommandProcessorThreadsPerCPU(const Value: Integer); + function GetCommandProcessorThreadsGrowUpto: Integer; + procedure SetCommandProcessorThreadsGrowUpto(const Value: Integer); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock, ShutDownLock: TCriticalSection; + ReadBuf: TBytes; + + // Thread Pool Infrastructure (from ncSources) + HandleCommandThreadPool: TncThreadPool; + + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetHost: string; virtual; // Virtual method for TLS + procedure InitializeTLS(aLine: TncLine); virtual; + procedure FinalizeTLS(aLine: TncLine); virtual; + function SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; virtual; + function ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; virtual; + procedure HandleTLSHandshake(aLine: TncLine); virtual; + procedure HandleTLSHandshakeComplete(aLine: TncLine); virtual; + property Line: TncLine read FLine; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default DefNoDelay; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default DefKeepAlive; + property OnConnected: TncOnConnectDisconnect read FOnConnected write FOnConnected; + property OnDisconnected: TncOnConnectDisconnect read FOnDisconnected write FOnDisconnected; + property OnReadData: TncOnReadData read FOnReadData write FOnReadData; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + + // Thread Pool Properties (from ncSources) + property CommandProcessorThreadPriority: TncThreadPriority read GetCommandProcessorThreadPriority write SetCommandProcessorThreadPriority default DefCommandProcessorThreadPriority; + property CommandProcessorThreads: Integer read GetCommandProcessorThreads write SetCommandProcessorThreads default DefCommandProcessorThreads; + property CommandProcessorThreadsPerCPU: Integer read GetCommandProcessorThreadsPerCPU write SetCommandProcessorThreadsPerCPU default DefCommandProcessorThreadsPerCPU; + property CommandProcessorThreadsGrowUpto: Integer read GetCommandProcessorThreadsGrowUpto write SetCommandProcessorThreadsGrowUpto default DefCommandProcessorThreadsGrowUpto; + + // TLS Properties + property UseTLS: Boolean read GetUseTLS write SetUseTLS default DefUseTLS; + property TlsProvider: TncTlsProvider read GetTlsProvider write SetTlsProvider default DefTlsProvider; + property CertificateFile: string read GetCertificateFile write SetCertificateFile; + property PrivateKeyFile: string read GetPrivateKeyFile write SetPrivateKeyFile; + property PrivateKeyPassword: string read GetPrivateKeyPassword write SetPrivateKeyPassword; + property CACertificatesFile: string read GetCACertificatesFile write SetCACertificatesFile; + property IgnoreCertificateErrors: Boolean read GetIgnoreCertificateErrors write SetIgnoreCertificateErrors default DefIgnoreCertificateErrors; + published + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Client Socket + TncClientProcessor = class; + + // Connection state for efficient message handling (ncSources-style) + TConnectionState = record + MessageBuffer: TBytes; // Accumulated message data + BytesToEndOfMessage: UInt64; // How many bytes still needed + MessageType: (mtUnknown, mtBinary, mtText); // Protocol type + ExpectedMessageLength: UInt64; // Total expected message length + HeaderComplete: Boolean; // Have we read the complete header? + procedure Reset; + end; + + TncCustomTCPClientDual = class(TncTCPBaseDual) + private + FHost: string; + FReconnect: Boolean; + FReconnectInterval: Cardinal; + FOnReconnected: TncOnReconnected; + FOnCommand: TncOnCommandReceived; // Binary protocol event + OriginalOnReadData: TncOnReadData; // Store original handler for protocol detection + FConnectionState: TConnectionState; // State-based message handling + function GetActive: Boolean; override; + // Override OnReadData property to preserve protocol detection + procedure SetOnReadData(const Value: TncOnReadData); + procedure SetHost(const Value: string); + function GetHost: string; + function GetReconnect: Boolean; + procedure SetReconnect(const Value: Boolean); + function GetReconnectInterval: Cardinal; + procedure SetReconnectInterval(const Value: Cardinal); + protected + WasConnected: Boolean; + LastConnectAttempt: Int64; + procedure DoActivate(aActivate: Boolean); override; + procedure DataSocketConnected(aLine: TncLine); + procedure DataSocketDisconnected(aLine: TncLine); + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Send(const aBuf; aBufSize: Integer); overload; inline; + procedure Send(const aBytes: TBytes); overload; inline; + procedure Send(const aStr: string); overload; inline; + procedure SendCommand(aCmd: Integer; const aData: TBytes = nil); // Binary protocol method + function Receive(aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(var aBytes: TBytes): Integer; inline; + procedure InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); // Protocol detection handler + property Host: string read GetHost write SetHost; + property Reconnect: Boolean read GetReconnect write SetReconnect default True; + property ReconnectInterval: Cardinal read GetReconnectInterval write SetReconnectInterval default DefCntReconnectInterval; + property OnReconnected: TncOnReconnected read FOnReconnected write FOnReconnected; + property OnCommand: TncOnCommandReceived read FOnCommand write FOnCommand; + // Override OnReadData to preserve protocol detection + property OnReadData: TncOnReadData read FOnReadData write SetOnReadData; + end; + + TncTCPClientDual = class(TncCustomTCPClientDual) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property NoDelay; + property KeepAlive; + property ReadBufferLen; + property Reconnect; + property ReconnectInterval; + property OnConnected; + property OnDisconnected; + property OnReadData; + property OnReconnected; + property OnCommand; + + // Thread Pool Properties (from ncSources) + property CommandProcessorThreadPriority; + property CommandProcessorThreads; + property CommandProcessorThreadsPerCPU; + property CommandProcessorThreadsGrowUpto; + + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; + end; + + TncClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomTCPClientDual; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomTCPClientDual); + procedure SocketWasReconnected; + procedure SocketProcess; inline; + procedure ProcessEvent; override; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Server Socket + TncServerProcessor = class; + + TncCustomTCPServerDual = class(TncTCPBaseDual) + private + FOnCommand: TncOnCommandReceived; // Binary protocol event + OriginalOnReadData: TncOnReadData; // Store original handler for protocol detection + FConnectionStates: TDictionary; // Per-connection state tracking + function GetActive: Boolean; override; + // Override OnReadData property to preserve protocol detection + procedure SetOnReadData(const Value: TncOnReadData); + protected + Listener: TncLine; + LinesToShutDown: array of TncLine; + procedure DataSocketConnected(aLine: TncLine); + procedure DataSocketDisconnected(aLine: TncLine); + procedure DoActivate(aActivate: Boolean); override; + public + ReadSocketHandles: TSocketHandleArray; + Lines: TThreadLineList; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure ShutDownLine(aLine: TncLine); + procedure Send(aLine: TncLine; const aBuf; aBufSize: Integer); overload; inline; + procedure Send(aLine: TncLine; const aBytes: TBytes); overload; inline; + procedure Send(aLine: TncLine; const aStr: string); overload; inline; + function Receive(aLine: TncLine; aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; inline; + procedure SendCommand(aLine: TncLine; aCmd: Integer; const aData: TBytes = nil); // Binary protocol method + procedure InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); // Protocol detection handler + property OnCommand: TncOnCommandReceived read FOnCommand write FOnCommand; + // Override OnReadData to preserve protocol detection + property OnReadData: TncOnReadData read FOnReadData write SetOnReadData; + end; + + TncTCPServerDual = class(TncCustomTCPServerDual) + public + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property NoDelay; + property KeepAlive; + property ReadBufferLen; + property OnConnected; + property OnDisconnected; + property OnReadData; + property OnCommand; + + // Thread Pool Properties (from ncSources) + property CommandProcessorThreadPriority; + property CommandProcessorThreads; + property CommandProcessorThreadsPerCPU; + property CommandProcessorThreadsGrowUpto; + + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; + end; + + TncServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomTCPServerDual; + procedure CheckLinesToShutDown; + public + ReadySockets: TSocketHandleArray; + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomTCPServerDual); + procedure SocketProcess; inline; + procedure ProcessEvent; override; + end; + +implementation + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TConnectionState } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +procedure TConnectionState.Reset; +begin + SetLength(MessageBuffer, 0); + BytesToEndOfMessage := 0; + MessageType := mtUnknown; + ExpectedMessageLength := 0; + HeaderComplete := False; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TThreadLineList } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TThreadLineList.Create; +begin + inherited Create; + FLock := TCriticalSection.Create; + FList := TSocketList.Create; + FLockCount := 0; +end; + +destructor TThreadLineList.Destroy; +begin + LockListNoCopy; + try + FList.Free; + inherited Destroy; + finally + UnlockListNoCopy; + FLock.Free; + end; +end; + +procedure TThreadLineList.Add(const Item: TncLine); +begin + LockListNoCopy; + try + // FList has Duplicates to dupError, so we know if this is already in the + // list it will not be accepted + FList.Add(Item.Handle, Item); + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Clear; +begin + LockListNoCopy; + try + FList.Clear; + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Remove(Item: TncLine); +begin + LockListNoCopy; + try + FList.Delete(FList.IndexOf(Item.Handle)); + finally + UnlockListNoCopy; + end; +end; + +function TThreadLineList.LockListNoCopy: TSocketList; +begin + FLock.Acquire; + Result := FList; +end; + +procedure TThreadLineList.UnlockListNoCopy; +begin + FLock.Release; +end; + +function TThreadLineList.LockList: TSocketList; +begin + FLock.Acquire; + try + if FLockCount = 0 then + begin + FListCopy := TSocketList.Create; + FListCopy.Assign(FList); + end; + Result := FListCopy; + + FLockCount := FLockCount + 1; + finally + FLock.Release; + end; +end; + +procedure TThreadLineList.UnlockList; +begin + FLock.Acquire; + try + if FLockCount = 0 then + raise Exception.Create('Cannot unlock a non-locked list'); + + FLockCount := FLockCount - 1; + + if FLockCount = 0 then + FListCopy.Free; + finally + FLock.Release; + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTlsConnectionContext } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTlsConnectionContext.Create(aIsServer: Boolean); +begin + inherited Create; + FIsServer := aIsServer; + + // Initialize TLS contexts using FillChar and then set public fields + FillChar(FClientContext, SizeOf(FClientContext), 0); + FClientContext.Initialized := False; + + FillChar(FServerContext, SizeOf(FServerContext), 0); + FServerContext.Initialized := False; + FServerContext.HandshakeCompleted := False; +end; + +destructor TncTlsConnectionContext.Destroy; +begin + // In a perfect world, FinalizeTLS was already called + // and all cleanup is done - destructor should be nearly empty + + {$IFDEF DEBUG} + // Debug check - verify cleanup already happened + if FIsServer then + Assert(not FServerContext.Initialized, 'Server TLS context not cleaned up!') + else + Assert(not FClientContext.Initialized, 'Client TLS context not cleaned up!'); + {$ENDIF} + + inherited Destroy; +end; + +function TncTlsConnectionContext.GetClientContext: PSChannelClient; +begin + Result := @FClientContext; +end; + +function TncTlsConnectionContext.GetServerContext: PSChannelServer; +begin + Result := @FServerContext; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTCPBaseDual } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTCPBaseDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TCriticalSection.Create; + ShutDownLock := TCriticalSection.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FNoDelay := DefNoDelay; + FKeepAlive := DefKeepAlive; + FReadBufferLen := DefReadBufferLen; + FOnConnected := nil; + FOnDisconnected := nil; + FOnReadData := nil; + + // Initialize Thread Pool Properties (from ncSources) + FCommandProcessorThreadPriority := DefCommandProcessorThreadPriority; + FCommandProcessorThreads := DefCommandProcessorThreads; + FCommandProcessorThreadsPerCPU := DefCommandProcessorThreadsPerCPU; + FCommandProcessorThreadsGrowUpto := DefCommandProcessorThreadsGrowUpto; + + // Initialize TLS properties + FUseTLS := DefUseTLS; + FTlsProvider := DefTlsProvider; + FCertificateFile := ''; + FPrivateKeyFile := ''; + FPrivateKeyPassword := ''; + FCACertificatesFile := ''; + FIgnoreCertificateErrors := DefIgnoreCertificateErrors; + + FIsServer := False; + + SetLength(ReadBuf, DefReadBufferLen); + + // Create Thread Pool for Command Processing (from ncSources) + HandleCommandThreadPool := TncThreadPool.Create(THandleCommandThread); + +end; + +function TncTCPBaseDual.Kind: TSocketType; +begin + Result := stTCP; +end; + +destructor TncTCPBaseDual.Destroy; +begin + Active := False; + // Clean up Thread Pool (from ncSources) + HandleCommandThreadPool.Free; + + PropertyLock.Free; + ShutDownLock.Free; + inherited Destroy; +end; + +procedure TncTCPBaseDual.Loaded; +begin + inherited Loaded; + + // Configure Thread Pool (from ncSources) + HandleCommandThreadPool.SetThreadPriority(FCommandProcessorThreadPriority); + HandleCommandThreadPool.SetExecThreads( + Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + HandleCommandThreadPool.GrowUpto := FCommandProcessorThreadsGrowUpto; + + if FInitActive then + DoActivate(True); +end; + +function TncTCPBaseDual.CreateLineObject: TncLine; +begin + Result := TncLineInternal.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); + + // Set up TLS callbacks if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Result).OnBeforeConnected := HandleTLSHandshake; + TncLineInternal(Result).OnBeforeDisconnected := FinalizeTLS; + end; +end; + +procedure TncTCPBaseDual.SetActive(const Value: Boolean); +begin + PropertyLock.Acquire; + try + if not(csLoading in ComponentState) then + DoActivate(Value); + + FInitActive := GetActive; // we only care here for the loaded event + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetFamily: TAddressType; +begin + PropertyLock.Acquire; + try + Result := FFamily; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetFamily(const Value: TAddressType); +begin + if not (csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create(ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + PropertyLock.Acquire; + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetPort: Integer; +begin + PropertyLock.Acquire; + try + Result := FPort; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileConnectionIsActiveStr); + + PropertyLock.Acquire; + try + FPort := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetReaderThreadPriority: TncThreadPriority; +begin + PropertyLock.Acquire; + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + PropertyLock.Acquire; + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetEventsUseMainThread: Boolean; +begin + PropertyLock.Acquire; + try + Result := FEventsUseMainThread; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetEventsUseMainThread(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FEventsUseMainThread := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileActiveStr); + + PropertyLock.Acquire; + try + FUseReaderThread := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetNoDelay: Boolean; +begin + PropertyLock.Acquire; + try + Result := FNoDelay; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetNoDelay(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FNoDelay := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetKeepAlive: Boolean; +begin + PropertyLock.Acquire; + try + Result := FKeepAlive; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetKeepAlive(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FKeepAlive := Value; + finally + PropertyLock.Release; + end; +end; + +// Update +function TncTCPBaseDual.GetReadBufferLen: Integer; +begin + PropertyLock.Acquire; + try + Result := FReadBufferLen; + finally + PropertyLock.Release; + end; +end; + +// Update +procedure TncTCPBaseDual.SetReadBufferLen(const Value: Integer); +begin + PropertyLock.Acquire; + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + PropertyLock.Release; + end; +end; + +// TLS Property Methods +function TncTCPBaseDual.GetUseTLS: Boolean; +begin + PropertyLock.Acquire; + try + Result := FUseTLS; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetUseTLS(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set UseTLS property whilst the connection is active'); + + PropertyLock.Acquire; + try + FUseTLS := Value; + + // Add TLS callback assignment when TLS is enabled + if Value then + begin + if FIsServer and (Self is TncCustomTCPServerDual) then + begin + // Server callback assignment + var Server := TncCustomTCPServerDual(Self); + if Server.Listener <> nil then + begin + TncLineInternal(Server.Listener).OnBeforeConnected := HandleTLSHandshake; + end; + end + else if not FIsServer and (Self is TncCustomTCPClientDual) then + begin + // Client callback assignment + var Client := TncCustomTCPClientDual(Self); + if Client.Line <> nil then + begin + TncLineInternal(Client.Line).OnBeforeConnected := HandleTLSHandshake; + end; + end; + end; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetTlsProvider: TncTlsProvider; +begin + PropertyLock.Acquire; + try + Result := FTlsProvider; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetTlsProvider(const Value: TncTlsProvider); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set TlsProvider property whilst the connection is active'); + + PropertyLock.Acquire; + try + // Validate provider availability + case Value of + tpSChannel: + begin + {$IFNDEF MSWINDOWS} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL validation - for now, not supported + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + + FTlsProvider := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetCertificateFile: string; +begin + PropertyLock.Acquire; + try + Result := FCertificateFile; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetCertificateFile(const Value: string); +begin + PropertyLock.Acquire; + try + FCertificateFile := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetPrivateKeyFile: string; +begin + PropertyLock.Acquire; + try + Result := FPrivateKeyFile; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetPrivateKeyFile(const Value: string); +begin + PropertyLock.Acquire; + try + FPrivateKeyFile := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetPrivateKeyPassword: string; +begin + PropertyLock.Acquire; + try + Result := FPrivateKeyPassword; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetPrivateKeyPassword(const Value: string); +begin + PropertyLock.Acquire; + try + FPrivateKeyPassword := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetCACertificatesFile: string; +begin + PropertyLock.Acquire; + try + Result := FCACertificatesFile; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetCACertificatesFile(const Value: string); +begin + PropertyLock.Acquire; + try + FCACertificatesFile := Value; + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetIgnoreCertificateErrors: Boolean; +begin + PropertyLock.Acquire; + try + Result := FIgnoreCertificateErrors; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetIgnoreCertificateErrors(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FIgnoreCertificateErrors := Value; + finally + PropertyLock.Release; + end; +end; + +// TLS base implementation + +function TncTCPBaseDual.GetHost: string; +begin + Result := ''; // Default implementation, override in client +end; + +// TLS Functionality Methods +procedure TncTCPBaseDual.InitializeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if not FUseTLS then + Exit; + + if aLine = nil then + Exit; + + // Get or create per-connection TLS context + if TncLineInternal(aLine).DataObject = nil then + begin + TlsContext := TncTlsConnectionContext.Create(FIsServer); + TncLineInternal(aLine).DataObject := TlsContext; + end + else + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + end; + + // Check if TLS is already initialized for this specific connection + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Exit; + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Exit; + end; + + // Initialize TLS for this specific connection + if FIsServer then + begin + TlsContext.GetServerContext^.AfterConnection(aLine, AnsiString(FCertificateFile), AnsiString(FPrivateKeyPassword)); + end + else + begin + TlsContext.GetClientContext^.AfterConnection(aLine, AnsiString(GetHost), FIgnoreCertificateErrors); + end; +end; + +procedure TncTCPBaseDual.HandleTLSHandshake(aLine: TncLine); +begin + // This method is called automatically before OnConnected fires + // It performs the TLS handshake synchronously + if FUseTLS and (aLine <> nil) then + begin + InitializeTLS(aLine); // Perform the complete TLS handshake + end; +end; + +procedure TncTCPBaseDual.HandleTLSHandshakeComplete(aLine: TncLine); +begin + // Call OnConnected for TLS connections after handshake completes + if FUseTLS and Assigned(OnConnected) then + begin + try + OnConnected(Self, aLine); + except + on E: Exception do + // OnConnected failed - could log this if needed + end; + end; +end; + +procedure TncTCPBaseDual.FinalizeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (aLine <> nil) and (TncLineInternal(aLine).DataObject <> nil) then + begin + try + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + TlsContext.GetServerContext^.BeforeDisconnection(aLine); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + TlsContext.GetClientContext^.BeforeDisconnection(aLine); + end; + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL cleanup + end; + end; + + // Clean up the TLS context object + TncLineInternal(aLine).DataObject := nil; + TlsContext.Free; + except + on E: Exception do + // Log error but don't raise exception during cleanup + end; + end; +end; + +function TncTCPBaseDual.SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Result := TlsContext.GetServerContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Result := TlsContext.GetClientContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL send implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); +end; + +function TncTCPBaseDual.ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; + WasHandshakeCompleted: Boolean; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + begin + WasHandshakeCompleted := TlsContext.GetServerContext^.HandshakeCompleted; + + Result := TlsContext.GetServerContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and WasHandshakeCompleted then + begin + raise Exception.Create('TLS client disconnected'); + end; + + // Check if handshake just completed + if not WasHandshakeCompleted and TlsContext.GetServerContext^.HandshakeCompleted then + begin + // Handshake just completed, call OnConnected + HandleTLSHandshakeComplete(aLine); + + // CRITICAL FIX: Return -1 to prevent OnReadData from being triggered with empty data + // The handshake completion callback has already been called above + Result := -1; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + begin + // For client, handshake is complete when Initialized becomes true + // But we need to track when it JUST became initialized (not if it was already initialized) + // Since the client calls AfterConnection during OnBeforeConnected, we know that + // the first call to Receive after OnBeforeConnected is when handshake is complete + + Result := TlsContext.GetClientContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and TlsContext.GetClientContext^.Initialized then + begin + raise Exception.Create('TLS server disconnected'); + end; + + // Client-side handshake completion detection: + // The client TLS handshake is handled in OnBeforeConnected event + // So by the time we get here, handshake is already complete + // We don't need to do anything special for client handshake completion + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL receive implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPClientDual } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomTCPClientDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FIsServer := False; // Set client flag for TLS context selection + FHost := DefHost; + FReconnect := True; + FReconnectInterval := DefCntReconnectInterval; + FOnReconnected := nil; + FOnCommand := nil; // Initialize the new field + OriginalOnReadData := OnReadData; // Store original handler + OnReadData := InternalReadDataHandler; // Set up protocol detection handler + FConnectionState.Reset; // Initialize connection state + + LastConnectAttempt := TStopWatch.GetTimeStamp; + WasConnected := False; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + TncLineInternal(Line).OnConnected := DataSocketConnected; + TncLineInternal(Line).OnDisconnected := DataSocketDisconnected; + + // Set up TLS callbacks if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Line).OnBeforeConnected := HandleTLSHandshake; + end; + + LineProcessor := TncClientProcessor.Create(Self); + try + if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; + LineProcessor.WaitForReady; +end; + + +destructor TncCustomTCPClientDual.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +procedure TncCustomTCPClientDual.DoActivate(aActivate: Boolean); +begin + + if aActivate = GetActive then + Exit; + + if aActivate then + begin + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + TncLineInternal(Line).CreateClientHandle(FHost, FPort); + + // if there were no exceptions, and line is still not active, + // that means the user has deactivated it in the OnConnect handler + if not Line.Active then + WasConnected := False; + end + else + begin + WasConnected := False; + TncLineInternal(Line).DestroyHandle; + end; +end; + +procedure TncCustomTCPClientDual.DataSocketConnected(aLine: TncLine); +begin + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if NoDelay then + try + TncLineInternal(Line).EnableNoDelay; + except + end; + + if KeepAlive then + try + TncLineInternal(Line).EnableKeepAlive; + except + end; + + try + TncLineInternal(Line).SetReceiveSize(1048576); // 1MB + TncLineInternal(Line).SetWriteSize(1048576); // 1MB + //TncLineInternal(Line).SetReceiveSize(20 * 1048576); + + except + end; + + // TLS initialization is now handled by OnBeforeConnected event + + if Assigned(OnConnected) then + try + OnConnected(Self, aLine); + except + end; + + LastConnectAttempt := TStopWatch.GetTimeStamp; + WasConnected := True; + + if UseReaderThread then + LineProcessor.Run; // Will just set events, this does not wait +end; + +procedure TncCustomTCPClientDual.DataSocketDisconnected(aLine: TncLine); +begin + if UseTLS then + FinalizeTLS(aLine); + + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, aLine); + except + end; +end; + +procedure TncCustomTCPClientDual.Send(const aBuf; aBufSize: Integer); +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + SendTLS(Line, aBuf, aBufSize); +end; + +procedure TncCustomTCPClientDual.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPClientDual.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +procedure TncCustomTCPClientDual.SendCommand(aCmd: Integer; const aData: TBytes = nil); +var + Command: TncCommand; + MessageBytes, FinalBuf: TBytes; + MsgByteCount, HeaderBytes: UInt64; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Create command like ncSources does + Command.CommandType := ctInitiator; + Command.UniqueID := 0; // Simplified for now + Command.Cmd := aCmd; + Command.Data := aData; + Command.RequiresResult := False; + Command.AsyncExecute := False; + Command.ResultIsErrorString := False; + Command.SourceComponentHandler := ''; + Command.PeerComponentHandler := ''; + + // Convert to bytes like ncSources + MessageBytes := Command.ToBytes; + MsgByteCount := Length(MessageBytes); + + // Use ncSources protocol format: [Magic: 4][MessageLength: 8][Data: variable] + HeaderBytes := SizeOf(TMagicHeaderType) + SizeOf(MsgByteCount); + SetLength(FinalBuf, HeaderBytes + MsgByteCount); + + // Write protocol header (same as ncSources) + PMagicHeaderType(@FinalBuf[0])^ := MagicHeader; // Magic: 4 bytes + PUInt64(@FinalBuf[SizeOf(MagicHeader)])^ := MsgByteCount; // MessageLength: 8 bytes + Move(MessageBytes[0], FinalBuf[HeaderBytes], MsgByteCount); // Data: variable + + Send(FinalBuf); +end; + +procedure TncCustomTCPClientDual.InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + Command: TncCommand; + Ofs: Integer; + BytesToRead: Integer; + OldLen: Integer; + TextData: TBytes; +begin + // CRITICAL FIX: When TLS is enabled, bypass protocol detection during handshake + // TLS handshake data should never reach the application layer + if UseTLS then + begin + // Check if TLS handshake is still in progress using per-connection context + if (TncLineInternal(aLine).DataObject <> nil) then + begin + var TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + if not TlsContext.GetClientContext^.Initialized then + begin + // During handshake, pass all data directly to original handler (TLS layer) + // Protocol detection should only happen AFTER TLS handshake completes + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, aBuf, aBufCount); + Exit; // Don't process for protocol detection during handshake + end; + end; + // If we reach here, TLS handshake is complete and data is decrypted application data + // Continue with normal protocol detection below + end; + + Ofs := 0; + + // Process incoming data using ncSources-style state machine + while Ofs < aBufCount do + begin + // Are we in the middle of accumulating a message? + if FConnectionState.BytesToEndOfMessage > 0 then + begin + // ncSources approach: We know exactly how many bytes we need + BytesToRead := Min(FConnectionState.BytesToEndOfMessage, aBufCount - Ofs); + + // Accumulate data efficiently + OldLen := Length(FConnectionState.MessageBuffer); + SetLength(FConnectionState.MessageBuffer, OldLen + BytesToRead); + Move(aBuf[Ofs], FConnectionState.MessageBuffer[OldLen], BytesToRead); + + Ofs := Ofs + BytesToRead; + FConnectionState.BytesToEndOfMessage := FConnectionState.BytesToEndOfMessage - BytesToRead; + end; + + // Do we have a complete message? + if FConnectionState.BytesToEndOfMessage = 0 then + begin + if Length(FConnectionState.MessageBuffer) > 0 then + begin + // Process complete message based on detected protocol + case FConnectionState.MessageType of + mtBinary: + begin + // Process binary command - Route to Thread Pool (from ncSources) + try + Command.FromBytes(FConnectionState.MessageBuffer); + + // Route to thread pool for processing like ncSources + HandleCommandThreadPool.Serialiser.Acquire; + try + var HandleCommandThread := THandleCommandThread(HandleCommandThreadPool.RequestReadyThread); + HandleCommandThread.WorkType := htwtOnCommand; + HandleCommandThread.Source := Self; + HandleCommandThread.Line := aLine; + HandleCommandThread.Cmd := Command.Cmd; + HandleCommandThread.Data := Command.Data; + HandleCommandThread.OnCommand := FOnCommand; + HandleCommandThread.EventsUseMainThread := EventsUseMainThread; + HandleCommandThreadPool.RunRequestedThread(HandleCommandThread); + finally + HandleCommandThreadPool.Serialiser.Release; + end; + except + // If parsing fails, treat as text + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, FConnectionState.MessageBuffer, Length(FConnectionState.MessageBuffer)); + end; + end; + mtText: + begin + // Process text data + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, FConnectionState.MessageBuffer, Length(FConnectionState.MessageBuffer)); + end; + end; + + // Reset for next message + FConnectionState.Reset; + end; + + // Start new message detection if we have more data + if Ofs < aBufCount then + begin + // Protocol detection: Check for magic header + if (aBufCount - Ofs) >= SizeOf(TMagicHeaderType) then + begin + if PMagicHeaderType(@aBuf[Ofs])^ = MagicHeader then + begin + // Binary protocol detected + FConnectionState.MessageType := mtBinary; + + // Do we have the complete header? + if (aBufCount - Ofs) >= (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) then + begin + // Read message length and set up state + FConnectionState.ExpectedMessageLength := PUInt64(@aBuf[Ofs + SizeOf(TMagicHeaderType)])^; + FConnectionState.BytesToEndOfMessage := FConnectionState.ExpectedMessageLength; + FConnectionState.HeaderComplete := True; + + // Skip past header + Ofs := Ofs + SizeOf(TMagicHeaderType) + SizeOf(UInt64); + + // Continue to accumulate message data + Continue; + end + else + begin + // Incomplete header - buffer remaining data and wait + SetLength(TextData, aBufCount - Ofs); + Move(aBuf[Ofs], TextData[0], aBufCount - Ofs); + FConnectionState.MessageBuffer := TextData; + FConnectionState.BytesToEndOfMessage := (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) - (aBufCount - Ofs); + FConnectionState.MessageType := mtUnknown; // Still detecting + Break; + end; + end + else + begin + // Unknown protocol - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing, don't accumulate + end; + end + else + begin + // Not enough data for magic header check - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing + end; + end; + end; + end; +end; + +procedure TncCustomTCPClientDual.SetOnReadData(const Value: TncOnReadData); +begin + // Store the user's handler and keep protocol detection active + OriginalOnReadData := Value; + inherited OnReadData := InternalReadDataHandler; +end; + +function TncCustomTCPClientDual.Receive(aTimeout: Cardinal): TBytes; +var + BufRead: Integer; +begin + if UseReaderThread then + raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); + Result := Copy(ReadBuf, 0, BufRead) +end; + +function TncCustomTCPClientDual.ReceiveRaw(var aBytes: TBytes): Integer; +begin + Result := ReceiveTLS(Line, aBytes[0], Length(aBytes)); +end; + +function TncCustomTCPClientDual.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomTCPClientDual.GetHost: string; +begin + PropertyLock.Acquire; + try + Result := FHost; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomTCPClientDual.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileConnectionIsActiveStr); + + PropertyLock.Acquire; + try + FHost := Value; + finally + PropertyLock.Release; + end; +end; + +function TncCustomTCPClientDual.GetReconnect: Boolean; +begin + PropertyLock.Acquire; + try + Result := FReconnect; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomTCPClientDual.SetReconnect(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FReconnect := Value; + finally + PropertyLock.Release; + end; +end; + +function TncCustomTCPClientDual.GetReconnectInterval: Cardinal; +begin + PropertyLock.Acquire; + try + Result := FReconnectInterval; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomTCPClientDual.SetReconnectInterval(const Value: Cardinal); +begin + PropertyLock.Acquire; + try + FReconnectInterval := Value; + finally + PropertyLock.Release; + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncClientProcessor } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncClientProcessor.Create(aClientSocket: TncCustomTCPClientDual); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncClientProcessor.SocketProcess; +var + BufRead: Integer; +begin + BufRead := FClientSocket.ReceiveTLS(FClientSocket.Line, FClientSocket.ReadBuf[0], Length(FClientSocket.ReadBuf)); + if Assigned(FClientSocket.OnReadData) and (BufRead > 0) then + try + FClientSocket.OnReadData(FClientSocket, FClientSocket.Line, FClientSocket.ReadBuf, BufRead); + except + end; +end; + +procedure TncClientProcessor.SocketWasReconnected; +begin + if Assigned(FClientSocket.FOnReconnected) then + FClientSocket.FOnReconnected(FClientSocket, FClientSocket.Line); + if Assigned(FClientSocket.FOnConnected) then + FClientSocket.FOnConnected(FClientSocket, FClientSocket.Line); +end; + +procedure TncClientProcessor.ProcessEvent; +var + PrevOnConnect: TncOnConnectDisconnect; + WasReconnected: Boolean; +begin + while (not Terminated) do // Repeat handling until terminated + try + if FClientSocket.Line.Active then // Repeat reading socket until disconnected + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(SocketProcess) // for synchronize + else + SocketProcess; + end; + end + else + // Is not Active, try reconnecting if was connected + begin + // Logic for reconnect mode + if FClientSocket.Reconnect and FClientSocket.WasConnected then + begin + // A minimal sleep time of 30 msec is required in Android before + // reattempting to connect on a recently deactivated network connection. + // We have put it to 60 for safety + Sleep(60); + if Terminated then + Break; + if TStopWatch.GetTimeStamp - FClientSocket.LastConnectAttempt > FClientSocket.ReconnectInterval * TTimeSpan.TicksPerMillisecond then + begin + FClientSocket.LastConnectAttempt := TStopWatch.GetTimeStamp; + + WasReconnected := False; + FClientSocket.PropertyLock.Acquire; + try + if not FClientSocket.Active then + begin + PrevOnConnect := FClientSocket.OnConnected; + try + // Disable firing the event in the wrong thread in case it gets connected + FClientSocket.OnConnected := nil; + FClientSocket.Active := True; + WasReconnected := True; + finally + FClientSocket.OnConnected := PrevOnConnect; + end; + end; + finally + FClientSocket.PropertyLock.Release; + end; + if WasReconnected then + if FClientSocket.EventsUseMainThread then + Synchronize(SocketWasReconnected) + else + SocketWasReconnected; + end; + end + else + Exit; + end; + except + // Something was disconnected, continue processing + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPServerDual } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomTCPServerDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FIsServer := True; // Set server flag for TLS context selection + FOnCommand := nil; // Initialize the new field + OriginalOnReadData := OnReadData; // Store original handler + OnReadData := InternalReadDataHandler; // Set up protocol detection handler + FConnectionStates := TDictionary.Create; // Initialize state tracking dictionary + + Listener := CreateLineObject; + if Listener.Family <> FFamily then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; + + TncLineInternal(Listener).OnConnected := DataSocketConnected; + TncLineInternal(Listener).OnDisconnected := DataSocketDisconnected; + + // Set up TLS callbacks if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Listener).OnBeforeConnected := HandleTLSHandshake; + end; + Lines := TThreadLineList.Create(); + + LineProcessor := TncServerProcessor.Create(Self); + try + if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; + LineProcessor.WaitForReady; +end; + +destructor TncCustomTCPServerDual.Destroy; +begin + // Will get Sockets.Lines disposed off + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Lines.Free; + Listener.Free; + + FConnectionStates.Free; // Cleanup state tracking dictionary + + inherited Destroy; +end; + +function TncCustomTCPServerDual.GetActive: Boolean; +begin + Result := Listener.Active; +end; + +procedure TncCustomTCPServerDual.DoActivate(aActivate: Boolean); +var + DataSockets: TSocketList; + i: Integer; +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + // Verify family setting before creating handle + if Assigned(Listener) and (Listener.Family <> FFamily) then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; + TncLineInternal(Listener).CreateServerHandle(FPort); + end + else + begin + if Assigned(Listener) then + TncLineInternal(Listener).DestroyHandle; + + // Cleanup connected sockets +{$HINTS OFF} + DataSockets := Lines.LockListNoCopy; + try + for i := 0 to DataSockets.Count - 1 do + try + if Assigned(DataSockets.Lines[i]) then + begin + TncLineInternal(DataSockets.Lines[i]).DestroyHandle; + DataSockets.Lines[i].Free; + end; + except + // + end; + DataSockets.Clear; + finally + Lines.UnlockListNoCopy; + end; + end; +end; + +procedure TncCustomTCPServerDual.ShutDownLine(aLine: TncLine); +var + i: Integer; +begin + if UseReaderThread then + begin + ShutDownLock.Acquire; + try + for i := 0 to High(LinesToShutDown) do + if LinesToShutDown[i] = aLine then + Exit; + + SetLength(LinesToShutDown, Length(LinesToShutDown) + 1); + LinesToShutDown[High(LinesToShutDown)] := aLine; + finally + ShutDownLock.Release; + end; + end + else + begin + Lines.Remove(aLine); + aLine.Free; + end; +end; + +procedure TncCustomTCPServerDual.DataSocketConnected(aLine: TncLine); +begin + if aLine = Listener then + begin + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Listener.Handle; + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + SetLength(ReadSocketHandles, Length(ReadSocketHandles) + 1); + ReadSocketHandles[High(ReadSocketHandles)] := aLine.Handle; + + if NoDelay then + try + TncLineInternal(aLine).EnableNoDelay; + except + end; + + if KeepAlive then + try + TncLineInternal(aLine).EnableKeepAlive; + except + end; + + try + TncLineInternal(aLine).SetReceiveSize(1048576); + TncLineInternal(aLine).SetWriteSize(1048576); + except + end; + + // TLS initialization is now handled by OnBeforeConnected event + + // For TLS connections, delay OnConnected until after handshake completes + if not UseTLS then + begin + if Assigned(OnConnected) then + try + OnConnected(Self, aLine); + except + end; + end + else + begin + // For TLS connections, OnConnected will be called after handshake completes + // This is handled in the first successful TLS receive operation + end; + end; +end; + +// Update : Moves the handle removal before the disconnect event handling +// This prevents other threads from trying to use the handle while the disconnect event is processing. +procedure TncCustomTCPServerDual.DataSocketDisconnected(aLine: TncLine); +var + i: Integer; +begin + if aLine = Listener then + SetLength(ReadSocketHandles, 0) + else + begin + if UseTLS then + FinalizeTLS(aLine); + + // Clean up connection state + FConnectionStates.Remove(aLine); + + // First remove the handle to prevent further processing + PropertyLock.Acquire; + try + for i := 0 to High(ReadSocketHandles) do + if ReadSocketHandles[i] = aLine.Handle then + begin + ReadSocketHandles[i] := ReadSocketHandles[High(ReadSocketHandles)]; + SetLength(ReadSocketHandles, Length(ReadSocketHandles) - 1); + Break; + end; + finally + PropertyLock.Release; + end; + + // Then handle disconnect event + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, aLine); + except + end; + end; +end; + +procedure TncCustomTCPServerDual.Send(aLine: TncLine; const aBuf; aBufSize: Integer); +begin + SendTLS(aLine, aBuf, aBufSize); +end; + +procedure TncCustomTCPServerDual.Send(aLine: TncLine; const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aLine, aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPServerDual.Send(aLine: TncLine; const aStr: string); +begin + Send(aLine, BytesOf(aStr)); +end; + +function TncCustomTCPServerDual.Receive(aLine: TncLine; aTimeout: Cardinal): TBytes; +var + i, BufRead, LineNdx: Integer; + DataSockets: TSocketList; + Line: TncLine; + ReadySockets: TSocketHandleArray; +begin + if UseReaderThread then + raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + + SetLength(Result, 0); + ReadySockets := Readable(ReadSocketHandles, aTimeout); + + for i := 0 to High(ReadySockets) do + try + if ReadySockets[i] = Listener.Handle then + // New line is here, accept it and create a new TncLine object + Lines.Add(TncLineInternal(Listener).AcceptLine); + except + end; + + DataSockets := Lines.LockListNoCopy; + try + for i := 0 to High(ReadySockets) do + try + if aLine.Handle = ReadySockets[i] then + begin + LineNdx := DataSockets.IndexOf(ReadySockets[i]); + if LineNdx = -1 then + Continue; + Line := DataSockets.Lines[LineNdx]; + try + if not Line.Active then + Abort; + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); + Result := Copy(ReadBuf, 0, BufRead); + except + // Line has disconnected, destroy the line + DataSockets.Delete(LineNdx); + Line.Free; + end; + end; + except + end; + finally + Lines.UnlockListNoCopy; + end; +end; + +function TncCustomTCPServerDual.ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; +begin + Result := ReceiveTLS(aLine, aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPServerDual.SendCommand(aLine: TncLine; aCmd: Integer; const aData: TBytes = nil); +var + Command: TncCommand; + MessageBytes, FinalBuf: TBytes; + MsgByteCount, HeaderBytes: UInt64; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Create command like ncSources does + Command.CommandType := ctInitiator; + Command.UniqueID := 0; // Simplified for now + Command.Cmd := aCmd; + Command.Data := aData; + Command.RequiresResult := False; + Command.AsyncExecute := False; + Command.ResultIsErrorString := False; + Command.SourceComponentHandler := ''; + Command.PeerComponentHandler := ''; + + // Convert to bytes like ncSources + MessageBytes := Command.ToBytes; + MsgByteCount := Length(MessageBytes); + + // Use ncSources protocol format: [Magic: 4][MessageLength: 8][Data: variable] + HeaderBytes := SizeOf(TMagicHeaderType) + SizeOf(MsgByteCount); + SetLength(FinalBuf, HeaderBytes + MsgByteCount); + + // Write protocol header (same as ncSources) + PMagicHeaderType(@FinalBuf[0])^ := MagicHeader; // Magic: 4 bytes + PUInt64(@FinalBuf[SizeOf(MagicHeader)])^ := MsgByteCount; // MessageLength: 8 bytes + Move(MessageBytes[0], FinalBuf[HeaderBytes], MsgByteCount); // Data: variable + + Send(aLine, FinalBuf); +end; + +procedure TncCustomTCPServerDual.InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + Command: TncCommand; + ConnectionState: TConnectionState; + Ofs: Integer; + BytesToRead: Integer; + OldLen: Integer; + TextData: TBytes; +begin + // CRITICAL FIX: When TLS is enabled, bypass protocol detection during handshake + // TLS handshake data should never reach the application layer + if UseTLS then + begin + // Check if TLS handshake is still in progress using per-connection context + if (TncLineInternal(aLine).DataObject <> nil) then + begin + var TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + if not TlsContext.GetServerContext^.HandshakeCompleted then + begin + // During handshake, pass all data directly to original handler (TLS layer) + // Protocol detection should only happen AFTER TLS handshake completes + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, aBuf, aBufCount); + Exit; // Don't process for protocol detection during handshake + end; + end; + // If we reach here, TLS handshake is complete and data is decrypted application data + // Continue with normal protocol detection below + end; + + // Get or create connection state + if not FConnectionStates.TryGetValue(aLine, ConnectionState) then + begin + ConnectionState.Reset; + FConnectionStates.Add(aLine, ConnectionState); + end; + + Ofs := 0; + + // Process incoming data using ncSources-style state machine + while Ofs < aBufCount do + begin + // Are we in the middle of accumulating a message? + if ConnectionState.BytesToEndOfMessage > 0 then + begin + // ncSources approach: We know exactly how many bytes we need + BytesToRead := Min(ConnectionState.BytesToEndOfMessage, aBufCount - Ofs); + + // Accumulate data efficiently + OldLen := Length(ConnectionState.MessageBuffer); + SetLength(ConnectionState.MessageBuffer, OldLen + BytesToRead); + Move(aBuf[Ofs], ConnectionState.MessageBuffer[OldLen], BytesToRead); + + Ofs := Ofs + BytesToRead; + ConnectionState.BytesToEndOfMessage := ConnectionState.BytesToEndOfMessage - BytesToRead; + end; + + // Do we have a complete message? + if ConnectionState.BytesToEndOfMessage = 0 then + begin + if Length(ConnectionState.MessageBuffer) > 0 then + begin + // Process complete message based on detected protocol + case ConnectionState.MessageType of + mtBinary: + begin + // Process binary command - Route to Thread Pool (from ncSources) + try + Command.FromBytes(ConnectionState.MessageBuffer); + + // Route to thread pool for processing like ncSources + HandleCommandThreadPool.Serialiser.Acquire; + try + var HandleCommandThread := THandleCommandThread(HandleCommandThreadPool.RequestReadyThread); + HandleCommandThread.WorkType := htwtOnCommand; + HandleCommandThread.Source := Self; + HandleCommandThread.Line := aLine; + HandleCommandThread.Cmd := Command.Cmd; + HandleCommandThread.Data := Command.Data; + HandleCommandThread.OnCommand := FOnCommand; + HandleCommandThread.EventsUseMainThread := EventsUseMainThread; + HandleCommandThreadPool.RunRequestedThread(HandleCommandThread); + finally + HandleCommandThreadPool.Serialiser.Release; + end; + except + // If parsing fails, treat as text + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, ConnectionState.MessageBuffer, Length(ConnectionState.MessageBuffer)); + end; + end; + mtText: + begin + // Process text data + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, ConnectionState.MessageBuffer, Length(ConnectionState.MessageBuffer)); + end; + end; + + // Reset for next message + ConnectionState.Reset; + end; + + // Start new message detection if we have more data + if Ofs < aBufCount then + begin + // Protocol detection: Check for magic header + if (aBufCount - Ofs) >= SizeOf(TMagicHeaderType) then + begin + if PMagicHeaderType(@aBuf[Ofs])^ = MagicHeader then + begin + // Binary protocol detected + ConnectionState.MessageType := mtBinary; + + // Do we have the complete header? + if (aBufCount - Ofs) >= (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) then + begin + // Read message length and set up state + ConnectionState.ExpectedMessageLength := PUInt64(@aBuf[Ofs + SizeOf(TMagicHeaderType)])^; + ConnectionState.BytesToEndOfMessage := ConnectionState.ExpectedMessageLength; + ConnectionState.HeaderComplete := True; + + // Skip past header + Ofs := Ofs + SizeOf(TMagicHeaderType) + SizeOf(UInt64); + + // Continue to accumulate message data + Continue; + end + else + begin + // Incomplete header - buffer remaining data and wait + SetLength(TextData, aBufCount - Ofs); + Move(aBuf[Ofs], TextData[0], aBufCount - Ofs); + ConnectionState.MessageBuffer := TextData; + ConnectionState.BytesToEndOfMessage := (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) - (aBufCount - Ofs); + ConnectionState.MessageType := mtUnknown; // Still detecting + Break; + end; + end + else + begin + // Unknown protocol - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing, don't accumulate + end; + end + else + begin + // Not enough data for magic header check - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing + end; + end; + end; + end; + + // Update connection state + FConnectionStates.AddOrSetValue(aLine, ConnectionState); +end; + +procedure TncCustomTCPServerDual.SetOnReadData(const Value: TncOnReadData); +begin + // Store the user's handler and keep protocol detection active + OriginalOnReadData := Value; + inherited OnReadData := InternalReadDataHandler; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncServerProcessor } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncServerProcessor.Create(aServerSocket: TncCustomTCPServerDual); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncServerProcessor.CheckLinesToShutDown; +var + i: Integer; +begin + // The list may be locked from custom code executed in the OnReadData handler + // So we will not delete anything, or lock the list, until this lock is freed + if FServerSocket.Lines.FLock.TryEnter then + try + FServerSocket.ShutDownLock.Acquire; + try + for i := 0 to High(FServerSocket.LinesToShutDown) do + try + FServerSocket.Lines.Remove(FServerSocket.LinesToShutDown[i]); + TncLineInternal(FServerSocket.LinesToShutDown[i]).DestroyHandle; + TncLineInternal(FServerSocket.LinesToShutDown[i]).Free; + except + end; + SetLength(FServerSocket.LinesToShutDown, 0); + finally + FServerSocket.ShutDownLock.Release; + end; + finally + FServerSocket.Lines.FLock.Leave; + end; +end; + +procedure TncServerProcessor.SocketProcess; +var + i, LineNdx, BufRead, ReadySocketsHigh: Integer; + DataSockets: TSocketList; + Line: TncLine; + j: Integer; +begin + ReadySocketsHigh := High(ReadySockets); + + // First accept new lines + i := 0; + while i <= ReadySocketsHigh do + begin + try + if ReadySockets[i] = FServerSocket.Listener.Handle then + begin + // New line is here, accept it and create a new TncLine object + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + FServerSocket.Lines.Add(TncLineInternal(FServerSocket.Listener).AcceptLine); + + Delete(ReadySockets, i, 1); + ReadySocketsHigh := ReadySocketsHigh - 1; + i := i - 1; + end; + except + end; + i := i + 1; + end; + + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + + // Check for new data + DataSockets := FServerSocket.Lines.FList; + for i := 0 to ReadySocketsHigh do + try + LineNdx := DataSockets.IndexOf(ReadySockets[i]); + if LineNdx = -1 then + begin + for j := 0 to High(FServerSocket.ReadSocketHandles) do + if FServerSocket.ReadSocketHandles[j] = ReadySockets[i] then + begin + FServerSocket.ReadSocketHandles[j] := FServerSocket.ReadSocketHandles[High(FServerSocket.ReadSocketHandles)]; + SetLength(FServerSocket.ReadSocketHandles, Length(FServerSocket.ReadSocketHandles) - 1); + Break; + end; + Continue; + end; + Line := DataSockets.Lines[LineNdx]; + try + if not Line.Active then + Abort; + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + BufRead := FServerSocket.ReceiveTLS(Line, FServerSocket.ReadBuf[0], Length(FServerSocket.ReadBuf)); + if Assigned(FServerSocket.OnReadData) and (BufRead > 0) then + FServerSocket.OnReadData(FServerSocket, Line, FServerSocket.ReadBuf, BufRead); + except + // Line has disconnected, destroy the line + DataSockets.Delete(LineNdx); + Line.Free; + end; + + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + except + end; +end; + +procedure TncServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Listener.Active and (not Terminated) do + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + Synchronize(SocketProcess); + CheckLinesToShutDown; + except + end + else + while FServerSocket.Listener.Active and (not Terminated) do + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + SocketProcess; + CheckLinesToShutDown; + except + end; +end; + +// Thread Pool Property Implementations (from ncSources) +function TncTCPBaseDual.GetCommandProcessorThreadPriority: TncThreadPriority; +begin + PropertyLock.Acquire; + try + Result := FCommandProcessorThreadPriority; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreadPriority(const Value: TncThreadPriority); +begin + PropertyLock.Acquire; + try + FCommandProcessorThreadPriority := Value; + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetThreadPriority(Value); + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetCommandProcessorThreads: Integer; +begin + PropertyLock.Acquire; + try + Result := FCommandProcessorThreads; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreads(const Value: Integer); +begin + PropertyLock.Acquire; + try + FCommandProcessorThreads := Value; + if Value <> 0 then + FCommandProcessorThreadsPerCPU := 0; + + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetExecThreads(Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetCommandProcessorThreadsPerCPU: Integer; +begin + PropertyLock.Acquire; + try + Result := FCommandProcessorThreadsPerCPU; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreadsPerCPU(const Value: Integer); +begin + PropertyLock.Acquire; + try + FCommandProcessorThreadsPerCPU := Value; + if Value <> 0 then + FCommandProcessorThreads := 0; + + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetExecThreads(Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + finally + PropertyLock.Release; + end; +end; + +function TncTCPBaseDual.GetCommandProcessorThreadsGrowUpto: Integer; +begin + PropertyLock.Acquire; + try + Result := FCommandProcessorThreadsGrowUpto; + finally + PropertyLock.Release; + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreadsGrowUpto(const Value: Integer); +begin + PropertyLock.Acquire; + try + FCommandProcessorThreadsGrowUpto := Value; + if not(csLoading in ComponentState) then + HandleCommandThreadPool.GrowUpto := Value; + finally + PropertyLock.Release; + end; +end; + +{ THandleCommandThread } + +procedure THandleCommandThread.CallOnCommandEvent; +begin + if Assigned(FOnCommand) then + try + FOnCommand(FSource, FLine, FCmd, FData); + except + // Swallow exceptions in worker thread to prevent thread termination + end; +end; + +procedure THandleCommandThread.ProcessEvent; +begin + if FEventsUseMainThread then + Synchronize(CallOnCommandEvent) + else + CallOnCommandEvent; +end; + + +end. + + diff --git a/Source/ncSocketsThd.pas b/Source/ncSocketsThd.pas new file mode 100644 index 0000000..c67c4e5 --- /dev/null +++ b/Source/ncSocketsThd.pas @@ -0,0 +1,938 @@ +unit ncSocketsThd; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - Threaded Socket Components +// +// This unit creates TncTCPServerThd and TncTCPClientThd components that provide +// raw socket functionality with thread pool processing for received data. +// +// Unlike TncSourceBase which is limited to command protocol processing, +// these components allow custom protocol handling while still benefiting +// from the thread pool architecture for performance. +// +// Component Architecture: +// - TncTCPServerThd: Raw TCP server with thread pool data processing +// - TncTCPClientThd: Raw TCP client with thread pool data processing +// - TncSocketBase: Base class with common thread pool functionality +// - TDataProcessingThread: Worker thread for processing raw data +// +// Key Features: +// - Raw socket data processing with thread pool +// - Reader threads for network I/O (non-blocking) +// - Processing threads for data handling (OnReadData event) +// - Component composition pattern wrapping TncTCPServer/TncTCPClient +// - All socket properties delegated to underlying components +// - TLS/SSL support through SChannel integration (Windows) +// +// Architecture: +// Network Data -> Reader Thread -> Processing Thread Pool -> OnReadData Event +// +// 13/07/2025 - by J.Pauwels +// - Added TLS/SSL support through SChannel integration +// - Added TLS properties (UseTLS, TlsProvider, CertificateFile) +// - Integrated secure communication capabilities for both server and client +// +// 12/07/2025 - by J.Pauwels +// - Initial creation +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, + System.Diagnostics, System.TimeSpan, System.RTLConsts, System.Types, + ncLines, ncSocketList, ncThreads, ncSockets; + +type + // Event type for raw data processing + TncOnServerReadData = procedure( + Sender: TObject; + aLine: TncLine; + const aBuf: TBytes; + aBufCount: Integer) of object; + + TncOnServerConnectDisconnect = procedure( + Sender: TObject; + aLine: TncLine) of object; + + TncOnServerReconnected = procedure( + Sender: TObject; + aLine: TncLine) of object; + +const + DefDataProcessorThreadPriority = ntpNormal; + DefDataProcessorThreads = 0; + DefDataProcessorThreadsPerCPU = 4; + DefDataProcessorThreadsGrowUpto = 32; + DefServerEventsUseMainThread = False; + +type + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncSocketBase + // Base class for TncTCPServerThd and TncTCPClientThd providing thread pool data processing + // Copies the TncSourceBase pattern but for raw data instead of commands + + TncSocketBase = class(TComponent) + private + FDataProcessorThreadPriority: TncThreadPriority; + FDataProcessorThreads: Integer; + FDataProcessorThreadsPerCPU: Integer; + FDataProcessorThreadsGrowUpto: Integer; + FEventsUseMainThread: Boolean; + + FOnConnected: TncOnServerConnectDisconnect; + FOnDisconnected: TncOnServerConnectDisconnect; + FOnReconnected: TncOnServerReconnected; + FOnReadData: TncOnServerReadData; + + // Socket property delegation getters/setters + function GetActive: Boolean; + procedure SetActive(const Value: Boolean); + function GetKeepAlive: Boolean; + procedure SetKeepAlive(const Value: Boolean); + function GetNoDelay: Boolean; + procedure SetNoDelay(const Value: Boolean); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetUseReaderThread: Boolean; + procedure SetUseReaderThread(const Value: Boolean); + function GetUseTLS: Boolean; + procedure SetUseTLS(const Value: Boolean); + function GetTlsProvider: TncTlsProvider; + procedure SetTlsProvider(const Value: TncTlsProvider); + function GetCertificateFile: string; + procedure SetCertificateFile(const Value: string); + function GetIgnoreCertificateErrors: Boolean; + procedure SetIgnoreCertificateErrors(const Value: Boolean); + function GetPrivateKeyPassword: string; + procedure SetPrivateKeyPassword(const Value: string); + + // Thread pool property getters/setters + function GetDataProcessorThreadPriority: TncThreadPriority; + procedure SetDataProcessorThreadPriority(const Value: TncThreadPriority); + function GetDataProcessorThreads: Integer; + procedure SetDataProcessorThreads(const Value: Integer); + function GetDataProcessorThreadsPerCPU: Integer; + procedure SetDataProcessorThreadsPerCPU(const Value: Integer); + function GetDataProcessorThreadsGrowUpto: Integer; + procedure SetDataProcessorThreadsGrowUpto(const Value: Integer); + function GetEventsUseMainThread: Boolean; + procedure SetEventsUseMainThread(const Value: Boolean); + private + // To set the component active on loaded if was set at design time + WasSetActive: Boolean; + WithinConnectionHandler: Boolean; + protected + PropertyLock: TCriticalSection; + DataProcessorThreadPool: TncThreadPool; + Socket: TncTCPBase; + + LastConnectedLine, LastDisconnectedLine, LastReconnectedLine: TncLine; + + procedure Loaded; override; + procedure TLSHandshakeWrapper(aLine: TncLine); + procedure CallConnectedEvents; + procedure SocketConnected(Sender: TObject; aLine: TncLine); + procedure CallDisconnectedEvents; + procedure SocketDisconnected(Sender: TObject; aLine: TncLine); + procedure CallReconnectedEvents; + procedure SocketReconnected(Sender: TObject; aLine: TncLine); + procedure SocketReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetThreadPoolThreadCount: Integer; + function GetThreadPoolActiveThreadCount: Integer; + published + // Socket properties (delegated to underlying socket) + property Active: Boolean read GetActive write SetActive default False; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default DefNoDelay; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default DefKeepAlive; + property Family: TAddressType read GetFamily write SetFamily default DefFamily; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + property UseReaderThread: Boolean read GetUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property UseTLS: Boolean read GetUseTLS write SetUseTLS default False; + property TlsProvider: TncTlsProvider read GetTlsProvider write SetTlsProvider default DefTlsProvider; + property CertificateFile: string read GetCertificateFile write SetCertificateFile; + property IgnoreCertificateErrors: Boolean read GetIgnoreCertificateErrors write SetIgnoreCertificateErrors default DefIgnoreCertificateErrors; + property PrivateKeyPassword: string read GetPrivateKeyPassword write SetPrivateKeyPassword; + + // Thread pool properties + property DataProcessorThreadPriority: TncThreadPriority read GetDataProcessorThreadPriority write SetDataProcessorThreadPriority default DefDataProcessorThreadPriority; + property DataProcessorThreads: Integer read GetDataProcessorThreads write SetDataProcessorThreads default DefDataProcessorThreads; + property DataProcessorThreadsPerCPU: Integer read GetDataProcessorThreadsPerCPU write SetDataProcessorThreadsPerCPU default DefDataProcessorThreadsPerCPU; + property DataProcessorThreadsGrowUpto: Integer read GetDataProcessorThreadsGrowUpto write SetDataProcessorThreadsGrowUpto default DefDataProcessorThreadsGrowUpto; + property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefServerEventsUseMainThread; + + // Events + property OnConnected: TncOnServerConnectDisconnect read FOnConnected write FOnConnected; + property OnDisconnected: TncOnServerConnectDisconnect read FOnDisconnected write FOnDisconnected; + property OnReadData: TncOnServerReadData read FOnReadData write FOnReadData; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TDataProcessingThread + // Worker thread that processes raw data from the thread pool + // Copies the THandleCommandThread pattern for consistency + + TDataProcessingThread = class(TncReadyThread) + public + OnReadData: TncOnServerReadData; + Server: TncSocketBase; + Line: TncLine; + Buffer: TBytes; + BufferCount: Integer; + + procedure CallOnReadDataEvent; + procedure ProcessEvent; override; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncTCPServerThd + // Server component providing raw socket functionality with thread pool processing + + TncTCPServerThd = class(TncSocketBase) + private + function GetLines: TThreadLineList; + protected + function GetReaderThreadPriority: TncThreadPriority; // Override to access server-specific property + procedure SetReaderThreadPriority(const Value: TncThreadPriority); // Override to access server-specific property + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure Send(aLine: TncLine; const aBuf; aBufSize: Integer); overload; inline; + procedure Send(aLine: TncLine; const aBytes: TBytes); overload; inline; + procedure Send(aLine: TncLine; const aStr: string); overload; inline; + procedure ShutDownLine(aLine: TncLine); + property Lines: TThreadLineList read GetLines; + published + // Inherited properties from TncSocketBase + property Active; + property Port; + property ReaderThreadPriority; + property NoDelay; + property KeepAlive; + property Family; + property ReadBufferLen; + property UseReaderThread; + property UseTLS; + property TlsProvider; + property CertificateFile; + property IgnoreCertificateErrors; + property PrivateKeyPassword; + property DataProcessorThreadPriority; + property DataProcessorThreads; + property DataProcessorThreadsPerCPU; + property DataProcessorThreadsGrowUpto; + property EventsUseMainThread; + property OnConnected; + property OnDisconnected; + property OnReadData; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncTCPClientThd + // Client component providing raw socket functionality with thread pool processing + + TncTCPClientThd = class(TncSocketBase) + private + FOnReconnected: TncOnServerReconnected; + function GetHost: string; + procedure SetHost(const Value: string); + function GetReconnect: Boolean; + procedure SetReconnect(const Value: Boolean); + function GetReconnectInterval: Cardinal; + procedure SetReconnectInterval(const Value: Cardinal); + function GetLine: TncLine; + protected + function GetReaderThreadPriority: TncThreadPriority; // Override to access client-specific property + procedure SetReaderThreadPriority(const Value: TncThreadPriority); // Override to access client-specific property + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure Send(const aBuf; aBufSize: Integer); overload; inline; + procedure Send(const aBytes: TBytes); overload; inline; + procedure Send(const aStr: string); overload; inline; + function Receive(aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(var aBytes: TBytes): Integer; inline; + + property Line: TncLine read GetLine; + published + // Inherited properties from TncSocketBase + property Active; + property Port; + property ReaderThreadPriority; + property NoDelay; + property KeepAlive; + property Family; + property ReadBufferLen; + property UseReaderThread; + property UseTLS; + property TlsProvider; + property CertificateFile; + property IgnoreCertificateErrors; + property PrivateKeyPassword; + property DataProcessorThreadPriority; + property DataProcessorThreads; + property DataProcessorThreadsPerCPU; + property DataProcessorThreadsGrowUpto; + property EventsUseMainThread; + property OnConnected; + property OnDisconnected; + property OnReadData; + + // Client-specific properties + property Host: string read GetHost write SetHost; + property Reconnect: Boolean read GetReconnect write SetReconnect default True; + property ReconnectInterval: Cardinal read GetReconnectInterval write SetReconnectInterval default DefCntReconnectInterval; + property OnReconnected: TncOnServerReconnected read FOnReconnected write FOnReconnected; + end; + +implementation + +uses + System.TypInfo; + +type + // Friend class declarations to access protected members + TncLineInternal = class(TncLine); + TncTCPBaseInternal = class(TncTCPBase); + TncCustomTCPServerInternal = class(TncCustomTCPServer); + TncTCPServerInternal = class(TncTCPServer); + +{ TncDataProcessingThread } + +procedure TDataProcessingThread.CallOnReadDataEvent; +begin + if Assigned(OnReadData) then + try + OnReadData(Server, Line, Buffer, BufferCount); + except + // Swallow exceptions to prevent thread termination + end; +end; + +procedure TDataProcessingThread.ProcessEvent; +begin + if Server.EventsUseMainThread then + Synchronize(CallOnReadDataEvent) + else + CallOnReadDataEvent; +end; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncSocketBase } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncSocketBase.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TCriticalSection.Create; + + Socket := nil; + WasSetActive := False; + WithinConnectionHandler := False; + + FDataProcessorThreadPriority := DefDataProcessorThreadPriority; + FDataProcessorThreads := DefDataProcessorThreads; + FDataProcessorThreadsPerCPU := DefDataProcessorThreadsPerCPU; + FDataProcessorThreadsGrowUpto := DefDataProcessorThreadsGrowUpto; + FEventsUseMainThread := DefServerEventsUseMainThread; + + FOnConnected := nil; + FOnDisconnected := nil; + FOnReconnected := nil; + FOnReadData := nil; + + DataProcessorThreadPool := TncThreadPool.Create(TDataProcessingThread); +end; + +destructor TncSocketBase.Destroy; +begin + DataProcessorThreadPool.Free; + PropertyLock.Free; + inherited Destroy; +end; + +function TncSocketBase.GetThreadPoolThreadCount: Integer; +begin + Result := DataProcessorThreadPool.GetThreadCount; +end; + +function TncSocketBase.GetThreadPoolActiveThreadCount: Integer; +begin + Result := DataProcessorThreadPool.GetActiveThreadCount; +end; + +procedure TncSocketBase.Loaded; +begin + inherited Loaded; + + DataProcessorThreadPool.SetThreadPriority(FDataProcessorThreadPriority); + DataProcessorThreadPool.SetExecThreads( + Max(1, Max(FDataProcessorThreads, GetNumberOfProcessors * FDataProcessorThreadsPerCPU)), + FDataProcessorThreadPriority); + + if WasSetActive then + Socket.Active := True; +end; + +procedure TncSocketBase.CallConnectedEvents; +begin + WithinConnectionHandler := True; + try + if Assigned(OnConnected) then + OnConnected(Self, LastConnectedLine); + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSocketBase.SocketConnected(Sender: TObject; aLine: TncLine); +begin + LastConnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallConnectedEvents) + else + CallConnectedEvents; +end; + +procedure TncSocketBase.CallDisconnectedEvents; +begin + WithinConnectionHandler := True; + try + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, LastDisconnectedLine); + except + end; + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSocketBase.SocketDisconnected(Sender: TObject; aLine: TncLine); +begin + LastDisconnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallDisconnectedEvents) + else + CallDisconnectedEvents; +end; + +procedure TncSocketBase.CallReconnectedEvents; +begin + WithinConnectionHandler := True; + try + if Assigned(TncTCPClientThd(Self).OnReconnected) then + try + TncTCPClientThd(Self).OnReconnected(Self, LastReconnectedLine); + except + end; + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSocketBase.SocketReconnected(Sender: TObject; aLine: TncLine); +begin + LastReconnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallReconnectedEvents) + else + CallReconnectedEvents; +end; + +// This is the key method - it queues raw data processing to the thread pool +procedure TncSocketBase.SocketReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); +var + DataProcessingThread: TDataProcessingThread; +begin + // The base socket handles TLS handshake internally and only fires OnReadData for application data + // So we can safely queue all data to the thread pool + if Assigned(OnReadData) then + begin + DataProcessorThreadPool.Serialiser.Acquire; + try + DataProcessingThread := TDataProcessingThread(DataProcessorThreadPool.RequestReadyThread); + DataProcessingThread.OnReadData := OnReadData; + DataProcessingThread.Server := Self; + DataProcessingThread.Line := aLine; + DataProcessingThread.Buffer := Copy(aBuf, 0, aBufCount); // Copy the buffer to avoid race conditions + DataProcessingThread.BufferCount := aBufCount; + DataProcessorThreadPool.RunRequestedThread(DataProcessingThread); + finally + DataProcessorThreadPool.Serialiser.Release; + end; + end; +end; + +// Socket property delegation methods +function TncSocketBase.GetActive: Boolean; +begin + Result := Socket.Active; +end; + +procedure TncSocketBase.SetActive(const Value: Boolean); +begin + if csLoading in ComponentState then + WasSetActive := Value + else + Socket.Active := Value; +end; + +function TncSocketBase.GetFamily: TAddressType; +begin + Result := Socket.Family; +end; + +procedure TncSocketBase.SetFamily(const Value: TAddressType); +begin + Socket.Family := Value; +end; + +function TncSocketBase.GetKeepAlive: Boolean; +begin + Result := Socket.KeepAlive; +end; + +procedure TncSocketBase.SetKeepAlive(const Value: Boolean); +begin + Socket.KeepAlive := Value; +end; + +function TncSocketBase.GetNoDelay: Boolean; +begin + Result := Socket.NoDelay; +end; + +procedure TncSocketBase.SetNoDelay(const Value: Boolean); +begin + Socket.NoDelay := Value; +end; + +function TncSocketBase.GetPort: Integer; +begin + Result := Socket.Port; +end; + +procedure TncSocketBase.SetPort(const Value: Integer); +begin + Socket.Port := Value; +end; + +function TncSocketBase.GetReaderThreadPriority: TncThreadPriority; +begin + Result := Socket.ReaderThreadPriority; +end; + +procedure TncSocketBase.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + Socket.ReaderThreadPriority := Value; +end; + +function TncSocketBase.GetReadBufferLen: Integer; +begin + Result := Socket.ReadBufferLen; +end; + +procedure TncSocketBase.SetReadBufferLen(const Value: Integer); +begin + Socket.ReadBufferLen := Value; +end; + +function TncSocketBase.GetUseReaderThread: Boolean; +begin + Result := Socket.UseReaderThread; +end; + +procedure TncSocketBase.SetUseReaderThread(const Value: Boolean); +begin + Socket.UseReaderThread := Value; +end; + +function TncSocketBase.GetUseTLS: Boolean; +begin + Result := Socket.UseTLS; +end; + +procedure TncSocketBase.SetUseTLS(const Value: Boolean); +begin + Socket.UseTLS := Value; + + // Set up TLS handshake callback if Line objects already exist + // The underlying ncSockets components will handle TLS setup during Line creation + if Value then + begin + if Socket is TncTCPClient then + begin + var Client := TncTCPClient(Socket); + if Client.Line <> nil then + begin + TncLineInternal(Client.Line).OnBeforeConnected := TLSHandshakeWrapper; + end; + // If Line doesn't exist yet, it will be set up automatically when Line is created + end + else if Socket is TncTCPServer then + begin + var Server := TncTCPServer(Socket); + if TncTCPServerInternal(Server).Listener <> nil then + begin + TncLineInternal(TncTCPServerInternal(Server).Listener).OnBeforeConnected := TLSHandshakeWrapper; + end; + end; + end; +end; + +function TncSocketBase.GetTlsProvider: TncTlsProvider; +begin + Result := Socket.TlsProvider; +end; + +procedure TncSocketBase.SetTlsProvider(const Value: TncTlsProvider); +begin + Socket.TlsProvider := Value; +end; + +function TncSocketBase.GetCertificateFile: string; +begin + Result := Socket.CertificateFile; +end; + +procedure TncSocketBase.SetCertificateFile(const Value: string); +begin + Socket.CertificateFile := Value; +end; + +function TncSocketBase.GetIgnoreCertificateErrors: Boolean; +begin + Result := Socket.IgnoreCertificateErrors; +end; + +procedure TncSocketBase.SetIgnoreCertificateErrors(const Value: Boolean); +begin + Socket.IgnoreCertificateErrors := Value; +end; + +function TncSocketBase.GetPrivateKeyPassword: string; +begin + Result := Socket.PrivateKeyPassword; +end; + +procedure TncSocketBase.SetPrivateKeyPassword(const Value: string); +begin + Socket.PrivateKeyPassword := Value; +end; + +// Thread pool property methods +function TncSocketBase.GetDataProcessorThreadPriority: TncThreadPriority; +begin + PropertyLock.Acquire; + try + Result := FDataProcessorThreadPriority; + finally + PropertyLock.Release; + end; +end; + +procedure TncSocketBase.SetDataProcessorThreadPriority(const Value: TncThreadPriority); +begin + PropertyLock.Acquire; + try + FDataProcessorThreadPriority := Value; + if not (csLoading in ComponentState) then + DataProcessorThreadPool.SetThreadPriority(Value); + finally + PropertyLock.Release; + end; +end; + +function TncSocketBase.GetDataProcessorThreads: Integer; +begin + PropertyLock.Acquire; + try + Result := FDataProcessorThreads; + finally + PropertyLock.Release; + end; +end; + +procedure TncSocketBase.SetDataProcessorThreads(const Value: Integer); +begin + PropertyLock.Acquire; + try + FDataProcessorThreads := Value; + if Value <> 0 then + FDataProcessorThreadsPerCPU := 0; + + if not (csLoading in ComponentState) then + DataProcessorThreadPool.SetExecThreads( + Max(1, Max(FDataProcessorThreads, GetNumberOfProcessors * FDataProcessorThreadsPerCPU)), + FDataProcessorThreadPriority); + finally + PropertyLock.Release; + end; +end; + +function TncSocketBase.GetDataProcessorThreadsPerCPU: Integer; +begin + PropertyLock.Acquire; + try + Result := FDataProcessorThreadsPerCPU; + finally + PropertyLock.Release; + end; +end; + +procedure TncSocketBase.SetDataProcessorThreadsPerCPU(const Value: Integer); +begin + PropertyLock.Acquire; + try + FDataProcessorThreadsPerCPU := Value; + if Value <> 0 then + FDataProcessorThreads := 0; + + if not (csLoading in ComponentState) then + DataProcessorThreadPool.SetExecThreads( + Max(1, Max(FDataProcessorThreads, GetNumberOfProcessors * FDataProcessorThreadsPerCPU)), + FDataProcessorThreadPriority); + finally + PropertyLock.Release; + end; +end; + +function TncSocketBase.GetDataProcessorThreadsGrowUpto: Integer; +begin + PropertyLock.Acquire; + try + Result := FDataProcessorThreadsGrowUpto; + finally + PropertyLock.Release; + end; +end; + +procedure TncSocketBase.SetDataProcessorThreadsGrowUpto(const Value: Integer); +begin + PropertyLock.Acquire; + try + FDataProcessorThreadsGrowUpto := Value; + if not (csLoading in ComponentState) then + DataProcessorThreadPool.GrowUpto := Value; + finally + PropertyLock.Release; + end; +end; + +function TncSocketBase.GetEventsUseMainThread: Boolean; +begin + PropertyLock.Acquire; + try + Result := FEventsUseMainThread; + finally + PropertyLock.Release; + end; +end; + +procedure TncSocketBase.SetEventsUseMainThread(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FEventsUseMainThread := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncSocketBase.TLSHandshakeWrapper(aLine: TncLine); +begin + TncTCPBaseInternal(Socket).HandleTLSHandshake(aLine); +end; + + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTCPServerThd } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTCPServerThd.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + // Create the underlying TCP server socket + Socket := TncTCPServer.Create(Self); + Socket.Family := afIPv4; + Socket.Port := DefPort; + Socket.NoDelay := DefNoDelay; + Socket.EventsUseMainThread := False; + Socket.OnConnected := SocketConnected; + Socket.OnDisconnected := SocketDisconnected; + Socket.OnReadData := SocketReadData; +end; + +destructor TncTCPServerThd.Destroy; +begin + Socket.Free; + inherited Destroy; +end; + +function TncTCPServerThd.GetLines: TThreadLineList; +begin + Result := TncTCPServer(Socket).Lines; +end; + +procedure TncTCPServerThd.Send(aLine: TncLine; const aBuf; aBufSize: Integer); +begin + TncTCPServer(Socket).Send(aLine, aBuf, aBufSize); +end; + +procedure TncTCPServerThd.Send(aLine: TncLine; const aBytes: TBytes); +begin + TncTCPServer(Socket).Send(aLine, aBytes); +end; + +procedure TncTCPServerThd.Send(aLine: TncLine; const aStr: string); +begin + TncTCPServer(Socket).Send(aLine, aStr); +end; + +procedure TncTCPServerThd.ShutDownLine(aLine: TncLine); +begin + TncTCPServer(Socket).ShutDownLine(aLine); +end; + +// Override to access server-specific property +function TncTCPServerThd.GetReaderThreadPriority: TncThreadPriority; +begin + Result := TncTCPServer(Socket).ReaderThreadPriority; +end; + +procedure TncTCPServerThd.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TncTCPServer(Socket).ReaderThreadPriority := Value; +end; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTCPClientThd } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTCPClientThd.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Socket := TncTCPClient.Create(Self); + Socket.Family := afIPv4; + Socket.Port := DefPort; + Socket.NoDelay := DefNoDelay; + Socket.EventsUseMainThread := False; + Socket.OnConnected := SocketConnected; + Socket.OnDisconnected := SocketDisconnected; + Socket.OnReadData := SocketReadData; + TncTCPClient(Socket).OnReconnected := SocketReconnected; +end; + +destructor TncTCPClientThd.Destroy; +begin + Socket.Free; + inherited Destroy; +end; + +function TncTCPClientThd.GetLine: TncLine; +begin + Result := TncTCPClient(Socket).Line; +end; + +procedure TncTCPClientThd.Send(const aBuf; aBufSize: Integer); +begin + TncTCPClient(Socket).Send(aBuf, aBufSize); +end; + +procedure TncTCPClientThd.Send(const aBytes: TBytes); +begin + TncTCPClient(Socket).Send(aBytes); +end; + +procedure TncTCPClientThd.Send(const aStr: string); +begin + TncTCPClient(Socket).Send(aStr); +end; + +function TncTCPClientThd.Receive(aTimeout: Cardinal = 2000): TBytes; +begin + Result := TncTCPClient(Socket).Receive(aTimeout); +end; + +function TncTCPClientThd.ReceiveRaw(var aBytes: TBytes): Integer; +begin + Result := TncTCPClient(Socket).ReceiveRaw(aBytes); +end; + +function TncTCPClientThd.GetHost: string; +begin + Result := TncTCPClient(Socket).Host; +end; + +procedure TncTCPClientThd.SetHost(const Value: string); +begin + TncTCPClient(Socket).Host := Value; +end; + +function TncTCPClientThd.GetReconnect: Boolean; +begin + Result := TncTCPClient(Socket).Reconnect; +end; + +procedure TncTCPClientThd.SetReconnect(const Value: Boolean); +begin + TncTCPClient(Socket).Reconnect := Value; +end; + +function TncTCPClientThd.GetReconnectInterval: Cardinal; +begin + Result := TncTCPClient(Socket).ReconnectInterval; +end; + +procedure TncTCPClientThd.SetReconnectInterval(const Value: Cardinal); +begin + TncTCPClient(Socket).ReconnectInterval := Value; +end; + +// Override to access client-specific property +function TncTCPClientThd.GetReaderThreadPriority: TncThreadPriority; +begin + Result := TncTCPClient(Socket).ReaderThreadPriority; +end; + +procedure TncTCPClientThd.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TncTCPClient(Socket).ReaderThreadPriority := Value; +end; + +end. diff --git a/Source/ncSources.pas b/Source/ncSources.pas index 4029540..54a71a7 100644 --- a/Source/ncSources.pas +++ b/Source/ncSources.pas @@ -25,6 +25,10 @@ // These components have built in encryption and compression, set by the // corresponding properties. // +// 14/01/2025 - by J.Pauwels +// - Explicitly set this unit to use TCP +// - Added IPV6 support +// // 12/8/2020 // - Complete re-engineering of the base component // @@ -184,6 +188,9 @@ TncSourceBase = class(TComponent, IncCommandHandler) function GetReaderThreadPriority: TncThreadPriority; procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + // For implementing the IncCommandHandler interface function GetComponentName: string; function GetOnConnected: TncOnSourceConnectDisconnect; @@ -264,6 +271,7 @@ TncSourceBase = class(TComponent, IncCommandHandler) property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; property NoDelay: Boolean read GetNoDelay write SetNoDelay default True; property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default True; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; // New properties for sources property CommandProcessorThreadPriority: TncThreadPriority read GetCommandProcessorThreadPriority write SetCommandProcessorThreadPriority @@ -365,6 +373,7 @@ constructor TncSourceLine.Create; function TncSourceLine.CreateLineObject: TncLine; begin Result := TncSourceLine.Create; // Create its own kind of objects + TncSourceLine(Result).SetKind(stTCP); // Explicitly set to TCP end; // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -865,6 +874,16 @@ procedure TncSourceBase.SetActive(const Value: Boolean); Socket.Active := Value; end; +function TncSourceBase.GetFamily: TAddressType; +begin + Result := Socket.Family; +end; + +procedure TncSourceBase.SetFamily(const Value: TAddressType); +begin + Socket.Family := Value; +end; + function TncSourceBase.GetKeepAlive: Boolean; begin Result := Socket.KeepAlive; @@ -1259,6 +1278,7 @@ TncTCPClientSourceSocket = class(TncTCPClient) function TncTCPClientSourceSocket.CreateLineObject: TncLine; begin Result := TncSourceLine.Create; + TncSourceLine(Result).SetKind(stTCP); end; constructor TncClientSource.Create(AOwner: TComponent); @@ -1268,6 +1288,7 @@ constructor TncClientSource.Create(AOwner: TComponent); FOnReconnected := nil; Socket := TncTCPClientSourceSocket.Create(nil); + Socket.Family := afIPv4; // Set default family Socket.Port := DefPort; Socket.NoDelay := DefNoDelay; Socket.EventsUseMainThread := False; @@ -1351,6 +1372,7 @@ TncTCPServerSourceSocket = class(TncTCPServer) function TncTCPServerSourceSocket.CreateLineObject: TncLine; begin Result := TncSourceLine.Create; + TncSourceLine(Result).SetKind(stTCP); end; constructor TncServerSource.Create(AOwner: TComponent); @@ -1358,6 +1380,7 @@ constructor TncServerSource.Create(AOwner: TComponent); inherited Create(AOwner); Socket := TncTCPServerSourceSocket.Create(nil); + Socket.Family := afIPv4; // Set default family Socket.NoDelay := DefNoDelay; Socket.Port := DefPort; Socket.EventsUseMainThread := False; @@ -1383,3 +1406,4 @@ procedure TncServerSource.ShutDownLine(aLine: TncLine); end; end. + diff --git a/Source/ncThreads.pas b/Source/ncThreads.pas index e733b5c..160b4c5 100644 --- a/Source/ncThreads.pas +++ b/Source/ncThreads.pas @@ -71,6 +71,9 @@ TncThreadPool = class procedure SetExecThreads(aThreadCount: Integer; aThreadPriority: TncThreadPriority); procedure SetThreadPriority(aPriority: TncThreadPriority); + + function GetThreadCount: Integer; + function GetActiveThreadCount: Integer; property GrowUpto: Integer read GetGrowUpto write SetGrowUpto; end; @@ -413,4 +416,31 @@ procedure TncThreadPool.SetGrowUpto(const Value: Integer); end; end; +function TncThreadPool.GetThreadCount: Integer; +begin + Serialiser.Acquire; + try + Result := Length(Threads); + finally + Serialiser.Release; + end; +end; + +function TncThreadPool.GetActiveThreadCount: Integer; +var + i: Integer; +begin + Serialiser.Acquire; + try + Result := 0; + for i := 0 to High(Threads) do + begin + if Assigned(Threads[i]) and (Threads[i].ReadyEvent.WaitFor(0) <> wrSignaled) then + Inc(Result); + end; + finally + Serialiser.Release; + end; +end; + end. diff --git a/Source/ncUDPSockets.pas b/Source/ncUDPSockets.pas new file mode 100644 index 0000000..e7d8b75 --- /dev/null +++ b/Source/ncUDPSockets.pas @@ -0,0 +1,1098 @@ +unit ncUDPSockets; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - UDP Socket Components +// +// This unit implements UDP Server and UDP Client components +// +// 14/1/2025 +// - Initial creation +// Currently implemented : +// - Broadcast +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, + ncLines, ncSocketList, ncThreads, ncIPUtils; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 64 * 1024; // 64KB default for UDP + DefReaderThreadPriority = ntpNormal; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefBroadcast = False; + DefFamily = afIPv4; + +resourcestring + ECannotSetPortWhileSocketActiveStr = 'Cannot set Port property while socket is active'; + ECannotSetHostWhileSocketActiveStr = 'Cannot set Host property while socket is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileSocketActiveStr = 'Cannot set UseReaderThread property while socket is active'; + ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnReadDatagram event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; +type + EPropertySetError = class(Exception); + + // Event types for UDP + TncOnDatagramEvent = procedure(Sender: TObject; aLine: TncLine;const aBuf: TBytes; aBufCount: Integer;const SenderAddr: TSockAddrStorage) of object; + + + // Base UDP Socket class + TncUDPBase = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FBroadcast: Boolean; + FLine: TncLine; + FReadBufferLen: Integer; + FOnReadDatagram: TncOnDatagramEvent; + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetBroadcast: Boolean; + procedure SetBroadcast(const Value: Boolean); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock: TCriticalSection; + ReadBuf: TBytes; + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetLine: TncLine; virtual; abstract; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property Broadcast: Boolean read GetBroadcast write SetBroadcast default DefBroadcast; + property OnReadDatagram: TncOnDatagramEvent read FOnReadDatagram write FOnReadDatagram; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + published + end; + + // UDP Client implementation + TncUDPClientProcessor = class; + + TncCustomUDPClient = class(TncUDPBase) + private + FHost: string; + function GetActive: Boolean; override; + procedure SetHost(const Value: string); + function GetHost: string; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + procedure Send(const aBuf; aBufSize: Integer); overload; + procedure Send(const aBytes: TBytes); overload; + procedure Send(const aStr: string); overload; + function Receive(aTimeout: Cardinal = 2000): TBytes; + property Host: string read GetHost write SetHost; + end; + + TncUDPClient = class(TncCustomUDPClient) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + end; + + TncUDPClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomUDPClient; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomUDPClient); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // UDP Server implementation + TncUDPServerProcessor = class; + + TncCustomUDPServer = class(TncUDPBase) + private + function GetActive: Boolean; override; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + function Receive(aTimeout: Cardinal = 2000): TBytes; + end; + + TncUDPServer = class(TncCustomUDPServer) + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + end; + + TncUDPServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomUDPServer; + public + ReadySockets: TSocketHandleArray; + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomUDPServer); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + +implementation + +{ TncUDPBase } + +constructor TncUDPBase.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TCriticalSection.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FBroadcast := DefBroadcast; + FReadBufferLen := DefReadBufferLen; + FOnReadDatagram := nil; + + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncUDPBase.Kind: TSocketType; +begin + Result := stUDP; +end; + +destructor TncUDPBase.Destroy; +begin + PropertyLock.Free; + inherited Destroy; +end; + +procedure TncUDPBase.Loaded; +begin + inherited Loaded; + if FInitActive then + DoActivate(True); +end; + +function TncUDPBase.CreateLineObject: TncLine; +begin + Result := TncLine.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); +end; + +procedure TncUDPBase.SetActive(const Value: Boolean); +begin + PropertyLock.Acquire; + try + if not(csLoading in ComponentState) then + DoActivate(Value); + FInitActive := GetActive; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBase.GetFamily: TAddressType; +begin + PropertyLock.Acquire; + try + Result := FFamily; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBase.SetFamily(const Value: TAddressType); +begin + if not(csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create + (ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + PropertyLock.Acquire; + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBase.GetPort: Integer; +begin + PropertyLock.Acquire; + try + Result := FPort; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBase.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FPort := Value; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBase.GetReaderThreadPriority: TncThreadPriority; +begin + PropertyLock.Acquire; + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBase.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + PropertyLock.Acquire; + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBase.GetBroadcast: Boolean; +begin + PropertyLock.Acquire; + try + Result := FBroadcast; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBase.SetBroadcast(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FBroadcast := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBase.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FUseReaderThread := Value; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBase.GetReadBufferLen: Integer; +begin + PropertyLock.Acquire; + try + Result := FReadBufferLen; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBase.SetReadBufferLen(const Value: Integer); +begin + PropertyLock.Acquire; + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + PropertyLock.Release; + end; +end; + +{ TncCustomUDPClient } + +constructor TncCustomUDPClient.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FHost := DefHost; + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPClientProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPClient.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPClient.GetLine: TncLine; +begin + Result := Line; +end; + +procedure TncCustomUDPClient.DoActivate(aActivate: Boolean); +begin + // Exit if socket is already in requested state + if aActivate = GetActive then + Exit; + + if aActivate then + begin + try + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // Create socket handle and establish connection + TncLineInternal(Line).CreateClientHandle(FHost, FPort, GetBroadcast); + + // Enable broadcast mode if requested + if GetBroadcast then + TncLineInternal(Line).EnableBroadcast; + + // Configure socket buffer sizes for optimal performance + try + TncLineInternal(Line).SetReceiveSize(GetReadBufferLen); + TncLineInternal(Line).SetWriteSize(GetReadBufferLen); + except + on E: Exception do + begin + TncLineInternal(Line).DestroyHandle; + raise; + end; + end; + + // Initialize socket handle array for reading + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + // Start reader thread if enabled + if UseReaderThread then + LineProcessor.Run; + except + on E: Exception do + begin + // Clean up on activation failure + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + raise; + end; + end; + end + else + begin + // Clean up when deactivating + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +function TncCustomUDPClient.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomUDPClient.GetHost: string; +begin + PropertyLock.Acquire; + try + Result := FHost; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomUDPClient.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FHost := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomUDPClient.Send(const aBuf; aBufSize: Integer); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + case Family of + afIPv4: + begin + if GetBroadcast then + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(FPort); + + // Use Winsock API directly for IPv4 broadcast + var addr := inet_addr(PAnsiChar(AnsiString(FHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendTo(aBuf, aBufSize, storage); + end + else + TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + end; + + afIPv6: + begin + if GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.') + else if FHost = '' then + raise Exception.Create('Host address cannot be empty for IPv6') + else + begin + // Validate IPv6 address format + if not TncIPUtils.IsIPv6ValidAddress(FHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(FPort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(FHost) then + begin + var scopePos := Pos('%', FHost); + if scopePos > 0 then + begin + var hostAddr := Copy(FHost, 1, scopePos - 1); + var scope := Copy(FHost, scopePos + 1, Length(FHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + // Convert the address part without scope ID + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendTo(aBuf, aBufSize, storage); + end; + end; + end; +end; + +procedure TncCustomUDPClient.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomUDPClient.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPClient.SendTo(const aBuf; aBufSize: Integer; + const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPClient.SendTo(const aBytes: TBytes; + const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPClient.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPClient.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPClientProcessor } + +constructor TncUDPClientProcessor.Create(aClientSocket: TncCustomUDPClient); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncUDPClientProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; +begin + // Initialize sender address structure + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + // Receive datagram with proper address structure + BufRead := recvfrom(FClientSocket.Line.Handle, + FClientSocket.ReadBuf[0], + Length(FClientSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if (BufRead > 0) and Assigned(FClientSocket.OnReadDatagram) then + try + FClientSocket.OnReadDatagram(FClientSocket, + FClientSocket.Line, + FClientSocket.ReadBuf, + BufRead, + SenderAddr); + except + end; +end; + +procedure TncUDPClientProcessor.ProcessEvent; +begin + while (not Terminated) do + try + if FClientSocket.Line.Active then + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(ProcessDatagram) + else + ProcessDatagram; + end; + end + else + Exit; + except + // Continue processing even after errors + end; +end; + +{ TncCustomUDPServer } + +constructor TncCustomUDPServer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPServerProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPServer.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPServer.GetLine: TncLine; +begin + Result := Line; +end; + +function TncCustomUDPServer.GetActive: Boolean; +begin + Result := Line.Active; +end; + +procedure TncCustomUDPServer.DoActivate(aActivate: Boolean); +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // CreateServerHandle will bind to all interfaces (0.0.0.0) + // through the AI_PASSIVE flag in ncLines.CreateServerHandle + TncLineInternal(Line).CreateServerHandle(FPort); + + // Enable broadcast if needed + if Broadcast then + TncLineInternal(Line).EnableBroadcast; + + // Set socket buffer sizes for better performance + try + TncLineInternal(Line).SetReceiveSize(ReadBufferLen); + TncLineInternal(Line).SetWriteSize(ReadBufferLen); + except + // Ignore buffer size errors + end; + + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPServer.SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPServer.SendTo(const aBytes: TBytes; const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPServer.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPServer.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPServerProcessor } + +constructor TncUDPServerProcessor.Create(aServerSocket: TncCustomUDPServer); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + + +procedure TncUDPServerProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; +begin + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(FServerSocket.Line.Handle, + FServerSocket.ReadBuf[0], + Length(FServerSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if (BufRead > 0) and Assigned(FServerSocket.OnReadDatagram) then + try + FServerSocket.OnReadDatagram(FServerSocket, FServerSocket.Line, + FServerSocket.ReadBuf, BufRead, SenderAddr); + except + end; +end; + +procedure TncUDPServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + Synchronize(ProcessDatagram); + end; + except + end + else + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + ProcessDatagram; + end; + except + end; +end; + +end. + diff --git a/Source/ncUDPSocketsDual.pas b/Source/ncUDPSocketsDual.pas new file mode 100644 index 0000000..c2dad67 --- /dev/null +++ b/Source/ncUDPSocketsDual.pas @@ -0,0 +1,1996 @@ +unit ncUDPSocketsDual; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - UDP Socket Components (Dual Mode - Raw + Protocol) +// +// This unit implements UDP Server and UDP Client components with both +// raw UDP support and lightweight command protocol support +// +// 23/07/2025 +// - Lightweight Command Protocol (LCP) +// - Auto-chunking for large data +// 14/1/2025 +// - Initial creation +// Currently implemented : +// - Broadcast +// - Raw UDP communication +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, System.DateUtils, + ncLines, ncSocketList, ncThreads, ncIPUtils, System.Generics.Collections; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 64 * 1024; // 64KB default for UDP + DefReaderThreadPriority = ntpNormal; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefBroadcast = False; + DefFamily = afIPv4; + + // UDP Performance constants + UDP_COMMAND_MAGIC = $4E43; // 'NC' + UDP_CHUNK_MAGIC = $4E44; // 'ND' signature for chunk packets + UDP_MAX_SAFE_PAYLOAD = 1392; // Optimal MTU (avoids fragmentation) + UDP_CHUNK_TIMEOUT = 5000; // 5 seconds timeout for incomplete transfers + +type + // UDP Command Header Structure + TUdpCommandHeader = packed record + Cmd: Integer; // Command ID (matches ncSocketsPro) + Flags: Byte; // Command flags for future extensibility + Sequence: UInt16; // Sequence number for tracking/ordering + end; + + // Complete UDP Command Packet Structure + TUdpCommandPacket = packed record + Magic: UInt16; // Protocol detection signature + Header: TUdpCommandHeader; // Command header + // Variable data follows after this structure + end; + + // UDP Chunk Header Structure (for auto-chunking large commands) + TUdpChunkHeader = packed record + Magic: UInt16; // Chunk magic signature ($4E44 = 'ND') + TransferID: UInt32; // Unique transfer identifier + ChunkIndex: UInt16; // Current chunk number (0-based) + TotalChunks: UInt16; // Total number of chunks + OriginalCmd: Integer; // Original command ID + OriginalFlags: Byte; // Original command flags + OriginalSequence: UInt16; // Original sequence number + end; + + // Pointer type for zero-copy operations + PUdpChunkHeader = ^TUdpChunkHeader; + + // Chunk reassembly tracking + TChunkTransfer = record + TransferID: UInt32; + OriginalCmd: Integer; + OriginalFlags: Byte; + OriginalSequence: UInt16; + TotalChunks: UInt16; + FragmentsRemaining: UInt16; + LastActivity: TDateTime; + CompleteData: TBytes; // Pre-allocated full buffer + Fragments: array of UInt32; // Bitwise tracking + ActualDataSize: UInt32; // Real size of the complete data (calculated when complete) + LastChunkSize: UInt16; // Size of the last chunk (for accurate total calculation) + + // Helper methods for bitwise operations + function IsFragmentReceived(FragmentIndex: UInt16): Boolean; + procedure SetFragmentReceived(FragmentIndex: UInt16); + end; + + // Chunk transfer manager + TncChunkManager = class + private + FTransfers: TDictionary; // Hash table for O(1) lookup + FLock: TCriticalSection; + function GenerateTransferID: UInt32; + procedure CleanupExpiredTransfers; + public + constructor Create; + destructor Destroy; override; + function StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; + function CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; + function AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; + function CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; + end; + +resourcestring + ECannotSetPortWhileSocketActiveStr = 'Cannot set Port property while socket is active'; + ECannotSetHostWhileSocketActiveStr = 'Cannot set Host property while socket is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileSocketActiveStr = 'Cannot set UseReaderThread property while socket is active'; + ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnReadDatagram event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; +type + EPropertySetError = class(Exception); + + // Event types for UDP + TncOnDatagramEvent = procedure(Sender: TObject; aLine: TncLine;const aBuf: TBytes; aBufCount: Integer;const SenderAddr: TSockAddrStorage) of object; + + // UDP Command Protocol Event + TncOnUDPCommandEvent = procedure(Sender: TObject; aLine: TncLine; const aSenderAddr: TSockAddrStorage; + aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16) of object; + + + // Base UDP Socket class + TncUDPBaseDual = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FBroadcast: Boolean; + FLine: TncLine; + FReadBufferLen: Integer; + FOnReadDatagram: TncOnDatagramEvent; + FOnCommand: TncOnUDPCommandEvent; + FChunkManager: TncChunkManager; // For auto-chunking large commands + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetBroadcast: Boolean; + procedure SetBroadcast(const Value: Boolean); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock: TCriticalSection; + ReadBuf: TBytes; + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetLine: TncLine; virtual; abstract; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property Broadcast: Boolean read GetBroadcast write SetBroadcast default DefBroadcast; + property OnReadDatagram: TncOnDatagramEvent read FOnReadDatagram write FOnReadDatagram; + property OnCommand: TncOnUDPCommandEvent read FOnCommand write FOnCommand; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + published + end; + + // UDP Client implementation + TncUDPClientProcessor = class; + + TncCustomUDPClientDual = class(TncUDPBaseDual) + private + FHost: string; + function GetActive: Boolean; override; + procedure SetHost(const Value: string); + function GetHost: string; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + procedure Send(const aBuf; aBufSize: Integer); overload; + procedure Send(const aBytes: TBytes); overload; + procedure Send(const aStr: string); overload; + + // UDP Command Protocol Methods + procedure SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + property Host: string read GetHost write SetHost; + end; + + TncUDPClientDual = class(TncCustomUDPClientDual) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + property OnCommand; + end; + + TncUDPClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomUDPClientDual; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomUDPClientDual); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // UDP Server implementation + TncUDPServerProcessor = class; + + TncCustomUDPServerDual = class(TncUDPBaseDual) + private + function GetActive: Boolean; override; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + + // UDP Command Protocol Methods + procedure SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + end; + + TncUDPServerDual = class(TncCustomUDPServerDual) + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + property OnCommand; + end; + + TncUDPServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomUDPServerDual; + public + ReadySockets: TSocketHandleArray; + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomUDPServerDual); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + +implementation + +{ TncUDPBaseDual } + +constructor TncUDPBaseDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TCriticalSection.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FBroadcast := DefBroadcast; + FReadBufferLen := DefReadBufferLen; + FOnReadDatagram := nil; + FOnCommand := nil; + FChunkManager := TncChunkManager.Create; // Initialize the chunk manager + + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncUDPBaseDual.Kind: TSocketType; +begin + Result := stUDP; +end; + +destructor TncUDPBaseDual.Destroy; +begin + PropertyLock.Free; + FChunkManager.Free; // Free the chunk manager + inherited Destroy; +end; + +procedure TncUDPBaseDual.Loaded; +begin + inherited Loaded; + if FInitActive then + DoActivate(True); +end; + +function TncUDPBaseDual.CreateLineObject: TncLine; +begin + Result := TncLine.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); +end; + +procedure TncUDPBaseDual.SetActive(const Value: Boolean); +begin + PropertyLock.Acquire; + try + if not(csLoading in ComponentState) then + DoActivate(Value); + FInitActive := GetActive; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseDual.GetFamily: TAddressType; +begin + PropertyLock.Acquire; + try + Result := FFamily; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseDual.SetFamily(const Value: TAddressType); +begin + if not(csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create + (ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + PropertyLock.Acquire; + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseDual.GetPort: Integer; +begin + PropertyLock.Acquire; + try + Result := FPort; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseDual.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FPort := Value; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseDual.GetReaderThreadPriority: TncThreadPriority; +begin + PropertyLock.Acquire; + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseDual.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + PropertyLock.Acquire; + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseDual.GetBroadcast: Boolean; +begin + PropertyLock.Acquire; + try + Result := FBroadcast; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseDual.SetBroadcast(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FBroadcast := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseDual.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FUseReaderThread := Value; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseDual.GetReadBufferLen: Integer; +begin + PropertyLock.Acquire; + try + Result := FReadBufferLen; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseDual.SetReadBufferLen(const Value: Integer); +begin + PropertyLock.Acquire; + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + PropertyLock.Release; + end; +end; + +{ TncCustomUDPClientDual } + +constructor TncCustomUDPClientDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FHost := DefHost; + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPClientProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPClientDual.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPClientDual.GetLine: TncLine; +begin + Result := Line; +end; + +procedure TncCustomUDPClientDual.DoActivate(aActivate: Boolean); +begin + // Exit if socket is already in requested state + if aActivate = GetActive then + Exit; + + if aActivate then + begin + try + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // Create socket handle and establish connection + TncLineInternal(Line).CreateClientHandle(FHost, FPort, GetBroadcast); + + // Enable broadcast mode if requested + if GetBroadcast then + TncLineInternal(Line).EnableBroadcast; + + // Configure socket buffer sizes for optimal performance + try + TncLineInternal(Line).SetReceiveSize(GetReadBufferLen); + TncLineInternal(Line).SetWriteSize(GetReadBufferLen); + except + on E: Exception do + begin + TncLineInternal(Line).DestroyHandle; + raise; + end; + end; + + // Initialize socket handle array for reading + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + // Start reader thread if enabled + if UseReaderThread then + LineProcessor.Run; + except + on E: Exception do + begin + // Clean up on activation failure + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + raise; + end; + end; + end + else + begin + // Clean up when deactivating + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +function TncCustomUDPClientDual.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomUDPClientDual.GetHost: string; +begin + PropertyLock.Acquire; + try + Result := FHost; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomUDPClientDual.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FHost := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomUDPClientDual.Send(const aBuf; aBufSize: Integer); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + case Family of + afIPv4: + begin + if GetBroadcast then + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(FPort); + + // Use Winsock API directly for IPv4 broadcast + var addr := inet_addr(PAnsiChar(AnsiString(FHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendTo(aBuf, aBufSize, storage); + end + else + TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + end; + + afIPv6: + begin + if GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.') + else if FHost = '' then + raise Exception.Create('Host address cannot be empty for IPv6') + else + begin + // Validate IPv6 address format + if not TncIPUtils.IsIPv6ValidAddress(FHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(FPort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(FHost) then + begin + var scopePos := Pos('%', FHost); + if scopePos > 0 then + begin + var hostAddr := Copy(FHost, 1, scopePos - 1); + var scope := Copy(FHost, scopePos + 1, Length(FHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + // Convert the address part without scope ID + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendTo(aBuf, aBufSize, storage); + end; + end; + end; +end; + +procedure TncCustomUDPClientDual.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomUDPClientDual.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +// UDP Command Protocol Methods for TncCustomUDPClientDual + +procedure TncCustomUDPClientDual.SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +begin + SendCommand(FHost, FPort, aCmd, aData, aFlags, aSequence); +end; + +procedure TncCustomUDPClientDual.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // IPv6 broadcast validation + if (Family = afIPv6) and GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Build destination address first (common for both paths) + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end; + end; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, storage); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, storage); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPClientDual.SendTo(const aBuf; aBufSize: Integer; + const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPClientDual.SendTo(const aBytes: TBytes; + const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPClientDual.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPClientDual.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPClientProcessor } + +constructor TncUDPClientProcessor.Create(aClientSocket: TncCustomUDPClientDual); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncUDPClientProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + // Initialize sender address structure + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + // Receive datagram with proper address structure + BufRead := recvfrom(FClientSocket.Line.Handle, + FClientSocket.ReadBuf[0], + Length(FClientSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FClientSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FClientSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FClientSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FClientSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FClientSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FClientSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end + else + begin + // =============================================== + // RAW DATA PACKET + // =============================================== + if Assigned(FClientSocket.OnReadDatagram) then + try + FClientSocket.OnReadDatagram(FClientSocket, + FClientSocket.Line, + FClientSocket.ReadBuf, + BufRead, + SenderAddr); + except + end; + end; + end + else + begin + // =============================================== + // TOO SMALL - Raw data + // =============================================== + if Assigned(FClientSocket.OnReadDatagram) then + try + FClientSocket.OnReadDatagram(FClientSocket, + FClientSocket.Line, + FClientSocket.ReadBuf, + BufRead, + SenderAddr); + except + end; + end; + end; +end; + +procedure TncUDPClientProcessor.ProcessEvent; +begin + while (not Terminated) do + try + if FClientSocket.Line.Active then + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(ProcessDatagram) + else + ProcessDatagram; + end; + end + else + Exit; + except + // Continue processing even after errors + end; +end; + +{ TncChunkManager } + +constructor TncChunkManager.Create; +begin + inherited Create; + FLock := TCriticalSection.Create; + FTransfers := TDictionary.Create; +end; + +destructor TncChunkManager.Destroy; +begin + FLock.Free; + FTransfers.Free; + inherited Destroy; +end; + +function TncChunkManager.GenerateTransferID: UInt32; +begin + // Simple transfer ID generation (timestamp + random) + Result := UInt32(GetTickCount) xor UInt32(Random(65536)); +end; + +procedure TncChunkManager.CleanupExpiredTransfers; +var + Now: TDateTime; + TransferID: UInt32; + Transfer: TChunkTransfer; + ExpiredIDs: TArray; + I: Integer; +begin + Now := System.SysUtils.Now; + SetLength(ExpiredIDs, 0); + + // First pass: identify expired transfers + for Transfer in FTransfers.Values do + begin + if MilliSecondsBetween(Now, Transfer.LastActivity) > UDP_CHUNK_TIMEOUT then + begin + SetLength(ExpiredIDs, Length(ExpiredIDs) + 1); + ExpiredIDs[High(ExpiredIDs)] := Transfer.TransferID; + end; + end; + + // Second pass: remove expired transfers + for I := 0 to High(ExpiredIDs) do + FTransfers.Remove(ExpiredIDs[I]); +end; + +function TncChunkManager.StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + FLock.Enter; + try + CleanupExpiredTransfers; + + Transfer.TransferID := GenerateTransferID; + Transfer.OriginalCmd := ACmd; + Transfer.OriginalFlags := AFlags; + Transfer.OriginalSequence := ASequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := AActualDataSize; // Store the actual data size + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate only maximum needed size (not over-allocate) + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := Transfer.TransferID; + finally + FLock.Leave; + end; +end; + +function TncChunkManager.CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + Result := False; + FLock.Enter; + try + // Check if transfer already exists + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + Result := True; // Already exists + Exit; + end; + + // Create new transfer + Transfer.TransferID := ATransferID; + Transfer.OriginalCmd := AOriginalCmd; + Transfer.OriginalFlags := AOriginalFlags; + Transfer.OriginalSequence := AOriginalSequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := 0; // Will be calculated when all chunks received + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate buffer for maximum possible data size + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := True; + finally + FLock.Leave; + end; +end; + +function TncChunkManager.AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; +var + Transfer: TChunkTransfer; + ChunkOffset: Integer; + DataSize: Integer; + MaxChunkSize: Integer; +begin + Result := False; + DataSize := Length(AChunkData); + + // Quick validation before lock + if DataSize = 0 then Exit; + + // Single lock operation only + FLock.Enter; + try + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + // Transfer exists - add chunk + if (AChunkIndex < Transfer.TotalChunks) and (not Transfer.IsFragmentReceived(AChunkIndex)) then + begin + // Calculate offset once and copy directly + MaxChunkSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + ChunkOffset := AChunkIndex * MaxChunkSize; + + // Direct memory operation + if ChunkOffset + DataSize <= Length(Transfer.CompleteData) then + begin + Move(AChunkData[0], Transfer.CompleteData[ChunkOffset], DataSize); + + // Update tracking + Transfer.SetFragmentReceived(AChunkIndex); + Dec(Transfer.FragmentsRemaining); + Transfer.LastActivity := System.SysUtils.Now; + + // Track last chunk size for accurate total calculation + if AChunkIndex = Transfer.TotalChunks - 1 then + Transfer.LastChunkSize := DataSize; + + // If all chunks received, calculate actual data size + if Transfer.FragmentsRemaining = 0 then + Transfer.ActualDataSize := (Transfer.TotalChunks - 1) * MaxChunkSize + Transfer.LastChunkSize; + + // Update the transfer back to dictionary once + FTransfers.AddOrSetValue(ATransferID, Transfer); + Result := True; + end; + end; + end; + finally + FLock.Leave; + end; +end; + +function TncChunkManager.CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; +var + Transfer: TChunkTransfer; +begin + Result := False; + FLock.Enter; + try + if FTransfers.TryGetValue(ATransferID, Transfer) and (Transfer.FragmentsRemaining = 0) then + begin + // All chunks received - prepare output + ACmd := Transfer.OriginalCmd; + AFlags := Transfer.OriginalFlags; + ASequence := Transfer.OriginalSequence; + + // Use the stored actual data size (from sender) + if Transfer.ActualDataSize > 0 then + begin + SetLength(ACompleteData, Transfer.ActualDataSize); + Move(Transfer.CompleteData[0], ACompleteData[0], Transfer.ActualDataSize); + end + else + SetLength(ACompleteData, 0); + + // Remove completed transfer + FTransfers.Remove(ATransferID); + Result := True; + end; + finally + FLock.Leave; + end; +end; + +{ TChunkTransfer - bitwise fragment tracking } + +function TChunkTransfer.IsFragmentReceived(FragmentIndex: UInt16): Boolean; +begin + if FragmentIndex >= TotalChunks then + begin + Result := False; + Exit; + end; + // Bitwise check: (fragments[fragmentNumber / 32] & (1u << (fragmentNumber % 32))) == 0 + Result := (Fragments[FragmentIndex div 32] and (UInt32(1) shl (FragmentIndex mod 32))) <> 0; +end; + +procedure TChunkTransfer.SetFragmentReceived(FragmentIndex: UInt16); +begin + if FragmentIndex < TotalChunks then + // Bitwise set: fragments[fragmentNumber / 32] |= (1u << (fragmentNumber % 32)) + Fragments[FragmentIndex div 32] := Fragments[FragmentIndex div 32] or (UInt32(1) shl (FragmentIndex mod 32)); +end; + +{ TncCustomUDPServerDual } + +constructor TncCustomUDPServerDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPServerProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPServerDual.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPServerDual.GetLine: TncLine; +begin + Result := Line; +end; + +function TncCustomUDPServerDual.GetActive: Boolean; +begin + Result := Line.Active; +end; + +procedure TncCustomUDPServerDual.DoActivate(aActivate: Boolean); +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // CreateServerHandle will bind to all interfaces (0.0.0.0) + // through the AI_PASSIVE flag in ncLines.CreateServerHandle + TncLineInternal(Line).CreateServerHandle(FPort); + + // Enable broadcast if needed + if Broadcast then + TncLineInternal(Line).EnableBroadcast; + + // Set socket buffer sizes for better performance + try + TncLineInternal(Line).SetReceiveSize(ReadBufferLen); + TncLineInternal(Line).SetWriteSize(ReadBufferLen); + except + // Ignore buffer size errors + end; + + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPServerDual.SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPServerDual.SendTo(const aBytes: TBytes; const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPServerDual.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +// UDP Command Protocol Methods for TncCustomUDPServerDual + +procedure TncCustomUDPServerDual.SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, DestAddr); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, DestAddr); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +procedure TncCustomUDPServerDual.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + // IPv6 broadcast validation + if (Family = afIPv6) and Broadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Build destination address based on family + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + end; +end; + +function TncCustomUDPServerDual.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPServerProcessor } + +constructor TncUDPServerProcessor.Create(aServerSocket: TncCustomUDPServerDual); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + + +procedure TncUDPServerProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(FServerSocket.Line.Handle, + FServerSocket.ReadBuf[0], + Length(FServerSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FServerSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FServerSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FServerSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FServerSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FServerSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FServerSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end + else + begin + // =============================================== + // RAW DATA PACKET + // =============================================== + if Assigned(FServerSocket.OnReadDatagram) then + try + FServerSocket.OnReadDatagram(FServerSocket, FServerSocket.Line, + FServerSocket.ReadBuf, BufRead, SenderAddr); + except + end; + end; + end + else + begin + // =============================================== + // TOO SMALL - Raw data + // =============================================== + if Assigned(FServerSocket.OnReadDatagram) then + try + FServerSocket.OnReadDatagram(FServerSocket, FServerSocket.Line, + FServerSocket.ReadBuf, BufRead, SenderAddr); + except + end; + end; + end; +end; + +procedure TncUDPServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + Synchronize(ProcessDatagram); + end; + except + end + else + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + ProcessDatagram; + end; + except + end; +end; + +end. + + + + diff --git a/Source/ncUDPSocketsLCP.pas b/Source/ncUDPSocketsLCP.pas new file mode 100644 index 0000000..d70edc1 --- /dev/null +++ b/Source/ncUDPSocketsLCP.pas @@ -0,0 +1,1942 @@ +unit ncUDPSocketsLCP; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - UDP Socket Components (LCP Only - Protocol Only) +// +// This unit implements UDP Server and UDP Client components with +// lightweight command protocol support ONLY (no raw UDP support) +// +// 23/07/2025 +// - Removed raw UDP support (OnReadData) +// - Protocol-only implementation +// Currently implemented : +// - Broadcast +// - Lightweight Command Protocol (LCP) ONLY +// - Auto-chunking for large data +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, System.DateUtils, + ncLines, ncSocketList, ncThreads, ncIPUtils, System.Generics.Collections; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 64 * 1024; // 64KB default for UDP + DefReaderThreadPriority = ntpNormal; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefBroadcast = False; + DefFamily = afIPv4; + + // UDP Performance constants + UDP_COMMAND_MAGIC = $4E43; // 'NC' + UDP_CHUNK_MAGIC = $4E44; // 'ND' signature for chunk packets + UDP_MAX_SAFE_PAYLOAD = 1392; // Optimal MTU (avoids fragmentation) + UDP_CHUNK_TIMEOUT = 5000; // 5 seconds timeout for incomplete transfers + +type + // UDP Command Header Structure + TUdpCommandHeader = packed record + Cmd: Integer; // Command ID (matches ncSocketsPro) + Flags: Byte; // Command flags for future extensibility + Sequence: UInt16; // Sequence number for tracking/ordering + end; + + // Complete UDP Command Packet Structure + TUdpCommandPacket = packed record + Magic: UInt16; // Protocol detection signature + Header: TUdpCommandHeader; // Command header + // Variable data follows after this structure + end; + + // UDP Chunk Header Structure (for auto-chunking large commands) + TUdpChunkHeader = packed record + Magic: UInt16; // Chunk magic signature ($4E44 = 'ND') + TransferID: UInt32; // Unique transfer identifier + ChunkIndex: UInt16; // Current chunk number (0-based) + TotalChunks: UInt16; // Total number of chunks + OriginalCmd: Integer; // Original command ID + OriginalFlags: Byte; // Original command flags + OriginalSequence: UInt16; // Original sequence number + end; + + // Pointer type for zero-copy operations + PUdpChunkHeader = ^TUdpChunkHeader; + + // Chunk reassembly tracking + TChunkTransfer = record + TransferID: UInt32; + OriginalCmd: Integer; + OriginalFlags: Byte; + OriginalSequence: UInt16; + TotalChunks: UInt16; + FragmentsRemaining: UInt16; + LastActivity: TDateTime; + CompleteData: TBytes; // Pre-allocated full buffer + Fragments: array of UInt32; // Bitwise tracking + ActualDataSize: UInt32; // Real size of the complete data (calculated when complete) + LastChunkSize: UInt16; // Size of the last chunk (for accurate total calculation) + + // Helper methods for bitwise operations + function IsFragmentReceived(FragmentIndex: UInt16): Boolean; + procedure SetFragmentReceived(FragmentIndex: UInt16); + end; + + // Chunk transfer manager + TncChunkManager = class + private + FTransfers: TDictionary; // Hash table for O(1) lookup + FLock: TCriticalSection; + function GenerateTransferID: UInt32; + procedure CleanupExpiredTransfers; + public + constructor Create; + destructor Destroy; override; + function StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; + function CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; + function AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; + function CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; + end; + +resourcestring + ECannotSetPortWhileSocketActiveStr = 'Cannot set Port property while socket is active'; + ECannotSetHostWhileSocketActiveStr = 'Cannot set Host property while socket is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileSocketActiveStr = 'Cannot set UseReaderThread property while socket is active'; + ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnCommand event handler to get protocol data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; +type + EPropertySetError = class(Exception); + + // Event types for UDP + TncOnDatagramEvent = procedure(Sender: TObject; aLine: TncLine;const aBuf: TBytes; aBufCount: Integer;const SenderAddr: TSockAddrStorage) of object; + + // UDP Command Protocol Event + TncOnUDPCommandEvent = procedure(Sender: TObject; aLine: TncLine; const aSenderAddr: TSockAddrStorage; + aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16) of object; + + + // Base UDP Socket class + TncUDPBaseLCP = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FBroadcast: Boolean; + FLine: TncLine; + FReadBufferLen: Integer; + FOnCommand: TncOnUDPCommandEvent; + FChunkManager: TncChunkManager; // For auto-chunking large commands + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetBroadcast: Boolean; + procedure SetBroadcast(const Value: Boolean); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock: TCriticalSection; + ReadBuf: TBytes; + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetLine: TncLine; virtual; abstract; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property Broadcast: Boolean read GetBroadcast write SetBroadcast default DefBroadcast; + property OnCommand: TncOnUDPCommandEvent read FOnCommand write FOnCommand; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + published + end; + + // UDP Client implementation + TncUDPClientProcessor = class; + + TncCustomUDPClientLCP = class(TncUDPBaseLCP) + private + FHost: string; + function GetActive: Boolean; override; + procedure SetHost(const Value: string); + function GetHost: string; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + procedure Send(const aBuf; aBufSize: Integer); overload; + procedure Send(const aBytes: TBytes); overload; + procedure Send(const aStr: string); overload; + + // UDP Command Protocol Methods + procedure SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + property Host: string read GetHost write SetHost; + end; + + TncUDPClientLCP = class(TncCustomUDPClientLCP) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnCommand; + end; + + TncUDPClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomUDPClientLCP; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomUDPClientLCP); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // UDP Server implementation + TncUDPServerProcessor = class; + + TncCustomUDPServerLCP = class(TncUDPBaseLCP) + private + function GetActive: Boolean; override; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + + // UDP Command Protocol Methods + procedure SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + end; + + TncUDPServerLCP = class(TncCustomUDPServerLCP) + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnCommand; + end; + + TncUDPServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomUDPServerLCP; + public + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomUDPServerLCP); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + +implementation + +{ TncUDPBaseLCP } + +constructor TncUDPBaseLCP.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TCriticalSection.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FBroadcast := DefBroadcast; + FReadBufferLen := DefReadBufferLen; + FOnCommand := nil; + FChunkManager := TncChunkManager.Create; // Initialize the chunk manager + + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncUDPBaseLCP.Kind: TSocketType; +begin + Result := stUDP; +end; + +destructor TncUDPBaseLCP.Destroy; +begin + PropertyLock.Free; + FChunkManager.Free; // Free the chunk manager + inherited Destroy; +end; + +procedure TncUDPBaseLCP.Loaded; +begin + inherited Loaded; + if FInitActive then + DoActivate(True); +end; + +function TncUDPBaseLCP.CreateLineObject: TncLine; +begin + Result := TncLine.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); +end; + +procedure TncUDPBaseLCP.SetActive(const Value: Boolean); +begin + PropertyLock.Acquire; + try + if not(csLoading in ComponentState) then + DoActivate(Value); + FInitActive := GetActive; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseLCP.GetFamily: TAddressType; +begin + PropertyLock.Acquire; + try + Result := FFamily; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseLCP.SetFamily(const Value: TAddressType); +begin + if not(csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create + (ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + PropertyLock.Acquire; + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseLCP.GetPort: Integer; +begin + PropertyLock.Acquire; + try + Result := FPort; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseLCP.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FPort := Value; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseLCP.GetReaderThreadPriority: TncThreadPriority; +begin + PropertyLock.Acquire; + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseLCP.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + PropertyLock.Acquire; + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseLCP.GetBroadcast: Boolean; +begin + PropertyLock.Acquire; + try + Result := FBroadcast; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseLCP.SetBroadcast(const Value: Boolean); +begin + PropertyLock.Acquire; + try + FBroadcast := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseLCP.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FUseReaderThread := Value; + finally + PropertyLock.Release; + end; +end; + +function TncUDPBaseLCP.GetReadBufferLen: Integer; +begin + PropertyLock.Acquire; + try + Result := FReadBufferLen; + finally + PropertyLock.Release; + end; +end; + +procedure TncUDPBaseLCP.SetReadBufferLen(const Value: Integer); +begin + PropertyLock.Acquire; + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + PropertyLock.Release; + end; +end; + +{ TncCustomUDPClientLCP } + +constructor TncCustomUDPClientLCP.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FHost := DefHost; + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPClientProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPClientLCP.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPClientLCP.GetLine: TncLine; +begin + Result := Line; +end; + +procedure TncCustomUDPClientLCP.DoActivate(aActivate: Boolean); +begin + // Exit if socket is already in requested state + if aActivate = GetActive then + Exit; + + if aActivate then + begin + try + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // Create socket handle and establish connection + TncLineInternal(Line).CreateClientHandle(FHost, FPort, GetBroadcast); + + // Enable broadcast mode if requested + if GetBroadcast then + TncLineInternal(Line).EnableBroadcast; + + // Configure socket buffer sizes for optimal performance + try + TncLineInternal(Line).SetReceiveSize(GetReadBufferLen); + TncLineInternal(Line).SetWriteSize(GetReadBufferLen); + except + on E: Exception do + begin + TncLineInternal(Line).DestroyHandle; + raise; + end; + end; + + // Initialize socket handle array for reading + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + // Start reader thread if enabled + if UseReaderThread then + LineProcessor.Run; + except + on E: Exception do + begin + // Clean up on activation failure + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + raise; + end; + end; + end + else + begin + // Clean up when deactivating + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +function TncCustomUDPClientLCP.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomUDPClientLCP.GetHost: string; +begin + PropertyLock.Acquire; + try + Result := FHost; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomUDPClientLCP.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileSocketActiveStr); + + PropertyLock.Acquire; + try + FHost := Value; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomUDPClientLCP.Send(const aBuf; aBufSize: Integer); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + case Family of + afIPv4: + begin + if GetBroadcast then + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(FPort); + + // Use Winsock API directly for IPv4 broadcast + var addr := inet_addr(PAnsiChar(AnsiString(FHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendTo(aBuf, aBufSize, storage); + end + else + TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + end; + + afIPv6: + begin + if GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.') + else if FHost = '' then + raise Exception.Create('Host address cannot be empty for IPv6') + else + begin + // Validate IPv6 address format + if not TncIPUtils.IsIPv6ValidAddress(FHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(FPort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(FHost) then + begin + var scopePos := Pos('%', FHost); + if scopePos > 0 then + begin + var hostAddr := Copy(FHost, 1, scopePos - 1); + var scope := Copy(FHost, scopePos + 1, Length(FHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + // Convert the address part without scope ID + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendTo(aBuf, aBufSize, storage); + end; + end; + end; +end; + +procedure TncCustomUDPClientLCP.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomUDPClientLCP.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +// UDP Command Protocol Methods for TncCustomUDPClientLCP + +procedure TncCustomUDPClientLCP.SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +begin + SendCommand(FHost, FPort, aCmd, aData, aFlags, aSequence); +end; + +procedure TncCustomUDPClientLCP.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // IPv6 broadcast validation + if (Family = afIPv6) and GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Build destination address first (common for both paths) + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end; + end; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, storage); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, storage); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPClientLCP.SendTo(const aBuf; aBufSize: Integer; + const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPClientLCP.SendTo(const aBytes: TBytes; + const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPClientLCP.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPClientLCP.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPClientProcessor } + +constructor TncUDPClientProcessor.Create(aClientSocket: TncCustomUDPClientLCP); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncUDPClientProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + // Initialize sender address structure + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + // Receive datagram with proper address structure + BufRead := recvfrom(FClientSocket.Line.Handle, + FClientSocket.ReadBuf[0], + Length(FClientSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FClientSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FClientSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FClientSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FClientSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FClientSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FClientSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end; + // NOTE: LCP ONLY - No else clause for raw data + // Any non-protocol packets are silently ignored + end; + // NOTE: LCP ONLY - Packets too small for protocol headers are silently ignored + end; +end; + +procedure TncUDPClientProcessor.ProcessEvent; +begin + while (not Terminated) do + try + if FClientSocket.Line.Active then + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(ProcessDatagram) + else + ProcessDatagram; + end; + end + else + Exit; + except + // Continue processing even after errors + end; +end; + +{ TncChunkManager } + +constructor TncChunkManager.Create; +begin + inherited Create; + FLock := TCriticalSection.Create; + FTransfers := TDictionary.Create; +end; + +destructor TncChunkManager.Destroy; +begin + FLock.Free; + FTransfers.Free; + inherited Destroy; +end; + +function TncChunkManager.GenerateTransferID: UInt32; +begin + // Simple transfer ID generation (timestamp + random) + Result := UInt32(GetTickCount) xor UInt32(Random(65536)); +end; + +procedure TncChunkManager.CleanupExpiredTransfers; +var + Now: TDateTime; + TransferID: UInt32; + Transfer: TChunkTransfer; + ExpiredIDs: TArray; + I: Integer; +begin + Now := System.SysUtils.Now; + SetLength(ExpiredIDs, 0); + + // First pass: identify expired transfers + for Transfer in FTransfers.Values do + begin + if MilliSecondsBetween(Now, Transfer.LastActivity) > UDP_CHUNK_TIMEOUT then + begin + SetLength(ExpiredIDs, Length(ExpiredIDs) + 1); + ExpiredIDs[High(ExpiredIDs)] := Transfer.TransferID; + end; + end; + + // Second pass: remove expired transfers + for I := 0 to High(ExpiredIDs) do + FTransfers.Remove(ExpiredIDs[I]); +end; + +function TncChunkManager.StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + FLock.Enter; + try + CleanupExpiredTransfers; + + Transfer.TransferID := GenerateTransferID; + Transfer.OriginalCmd := ACmd; + Transfer.OriginalFlags := AFlags; + Transfer.OriginalSequence := ASequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := AActualDataSize; // Store the actual data size + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate only maximum needed size (not over-allocate) + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := Transfer.TransferID; + finally + FLock.Leave; + end; +end; + +function TncChunkManager.CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + Result := False; + FLock.Enter; + try + // Check if transfer already exists + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + Result := True; // Already exists + Exit; + end; + + // Create new transfer + Transfer.TransferID := ATransferID; + Transfer.OriginalCmd := AOriginalCmd; + Transfer.OriginalFlags := AOriginalFlags; + Transfer.OriginalSequence := AOriginalSequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := 0; // Will be calculated when all chunks received + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate buffer for maximum possible data size + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := True; + finally + FLock.Leave; + end; +end; + +function TncChunkManager.AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; +var + Transfer: TChunkTransfer; + ChunkOffset: Integer; + DataSize: Integer; + MaxChunkSize: Integer; +begin + Result := False; + DataSize := Length(AChunkData); + + // Quick validation before lock + if DataSize = 0 then Exit; + + // Single lock operation only + FLock.Enter; + try + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + // Transfer exists - add chunk + if (AChunkIndex < Transfer.TotalChunks) and (not Transfer.IsFragmentReceived(AChunkIndex)) then + begin + // Calculate offset once and copy directly + MaxChunkSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + ChunkOffset := AChunkIndex * MaxChunkSize; + + // Direct memory operation + if ChunkOffset + DataSize <= Length(Transfer.CompleteData) then + begin + Move(AChunkData[0], Transfer.CompleteData[ChunkOffset], DataSize); + + // Update tracking + Transfer.SetFragmentReceived(AChunkIndex); + Dec(Transfer.FragmentsRemaining); + Transfer.LastActivity := System.SysUtils.Now; + + // Track last chunk size for accurate total calculation + if AChunkIndex = Transfer.TotalChunks - 1 then + Transfer.LastChunkSize := DataSize; + + // If all chunks received, calculate actual data size + if Transfer.FragmentsRemaining = 0 then + Transfer.ActualDataSize := (Transfer.TotalChunks - 1) * MaxChunkSize + Transfer.LastChunkSize; + + // Update the transfer back to dictionary once + FTransfers.AddOrSetValue(ATransferID, Transfer); + Result := True; + end; + end; + end; + finally + FLock.Leave; + end; +end; + +function TncChunkManager.CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; +var + Transfer: TChunkTransfer; +begin + Result := False; + FLock.Enter; + try + if FTransfers.TryGetValue(ATransferID, Transfer) and (Transfer.FragmentsRemaining = 0) then + begin + // All chunks received - prepare output + ACmd := Transfer.OriginalCmd; + AFlags := Transfer.OriginalFlags; + ASequence := Transfer.OriginalSequence; + + // Use the stored actual data size (from sender) + if Transfer.ActualDataSize > 0 then + begin + SetLength(ACompleteData, Transfer.ActualDataSize); + Move(Transfer.CompleteData[0], ACompleteData[0], Transfer.ActualDataSize); + end + else + SetLength(ACompleteData, 0); + + // Remove completed transfer + FTransfers.Remove(ATransferID); + Result := True; + end; + finally + FLock.Leave; + end; +end; + +{ TChunkTransfer - bitwise fragment tracking } + +function TChunkTransfer.IsFragmentReceived(FragmentIndex: UInt16): Boolean; +begin + if FragmentIndex >= TotalChunks then + begin + Result := False; + Exit; + end; + // Bitwise check: (fragments[fragmentNumber / 32] & (1u << (fragmentNumber % 32))) == 0 + Result := (Fragments[FragmentIndex div 32] and (UInt32(1) shl (FragmentIndex mod 32))) <> 0; +end; + +procedure TChunkTransfer.SetFragmentReceived(FragmentIndex: UInt16); +begin + if FragmentIndex < TotalChunks then + // Bitwise set: fragments[fragmentNumber / 32] |= (1u << (fragmentNumber % 32)) + Fragments[FragmentIndex div 32] := Fragments[FragmentIndex div 32] or (UInt32(1) shl (FragmentIndex mod 32)); +end; + +{ TncCustomUDPServerLCP } + +constructor TncCustomUDPServerLCP.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPServerProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPServerLCP.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPServerLCP.GetLine: TncLine; +begin + Result := Line; +end; + +function TncCustomUDPServerLCP.GetActive: Boolean; +begin + Result := Line.Active; +end; + +procedure TncCustomUDPServerLCP.DoActivate(aActivate: Boolean); +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // CreateServerHandle will bind to all interfaces (0.0.0.0) + // through the AI_PASSIVE flag in ncLines.CreateServerHandle + TncLineInternal(Line).CreateServerHandle(FPort); + + // Enable broadcast if needed + if Broadcast then + TncLineInternal(Line).EnableBroadcast; + + // Set socket buffer sizes for better performance + try + TncLineInternal(Line).SetReceiveSize(ReadBufferLen); + TncLineInternal(Line).SetWriteSize(ReadBufferLen); + except + // Ignore buffer size errors + end; + + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPServerLCP.SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPServerLCP.SendTo(const aBytes: TBytes; const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPServerLCP.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +// UDP Command Protocol Methods for TncCustomUDPServerLCP + +procedure TncCustomUDPServerLCP.SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, DestAddr); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, DestAddr); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +procedure TncCustomUDPServerLCP.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + // IPv6 broadcast validation + if (Family = afIPv6) and Broadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Build destination address based on family + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + end; +end; + +function TncCustomUDPServerLCP.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPServerProcessor } + +constructor TncUDPServerProcessor.Create(aServerSocket: TncCustomUDPServerLCP); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + + +procedure TncUDPServerProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(FServerSocket.Line.Handle, + FServerSocket.ReadBuf[0], + Length(FServerSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FServerSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FServerSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FServerSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FServerSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FServerSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FServerSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end; + // NOTE: LCP ONLY - No else clause for raw data + // Any non-protocol packets are silently ignored + end; + // NOTE: LCP ONLY - Packets too small for protocol headers are silently ignored + end; +end; + +procedure TncUDPServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + Synchronize(ProcessDatagram); + end; + except + end + else + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + ProcessDatagram; + end; + except + end; +end; + +end. + + + + diff --git a/Source_using_TMonitor/Encryption/ncEncBlockciphers.pas b/Source_using_TMonitor/Encryption/ncEncBlockciphers.pas new file mode 100644 index 0000000..c37fbc6 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncBlockciphers.pas @@ -0,0 +1,813 @@ +{$R-} +{$Q-} +unit ncEncBlockciphers; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +{ ****************************************************************************** } +{ Base type definition for 64 bit block ciphers } +type + TncEnc_blockcipher64 = class(TncEncBlockCipher) + private + IV, CV: array [0 .. 7] of Byte; + procedure IncCounter; + public + class function GetBlockSize: Integer; override; + { Get the block size of the cipher (in bits) } + + procedure Reset; override; + { Reset any stored chaining information } + procedure Burn; override; + { Clear all stored key information and chaining information } + procedure SetIV(const Value); override; + { Sets the IV to Value and performs a reset } + procedure GetIV(var Value); override; + { Returns the current chaining information, not the actual IV } + procedure Init(const Key; Size: NativeUInt; InitVector: Pointer); override; + { Do key setup based on the data in Key, size is in bits } + + procedure EncryptCBC(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CBC method of encryption } + procedure DecryptCBC(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CBC method of decryption } + procedure EncryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CFB (8 bit) method of encryption } + procedure DecryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CFB (8 bit) method of decryption } + procedure EncryptCFBblock(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CFB (block) method of encryption } + procedure DecryptCFBblock(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CFB (block) method of decryption } + procedure EncryptOFB(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the OFB method of encryption } + procedure DecryptOFB(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the OFB method of decryption } + procedure EncryptCTR(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CTR method of encryption } + procedure DecryptCTR(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CTR method of decryption } + end; + + { ****************************************************************************** } + { Base type definition for 128 bit block ciphers } +type + TncEnc_blockcipher128 = class(TncEncBlockCipher) + private + IV, CV: array [0 .. 15] of Byte; + + procedure IncCounter; + public + class function GetBlockSize: Integer; override; + { Get the block size of the cipher (in bits) } + + procedure Reset; override; + { Reset any stored chaining information } + procedure Burn; override; + { Clear all stored key information and chaining information } + procedure SetIV(const Value); override; + { Sets the IV to Value and performs a reset } + procedure GetIV(var Value); override; + { Returns the current chaining information, not the actual IV } + procedure Init(const Key; Size: NativeUInt; InitVector: Pointer); override; + { Do key setup based on the data in Key, size is in bits } + + procedure EncryptCBC(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CBC method of encryption } + procedure DecryptCBC(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CBC method of decryption } + procedure EncryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CFB (8 bit) method of encryption } + procedure DecryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CFB (8 bit) method of decryption } + procedure EncryptCFBblock(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CFB (block) method of encryption } + procedure DecryptCFBblock(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CFB (block) method of decryption } + procedure EncryptOFB(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the OFB method of encryption } + procedure DecryptOFB(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the OFB method of decryption } + procedure EncryptCTR(const Indata; var Outdata; Size: NativeUInt); override; + { Encrypt size bytes of data using the CTR method of encryption } + procedure DecryptCTR(const Indata; var Outdata; Size: NativeUInt); override; + { Decrypt size bytes of data using the CTR method of decryption } + end; + +implementation + +{ ** TncEnc_blockcipher64 ******************************************************** } + +procedure TncEnc_blockcipher64.IncCounter; +var + i: Integer; +begin + Inc(CV[7]); + i := 7; + while (i > 0) and (CV[i] = 0) do + begin + Inc(CV[i - 1]); + Dec(i); + end; +end; + +class function TncEnc_blockcipher64.GetBlockSize: Integer; +begin + Result := 64; +end; + +procedure TncEnc_blockcipher64.Init(const Key; Size: NativeUInt; InitVector: Pointer); +begin + inherited Init(Key, Size, InitVector); + InitKey(Key, Size); + if InitVector = nil then + begin + FillChar(IV, 8, 0); + EncryptECB(IV, IV); + Reset; + end + else + begin + Move(InitVector^, IV, 8); + Reset; + end; +end; + +procedure TncEnc_blockcipher64.SetIV(const Value); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + Move(Value, IV, 8); + Reset; +end; + +procedure TncEnc_blockcipher64.GetIV(var Value); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + Move(CV, Value, 8); +end; + +procedure TncEnc_blockcipher64.Reset; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised) + else + Move(IV, CV, 8); +end; + +procedure TncEnc_blockcipher64.Burn; +begin + FillChar(IV, 8, $FF); + FillChar(CV, 8, $FF); + inherited Burn; +end; + +procedure TncEnc_blockcipher64.EncryptCBC(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + Move(p1^, p2^, 8); + XorBlock(p2^, CV, 8); + EncryptECB(p2^, p2^); + Move(p2^, CV, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, CV, Size mod 8); + end; +end; + +procedure TncEnc_blockcipher64.DecryptCBC(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; + Temp: array [0 .. 7] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + Move(p1^, p2^, 8); + Move(p1^, Temp, 8); + DecryptECB(p2^, p2^); + XorBlock(p2^, CV, 8); + Move(Temp, CV, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, CV, Size mod 8); + end; +end; + +procedure TncEnc_blockcipher64.EncryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; + Temp: array [0 .. 7] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to Size do + begin + EncryptECB(CV, Temp); + p2^ := p1^ xor Temp[0]; + Move(CV[1], CV[0], 8 - 1); + CV[7] := p2^; + Inc(p1); + Inc(p2); + end; +end; + +procedure TncEnc_blockcipher64.DecryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; + TempByte: Byte; + Temp: array [0 .. 7] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to Size do + begin + TempByte := p1^; + EncryptECB(CV, Temp); + p2^ := p1^ xor Temp[0]; + Move(CV[1], CV[0], 8 - 1); + CV[7] := TempByte; + Inc(p1); + Inc(p2); + end; +end; + +procedure TncEnc_blockcipher64.EncryptCFBblock(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + EncryptECB(CV, CV); + Move(p1^, p2^, 8); + XorBlock(p2^, CV, 8); + Move(p2^, CV, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, CV, Size mod 8); + end; +end; + +procedure TncEnc_blockcipher64.DecryptCFBblock(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; + Temp: array [0 .. 7] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + Move(p1^, Temp, 8); + EncryptECB(CV, CV); + Move(p1^, p2^, 8); + XorBlock(p2^, CV, 8); + Move(Temp, CV, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, CV, Size mod 8); + end; +end; + +procedure TncEnc_blockcipher64.EncryptOFB(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + EncryptECB(CV, CV); + Move(p1^, p2^, 8); + XorBlock(p2^, CV, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, CV, Size mod 8); + end; +end; + +procedure TncEnc_blockcipher64.DecryptOFB(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + EncryptECB(CV, CV); + Move(p1^, p2^, 8); + XorBlock(p2^, CV, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, CV, Size mod 8); + end; +end; + +procedure TncEnc_blockcipher64.EncryptCTR(const Indata; var Outdata; Size: NativeUInt); +var + Temp: array [0 .. 7] of Byte; + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, 8); + XorBlock(p2^, Temp, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, Temp, Size mod 8); + end; +end; + +procedure TncEnc_blockcipher64.DecryptCTR(const Indata; var Outdata; Size: NativeUInt); +var + Temp: array [0 .. 7] of Byte; + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 8) do + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, 8); + XorBlock(p2^, Temp, 8); + p1 := Pointer(NativeUInt(p1) + 8); + p2 := Pointer(NativeUInt(p2) + 8); + end; + if (Size mod 8) <> 0 then + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, Size mod 8); + XorBlock(p2^, Temp, Size mod 8); + end; +end; + +{ ** TncEnc_blockcipher128 ******************************************************** } + +procedure TncEnc_blockcipher128.IncCounter; +var + i: Integer; +begin + Inc(CV[15]); + i := 15; + while (i > 0) and (CV[i] = 0) do + begin + Inc(CV[i - 1]); + Dec(i); + end; +end; + +class function TncEnc_blockcipher128.GetBlockSize: Integer; +begin + Result := 128; +end; + +procedure TncEnc_blockcipher128.Init(const Key; Size: NativeUInt; InitVector: Pointer); +begin + inherited Init(Key, Size, InitVector); + InitKey(Key, Size); + if InitVector = nil then + begin + FillChar(IV, 16, 0); + EncryptECB(IV, IV); + Reset; + end + else + begin + Move(InitVector^, IV, 16); + Reset; + end; +end; + +procedure TncEnc_blockcipher128.SetIV(const Value); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + Move(Value, IV, 16); + Reset; +end; + +procedure TncEnc_blockcipher128.GetIV(var Value); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + Move(CV, Value, 16); +end; + +procedure TncEnc_blockcipher128.Reset; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised) + else + Move(IV, CV, 16); +end; + +procedure TncEnc_blockcipher128.Burn; +begin + FillChar(IV, 16, $FF); + FillChar(CV, 16, $FF); + inherited Burn; +end; + +procedure TncEnc_blockcipher128.EncryptCBC(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + Move(p1^, p2^, 16); + XorBlock(p2^, CV, 16); + EncryptECB(p2^, p2^); + Move(p2^, CV, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, CV, Size mod 16); + end; +end; + +procedure TncEnc_blockcipher128.DecryptCBC(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; + Temp: array [0 .. 15] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + Move(p1^, p2^, 16); + Move(p1^, Temp, 16); + DecryptECB(p2^, p2^); + XorBlock(p2^, CV, 16); + Move(Temp, CV, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, CV, Size mod 16); + end; +end; + +procedure TncEnc_blockcipher128.EncryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; + Temp: array [0 .. 15] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to Size do + begin + EncryptECB(CV, Temp); + p2^ := p1^ xor Temp[0]; + Move(CV[1], CV[0], 15); + CV[15] := p2^; + Inc(p1); + Inc(p2); + end; +end; + +procedure TncEnc_blockcipher128.DecryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; + TempByte: Byte; + Temp: array [0 .. 15] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to Size do + begin + TempByte := p1^; + EncryptECB(CV, Temp); + p2^ := p1^ xor Temp[0]; + Move(CV[1], CV[0], 15); + CV[15] := TempByte; + Inc(p1); + Inc(p2); + end; +end; + +procedure TncEnc_blockcipher128.EncryptCFBblock(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + EncryptECB(CV, CV); + Move(p1^, p2^, 16); + XorBlock(p2^, CV, 16); + Move(p2^, CV, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, CV, Size mod 16); + end; +end; + +procedure TncEnc_blockcipher128.DecryptCFBblock(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pbyte; + Temp: array [0 .. 15] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + Move(p1^, Temp, 16); + EncryptECB(CV, CV); + Move(p1^, p2^, 16); + XorBlock(p2^, CV, 16); + Move(Temp, CV, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, CV, Size mod 16); + end; +end; + +procedure TncEnc_blockcipher128.EncryptOFB(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + EncryptECB(CV, CV); + Move(p1^, p2^, 16); + XorBlock(p2^, CV, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, CV, Size mod 16); + end; +end; + +procedure TncEnc_blockcipher128.DecryptOFB(const Indata; var Outdata; Size: NativeUInt); +var + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + EncryptECB(CV, CV); + Move(p1^, p2^, 16); + XorBlock(p2^, CV, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, CV); + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, CV, Size mod 16); + end; +end; + +procedure TncEnc_blockcipher128.EncryptCTR(const Indata; var Outdata; Size: NativeUInt); +var + Temp: array [0 .. 15] of Byte; + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, 16); + XorBlock(p2^, Temp, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, Temp, Size mod 16); + end; +end; + +procedure TncEnc_blockcipher128.DecryptCTR(const Indata; var Outdata; Size: NativeUInt); +var + Temp: array [0 .. 15] of Byte; + i: longword; + p1, p2: Pointer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + p1 := @Indata; + p2 := @Outdata; + for i := 1 to (Size div 16) do + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, 16); + XorBlock(p2^, Temp, 16); + p1 := Pointer(NativeUInt(p1) + 16); + p2 := Pointer(NativeUInt(p2) + 16); + end; + if (Size mod 16) <> 0 then + begin + EncryptECB(CV, Temp); + IncCounter; + Move(p1^, p2^, Size mod 16); + XorBlock(p2^, Temp, Size mod 16); + end; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncBlowfish.pas b/Source_using_TMonitor/Encryption/ncEncBlowfish.pas new file mode 100644 index 0000000..cea8b9e --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncBlowfish.pas @@ -0,0 +1,287 @@ +{$R-} +{$Q-} +unit ncEncBlowfish; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_blowfish = class(TncEnc_blockcipher64) + protected + SBox: array [0 .. 3, 0 .. 255] of UInt32; + PBox: array [0 .. 17] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + PBoxOrg: array [0 .. 17] of UInt32 = ($243F6A88, $85A308D3, $13198A2E, $03707344, $A4093822, $299F31D0, $082EFA98, $EC4E6C89, $452821E6, $38D01377, $BE5466CF, $34E90C6C, $C0AC29B7, $C97C50DD, $3F84D5B5, $B5470917, $9216D5D9, $8979FB1B); + SBoxOrg: array [0 .. 3, 0 .. 255] of UInt32 = (($D1310BA6, $98DFB5AC, $2FFD72DB, $D01ADFB7, $B8E1AFED, $6A267E96, $BA7C9045, $F12C7F99, $24A19947, $B3916CF7, $0801F2E2, $858EFC16, $636920D8, $71574E69, $A458FEA3, $F4933D7E, $0D95748F, $728EB658, $718BCD58, $82154AEE, $7B54A41D, $C25A59B5, $9C30D539, $2AF26013, + $C5D1B023, $286085F0, $CA417918, $B8DB38EF, $8E79DCB0, $603A180E, $6C9E0E8B, $B01E8A3E, $D71577C1, $BD314B27, $78AF2FDA, $55605C60, $E65525F3, $AA55AB94, $57489862, $63E81440, $55CA396A, $2AAB10B6, $B4CC5C34, $1141E8CE, $A15486AF, $7C72E993, $B3EE1411, $636FBC2A, $2BA9C55D, $741831F6, $CE5C3E16, $9B87931E, + $AFD6BA33, $6C24CF5C, $7A325381, $28958677, $3B8F4898, $6B4BB9AF, $C4BFE81B, $66282193, $61D809CC, $FB21A991, $487CAC60, $5DEC8032, $EF845D5D, $E98575B1, $DC262302, $EB651B88, $23893E81, $D396ACC5, $0F6D6FF3, $83F44239, $2E0B4482, $A4842004, $69C8F04A, $9E1F9B5E, $21C66842, $F6E96C9A, $670C9C61, $ABD388F0, + $6A51A0D2, $D8542F68, $960FA728, $AB5133A3, $6EEF0B6C, $137A3BE4, $BA3BF050, $7EFB2A98, $A1F1651D, $39AF0176, $66CA593E, $82430E88, $8CEE8619, $456F9FB4, $7D84A5C3, $3B8B5EBE, $E06F75D8, $85C12073, $401A449F, $56C16AA6, $4ED3AA62, $363F7706, $1BFEDF72, $429B023D, $37D0D724, $D00A1248, $DB0FEAD3, $49F1C09B, + $075372C9, $80991B7B, $25D479D8, $F6E8DEF7, $E3FE501A, $B6794C3B, $976CE0BD, $04C006BA, $C1A94FB6, $409F60C4, $5E5C9EC2, $196A2463, $68FB6FAF, $3E6C53B5, $1339B2EB, $3B52EC6F, $6DFC511F, $9B30952C, $CC814544, $AF5EBD09, $BEE3D004, $DE334AFD, $660F2807, $192E4BB3, $C0CBA857, $45C8740F, $D20B5F39, $B9D3FBDB, + $5579C0BD, $1A60320A, $D6A100C6, $402C7279, $679F25FE, $FB1FA3CC, $8EA5E9F8, $DB3222F8, $3C7516DF, $FD616B15, $2F501EC8, $AD0552AB, $323DB5FA, $FD238760, $53317B48, $3E00DF82, $9E5C57BB, $CA6F8CA0, $1A87562E, $DF1769DB, $D542A8F6, $287EFFC3, $AC6732C6, $8C4F5573, $695B27B0, $BBCA58C8, $E1FFA35D, $B8F011A0, + $10FA3D98, $FD2183B8, $4AFCB56C, $2DD1D35B, $9A53E479, $B6F84565, $D28E49BC, $4BFB9790, $E1DDF2DA, $A4CB7E33, $62FB1341, $CEE4C6E8, $EF20CADA, $36774C01, $D07E9EFE, $2BF11FB4, $95DBDA4D, $AE909198, $EAAD8E71, $6B93D5A0, $D08ED1D0, $AFC725E0, $8E3C5B2F, $8E7594B7, $8FF6E2FB, $F2122B64, $8888B812, $900DF01C, + $4FAD5EA0, $688FC31C, $D1CFF191, $B3A8C1AD, $2F2F2218, $BE0E1777, $EA752DFE, $8B021FA1, $E5A0CC0F, $B56F74E8, $18ACF3D6, $CE89E299, $B4A84FE0, $FD13E0B7, $7CC43B81, $D2ADA8D9, $165FA266, $80957705, $93CC7314, $211A1477, $E6AD2065, $77B5FA86, $C75442F5, $FB9D35CF, $EBCDAF0C, $7B3E89A0, $D6411BD3, $AE1E7E49, + $00250E2D, $2071B35E, $226800BB, $57B8E0AF, $2464369B, $F009B91E, $5563911D, $59DFA6AA, $78C14389, $D95A537F, $207D5BA2, $02E5B9C5, $83260376, $6295CFA9, $11C81968, $4E734A41, $B3472DCA, $7B14A94A, $1B510052, $9A532915, $D60F573F, $BC9BC6E4, $2B60A476, $81E67400, $08BA6FB5, $571BE91F, $F296EC6B, $2A0DD915, + $B6636521, $E7B9F9B6, $FF34052E, $C5855664, $53B02D5D, $A99F8FA1, $08BA4799, $6E85076A), ($4B7A70E9, $B5B32944, $DB75092E, $C4192623, $AD6EA6B0, $49A7DF7D, $9CEE60B8, $8FEDB266, $ECAA8C71, $699A17FF, $5664526C, $C2B19EE1, $193602A5, $75094C29, $A0591340, $E4183A3E, $3F54989A, $5B429D65, $6B8FE4D6, $99F73FD6, + $A1D29C07, $EFE830F5, $4D2D38E6, $F0255DC1, $4CDD2086, $8470EB26, $6382E9C6, $021ECC5E, $09686B3F, $3EBAEFC9, $3C971814, $6B6A70A1, $687F3584, $52A0E286, $B79C5305, $AA500737, $3E07841C, $7FDEAE5C, $8E7D44EC, $5716F2B8, $B03ADA37, $F0500C0D, $F01C1F04, $0200B3FF, $AE0CF51A, $3CB574B2, $25837A58, $DC0921BD, + $D19113F9, $7CA92FF6, $94324773, $22F54701, $3AE5E581, $37C2DADC, $C8B57634, $9AF3DDA7, $A9446146, $0FD0030E, $ECC8C73E, $A4751E41, $E238CD99, $3BEA0E2F, $3280BBA1, $183EB331, $4E548B38, $4F6DB908, $6F420D03, $F60A04BF, $2CB81290, $24977C79, $5679B072, $BCAF89AF, $DE9A771F, $D9930810, $B38BAE12, $DCCF3F2E, + $5512721F, $2E6B7124, $501ADDE6, $9F84CD87, $7A584718, $7408DA17, $BC9F9ABC, $E94B7D8C, $EC7AEC3A, $DB851DFA, $63094366, $C464C3D2, $EF1C1847, $3215D908, $DD433B37, $24C2BA16, $12A14D43, $2A65C451, $50940002, $133AE4DD, $71DFF89E, $10314E55, $81AC77D6, $5F11199B, $043556F1, $D7A3C76B, $3C11183B, $5924A509, + $F28FE6ED, $97F1FBFA, $9EBABF2C, $1E153C6E, $86E34570, $EAE96FB1, $860E5E0A, $5A3E2AB3, $771FE71C, $4E3D06FA, $2965DCB9, $99E71D0F, $803E89D6, $5266C825, $2E4CC978, $9C10B36A, $C6150EBA, $94E2EA78, $A5FC3C53, $1E0A2DF4, $F2F74EA7, $361D2B3D, $1939260F, $19C27960, $5223A708, $F71312B6, $EBADFE6E, $EAC31F66, + $E3BC4595, $A67BC883, $B17F37D1, $018CFF28, $C332DDEF, $BE6C5AA5, $65582185, $68AB9802, $EECEA50F, $DB2F953B, $2AEF7DAD, $5B6E2F84, $1521B628, $29076170, $ECDD4775, $619F1510, $13CCA830, $EB61BD96, $0334FE1E, $AA0363CF, $B5735C90, $4C70A239, $D59E9E0B, $CBAADE14, $EECC86BC, $60622CA7, $9CAB5CAB, $B2F3846E, + $648B1EAF, $19BDF0CA, $A02369B9, $655ABB50, $40685A32, $3C2AB4B3, $319EE9D5, $C021B8F7, $9B540B19, $875FA099, $95F7997E, $623D7DA8, $F837889A, $97E32D77, $11ED935F, $16681281, $0E358829, $C7E61FD6, $96DEDFA1, $7858BA99, $57F584A5, $1B227263, $9B83C3FF, $1AC24696, $CDB30AEB, $532E3054, $8FD948E4, $6DBC3128, + $58EBF2EF, $34C6FFEA, $FE28ED61, $EE7C3C73, $5D4A14D9, $E864B7E3, $42105D14, $203E13E0, $45EEE2B6, $A3AAABEA, $DB6C4F15, $FACB4FD0, $C742F442, $EF6ABBB5, $654F3B1D, $41CD2105, $D81E799E, $86854DC7, $E44B476A, $3D816250, $CF62A1F2, $5B8D2646, $FC8883A0, $C1C7B6A3, $7F1524C3, $69CB7492, $47848A0B, $5692B285, + $095BBF00, $AD19489D, $1462B174, $23820E00, $58428D2A, $0C55F5EA, $1DADF43E, $233F7061, $3372F092, $8D937E41, $D65FECF1, $6C223BDB, $7CDE3759, $CBEE7460, $4085F2A7, $CE77326E, $A6078084, $19F8509E, $E8EFD855, $61D99735, $A969A7AA, $C50C06C2, $5A04ABFC, $800BCADC, $9E447A2E, $C3453484, $FDD56705, $0E1E9EC9, + $DB73DBD3, $105588CD, $675FDA79, $E3674340, $C5C43465, $713E38D8, $3D28F89E, $F16DFF20, $153E21E7, $8FB03D4A, $E6E39F2B, $DB83ADF7), ($E93D5A68, $948140F7, $F64C261C, $94692934, $411520F7, $7602D4F7, $BCF46B2E, $D4A20068, $D4082471, $3320F46A, $43B7D4B7, $500061AF, $1E39F62E, $97244546, $14214F74, $BF8B8840, + $4D95FC1D, $96B591AF, $70F4DDD3, $66A02F45, $BFBC09EC, $03BD9785, $7FAC6DD0, $31CB8504, $96EB27B3, $55FD3941, $DA2547E6, $ABCA0A9A, $28507825, $530429F4, $0A2C86DA, $E9B66DFB, $68DC1462, $D7486900, $680EC0A4, $27A18DEE, $4F3FFEA2, $E887AD8C, $B58CE006, $7AF4D6B6, $AACE1E7C, $D3375FEC, $CE78A399, $406B2A42, + $20FE9E35, $D9F385B9, $EE39D7AB, $3B124E8B, $1DC9FAF7, $4B6D1856, $26A36631, $EAE397B2, $3A6EFA74, $DD5B4332, $6841E7F7, $CA7820FB, $FB0AF54E, $D8FEB397, $454056AC, $BA489527, $55533A3A, $20838D87, $FE6BA9B7, $D096954B, $55A867BC, $A1159A58, $CCA92963, $99E1DB33, $A62A4A56, $3F3125F9, $5EF47E1C, $9029317C, + $FDF8E802, $04272F70, $80BB155C, $05282CE3, $95C11548, $E4C66D22, $48C1133F, $C70F86DC, $07F9C9EE, $41041F0F, $404779A4, $5D886E17, $325F51EB, $D59BC0D1, $F2BCC18F, $41113564, $257B7834, $602A9C60, $DFF8E8A3, $1F636C1B, $0E12B4C2, $02E1329E, $AF664FD1, $CAD18115, $6B2395E0, $333E92E1, $3B240B62, $EEBEB922, + $85B2A20E, $E6BA0D99, $DE720C8C, $2DA2F728, $D0127845, $95B794FD, $647D0862, $E7CCF5F0, $5449A36F, $877D48FA, $C39DFD27, $F33E8D1E, $0A476341, $992EFF74, $3A6F6EAB, $F4F8FD37, $A812DC60, $A1EBDDF8, $991BE14C, $DB6E6B0D, $C67B5510, $6D672C37, $2765D43B, $DCD0E804, $F1290DC7, $CC00FFA3, $B5390F92, $690FED0B, + $667B9FFB, $CEDB7D9C, $A091CF0B, $D9155EA3, $BB132F88, $515BAD24, $7B9479BF, $763BD6EB, $37392EB3, $CC115979, $8026E297, $F42E312D, $6842ADA7, $C66A2B3B, $12754CCC, $782EF11C, $6A124237, $B79251E7, $06A1BBE6, $4BFB6350, $1A6B1018, $11CAEDFA, $3D25BDD8, $E2E1C3C9, $44421659, $0A121386, $D90CEC6E, $D5ABEA2A, + $64AF674E, $DA86A85F, $BEBFE988, $64E4C3FE, $9DBC8057, $F0F7C086, $60787BF8, $6003604D, $D1FD8346, $F6381FB0, $7745AE04, $D736FCCC, $83426B33, $F01EAB71, $B0804187, $3C005E5F, $77A057BE, $BDE8AE24, $55464299, $BF582E61, $4E58F48F, $F2DDFDA2, $F474EF38, $8789BDC2, $5366F9C3, $C8B38E74, $B475F255, $46FCD9B9, + $7AEB2661, $8B1DDF84, $846A0E79, $915F95E2, $466E598E, $20B45770, $8CD55591, $C902DE4C, $B90BACE1, $BB8205D0, $11A86248, $7574A99E, $B77F19B6, $E0A9DC09, $662D09A1, $C4324633, $E85A1F02, $09F0BE8C, $4A99A025, $1D6EFE10, $1AB93D1D, $0BA5A4DF, $A186F20F, $2868F169, $DCB7DA83, $573906FE, $A1E2CE9B, $4FCD7F52, + $50115E01, $A70683FA, $A002B5C4, $0DE6D027, $9AF88C27, $773F8641, $C3604C06, $61A806B5, $F0177A28, $C0F586E0, $006058AA, $30DC7D62, $11E69ED7, $2338EA63, $53C2DD94, $C2C21634, $BBCBEE56, $90BCB6DE, $EBFC7DA1, $CE591D76, $6F05E409, $4B7C0188, $39720A3D, $7C927C24, $86E3725F, $724D9DB9, $1AC15BB4, $D39EB8FC, + $ED545578, $08FCA5B5, $D83D7CD3, $4DAD0FC4, $1E50EF5E, $B161E6F8, $A28514D9, $6C51133C, $6FD5C7E7, $56E14EC4, $362ABFCE, $DDC6C837, $D79A3234, $92638212, $670EFA8E, $406000E0), ($3A39CE37, $D3FAF5CF, $ABC27737, $5AC52D1B, $5CB0679E, $4FA33742, $D3822740, $99BC9BBE, $D5118E9D, $BF0F7315, $D62D1C7E, $C700C47B, + $B78C1B6B, $21A19045, $B26EB1BE, $6A366EB4, $5748AB2F, $BC946E79, $C6A376D2, $6549C2C8, $530FF8EE, $468DDE7D, $D5730A1D, $4CD04DC6, $2939BBDB, $A9BA4650, $AC9526E8, $BE5EE304, $A1FAD5F0, $6A2D519A, $63EF8CE2, $9A86EE22, $C089C2B8, $43242EF6, $A51E03AA, $9CF2D0A4, $83C061BA, $9BE96A4D, $8FE51550, $BA645BD6, + $2826A2F9, $A73A3AE1, $4BA99586, $EF5562E9, $C72FEFD3, $F752F7DA, $3F046F69, $77FA0A59, $80E4A915, $87B08601, $9B09E6AD, $3B3EE593, $E990FD5A, $9E34D797, $2CF0B7D9, $022B8B51, $96D5AC3A, $017DA67D, $D1CF3ED6, $7C7D2D28, $1F9F25CF, $ADF2B89B, $5AD6B472, $5A88F54C, $E029AC71, $E019A5E6, $47B0ACFD, $ED93FA9B, + $E8D3C48D, $283B57CC, $F8D56629, $79132E28, $785F0191, $ED756055, $F7960E44, $E3D35E8C, $15056DD4, $88F46DBA, $03A16125, $0564F0BD, $C3EB9E15, $3C9057A2, $97271AEC, $A93A072A, $1B3F6D9B, $1E6321F5, $F59C66FB, $26DCF319, $7533D928, $B155FDF5, $03563482, $8ABA3CBB, $28517711, $C20AD9F8, $ABCC5167, $CCAD925F, + $4DE81751, $3830DC8E, $379D5862, $9320F991, $EA7A90C2, $FB3E7BCE, $5121CE64, $774FBE32, $A8B6E37E, $C3293D46, $48DE5369, $6413E680, $A2AE0810, $DD6DB224, $69852DFD, $09072166, $B39A460A, $6445C0DD, $586CDECF, $1C20C8AE, $5BBEF7DD, $1B588D40, $CCD2017F, $6BB4E3BB, $DDA26A7E, $3A59FF45, $3E350A44, $BCB4CDD5, + $72EACEA8, $FA6484BB, $8D6612AE, $BF3C6F47, $D29BE463, $542F5D9E, $AEC2771B, $F64E6370, $740E0D8D, $E75B1357, $F8721671, $AF537D5D, $4040CB08, $4EB4E2CC, $34D2466A, $0115AF84, $E1B00428, $95983A1D, $06B89FB4, $CE6EA048, $6F3F3B82, $3520AB82, $011A1D4B, $277227F8, $611560B1, $E7933FDC, $BB3A792B, $344525BD, + $A08839E1, $51CE794B, $2F32C9B7, $A01FBAC9, $E01CC87E, $BCC7D1F6, $CF0111C3, $A1E8AAC7, $1A908749, $D44FBD9A, $D0DADECB, $D50ADA38, $0339C32A, $C6913667, $8DF9317C, $E0B12B4F, $F79E59B7, $43F5BB3A, $F2D519FF, $27D9459C, $BF97222C, $15E6FC2A, $0F91FC71, $9B941525, $FAE59361, $CEB69CEB, $C2A86459, $12BAA8D1, + $B6C1075E, $E3056A0C, $10D25065, $CB03A442, $E0EC6E0E, $1698DB3B, $4C98A0BE, $3278E964, $9F1F9532, $E0D392DF, $D3A0342B, $8971F21E, $1B0A7441, $4BA3348C, $C5BE7120, $C37632D8, $DF359F8D, $9B992F2E, $E60B6F47, $0FE3F11D, $E54CDA54, $1EDAD891, $CE6279CF, $CD3E7E6F, $1618B166, $FD2C1D05, $848FD2C5, $F6FB2299, + $F523F357, $A6327623, $93A83531, $56CCCD02, $ACF08162, $5A75EBB5, $6E163697, $88D273CC, $DE966292, $81B949D0, $4C50901B, $71C65614, $E6C6C7BD, $327A140A, $45E1D006, $C3F27B9A, $C9AA53FD, $62A80F00, $BB25BFE2, $35BDD2F6, $71126905, $B2040222, $B6CBCF7C, $CD769C2B, $53113EC0, $1640E3D3, $38ABBD60, $2547ADF0, + $BA38209C, $F746CE76, $77AFA1C5, $20756060, $85CBFE4E, $8AE88DD8, $7AAAF9B0, $4CF9AA7E, $1948C25C, $02FB8A8C, $01C36AE4, $D6EBE1F9, $90D4F869, $A65CDEA0, $3F09252D, $C208E69F, $B74E6132, $CE77E25B, $578FDFE3, $3AC372E6)); + +class function TncEnc_blowfish.GetAlgorithm: string; +begin + Result := 'Blowfish'; +end; + +class function TncEnc_blowfish.GetMaxKeySize: Integer; +begin + Result := 448; +end; + +class function TncEnc_blowfish.SelfTest: Boolean; +const + Key1: array [0 .. 7] of Byte = ($00, $00, $00, $00, $00, $00, $00, $00); + Key2: array [0 .. 7] of Byte = ($7C, $A1, $10, $45, $4A, $1A, $6E, $57); + InData1: array [0 .. 7] of Byte = ($00, $00, $00, $00, $00, $00, $00, $00); + InData2: array [0 .. 7] of Byte = ($01, $A1, $D6, $D0, $39, $77, $67, $42); + OutData1: array [0 .. 7] of Byte = ($4E, $F9, $97, $45, $61, $98, $DD, $78); + OutData2: array [0 .. 7] of Byte = ($59, $C6, $82, $45, $EB, $05, $28, $2B); +var + Cipher: TncEnc_blowfish; + Data: array [0 .. 7] of Byte; +begin + Cipher := TncEnc_blowfish.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Data); + Result := Boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.Reset; + Cipher.DecryptECB(Data, Data); + Result := Boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(InData2, Data); + Result := Boolean(CompareMem(@Data, @OutData2, Sizeof(Data))) and Result; + Cipher.Reset; + Cipher.DecryptECB(Data, Data); + Result := Boolean(CompareMem(@Data, @InData2, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_blowfish.InitKey(const Key; Size: longword); +var + i, k: longword; + A: UInt32; + KeyB: PByteArray; + Block: array [0 .. 7] of Byte; +begin + Size := Size div 8; + KeyB := @Key; + Move(SBoxOrg, SBox, Sizeof(SBox)); + Move(PBoxOrg, PBox, Sizeof(PBox)); + k := 0; + for i := 0 to 17 do + begin + A := UInt32(KeyB^[(k + 3) mod Size]); + A := A + (UInt32(KeyB^[(k + 2) mod Size]) shl 8); + A := A + (UInt32(KeyB^[(k + 1) mod Size]) shl 16); + A := A + (UInt32(KeyB^[k]) shl 24); + PBox[i] := PBox[i] xor A; + k := (k + 4) mod Size; + end; + FillChar(Block, Sizeof(Block), 0); + for i := 0 to 8 do + begin + EncryptECB(Block, Block); + PBox[i * 2] := UInt32(Block[3]) + (UInt32(Block[2]) shl 8) + (UInt32(Block[1]) shl 16) + (UInt32(Block[0]) shl 24); + PBox[i * 2 + 1] := UInt32(Block[7]) + (UInt32(Block[6]) shl 8) + (UInt32(Block[5]) shl 16) + (UInt32(Block[4]) shl 24); + end; + for k := 0 to 3 do + begin + for i := 0 to 127 do + begin + EncryptECB(Block, Block); + SBox[k, i * 2] := UInt32(Block[3]) + (UInt32(Block[2]) shl 8) + (UInt32(Block[1]) shl 16) + (UInt32(Block[0]) shl 24); + SBox[k, i * 2 + 1] := UInt32(Block[7]) + (UInt32(Block[6]) shl 8) + (UInt32(Block[5]) shl 16) + (UInt32(Block[4]) shl 24); + end; + end; +end; + +procedure TncEnc_blowfish.Burn; +begin + FillChar(SBox, Sizeof(SBox), $FF); + FillChar(PBox, Sizeof(PBox), $FF); + inherited Burn; +end; + +procedure TncEnc_blowfish.EncryptECB(const InData; var OutData); +var + xL, xR: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + xL := PUInt32(@InData)^; + xR := PUInt32(NativeUInt(@InData) + 4)^; + xL := ((xL and $FF) shl 24) or ((xL and $FF00) shl 8) or ((xL and $FF0000) shr 8) or ((xL and $FF000000) shr 24); + xR := ((xR and $FF) shl 24) or ((xR and $FF00) shl 8) or ((xR and $FF0000) shr 8) or ((xR and $FF000000) shr 24); + xL := xL xor PBox[0]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[1]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[2]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[3]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[4]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[5]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[6]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[7]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[8]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[9]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[10]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[11]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[12]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[13]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[14]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[15]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[16]; + xR := xR xor PBox[17]; + xL := ((xL and $FF) shl 24) or ((xL and $FF00) shl 8) or ((xL and $FF0000) shr 8) or ((xL and $FF000000) shr 24); + xR := ((xR and $FF) shl 24) or ((xR and $FF00) shl 8) or ((xR and $FF0000) shr 8) or ((xR and $FF000000) shr 24); + PUInt32(@OutData)^ := xR; + PUInt32(NativeUInt(@OutData) + 4)^ := xL; +end; + +procedure TncEnc_blowfish.DecryptECB(const InData; var OutData); +var + xL, xR: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + xL := PUInt32(@InData)^; + xR := PUInt32(NativeUInt(@InData) + 4)^; + xL := (xL shr 24) or ((xL shr 8) and $FF00) or ((xL shl 8) and $FF0000) or (xL shl 24); + xR := (xR shr 24) or ((xR shr 8) and $FF00) or ((xR shl 8) and $FF0000) or (xR shl 24); + xL := xL xor PBox[17]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[16]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[15]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[14]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[13]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[12]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[11]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[10]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[9]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[8]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[7]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[6]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[5]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[4]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[3]; + xR := xR xor (((SBox[0, (xL shr 24) and $FF] + SBox[1, (xL shr 16) and $FF]) xor SBox[2, (xL shr 8) and $FF]) + SBox[3, xL and $FF]) xor PBox[2]; + xL := xL xor (((SBox[0, (xR shr 24) and $FF] + SBox[1, (xR shr 16) and $FF]) xor SBox[2, (xR shr 8) and $FF]) + SBox[3, xR and $FF]) xor PBox[1]; + xR := xR xor PBox[0]; + xL := (xL shr 24) or ((xL shr 8) and $FF00) or ((xL shl 8) and $FF0000) or (xL shl 24); + xR := (xR shr 24) or ((xR shr 8) and $FF00) or ((xR shl 8) and $FF0000) or (xR shl 24); + PUInt32(@OutData)^ := xR; + PUInt32(NativeUInt(@OutData) + 4)^ := xL; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncCast128.pas b/Source_using_TMonitor/Encryption/ncEncCast128.pas new file mode 100644 index 0000000..ad54edf --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncCast128.pas @@ -0,0 +1,439 @@ +{$R-} +{$Q-} +unit ncEncCast128; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_cast128 = class(TncEnc_blockcipher64) + protected + KeyData: array [0 .. 31] of UInt32; + Rounds: longword; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + cast_sbox1: array [0 .. 255] of UInt32 = ($30FB40D4, $9FA0FF0B, $6BECCD2F, $3F258C7A, $1E213F2F, $9C004DD3, $6003E540, $CF9FC949, $BFD4AF27, $88BBBDB5, $E2034090, $98D09675, $6E63A0E0, $15C361D2, $C2E7661D, $22D4FF8E, $28683B6F, $C07FD059, $FF2379C8, $775F50E2, $43C340D3, $DF2F8656, $887CA41A, $A2D2BD2D, $A1C9E0D6, + $346C4819, $61B76D87, $22540F2F, $2ABE32E1, $AA54166B, $22568E3A, $A2D341D0, $66DB40C8, $A784392F, $004DFF2F, $2DB9D2DE, $97943FAC, $4A97C1D8, $527644B7, $B5F437A7, $B82CBAEF, $D751D159, $6FF7F0ED, $5A097A1F, $827B68D0, $90ECF52E, $22B0C054, $BC8E5935, $4B6D2F7F, $50BB64A2, $D2664910, $BEE5812D, $B7332290, + $E93B159F, $B48EE411, $4BFF345D, $FD45C240, $AD31973F, $C4F6D02E, $55FC8165, $D5B1CAAD, $A1AC2DAE, $A2D4B76D, $C19B0C50, $882240F2, $0C6E4F38, $A4E4BFD7, $4F5BA272, $564C1D2F, $C59C5319, $B949E354, $B04669FE, $B1B6AB8A, $C71358DD, $6385C545, $110F935D, $57538AD5, $6A390493, $E63D37E0, $2A54F6B3, $3A787D5F, + $6276A0B5, $19A6FCDF, $7A42206A, $29F9D4D5, $F61B1891, $BB72275E, $AA508167, $38901091, $C6B505EB, $84C7CB8C, $2AD75A0F, $874A1427, $A2D1936B, $2AD286AF, $AA56D291, $D7894360, $425C750D, $93B39E26, $187184C9, $6C00B32D, $73E2BB14, $A0BEBC3C, $54623779, $64459EAB, $3F328B82, $7718CF82, $59A2CEA6, $04EE002E, + $89FE78E6, $3FAB0950, $325FF6C2, $81383F05, $6963C5C8, $76CB5AD6, $D49974C9, $CA180DCF, $380782D5, $C7FA5CF6, $8AC31511, $35E79E13, $47DA91D0, $F40F9086, $A7E2419E, $31366241, $051EF495, $AA573B04, $4A805D8D, $548300D0, $00322A3C, $BF64CDDF, $BA57A68E, $75C6372B, $50AFD341, $A7C13275, $915A0BF5, $6B54BFAB, + $2B0B1426, $AB4CC9D7, $449CCD82, $F7FBF265, $AB85C5F3, $1B55DB94, $AAD4E324, $CFA4BD3F, $2DEAA3E2, $9E204D02, $C8BD25AC, $EADF55B3, $D5BD9E98, $E31231B2, $2AD5AD6C, $954329DE, $ADBE4528, $D8710F69, $AA51C90F, $AA786BF6, $22513F1E, $AA51A79B, $2AD344CC, $7B5A41F0, $D37CFBAD, $1B069505, $41ECE491, $B4C332E6, + $032268D4, $C9600ACC, $CE387E6D, $BF6BB16C, $6A70FB78, $0D03D9C9, $D4DF39DE, $E01063DA, $4736F464, $5AD328D8, $B347CC96, $75BB0FC3, $98511BFB, $4FFBCC35, $B58BCF6A, $E11F0ABC, $BFC5FE4A, $A70AEC10, $AC39570A, $3F04442F, $6188B153, $E0397A2E, $5727CB79, $9CEB418F, $1CACD68D, $2AD37C96, $0175CB9D, $C69DFF09, + $C75B65F0, $D9DB40D8, $EC0E7779, $4744EAD4, $B11C3274, $DD24CB9E, $7E1C54BD, $F01144F9, $D2240EB1, $9675B3FD, $A3AC3755, $D47C27AF, $51C85F4D, $56907596, $A5BB15E6, $580304F0, $CA042CF1, $011A37EA, $8DBFAADB, $35BA3E4A, $3526FFA0, $C37B4D09, $BC306ED9, $98A52666, $5648F725, $FF5E569D, $0CED63D0, $7C63B2CF, + $700B45E1, $D5EA50F1, $85A92872, $AF1FBDA7, $D4234870, $A7870BF3, $2D3B4D79, $42E04198, $0CD0EDE7, $26470DB8, $F881814C, $474D6AD7, $7C0C5E5C, $D1231959, $381B7298, $F5D2F4DB, $AB838653, $6E2F1E23, $83719C9E, $BD91E046, $9A56456E, $DC39200C, $20C8C571, $962BDA1C, $E1E696FF, $B141AB08, $7CCA89B9, $1A69E783, + $02CC4843, $A2F7C579, $429EF47D, $427B169C, $5AC9F049, $DD8F0F00, $5C8165BF); + + cast_sbox2: array [0 .. 255] of UInt32 = ($1F201094, $EF0BA75B, $69E3CF7E, $393F4380, $FE61CF7A, $EEC5207A, $55889C94, $72FC0651, $ADA7EF79, $4E1D7235, $D55A63CE, $DE0436BA, $99C430EF, $5F0C0794, $18DCDB7D, $A1D6EFF3, $A0B52F7B, $59E83605, $EE15B094, $E9FFD909, $DC440086, $EF944459, $BA83CCB3, $E0C3CDFB, $D1DA4181, + $3B092AB1, $F997F1C1, $A5E6CF7B, $01420DDB, $E4E7EF5B, $25A1FF41, $E180F806, $1FC41080, $179BEE7A, $D37AC6A9, $FE5830A4, $98DE8B7F, $77E83F4E, $79929269, $24FA9F7B, $E113C85B, $ACC40083, $D7503525, $F7EA615F, $62143154, $0D554B63, $5D681121, $C866C359, $3D63CF73, $CEE234C0, $D4D87E87, $5C672B21, $071F6181, + $39F7627F, $361E3084, $E4EB573B, $602F64A4, $D63ACD9C, $1BBC4635, $9E81032D, $2701F50C, $99847AB4, $A0E3DF79, $BA6CF38C, $10843094, $2537A95E, $F46F6FFE, $A1FF3B1F, $208CFB6A, $8F458C74, $D9E0A227, $4EC73A34, $FC884F69, $3E4DE8DF, $EF0E0088, $3559648D, $8A45388C, $1D804366, $721D9BFD, $A58684BB, $E8256333, + $844E8212, $128D8098, $FED33FB4, $CE280AE1, $27E19BA5, $D5A6C252, $E49754BD, $C5D655DD, $EB667064, $77840B4D, $A1B6A801, $84DB26A9, $E0B56714, $21F043B7, $E5D05860, $54F03084, $066FF472, $A31AA153, $DADC4755, $B5625DBF, $68561BE6, $83CA6B94, $2D6ED23B, $ECCF01DB, $A6D3D0BA, $B6803D5C, $AF77A709, $33B4A34C, + $397BC8D6, $5EE22B95, $5F0E5304, $81ED6F61, $20E74364, $B45E1378, $DE18639B, $881CA122, $B96726D1, $8049A7E8, $22B7DA7B, $5E552D25, $5272D237, $79D2951C, $C60D894C, $488CB402, $1BA4FE5B, $A4B09F6B, $1CA815CF, $A20C3005, $8871DF63, $B9DE2FCB, $0CC6C9E9, $0BEEFF53, $E3214517, $B4542835, $9F63293C, $EE41E729, + $6E1D2D7C, $50045286, $1E6685F3, $F33401C6, $30A22C95, $31A70850, $60930F13, $73F98417, $A1269859, $EC645C44, $52C877A9, $CDFF33A6, $A02B1741, $7CBAD9A2, $2180036F, $50D99C08, $CB3F4861, $C26BD765, $64A3F6AB, $80342676, $25A75E7B, $E4E6D1FC, $20C710E6, $CDF0B680, $17844D3B, $31EEF84D, $7E0824E4, $2CCB49EB, + $846A3BAE, $8FF77888, $EE5D60F6, $7AF75673, $2FDD5CDB, $A11631C1, $30F66F43, $B3FAEC54, $157FD7FA, $EF8579CC, $D152DE58, $DB2FFD5E, $8F32CE19, $306AF97A, $02F03EF8, $99319AD5, $C242FA0F, $A7E3EBB0, $C68E4906, $B8DA230C, $80823028, $DCDEF3C8, $D35FB171, $088A1BC8, $BEC0C560, $61A3C9E8, $BCA8F54D, $C72FEFFA, + $22822E99, $82C570B4, $D8D94E89, $8B1C34BC, $301E16E6, $273BE979, $B0FFEAA6, $61D9B8C6, $00B24869, $B7FFCE3F, $08DC283B, $43DAF65A, $F7E19798, $7619B72F, $8F1C9BA4, $DC8637A0, $16A7D3B1, $9FC393B7, $A7136EEB, $C6BCC63E, $1A513742, $EF6828BC, $520365D6, $2D6A77AB, $3527ED4B, $821FD216, $095C6E2E, $DB92F2FB, + $5EEA29CB, $145892F5, $91584F7F, $5483697B, $2667A8CC, $85196048, $8C4BACEA, $833860D4, $0D23E0F9, $6C387E8A, $0AE6D249, $B284600C, $D835731D, $DCB1C647, $AC4C56EA, $3EBD81B3, $230EABB0, $6438BC87, $F0B5B1FA, $8F5EA2B3, $FC184642, $0A036B7A, $4FB089BD, $649DA589, $A345415E, $5C038323, $3E5D3BB9, $43D79572, + $7E6DD07C, $06DFDF1E, $6C6CC4EF, $7160A539, $73BFBE70, $83877605, $4523ECF1); + + cast_sbox3: array [0 .. 255] of UInt32 = ($8DEFC240, $25FA5D9F, $EB903DBF, $E810C907, $47607FFF, $369FE44B, $8C1FC644, $AECECA90, $BEB1F9BF, $EEFBCAEA, $E8CF1950, $51DF07AE, $920E8806, $F0AD0548, $E13C8D83, $927010D5, $11107D9F, $07647DB9, $B2E3E4D4, $3D4F285E, $B9AFA820, $FADE82E0, $A067268B, $8272792E, $553FB2C0, + $489AE22B, $D4EF9794, $125E3FBC, $21FFFCEE, $825B1BFD, $9255C5ED, $1257A240, $4E1A8302, $BAE07FFF, $528246E7, $8E57140E, $3373F7BF, $8C9F8188, $A6FC4EE8, $C982B5A5, $A8C01DB7, $579FC264, $67094F31, $F2BD3F5F, $40FFF7C1, $1FB78DFC, $8E6BD2C1, $437BE59B, $99B03DBF, $B5DBC64B, $638DC0E6, $55819D99, $A197C81C, + $4A012D6E, $C5884A28, $CCC36F71, $B843C213, $6C0743F1, $8309893C, $0FEDDD5F, $2F7FE850, $D7C07F7E, $02507FBF, $5AFB9A04, $A747D2D0, $1651192E, $AF70BF3E, $58C31380, $5F98302E, $727CC3C4, $0A0FB402, $0F7FEF82, $8C96FDAD, $5D2C2AAE, $8EE99A49, $50DA88B8, $8427F4A0, $1EAC5790, $796FB449, $8252DC15, $EFBD7D9B, + $A672597D, $ADA840D8, $45F54504, $FA5D7403, $E83EC305, $4F91751A, $925669C2, $23EFE941, $A903F12E, $60270DF2, $0276E4B6, $94FD6574, $927985B2, $8276DBCB, $02778176, $F8AF918D, $4E48F79E, $8F616DDF, $E29D840E, $842F7D83, $340CE5C8, $96BBB682, $93B4B148, $EF303CAB, $984FAF28, $779FAF9B, $92DC560D, $224D1E20, + $8437AA88, $7D29DC96, $2756D3DC, $8B907CEE, $B51FD240, $E7C07CE3, $E566B4A1, $C3E9615E, $3CF8209D, $6094D1E3, $CD9CA341, $5C76460E, $00EA983B, $D4D67881, $FD47572C, $F76CEDD9, $BDA8229C, $127DADAA, $438A074E, $1F97C090, $081BDB8A, $93A07EBE, $B938CA15, $97B03CFF, $3DC2C0F8, $8D1AB2EC, $64380E51, $68CC7BFB, + $D90F2788, $12490181, $5DE5FFD4, $DD7EF86A, $76A2E214, $B9A40368, $925D958F, $4B39FFFA, $BA39AEE9, $A4FFD30B, $FAF7933B, $6D498623, $193CBCFA, $27627545, $825CF47A, $61BD8BA0, $D11E42D1, $CEAD04F4, $127EA392, $10428DB7, $8272A972, $9270C4A8, $127DE50B, $285BA1C8, $3C62F44F, $35C0EAA5, $E805D231, $428929FB, + $B4FCDF82, $4FB66A53, $0E7DC15B, $1F081FAB, $108618AE, $FCFD086D, $F9FF2889, $694BCC11, $236A5CAE, $12DECA4D, $2C3F8CC5, $D2D02DFE, $F8EF5896, $E4CF52DA, $95155B67, $494A488C, $B9B6A80C, $5C8F82BC, $89D36B45, $3A609437, $EC00C9A9, $44715253, $0A874B49, $D773BC40, $7C34671C, $02717EF6, $4FEB5536, $A2D02FFF, + $D2BF60C4, $D43F03C0, $50B4EF6D, $07478CD1, $006E1888, $A2E53F55, $B9E6D4BC, $A2048016, $97573833, $D7207D67, $DE0F8F3D, $72F87B33, $ABCC4F33, $7688C55D, $7B00A6B0, $947B0001, $570075D2, $F9BB88F8, $8942019E, $4264A5FF, $856302E0, $72DBD92B, $EE971B69, $6EA22FDE, $5F08AE2B, $AF7A616D, $E5C98767, $CF1FEBD2, + $61EFC8C2, $F1AC2571, $CC8239C2, $67214CB8, $B1E583D1, $B7DC3E62, $7F10BDCE, $F90A5C38, $0FF0443D, $606E6DC6, $60543A49, $5727C148, $2BE98A1D, $8AB41738, $20E1BE24, $AF96DA0F, $68458425, $99833BE5, $600D457D, $282F9350, $8334B362, $D91D1120, $2B6D8DA0, $642B1E31, $9C305A00, $52BCE688, $1B03588A, $F7BAEFD5, + $4142ED9C, $A4315C11, $83323EC5, $DFEF4636, $A133C501, $E9D3531C, $EE353783); + + cast_sbox4: array [0 .. 255] of UInt32 = ($9DB30420, $1FB6E9DE, $A7BE7BEF, $D273A298, $4A4F7BDB, $64AD8C57, $85510443, $FA020ED1, $7E287AFF, $E60FB663, $095F35A1, $79EBF120, $FD059D43, $6497B7B1, $F3641F63, $241E4ADF, $28147F5F, $4FA2B8CD, $C9430040, $0CC32220, $FDD30B30, $C0A5374F, $1D2D00D9, $24147B15, $EE4D111A, + $0FCA5167, $71FF904C, $2D195FFE, $1A05645F, $0C13FEFE, $081B08CA, $05170121, $80530100, $E83E5EFE, $AC9AF4F8, $7FE72701, $D2B8EE5F, $06DF4261, $BB9E9B8A, $7293EA25, $CE84FFDF, $F5718801, $3DD64B04, $A26F263B, $7ED48400, $547EEBE6, $446D4CA0, $6CF3D6F5, $2649ABDF, $AEA0C7F5, $36338CC1, $503F7E93, $D3772061, + $11B638E1, $72500E03, $F80EB2BB, $ABE0502E, $EC8D77DE, $57971E81, $E14F6746, $C9335400, $6920318F, $081DBB99, $FFC304A5, $4D351805, $7F3D5CE3, $A6C866C6, $5D5BCCA9, $DAEC6FEA, $9F926F91, $9F46222F, $3991467D, $A5BF6D8E, $1143C44F, $43958302, $D0214EEB, $022083B8, $3FB6180C, $18F8931E, $281658E6, $26486E3E, + $8BD78A70, $7477E4C1, $B506E07C, $F32D0A25, $79098B02, $E4EABB81, $28123B23, $69DEAD38, $1574CA16, $DF871B62, $211C40B7, $A51A9EF9, $0014377B, $041E8AC8, $09114003, $BD59E4D2, $E3D156D5, $4FE876D5, $2F91A340, $557BE8DE, $00EAE4A7, $0CE5C2EC, $4DB4BBA6, $E756BDFF, $DD3369AC, $EC17B035, $06572327, $99AFC8B0, + $56C8C391, $6B65811C, $5E146119, $6E85CB75, $BE07C002, $C2325577, $893FF4EC, $5BBFC92D, $D0EC3B25, $B7801AB7, $8D6D3B24, $20C763EF, $C366A5FC, $9C382880, $0ACE3205, $AAC9548A, $ECA1D7C7, $041AFA32, $1D16625A, $6701902C, $9B757A54, $31D477F7, $9126B031, $36CC6FDB, $C70B8B46, $D9E66A48, $56E55A79, $026A4CEB, + $52437EFF, $2F8F76B4, $0DF980A5, $8674CDE3, $EDDA04EB, $17A9BE04, $2C18F4DF, $B7747F9D, $AB2AF7B4, $EFC34D20, $2E096B7C, $1741A254, $E5B6A035, $213D42F6, $2C1C7C26, $61C2F50F, $6552DAF9, $D2C231F8, $25130F69, $D8167FA2, $0418F2C8, $001A96A6, $0D1526AB, $63315C21, $5E0A72EC, $49BAFEFD, $187908D9, $8D0DBD86, + $311170A7, $3E9B640C, $CC3E10D7, $D5CAD3B6, $0CAEC388, $F73001E1, $6C728AFF, $71EAE2A1, $1F9AF36E, $CFCBD12F, $C1DE8417, $AC07BE6B, $CB44A1D8, $8B9B0F56, $013988C3, $B1C52FCA, $B4BE31CD, $D8782806, $12A3A4E2, $6F7DE532, $58FD7EB6, $D01EE900, $24ADFFC2, $F4990FC5, $9711AAC5, $001D7B95, $82E5E7D2, $109873F6, + $00613096, $C32D9521, $ADA121FF, $29908415, $7FBB977F, $AF9EB3DB, $29C9ED2A, $5CE2A465, $A730F32C, $D0AA3FE8, $8A5CC091, $D49E2CE7, $0CE454A9, $D60ACD86, $015F1919, $77079103, $DEA03AF6, $78A8565E, $DEE356DF, $21F05CBE, $8B75E387, $B3C50651, $B8A5C3EF, $D8EEB6D2, $E523BE77, $C2154529, $2F69EFDF, $AFE67AFB, + $F470C4B2, $F3E0EB5B, $D6CC9876, $39E4460C, $1FDA8538, $1987832F, $CA007367, $A99144F8, $296B299E, $492FC295, $9266BEAB, $B5676E69, $9BD3DDDA, $DF7E052F, $DB25701C, $1B5E51EE, $F65324E6, $6AFCE36C, $0316CC04, $8644213E, $B7DC59D0, $7965291F, $CCD6FD43, $41823979, $932BCDF6, $B657C34D, $4EDFD282, $7AE5290C, + $3CB9536B, $851E20FE, $9833557E, $13ECF0B0, $D3FFB372, $3F85C5C1, $0AEF7ED2); + + cast_sbox5: array [0 .. 255] of UInt32 = ($7EC90C04, $2C6E74B9, $9B0E66DF, $A6337911, $B86A7FFF, $1DD358F5, $44DD9D44, $1731167F, $08FBF1FA, $E7F511CC, $D2051B00, $735ABA00, $2AB722D8, $386381CB, $ACF6243A, $69BEFD7A, $E6A2E77F, $F0C720CD, $C4494816, $CCF5C180, $38851640, $15B0A848, $E68B18CB, $4CAADEFF, $5F480A01, + $0412B2AA, $259814FC, $41D0EFE2, $4E40B48D, $248EB6FB, $8DBA1CFE, $41A99B02, $1A550A04, $BA8F65CB, $7251F4E7, $95A51725, $C106ECD7, $97A5980A, $C539B9AA, $4D79FE6A, $F2F3F763, $68AF8040, $ED0C9E56, $11B4958B, $E1EB5A88, $8709E6B0, $D7E07156, $4E29FEA7, $6366E52D, $02D1C000, $C4AC8E05, $9377F571, $0C05372A, + $578535F2, $2261BE02, $D642A0C9, $DF13A280, $74B55BD2, $682199C0, $D421E5EC, $53FB3CE8, $C8ADEDB3, $28A87FC9, $3D959981, $5C1FF900, $FE38D399, $0C4EFF0B, $062407EA, $AA2F4FB1, $4FB96976, $90C79505, $B0A8A774, $EF55A1FF, $E59CA2C2, $A6B62D27, $E66A4263, $DF65001F, $0EC50966, $DFDD55BC, $29DE0655, $911E739A, + $17AF8975, $32C7911C, $89F89468, $0D01E980, $524755F4, $03B63CC9, $0CC844B2, $BCF3F0AA, $87AC36E9, $E53A7426, $01B3D82B, $1A9E7449, $64EE2D7E, $CDDBB1DA, $01C94910, $B868BF80, $0D26F3FD, $9342EDE7, $04A5C284, $636737B6, $50F5B616, $F24766E3, $8ECA36C1, $136E05DB, $FEF18391, $FB887A37, $D6E7F7D4, $C7FB7DC9, + $3063FCDF, $B6F589DE, $EC2941DA, $26E46695, $B7566419, $F654EFC5, $D08D58B7, $48925401, $C1BACB7F, $E5FF550F, $B6083049, $5BB5D0E8, $87D72E5A, $AB6A6EE1, $223A66CE, $C62BF3CD, $9E0885F9, $68CB3E47, $086C010F, $A21DE820, $D18B69DE, $F3F65777, $FA02C3F6, $407EDAC3, $CBB3D550, $1793084D, $B0D70EBA, $0AB378D5, + $D951FB0C, $DED7DA56, $4124BBE4, $94CA0B56, $0F5755D1, $E0E1E56E, $6184B5BE, $580A249F, $94F74BC0, $E327888E, $9F7B5561, $C3DC0280, $05687715, $646C6BD7, $44904DB3, $66B4F0A3, $C0F1648A, $697ED5AF, $49E92FF6, $309E374F, $2CB6356A, $85808573, $4991F840, $76F0AE02, $083BE84D, $28421C9A, $44489406, $736E4CB8, + $C1092910, $8BC95FC6, $7D869CF4, $134F616F, $2E77118D, $B31B2BE1, $AA90B472, $3CA5D717, $7D161BBA, $9CAD9010, $AF462BA2, $9FE459D2, $45D34559, $D9F2DA13, $DBC65487, $F3E4F94E, $176D486F, $097C13EA, $631DA5C7, $445F7382, $175683F4, $CDC66A97, $70BE0288, $B3CDCF72, $6E5DD2F3, $20936079, $459B80A5, $BE60E2DB, + $A9C23101, $EBA5315C, $224E42F2, $1C5C1572, $F6721B2C, $1AD2FFF3, $8C25404E, $324ED72F, $4067B7FD, $0523138E, $5CA3BC78, $DC0FD66E, $75922283, $784D6B17, $58EBB16E, $44094F85, $3F481D87, $FCFEAE7B, $77B5FF76, $8C2302BF, $AAF47556, $5F46B02A, $2B092801, $3D38F5F7, $0CA81F36, $52AF4A8A, $66D5E7C0, $DF3B0874, + $95055110, $1B5AD7A8, $F61ED5AD, $6CF6E479, $20758184, $D0CEFA65, $88F7BE58, $4A046826, $0FF6F8F3, $A09C7F70, $5346ABA0, $5CE96C28, $E176EDA3, $6BAC307F, $376829D2, $85360FA9, $17E3FE2A, $24B79767, $F5A96B20, $D6CD2595, $68FF1EBF, $7555442C, $F19F06BE, $F9E0659A, $EEB9491D, $34010718, $BB30CAB8, $E822FE15, + $88570983, $750E6249, $DA627E55, $5E76FFA8, $B1534546, $6D47DE08, $EFE9E7D4); + + cast_sbox6: array [0 .. 255] of UInt32 = ($F6FA8F9D, $2CAC6CE1, $4CA34867, $E2337F7C, $95DB08E7, $016843B4, $ECED5CBC, $325553AC, $BF9F0960, $DFA1E2ED, $83F0579D, $63ED86B9, $1AB6A6B8, $DE5EBE39, $F38FF732, $8989B138, $33F14961, $C01937BD, $F506C6DA, $E4625E7E, $A308EA99, $4E23E33C, $79CBD7CC, $48A14367, $A3149619, + $FEC94BD5, $A114174A, $EAA01866, $A084DB2D, $09A8486F, $A888614A, $2900AF98, $01665991, $E1992863, $C8F30C60, $2E78EF3C, $D0D51932, $CF0FEC14, $F7CA07D2, $D0A82072, $FD41197E, $9305A6B0, $E86BE3DA, $74BED3CD, $372DA53C, $4C7F4448, $DAB5D440, $6DBA0EC3, $083919A7, $9FBAEED9, $49DBCFB0, $4E670C53, $5C3D9C01, + $64BDB941, $2C0E636A, $BA7DD9CD, $EA6F7388, $E70BC762, $35F29ADB, $5C4CDD8D, $F0D48D8C, $B88153E2, $08A19866, $1AE2EAC8, $284CAF89, $AA928223, $9334BE53, $3B3A21BF, $16434BE3, $9AEA3906, $EFE8C36E, $F890CDD9, $80226DAE, $C340A4A3, $DF7E9C09, $A694A807, $5B7C5ECC, $221DB3A6, $9A69A02F, $68818A54, $CEB2296F, + $53C0843A, $FE893655, $25BFE68A, $B4628ABC, $CF222EBF, $25AC6F48, $A9A99387, $53BDDB65, $E76FFBE7, $E967FD78, $0BA93563, $8E342BC1, $E8A11BE9, $4980740D, $C8087DFC, $8DE4BF99, $A11101A0, $7FD37975, $DA5A26C0, $E81F994F, $9528CD89, $FD339FED, $B87834BF, $5F04456D, $22258698, $C9C4C83B, $2DC156BE, $4F628DAA, + $57F55EC5, $E2220ABE, $D2916EBF, $4EC75B95, $24F2C3C0, $42D15D99, $CD0D7FA0, $7B6E27FF, $A8DC8AF0, $7345C106, $F41E232F, $35162386, $E6EA8926, $3333B094, $157EC6F2, $372B74AF, $692573E4, $E9A9D848, $F3160289, $3A62EF1D, $A787E238, $F3A5F676, $74364853, $20951063, $4576698D, $B6FAD407, $592AF950, $36F73523, + $4CFB6E87, $7DA4CEC0, $6C152DAA, $CB0396A8, $C50DFE5D, $FCD707AB, $0921C42F, $89DFF0BB, $5FE2BE78, $448F4F33, $754613C9, $2B05D08D, $48B9D585, $DC049441, $C8098F9B, $7DEDE786, $C39A3373, $42410005, $6A091751, $0EF3C8A6, $890072D6, $28207682, $A9A9F7BE, $BF32679D, $D45B5B75, $B353FD00, $CBB0E358, $830F220A, + $1F8FB214, $D372CF08, $CC3C4A13, $8CF63166, $061C87BE, $88C98F88, $6062E397, $47CF8E7A, $B6C85283, $3CC2ACFB, $3FC06976, $4E8F0252, $64D8314D, $DA3870E3, $1E665459, $C10908F0, $513021A5, $6C5B68B7, $822F8AA0, $3007CD3E, $74719EEF, $DC872681, $073340D4, $7E432FD9, $0C5EC241, $8809286C, $F592D891, $08A930F6, + $957EF305, $B7FBFFBD, $C266E96F, $6FE4AC98, $B173ECC0, $BC60B42A, $953498DA, $FBA1AE12, $2D4BD736, $0F25FAAB, $A4F3FCEB, $E2969123, $257F0C3D, $9348AF49, $361400BC, $E8816F4A, $3814F200, $A3F94043, $9C7A54C2, $BC704F57, $DA41E7F9, $C25AD33A, $54F4A084, $B17F5505, $59357CBE, $EDBD15C8, $7F97C5AB, $BA5AC7B5, + $B6F6DEAF, $3A479C3A, $5302DA25, $653D7E6A, $54268D49, $51A477EA, $5017D55B, $D7D25D88, $44136C76, $0404A8C8, $B8E5A121, $B81A928A, $60ED5869, $97C55B96, $EAEC991B, $29935913, $01FDB7F1, $088E8DFA, $9AB6F6F5, $3B4CBF9F, $4A5DE3AB, $E6051D35, $A0E1D855, $D36B4CF1, $F544EDEB, $B0E93524, $BEBB8FBD, $A2D762CF, + $49C92F54, $38B5F331, $7128A454, $48392905, $A65B1DB8, $851C97BD, $D675CF2F); + + cast_sbox7: array [0 .. 255] of UInt32 = ($85E04019, $332BF567, $662DBFFF, $CFC65693, $2A8D7F6F, $AB9BC912, $DE6008A1, $2028DA1F, $0227BCE7, $4D642916, $18FAC300, $50F18B82, $2CB2CB11, $B232E75C, $4B3695F2, $B28707DE, $A05FBCF6, $CD4181E9, $E150210C, $E24EF1BD, $B168C381, $FDE4E789, $5C79B0D8, $1E8BFD43, $4D495001, + $38BE4341, $913CEE1D, $92A79C3F, $089766BE, $BAEEADF4, $1286BECF, $B6EACB19, $2660C200, $7565BDE4, $64241F7A, $8248DCA9, $C3B3AD66, $28136086, $0BD8DFA8, $356D1CF2, $107789BE, $B3B2E9CE, $0502AA8F, $0BC0351E, $166BF52A, $EB12FF82, $E3486911, $D34D7516, $4E7B3AFF, $5F43671B, $9CF6E037, $4981AC83, $334266CE, + $8C9341B7, $D0D854C0, $CB3A6C88, $47BC2829, $4725BA37, $A66AD22B, $7AD61F1E, $0C5CBAFA, $4437F107, $B6E79962, $42D2D816, $0A961288, $E1A5C06E, $13749E67, $72FC081A, $B1D139F7, $F9583745, $CF19DF58, $BEC3F756, $C06EBA30, $07211B24, $45C28829, $C95E317F, $BC8EC511, $38BC46E9, $C6E6FA14, $BAE8584A, $AD4EBC46, + $468F508B, $7829435F, $F124183B, $821DBA9F, $AFF60FF4, $EA2C4E6D, $16E39264, $92544A8B, $009B4FC3, $ABA68CED, $9AC96F78, $06A5B79A, $B2856E6E, $1AEC3CA9, $BE838688, $0E0804E9, $55F1BE56, $E7E5363B, $B3A1F25D, $F7DEBB85, $61FE033C, $16746233, $3C034C28, $DA6D0C74, $79AAC56C, $3CE4E1AD, $51F0C802, $98F8F35A, + $1626A49F, $EED82B29, $1D382FE3, $0C4FB99A, $BB325778, $3EC6D97B, $6E77A6A9, $CB658B5C, $D45230C7, $2BD1408B, $60C03EB7, $B9068D78, $A33754F4, $F430C87D, $C8A71302, $B96D8C32, $EBD4E7BE, $BE8B9D2D, $7979FB06, $E7225308, $8B75CF77, $11EF8DA4, $E083C858, $8D6B786F, $5A6317A6, $FA5CF7A0, $5DDA0033, $F28EBFB0, + $F5B9C310, $A0EAC280, $08B9767A, $A3D9D2B0, $79D34217, $021A718D, $9AC6336A, $2711FD60, $438050E3, $069908A8, $3D7FEDC4, $826D2BEF, $4EEB8476, $488DCF25, $36C9D566, $28E74E41, $C2610ACA, $3D49A9CF, $BAE3B9DF, $B65F8DE6, $92AEAF64, $3AC7D5E6, $9EA80509, $F22B017D, $A4173F70, $DD1E16C3, $15E0D7F9, $50B1B887, + $2B9F4FD5, $625ABA82, $6A017962, $2EC01B9C, $15488AA9, $D716E740, $40055A2C, $93D29A22, $E32DBF9A, $058745B9, $3453DC1E, $D699296E, $496CFF6F, $1C9F4986, $DFE2ED07, $B87242D1, $19DE7EAE, $053E561A, $15AD6F8C, $66626C1C, $7154C24C, $EA082B2A, $93EB2939, $17DCB0F0, $58D4F2AE, $9EA294FB, $52CF564C, $9883FE66, + $2EC40581, $763953C3, $01D6692E, $D3A0C108, $A1E7160E, $E4F2DFA6, $693ED285, $74904698, $4C2B0EDD, $4F757656, $5D393378, $A132234F, $3D321C5D, $C3F5E194, $4B269301, $C79F022F, $3C997E7E, $5E4F9504, $3FFAFBBD, $76F7AD0E, $296693F4, $3D1FCE6F, $C61E45BE, $D3B5AB34, $F72BF9B7, $1B0434C0, $4E72B567, $5592A33D, + $B5229301, $CFD2A87F, $60AEB767, $1814386B, $30BCC33D, $38A0C07D, $FD1606F2, $C363519B, $589DD390, $5479F8E6, $1CB8D647, $97FD61A9, $EA7759F4, $2D57539D, $569A58CF, $E84E63AD, $462E1B78, $6580F87E, $F3817914, $91DA55F4, $40A230F3, $D1988F35, $B6E318D2, $3FFA50BC, $3D40F021, $C3C0BDAE, $4958C24C, $518F36B2, + $84B1D370, $0FEDCE83, $878DDADA, $F2A279C7, $94E01BE8, $90716F4B, $954B8AA3); + + cast_sbox8: array [0 .. 255] of UInt32 = ($E216300D, $BBDDFFFC, $A7EBDABD, $35648095, $7789F8B7, $E6C1121B, $0E241600, $052CE8B5, $11A9CFB0, $E5952F11, $ECE7990A, $9386D174, $2A42931C, $76E38111, $B12DEF3A, $37DDDDFC, $DE9ADEB1, $0A0CC32C, $BE197029, $84A00940, $BB243A0F, $B4D137CF, $B44E79F0, $049EEDFD, $0B15A15D, + $480D3168, $8BBBDE5A, $669DED42, $C7ECE831, $3F8F95E7, $72DF191B, $7580330D, $94074251, $5C7DCDFA, $ABBE6D63, $AA402164, $B301D40A, $02E7D1CA, $53571DAE, $7A3182A2, $12A8DDEC, $FDAA335D, $176F43E8, $71FB46D4, $38129022, $CE949AD4, $B84769AD, $965BD862, $82F3D055, $66FB9767, $15B80B4E, $1D5B47A0, $4CFDE06F, + $C28EC4B8, $57E8726E, $647A78FC, $99865D44, $608BD593, $6C200E03, $39DC5FF6, $5D0B00A3, $AE63AFF2, $7E8BD632, $70108C0C, $BBD35049, $2998DF04, $980CF42A, $9B6DF491, $9E7EDD53, $06918548, $58CB7E07, $3B74EF2E, $522FFFB1, $D24708CC, $1C7E27CD, $A4EB215B, $3CF1D2E2, $19B47A38, $424F7618, $35856039, $9D17DEE7, + $27EB35E6, $C9AFF67B, $36BAF5B8, $09C467CD, $C18910B1, $E11DBF7B, $06CD1AF8, $7170C608, $2D5E3354, $D4DE495A, $64C6D006, $BCC0C62C, $3DD00DB3, $708F8F34, $77D51B42, $264F620F, $24B8D2BF, $15C1B79E, $46A52564, $F8D7E54E, $3E378160, $7895CDA5, $859C15A5, $E6459788, $C37BC75F, $DB07BA0C, $0676A3AB, $7F229B1E, + $31842E7B, $24259FD7, $F8BEF472, $835FFCB8, $6DF4C1F2, $96F5B195, $FD0AF0FC, $B0FE134C, $E2506D3D, $4F9B12EA, $F215F225, $A223736F, $9FB4C428, $25D04979, $34C713F8, $C4618187, $EA7A6E98, $7CD16EFC, $1436876C, $F1544107, $BEDEEE14, $56E9AF27, $A04AA441, $3CF7C899, $92ECBAE6, $DD67016D, $151682EB, $A842EEDF, + $FDBA60B4, $F1907B75, $20E3030F, $24D8C29E, $E139673B, $EFA63FB8, $71873054, $B6F2CF3B, $9F326442, $CB15A4CC, $B01A4504, $F1E47D8D, $844A1BE5, $BAE7DFDC, $42CBDA70, $CD7DAE0A, $57E85B7A, $D53F5AF6, $20CF4D8C, $CEA4D428, $79D130A4, $3486EBFB, $33D3CDDC, $77853B53, $37EFFCB5, $C5068778, $E580B3E6, $4E68B8F4, + $C5C8B37E, $0D809EA2, $398FEB7C, $132A4F94, $43B7950E, $2FEE7D1C, $223613BD, $DD06CAA2, $37DF932B, $C4248289, $ACF3EBC3, $5715F6B7, $EF3478DD, $F267616F, $C148CBE4, $9052815E, $5E410FAB, $B48A2465, $2EDA7FA4, $E87B40E4, $E98EA084, $5889E9E1, $EFD390FC, $DD07D35B, $DB485694, $38D7E5B2, $57720101, $730EDEBC, + $5B643113, $94917E4F, $503C2FBA, $646F1282, $7523D24A, $E0779695, $F9C17A8F, $7A5B2121, $D187B896, $29263A4D, $BA510CDF, $81F47C9F, $AD1163ED, $EA7B5965, $1A00726E, $11403092, $00DA6D77, $4A0CDD61, $AD1F4603, $605BDFB0, $9EEDC364, $22EBE6A8, $CEE7D28A, $A0E736A0, $5564A6B9, $10853209, $C7EB8F37, $2DE705CA, + $8951570F, $DF09822B, $BD691A6C, $AA12E4F2, $87451C0F, $E0F6A27A, $3ADA4819, $4CF1764F, $0D771C2B, $67CDB156, $350D8384, $5938FA0F, $42399EF3, $36997B07, $0E84093D, $4AA93E61, $8360D87B, $1FA98B0C, $1149382C, $E97625A5, $0614D1B7, $0E25244B, $0C768347, $589E8D82, $0D2059D1, $A466BB1E, $F8DA0A82, $04F19130, + $BA6E4EC0, $99265164, $1EE7230D, $50B2AD80, $EAEE6801, $8DB2A283, $EA8BF59E); + +function LRot32(const a, n: UInt32): UInt32; inline; +begin + Result := (a shl n) or (a shr (32 - n)); +end; + +class function TncEnc_cast128.GetMaxKeySize: Integer; +begin + Result := 128; +end; + +class function TncEnc_cast128.GetAlgorithm: string; +begin + Result := 'Cast128'; +end; + +class function TncEnc_cast128.SelfTest: Boolean; +const + Key: array [0 .. 15] of Byte = ($01, $23, $45, $67, $12, $34, $56, $78, $23, $45, $67, $89, $34, $56, $78, $9A); + InBlock: array [0 .. 7] of Byte = ($01, $23, $45, $67, $89, $AB, $CD, $EF); + Out128: array [0 .. 7] of Byte = ($23, $8B, $4F, $E5, $84, $7E, $44, $B2); + Out80: array [0 .. 7] of Byte = ($EB, $6A, $71, $1A, $2C, $02, $27, $1B); + Out40: array [0 .. 7] of Byte = ($7A, $C8, $16, $D1, $6E, $9B, $30, $2E); +var + Block: array [0 .. 7] of Byte; + Cipher: TncEnc_cast128; +begin + Cipher := TncEnc_cast128.Create(nil); + Cipher.Init(Key, 128, nil); + Cipher.EncryptECB(InBlock, Block); + Result := Boolean(CompareMem(@Block, @Out128, 8)); + Cipher.DecryptECB(Block, Block); + Result := Result and Boolean(CompareMem(@Block, @InBlock, 8)); + Cipher.Burn; + Cipher.Init(Key, 80, nil); + Cipher.EncryptECB(InBlock, Block); + Result := Result and Boolean(CompareMem(@Block, @Out80, 8)); + Cipher.DecryptECB(Block, Block); + Result := Result and Boolean(CompareMem(@Block, @InBlock, 8)); + Cipher.Burn; + Cipher.Init(Key, 40, nil); + Cipher.EncryptECB(InBlock, Block); + Result := Result and Boolean(CompareMem(@Block, @Out40, 8)); + Cipher.DecryptECB(Block, Block); + Result := Result and Boolean(CompareMem(@Block, @InBlock, 8)); + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_cast128.InitKey(const Key; Size: longword); +var + x, t, z: array [0 .. 3] of UInt32; + i: longword; +begin + Size := Size div 8; + if Size <= 10 then + Rounds := 12 + else + Rounds := 16; + FillChar(x, Sizeof(x), 0); + Move(Key, x, Size); + x[0] := (x[0] shr 24) or ((x[0] shr 8) and $FF00) or ((x[0] shl 8) and $FF0000) or (x[0] shl 24); + x[1] := (x[1] shr 24) or ((x[1] shr 8) and $FF00) or ((x[1] shl 8) and $FF0000) or (x[1] shl 24); + x[2] := (x[2] shr 24) or ((x[2] shr 8) and $FF00) or ((x[2] shl 8) and $FF0000) or (x[2] shl 24); + x[3] := (x[3] shr 24) or ((x[3] shr 8) and $FF00) or ((x[3] shl 8) and $FF0000) or (x[3] shl 24); + i := 0; + while i < 32 do + begin + case (i and 4) of + 0: + begin + z[0] := x[0] xor cast_sbox5[(x[3] shr 16) and $FF] xor cast_sbox6[x[3] and $FF] xor cast_sbox7[x[3] shr 24] xor cast_sbox8[(x[3] shr 8) and $FF] xor cast_sbox7[x[2] shr 24]; + t[0] := z[0]; + z[1] := x[2] xor cast_sbox5[z[0] shr 24] xor cast_sbox6[(z[0] shr 8) and $FF] xor cast_sbox7[(z[0] shr 16) and $FF] xor cast_sbox8[z[0] and $FF] xor cast_sbox8[(x[2] shr 8) and $FF]; + t[1] := z[1]; + z[2] := x[3] xor cast_sbox5[z[1] and $FF] xor cast_sbox6[(z[1] shr 8) and $FF] xor cast_sbox7[(z[1] shr 16) and $FF] xor cast_sbox8[z[1] shr 24] xor cast_sbox5[(x[2] shr 16) and $FF]; + t[2] := z[2]; + z[3] := x[1] xor cast_sbox5[(z[2] shr 8) and $FF] xor cast_sbox6[(z[2] shr 16) and $FF] xor cast_sbox7[z[2] and $FF] xor cast_sbox8[z[2] shr 24] xor cast_sbox6[x[2] and $FF]; + t[3] := z[3]; + end; + 4: + begin + x[0] := z[2] xor cast_sbox5[(z[1] shr 16) and $FF] xor cast_sbox6[z[1] and $FF] xor cast_sbox7[z[1] shr 24] xor cast_sbox8[(z[1] shr 8) and $FF] xor cast_sbox7[z[0] shr 24]; + t[0] := x[0]; + x[1] := z[0] xor cast_sbox5[x[0] shr 24] xor cast_sbox6[(x[0] shr 8) and $FF] xor cast_sbox7[(x[0] shr 16) and $FF] xor cast_sbox8[x[0] and $FF] xor cast_sbox8[(z[0] shr 8) and $FF]; + t[1] := x[1]; + x[2] := z[1] xor cast_sbox5[x[1] and $FF] xor cast_sbox6[(x[1] shr 8) and $FF] xor cast_sbox7[(x[1] shr 16) and $FF] xor cast_sbox8[x[1] shr 24] xor cast_sbox5[(z[0] shr 16) and $FF]; + t[2] := x[2]; + x[3] := z[3] xor cast_sbox5[(x[2] shr 8) and $FF] xor cast_sbox6[(x[2] shr 16) and $FF] xor cast_sbox7[x[2] and $FF] xor cast_sbox8[x[2] shr 24] xor cast_sbox6[z[0] and $FF]; + t[3] := x[3]; + end; + end; + case (i and 12) of + 0, 12: + begin + KeyData[i + 0] := cast_sbox5[t[2] shr 24] xor cast_sbox6[(t[2] shr 16) and $FF] xor cast_sbox7[t[1] and $FF] xor cast_sbox8[(t[1] shr 8) and $FF]; + KeyData[i + 1] := cast_sbox5[(t[2] shr 8) and $FF] xor cast_sbox6[t[2] and $FF] xor cast_sbox7[(t[1] shr 16) and $FF] xor cast_sbox8[t[1] shr 24]; + KeyData[i + 2] := cast_sbox5[t[3] shr 24] xor cast_sbox6[(t[3] shr 16) and $FF] xor cast_sbox7[t[0] and $FF] xor cast_sbox8[(t[0] shr 8) and $FF]; + KeyData[i + 3] := cast_sbox5[(t[3] shr 8) and $FF] xor cast_sbox6[t[3] and $FF] xor cast_sbox7[(t[0] shr 16) and $FF] xor cast_sbox8[t[0] shr 24]; + end; + 4, 8: + begin + KeyData[i + 0] := cast_sbox5[t[0] and $FF] xor cast_sbox6[(t[0] shr 8) and $FF] xor cast_sbox7[t[3] shr 24] xor cast_sbox8[(t[3] shr 16) and $FF]; + KeyData[i + 1] := cast_sbox5[(t[0] shr 16) and $FF] xor cast_sbox6[t[0] shr 24] xor cast_sbox7[(t[3] shr 8) and $FF] xor cast_sbox8[t[3] and $FF]; + KeyData[i + 2] := cast_sbox5[t[1] and $FF] xor cast_sbox6[(t[1] shr 8) and $FF] xor cast_sbox7[t[2] shr 24] xor cast_sbox8[(t[2] shr 16) and $FF]; + KeyData[i + 3] := cast_sbox5[(t[1] shr 16) and $FF] xor cast_sbox6[t[1] shr 24] xor cast_sbox7[(t[2] shr 8) and $FF] xor cast_sbox8[t[2] and $FF]; + end; + end; + case (i and 12) of + 0: + begin + KeyData[i + 0] := KeyData[i + 0] xor cast_sbox5[(z[0] shr 8) and $FF]; + KeyData[i + 1] := KeyData[i + 1] xor cast_sbox6[(z[1] shr 8) and $FF]; + KeyData[i + 2] := KeyData[i + 2] xor cast_sbox7[(z[2] shr 16) and $FF]; + KeyData[i + 3] := KeyData[i + 3] xor cast_sbox8[z[3] shr 24]; + end; + 4: + begin + KeyData[i + 0] := KeyData[i + 0] xor cast_sbox5[x[2] shr 24]; + KeyData[i + 1] := KeyData[i + 1] xor cast_sbox6[(x[3] shr 16) and $FF]; + KeyData[i + 2] := KeyData[i + 2] xor cast_sbox7[x[0] and $FF]; + KeyData[i + 3] := KeyData[i + 3] xor cast_sbox8[x[1] and $FF]; + end; + 8: + begin + KeyData[i + 0] := KeyData[i + 0] xor cast_sbox5[(z[2] shr 16) and $FF]; + KeyData[i + 1] := KeyData[i + 1] xor cast_sbox6[z[3] shr 24]; + KeyData[i + 2] := KeyData[i + 2] xor cast_sbox7[(z[0] shr 8) and $FF]; + KeyData[i + 3] := KeyData[i + 3] xor cast_sbox8[(z[1] shr 8) and $FF]; + end; + 12: + begin + KeyData[i + 0] := KeyData[i + 0] xor cast_sbox5[x[0] and $FF]; + KeyData[i + 1] := KeyData[i + 1] xor cast_sbox6[x[1] and $FF]; + KeyData[i + 2] := KeyData[i + 2] xor cast_sbox7[x[2] shr 24]; + KeyData[i + 3] := KeyData[i + 3] xor cast_sbox8[(x[3] shr 16) and $FF]; + end; + end; + if (i >= 16) then + begin + KeyData[i + 0] := KeyData[i + 0] and 31; + KeyData[i + 1] := KeyData[i + 1] and 31; + KeyData[i + 2] := KeyData[i + 2] and 31; + KeyData[i + 3] := KeyData[i + 3] and 31; + end; + Inc(i, 4); + end; +end; + +procedure TncEnc_cast128.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), $FF); + Rounds := 0; + inherited Burn; +end; + +procedure TncEnc_cast128.EncryptECB(const InData; var OutData); +var + t, l, r: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + l := PUInt32(@InData)^; + r := PUInt32(NativeUInt(@InData) + 4)^; + l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24); + r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24); + t := LRot32(KeyData[0] + r, KeyData[0 + 16]); + l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[1] xor l, KeyData[1 + 16]); + r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[2] - r, KeyData[2 + 16]); + l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[3] + l, KeyData[3 + 16]); + r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[4] xor r, KeyData[4 + 16]); + l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[5] - l, KeyData[5 + 16]); + r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[6] + r, KeyData[6 + 16]); + l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[7] xor l, KeyData[7 + 16]); + r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[8] - r, KeyData[8 + 16]); + l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[9] + l, KeyData[9 + 16]); + r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[10] xor r, KeyData[10 + 16]); + l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[11] - l, KeyData[11 + 16]); + r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + if Rounds > 12 then + begin + t := LRot32(KeyData[12] + r, KeyData[12 + 16]); + l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[13] xor l, KeyData[13 + 16]); + r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[14] - r, KeyData[14 + 16]); + l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[15] + l, KeyData[15 + 16]); + r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + end; + l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24); + r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24); + PUInt32(@OutData)^ := r; + PUInt32(NativeUInt(@OutData) + 4)^ := l; +end; + +procedure TncEnc_cast128.DecryptECB(const InData; var OutData); +var + t, l, r: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + r := PUInt32(@InData)^; + l := PUInt32(NativeUInt(@InData) + 4)^; + l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24); + r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24); + if Rounds > 12 then + begin + t := LRot32(KeyData[15] + l, KeyData[15 + 16]); + r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[14] - r, KeyData[14 + 16]); + l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[13] xor l, KeyData[13 + 16]); + r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[12] + r, KeyData[12 + 16]); + l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + end; + t := LRot32(KeyData[11] - l, KeyData[11 + 16]); + r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[10] xor r, KeyData[10 + 16]); + l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[9] + l, KeyData[9 + 16]); + r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[8] - r, KeyData[8 + 16]); + l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[7] xor l, KeyData[7 + 16]); + r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[6] + r, KeyData[6 + 16]); + l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[5] - l, KeyData[5 + 16]); + r := r xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[4] xor r, KeyData[4 + 16]); + l := l xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[3] + l, KeyData[3 + 16]); + r := r xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + t := LRot32(KeyData[2] - r, KeyData[2 + 16]); + l := l xor (((cast_sbox1[t shr 24] + cast_sbox2[(t shr 16) and $FF]) xor cast_sbox3[(t shr 8) and $FF]) - cast_sbox4[t and $FF]); + t := LRot32(KeyData[1] xor l, KeyData[1 + 16]); + r := r xor (((cast_sbox1[t shr 24] - cast_sbox2[(t shr 16) and $FF]) + cast_sbox3[(t shr 8) and $FF]) xor cast_sbox4[t and $FF]); + t := LRot32(KeyData[0] + r, KeyData[0 + 16]); + l := l xor (((cast_sbox1[t shr 24] xor cast_sbox2[(t shr 16) and $FF]) - cast_sbox3[(t shr 8) and $FF]) + cast_sbox4[t and $FF]); + l := (l shr 24) or ((l shr 8) and $FF00) or ((l shl 8) and $FF0000) or (l shl 24); + r := (r shr 24) or ((r shr 8) and $FF00) or ((r shl 8) and $FF0000) or (r shl 24); + PUInt32(@OutData)^ := l; + PUInt32(NativeUInt(@OutData) + 4)^ := r; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncCast256.pas b/Source_using_TMonitor/Encryption/ncEncCast256.pas new file mode 100644 index 0000000..898a445 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncCast256.pas @@ -0,0 +1,434 @@ +{$R-} +{$Q-} +unit ncEncCast256; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_cast256 = class(TncEnc_blockcipher128) + protected + Kr, Km: array [0 .. 11, 0 .. 3] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + S1: array [0 .. 255] of UInt32 = ($30FB40D4, $9FA0FF0B, $6BECCD2F, $3F258C7A, $1E213F2F, $9C004DD3, $6003E540, $CF9FC949, $BFD4AF27, $88BBBDB5, $E2034090, $98D09675, $6E63A0E0, $15C361D2, $C2E7661D, $22D4FF8E, $28683B6F, $C07FD059, $FF2379C8, $775F50E2, $43C340D3, $DF2F8656, $887CA41A, $A2D2BD2D, $A1C9E0D6, + $346C4819, $61B76D87, $22540F2F, $2ABE32E1, $AA54166B, $22568E3A, $A2D341D0, $66DB40C8, $A784392F, $004DFF2F, $2DB9D2DE, $97943FAC, $4A97C1D8, $527644B7, $B5F437A7, $B82CBAEF, $D751D159, $6FF7F0ED, $5A097A1F, $827B68D0, $90ECF52E, $22B0C054, $BC8E5935, $4B6D2F7F, $50BB64A2, $D2664910, $BEE5812D, $B7332290, + $E93B159F, $B48EE411, $4BFF345D, $FD45C240, $AD31973F, $C4F6D02E, $55FC8165, $D5B1CAAD, $A1AC2DAE, $A2D4B76D, $C19B0C50, $882240F2, $0C6E4F38, $A4E4BFD7, $4F5BA272, $564C1D2F, $C59C5319, $B949E354, $B04669FE, $B1B6AB8A, $C71358DD, $6385C545, $110F935D, $57538AD5, $6A390493, $E63D37E0, $2A54F6B3, $3A787D5F, + $6276A0B5, $19A6FCDF, $7A42206A, $29F9D4D5, $F61B1891, $BB72275E, $AA508167, $38901091, $C6B505EB, $84C7CB8C, $2AD75A0F, $874A1427, $A2D1936B, $2AD286AF, $AA56D291, $D7894360, $425C750D, $93B39E26, $187184C9, $6C00B32D, $73E2BB14, $A0BEBC3C, $54623779, $64459EAB, $3F328B82, $7718CF82, $59A2CEA6, $04EE002E, + $89FE78E6, $3FAB0950, $325FF6C2, $81383F05, $6963C5C8, $76CB5AD6, $D49974C9, $CA180DCF, $380782D5, $C7FA5CF6, $8AC31511, $35E79E13, $47DA91D0, $F40F9086, $A7E2419E, $31366241, $051EF495, $AA573B04, $4A805D8D, $548300D0, $00322A3C, $BF64CDDF, $BA57A68E, $75C6372B, $50AFD341, $A7C13275, $915A0BF5, $6B54BFAB, + $2B0B1426, $AB4CC9D7, $449CCD82, $F7FBF265, $AB85C5F3, $1B55DB94, $AAD4E324, $CFA4BD3F, $2DEAA3E2, $9E204D02, $C8BD25AC, $EADF55B3, $D5BD9E98, $E31231B2, $2AD5AD6C, $954329DE, $ADBE4528, $D8710F69, $AA51C90F, $AA786BF6, $22513F1E, $AA51A79B, $2AD344CC, $7B5A41F0, $D37CFBAD, $1B069505, $41ECE491, $B4C332E6, + $032268D4, $C9600ACC, $CE387E6D, $BF6BB16C, $6A70FB78, $0D03D9C9, $D4DF39DE, $E01063DA, $4736F464, $5AD328D8, $B347CC96, $75BB0FC3, $98511BFB, $4FFBCC35, $B58BCF6A, $E11F0ABC, $BFC5FE4A, $A70AEC10, $AC39570A, $3F04442F, $6188B153, $E0397A2E, $5727CB79, $9CEB418F, $1CACD68D, $2AD37C96, $0175CB9D, $C69DFF09, + $C75B65F0, $D9DB40D8, $EC0E7779, $4744EAD4, $B11C3274, $DD24CB9E, $7E1C54BD, $F01144F9, $D2240EB1, $9675B3FD, $A3AC3755, $D47C27AF, $51C85F4D, $56907596, $A5BB15E6, $580304F0, $CA042CF1, $011A37EA, $8DBFAADB, $35BA3E4A, $3526FFA0, $C37B4D09, $BC306ED9, $98A52666, $5648F725, $FF5E569D, $0CED63D0, $7C63B2CF, + $700B45E1, $D5EA50F1, $85A92872, $AF1FBDA7, $D4234870, $A7870BF3, $2D3B4D79, $42E04198, $0CD0EDE7, $26470DB8, $F881814C, $474D6AD7, $7C0C5E5C, $D1231959, $381B7298, $F5D2F4DB, $AB838653, $6E2F1E23, $83719C9E, $BD91E046, $9A56456E, $DC39200C, $20C8C571, $962BDA1C, $E1E696FF, $B141AB08, $7CCA89B9, $1A69E783, + $02CC4843, $A2F7C579, $429EF47D, $427B169C, $5AC9F049, $DD8F0F00, $5C8165BF); + S2: array [0 .. 255] of UInt32 = ($1F201094, $EF0BA75B, $69E3CF7E, $393F4380, $FE61CF7A, $EEC5207A, $55889C94, $72FC0651, $ADA7EF79, $4E1D7235, $D55A63CE, $DE0436BA, $99C430EF, $5F0C0794, $18DCDB7D, $A1D6EFF3, $A0B52F7B, $59E83605, $EE15B094, $E9FFD909, $DC440086, $EF944459, $BA83CCB3, $E0C3CDFB, $D1DA4181, + $3B092AB1, $F997F1C1, $A5E6CF7B, $01420DDB, $E4E7EF5B, $25A1FF41, $E180F806, $1FC41080, $179BEE7A, $D37AC6A9, $FE5830A4, $98DE8B7F, $77E83F4E, $79929269, $24FA9F7B, $E113C85B, $ACC40083, $D7503525, $F7EA615F, $62143154, $0D554B63, $5D681121, $C866C359, $3D63CF73, $CEE234C0, $D4D87E87, $5C672B21, $071F6181, + $39F7627F, $361E3084, $E4EB573B, $602F64A4, $D63ACD9C, $1BBC4635, $9E81032D, $2701F50C, $99847AB4, $A0E3DF79, $BA6CF38C, $10843094, $2537A95E, $F46F6FFE, $A1FF3B1F, $208CFB6A, $8F458C74, $D9E0A227, $4EC73A34, $FC884F69, $3E4DE8DF, $EF0E0088, $3559648D, $8A45388C, $1D804366, $721D9BFD, $A58684BB, $E8256333, + $844E8212, $128D8098, $FED33FB4, $CE280AE1, $27E19BA5, $D5A6C252, $E49754BD, $C5D655DD, $EB667064, $77840B4D, $A1B6A801, $84DB26A9, $E0B56714, $21F043B7, $E5D05860, $54F03084, $066FF472, $A31AA153, $DADC4755, $B5625DBF, $68561BE6, $83CA6B94, $2D6ED23B, $ECCF01DB, $A6D3D0BA, $B6803D5C, $AF77A709, $33B4A34C, + $397BC8D6, $5EE22B95, $5F0E5304, $81ED6F61, $20E74364, $B45E1378, $DE18639B, $881CA122, $B96726D1, $8049A7E8, $22B7DA7B, $5E552D25, $5272D237, $79D2951C, $C60D894C, $488CB402, $1BA4FE5B, $A4B09F6B, $1CA815CF, $A20C3005, $8871DF63, $B9DE2FCB, $0CC6C9E9, $0BEEFF53, $E3214517, $B4542835, $9F63293C, $EE41E729, + $6E1D2D7C, $50045286, $1E6685F3, $F33401C6, $30A22C95, $31A70850, $60930F13, $73F98417, $A1269859, $EC645C44, $52C877A9, $CDFF33A6, $A02B1741, $7CBAD9A2, $2180036F, $50D99C08, $CB3F4861, $C26BD765, $64A3F6AB, $80342676, $25A75E7B, $E4E6D1FC, $20C710E6, $CDF0B680, $17844D3B, $31EEF84D, $7E0824E4, $2CCB49EB, + $846A3BAE, $8FF77888, $EE5D60F6, $7AF75673, $2FDD5CDB, $A11631C1, $30F66F43, $B3FAEC54, $157FD7FA, $EF8579CC, $D152DE58, $DB2FFD5E, $8F32CE19, $306AF97A, $02F03EF8, $99319AD5, $C242FA0F, $A7E3EBB0, $C68E4906, $B8DA230C, $80823028, $DCDEF3C8, $D35FB171, $088A1BC8, $BEC0C560, $61A3C9E8, $BCA8F54D, $C72FEFFA, + $22822E99, $82C570B4, $D8D94E89, $8B1C34BC, $301E16E6, $273BE979, $B0FFEAA6, $61D9B8C6, $00B24869, $B7FFCE3F, $08DC283B, $43DAF65A, $F7E19798, $7619B72F, $8F1C9BA4, $DC8637A0, $16A7D3B1, $9FC393B7, $A7136EEB, $C6BCC63E, $1A513742, $EF6828BC, $520365D6, $2D6A77AB, $3527ED4B, $821FD216, $095C6E2E, $DB92F2FB, + $5EEA29CB, $145892F5, $91584F7F, $5483697B, $2667A8CC, $85196048, $8C4BACEA, $833860D4, $0D23E0F9, $6C387E8A, $0AE6D249, $B284600C, $D835731D, $DCB1C647, $AC4C56EA, $3EBD81B3, $230EABB0, $6438BC87, $F0B5B1FA, $8F5EA2B3, $FC184642, $0A036B7A, $4FB089BD, $649DA589, $A345415E, $5C038323, $3E5D3BB9, $43D79572, + $7E6DD07C, $06DFDF1E, $6C6CC4EF, $7160A539, $73BFBE70, $83877605, $4523ECF1); + S3: array [0 .. 255] of UInt32 = ($8DEFC240, $25FA5D9F, $EB903DBF, $E810C907, $47607FFF, $369FE44B, $8C1FC644, $AECECA90, $BEB1F9BF, $EEFBCAEA, $E8CF1950, $51DF07AE, $920E8806, $F0AD0548, $E13C8D83, $927010D5, $11107D9F, $07647DB9, $B2E3E4D4, $3D4F285E, $B9AFA820, $FADE82E0, $A067268B, $8272792E, $553FB2C0, + $489AE22B, $D4EF9794, $125E3FBC, $21FFFCEE, $825B1BFD, $9255C5ED, $1257A240, $4E1A8302, $BAE07FFF, $528246E7, $8E57140E, $3373F7BF, $8C9F8188, $A6FC4EE8, $C982B5A5, $A8C01DB7, $579FC264, $67094F31, $F2BD3F5F, $40FFF7C1, $1FB78DFC, $8E6BD2C1, $437BE59B, $99B03DBF, $B5DBC64B, $638DC0E6, $55819D99, $A197C81C, + $4A012D6E, $C5884A28, $CCC36F71, $B843C213, $6C0743F1, $8309893C, $0FEDDD5F, $2F7FE850, $D7C07F7E, $02507FBF, $5AFB9A04, $A747D2D0, $1651192E, $AF70BF3E, $58C31380, $5F98302E, $727CC3C4, $0A0FB402, $0F7FEF82, $8C96FDAD, $5D2C2AAE, $8EE99A49, $50DA88B8, $8427F4A0, $1EAC5790, $796FB449, $8252DC15, $EFBD7D9B, + $A672597D, $ADA840D8, $45F54504, $FA5D7403, $E83EC305, $4F91751A, $925669C2, $23EFE941, $A903F12E, $60270DF2, $0276E4B6, $94FD6574, $927985B2, $8276DBCB, $02778176, $F8AF918D, $4E48F79E, $8F616DDF, $E29D840E, $842F7D83, $340CE5C8, $96BBB682, $93B4B148, $EF303CAB, $984FAF28, $779FAF9B, $92DC560D, $224D1E20, + $8437AA88, $7D29DC96, $2756D3DC, $8B907CEE, $B51FD240, $E7C07CE3, $E566B4A1, $C3E9615E, $3CF8209D, $6094D1E3, $CD9CA341, $5C76460E, $00EA983B, $D4D67881, $FD47572C, $F76CEDD9, $BDA8229C, $127DADAA, $438A074E, $1F97C090, $081BDB8A, $93A07EBE, $B938CA15, $97B03CFF, $3DC2C0F8, $8D1AB2EC, $64380E51, $68CC7BFB, + $D90F2788, $12490181, $5DE5FFD4, $DD7EF86A, $76A2E214, $B9A40368, $925D958F, $4B39FFFA, $BA39AEE9, $A4FFD30B, $FAF7933B, $6D498623, $193CBCFA, $27627545, $825CF47A, $61BD8BA0, $D11E42D1, $CEAD04F4, $127EA392, $10428DB7, $8272A972, $9270C4A8, $127DE50B, $285BA1C8, $3C62F44F, $35C0EAA5, $E805D231, $428929FB, + $B4FCDF82, $4FB66A53, $0E7DC15B, $1F081FAB, $108618AE, $FCFD086D, $F9FF2889, $694BCC11, $236A5CAE, $12DECA4D, $2C3F8CC5, $D2D02DFE, $F8EF5896, $E4CF52DA, $95155B67, $494A488C, $B9B6A80C, $5C8F82BC, $89D36B45, $3A609437, $EC00C9A9, $44715253, $0A874B49, $D773BC40, $7C34671C, $02717EF6, $4FEB5536, $A2D02FFF, + $D2BF60C4, $D43F03C0, $50B4EF6D, $07478CD1, $006E1888, $A2E53F55, $B9E6D4BC, $A2048016, $97573833, $D7207D67, $DE0F8F3D, $72F87B33, $ABCC4F33, $7688C55D, $7B00A6B0, $947B0001, $570075D2, $F9BB88F8, $8942019E, $4264A5FF, $856302E0, $72DBD92B, $EE971B69, $6EA22FDE, $5F08AE2B, $AF7A616D, $E5C98767, $CF1FEBD2, + $61EFC8C2, $F1AC2571, $CC8239C2, $67214CB8, $B1E583D1, $B7DC3E62, $7F10BDCE, $F90A5C38, $0FF0443D, $606E6DC6, $60543A49, $5727C148, $2BE98A1D, $8AB41738, $20E1BE24, $AF96DA0F, $68458425, $99833BE5, $600D457D, $282F9350, $8334B362, $D91D1120, $2B6D8DA0, $642B1E31, $9C305A00, $52BCE688, $1B03588A, $F7BAEFD5, + $4142ED9C, $A4315C11, $83323EC5, $DFEF4636, $A133C501, $E9D3531C, $EE353783); + S4: array [0 .. 255] of UInt32 = ($9DB30420, $1FB6E9DE, $A7BE7BEF, $D273A298, $4A4F7BDB, $64AD8C57, $85510443, $FA020ED1, $7E287AFF, $E60FB663, $095F35A1, $79EBF120, $FD059D43, $6497B7B1, $F3641F63, $241E4ADF, $28147F5F, $4FA2B8CD, $C9430040, $0CC32220, $FDD30B30, $C0A5374F, $1D2D00D9, $24147B15, $EE4D111A, + $0FCA5167, $71FF904C, $2D195FFE, $1A05645F, $0C13FEFE, $081B08CA, $05170121, $80530100, $E83E5EFE, $AC9AF4F8, $7FE72701, $D2B8EE5F, $06DF4261, $BB9E9B8A, $7293EA25, $CE84FFDF, $F5718801, $3DD64B04, $A26F263B, $7ED48400, $547EEBE6, $446D4CA0, $6CF3D6F5, $2649ABDF, $AEA0C7F5, $36338CC1, $503F7E93, $D3772061, + $11B638E1, $72500E03, $F80EB2BB, $ABE0502E, $EC8D77DE, $57971E81, $E14F6746, $C9335400, $6920318F, $081DBB99, $FFC304A5, $4D351805, $7F3D5CE3, $A6C866C6, $5D5BCCA9, $DAEC6FEA, $9F926F91, $9F46222F, $3991467D, $A5BF6D8E, $1143C44F, $43958302, $D0214EEB, $022083B8, $3FB6180C, $18F8931E, $281658E6, $26486E3E, + $8BD78A70, $7477E4C1, $B506E07C, $F32D0A25, $79098B02, $E4EABB81, $28123B23, $69DEAD38, $1574CA16, $DF871B62, $211C40B7, $A51A9EF9, $0014377B, $041E8AC8, $09114003, $BD59E4D2, $E3D156D5, $4FE876D5, $2F91A340, $557BE8DE, $00EAE4A7, $0CE5C2EC, $4DB4BBA6, $E756BDFF, $DD3369AC, $EC17B035, $06572327, $99AFC8B0, + $56C8C391, $6B65811C, $5E146119, $6E85CB75, $BE07C002, $C2325577, $893FF4EC, $5BBFC92D, $D0EC3B25, $B7801AB7, $8D6D3B24, $20C763EF, $C366A5FC, $9C382880, $0ACE3205, $AAC9548A, $ECA1D7C7, $041AFA32, $1D16625A, $6701902C, $9B757A54, $31D477F7, $9126B031, $36CC6FDB, $C70B8B46, $D9E66A48, $56E55A79, $026A4CEB, + $52437EFF, $2F8F76B4, $0DF980A5, $8674CDE3, $EDDA04EB, $17A9BE04, $2C18F4DF, $B7747F9D, $AB2AF7B4, $EFC34D20, $2E096B7C, $1741A254, $E5B6A035, $213D42F6, $2C1C7C26, $61C2F50F, $6552DAF9, $D2C231F8, $25130F69, $D8167FA2, $0418F2C8, $001A96A6, $0D1526AB, $63315C21, $5E0A72EC, $49BAFEFD, $187908D9, $8D0DBD86, + $311170A7, $3E9B640C, $CC3E10D7, $D5CAD3B6, $0CAEC388, $F73001E1, $6C728AFF, $71EAE2A1, $1F9AF36E, $CFCBD12F, $C1DE8417, $AC07BE6B, $CB44A1D8, $8B9B0F56, $013988C3, $B1C52FCA, $B4BE31CD, $D8782806, $12A3A4E2, $6F7DE532, $58FD7EB6, $D01EE900, $24ADFFC2, $F4990FC5, $9711AAC5, $001D7B95, $82E5E7D2, $109873F6, + $00613096, $C32D9521, $ADA121FF, $29908415, $7FBB977F, $AF9EB3DB, $29C9ED2A, $5CE2A465, $A730F32C, $D0AA3FE8, $8A5CC091, $D49E2CE7, $0CE454A9, $D60ACD86, $015F1919, $77079103, $DEA03AF6, $78A8565E, $DEE356DF, $21F05CBE, $8B75E387, $B3C50651, $B8A5C3EF, $D8EEB6D2, $E523BE77, $C2154529, $2F69EFDF, $AFE67AFB, + $F470C4B2, $F3E0EB5B, $D6CC9876, $39E4460C, $1FDA8538, $1987832F, $CA007367, $A99144F8, $296B299E, $492FC295, $9266BEAB, $B5676E69, $9BD3DDDA, $DF7E052F, $DB25701C, $1B5E51EE, $F65324E6, $6AFCE36C, $0316CC04, $8644213E, $B7DC59D0, $7965291F, $CCD6FD43, $41823979, $932BCDF6, $B657C34D, $4EDFD282, $7AE5290C, + $3CB9536B, $851E20FE, $9833557E, $13ECF0B0, $D3FFB372, $3F85C5C1, $0AEF7ED2); + +function LRot32(const a, n: UInt32): UInt32; inline; +begin + Result := (a shl n) or (a shr (32 - n)); +end; + +function SwapUInt32(const a: UInt32): UInt32; inline; +begin + Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); +end; + +function F1(const a, rk, mk: UInt32): UInt32; inline; +var + t: UInt32; +begin + t := LRot32(mk + a, rk); + Result := ((S1[t shr 24] xor S2[(t shr 16) and $FF]) - S3[(t shr 8) and $FF]) + S4[t and $FF]; +end; + +function F2(const a, rk, mk: UInt32): UInt32; inline; +var + t: UInt32; +begin + t := LRot32(mk xor a, rk); + Result := ((S1[t shr 24] - S2[(t shr 16) and $FF]) + S3[(t shr 8) and $FF]) xor S4[t and $FF]; +end; + +function F3(const a, rk, mk: UInt32): UInt32; inline; +var + t: UInt32; +begin + t := LRot32(mk - a, rk); + Result := ((S1[t shr 24] + S2[(t shr 16) and $FF]) xor S3[(t shr 8) and $FF]) - S4[t and $FF]; +end; + +class function TncEnc_cast256.GetMaxKeySize: Integer; +begin + Result := 256; +end; + +class function TncEnc_cast256.GetAlgorithm: string; +begin + Result := 'Cast256'; +end; + +class function TncEnc_cast256.SelfTest: Boolean; +const + Key1: array [0 .. 15] of byte = ($23, $42, $BB, $9E, $FA, $38, $54, $2C, $0A, $F7, $56, $47, $F2, $9F, $61, $5D); + InBlock1: array [0 .. 15] of byte = ($00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $0C, $9B, $28, $07); + OutBlock1: array [0 .. 15] of byte = ($96, $3A, $8A, $50, $CE, $B5, $4D, $08, $E0, $DE, $E0, $F1, $D0, $41, $3D, $CF); + Key2: array [0 .. 23] of byte = ($23, $42, $BB, $9E, $FA, $38, $54, $2C, $BE, $D0, $AC, $83, $94, $0A, $C2, $98, $BA, $C7, $7A, $77, $17, $94, $28, $63); + InBlock2: array [0 .. 15] of byte = ($00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $DE, $25, $5A, $FF); + OutBlock2: array [0 .. 15] of byte = ($2B, $C1, $92, $9F, $30, $13, $47, $A9, $9D, $3F, $3E, $45, $AD, $34, $01, $E8); + Key3: array [0 .. 31] of byte = ($23, $42, $BB, $9E, $FA, $38, $54, $2C, $BE, $D0, $AC, $83, $94, $0A, $C2, $98, $8D, $7C, $47, $CE, $26, $49, $08, $46, $1C, $C1, $B5, $13, $7A, $E6, $B6, $04); + InBlock3: array [0 .. 15] of byte = ($00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $C5, $FC, $EB, $19); + OutBlock3: array [0 .. 15] of byte = ($1E, $2E, $BC, $6C, $9F, $2E, $43, $8E, $1D, $90, $D9, $B9, $C6, $85, $32, $86); +var + Block: array [0 .. 15] of byte; + Cipher: TncEnc_cast256; +begin + Cipher := TncEnc_cast256.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InBlock1, Block); + Result := Boolean(CompareMem(@Block, @OutBlock1, 8)); + Cipher.DecryptECB(Block, Block); + Result := Result and Boolean(CompareMem(@Block, @InBlock1, 16)); + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(InBlock2, Block); + Result := Result and Boolean(CompareMem(@Block, @OutBlock2, 8)); + Cipher.DecryptECB(Block, Block); + Result := Result and Boolean(CompareMem(@Block, @InBlock2, 16)); + Cipher.Burn; + Cipher.Init(Key3, Sizeof(Key3) * 8, nil); + Cipher.EncryptECB(InBlock3, Block); + Result := Result and Boolean(CompareMem(@Block, @OutBlock3, 8)); + Cipher.DecryptECB(Block, Block); + Result := Result and Boolean(CompareMem(@Block, @InBlock3, 16)); + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_cast256.InitKey(const Key; Size: longword); +var + x: array [0 .. 7] of UInt32; + cm, cr: UInt32; + i, j: longword; + tr, tm: array [0 .. 7] of UInt32; +begin + Size := Size div 8; + + FillChar(x, Sizeof(x), 0); + Move(Key, x, Size); + + cm := $5A827999; + cr := 19; + for i := 0 to 7 do + x[i] := (x[i] shl 24) or ((x[i] shl 8) and $FF0000) or ((x[i] shr 8) and $FF00) or (x[i] shr 24); + for i := 0 to 11 do + begin + for j := 0 to 7 do + begin + tm[j] := cm; + Inc(cm, $6ED9EBA1); + tr[j] := cr; + Inc(cr, 17); + end; + x[6] := x[6] xor F1(x[7], tr[0], tm[0]); + x[5] := x[5] xor F2(x[6], tr[1], tm[1]); + x[4] := x[4] xor F3(x[5], tr[2], tm[2]); + x[3] := x[3] xor F1(x[4], tr[3], tm[3]); + x[2] := x[2] xor F2(x[3], tr[4], tm[4]); + x[1] := x[1] xor F3(x[2], tr[5], tm[5]); + x[0] := x[0] xor F1(x[1], tr[6], tm[6]); + x[7] := x[7] xor F2(x[0], tr[7], tm[7]); + + for j := 0 to 7 do + begin + tm[j] := cm; + Inc(cm, $6ED9EBA1); + tr[j] := cr; + Inc(cr, 17); + end; + x[6] := x[6] xor F1(x[7], tr[0], tm[0]); + x[5] := x[5] xor F2(x[6], tr[1], tm[1]); + x[4] := x[4] xor F3(x[5], tr[2], tm[2]); + x[3] := x[3] xor F1(x[4], tr[3], tm[3]); + x[2] := x[2] xor F2(x[3], tr[4], tm[4]); + x[1] := x[1] xor F3(x[2], tr[5], tm[5]); + x[0] := x[0] xor F1(x[1], tr[6], tm[6]); + x[7] := x[7] xor F2(x[0], tr[7], tm[7]); + + Kr[i, 0] := x[0] and 31; + Kr[i, 1] := x[2] and 31; + Kr[i, 2] := x[4] and 31; + Kr[i, 3] := x[6] and 31; + Km[i, 0] := x[7]; + Km[i, 1] := x[5]; + Km[i, 2] := x[3]; + Km[i, 3] := x[1]; + end; + FillChar(x, Sizeof(x), $FF); +end; + +procedure TncEnc_cast256.Burn; +begin + FillChar(Kr, Sizeof(Kr), $FF); + FillChar(Km, Sizeof(Km), $FF); + inherited Burn; +end; + +procedure TncEnc_cast256.EncryptECB(const InData; var OutData); +var + a: array [0 .. 3] of UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + a[0] := PUInt32(@InData)^; + a[1] := PUInt32(NativeUInt(@InData) + 4)^; + a[2] := PUInt32(NativeUInt(@InData) + 8)^; + a[3] := PUInt32(NativeUInt(@InData) + 12)^; + + a[0] := SwapUInt32(a[0]); + a[1] := SwapUInt32(a[1]); + a[2] := SwapUInt32(a[2]); + a[3] := SwapUInt32(a[3]); + a[2] := a[2] xor F1(a[3], Kr[0, 0], Km[0, 0]); + a[1] := a[1] xor F2(a[2], Kr[0, 1], Km[0, 1]); + a[0] := a[0] xor F3(a[1], Kr[0, 2], Km[0, 2]); + a[3] := a[3] xor F1(a[0], Kr[0, 3], Km[0, 3]); + a[2] := a[2] xor F1(a[3], Kr[1, 0], Km[1, 0]); + a[1] := a[1] xor F2(a[2], Kr[1, 1], Km[1, 1]); + a[0] := a[0] xor F3(a[1], Kr[1, 2], Km[1, 2]); + a[3] := a[3] xor F1(a[0], Kr[1, 3], Km[1, 3]); + a[2] := a[2] xor F1(a[3], Kr[2, 0], Km[2, 0]); + a[1] := a[1] xor F2(a[2], Kr[2, 1], Km[2, 1]); + a[0] := a[0] xor F3(a[1], Kr[2, 2], Km[2, 2]); + a[3] := a[3] xor F1(a[0], Kr[2, 3], Km[2, 3]); + a[2] := a[2] xor F1(a[3], Kr[3, 0], Km[3, 0]); + a[1] := a[1] xor F2(a[2], Kr[3, 1], Km[3, 1]); + a[0] := a[0] xor F3(a[1], Kr[3, 2], Km[3, 2]); + a[3] := a[3] xor F1(a[0], Kr[3, 3], Km[3, 3]); + a[2] := a[2] xor F1(a[3], Kr[4, 0], Km[4, 0]); + a[1] := a[1] xor F2(a[2], Kr[4, 1], Km[4, 1]); + a[0] := a[0] xor F3(a[1], Kr[4, 2], Km[4, 2]); + a[3] := a[3] xor F1(a[0], Kr[4, 3], Km[4, 3]); + a[2] := a[2] xor F1(a[3], Kr[5, 0], Km[5, 0]); + a[1] := a[1] xor F2(a[2], Kr[5, 1], Km[5, 1]); + a[0] := a[0] xor F3(a[1], Kr[5, 2], Km[5, 2]); + a[3] := a[3] xor F1(a[0], Kr[5, 3], Km[5, 3]); + + a[3] := a[3] xor F1(a[0], Kr[6, 3], Km[6, 3]); + a[0] := a[0] xor F3(a[1], Kr[6, 2], Km[6, 2]); + a[1] := a[1] xor F2(a[2], Kr[6, 1], Km[6, 1]); + a[2] := a[2] xor F1(a[3], Kr[6, 0], Km[6, 0]); + a[3] := a[3] xor F1(a[0], Kr[7, 3], Km[7, 3]); + a[0] := a[0] xor F3(a[1], Kr[7, 2], Km[7, 2]); + a[1] := a[1] xor F2(a[2], Kr[7, 1], Km[7, 1]); + a[2] := a[2] xor F1(a[3], Kr[7, 0], Km[7, 0]); + a[3] := a[3] xor F1(a[0], Kr[8, 3], Km[8, 3]); + a[0] := a[0] xor F3(a[1], Kr[8, 2], Km[8, 2]); + a[1] := a[1] xor F2(a[2], Kr[8, 1], Km[8, 1]); + a[2] := a[2] xor F1(a[3], Kr[8, 0], Km[8, 0]); + a[3] := a[3] xor F1(a[0], Kr[9, 3], Km[9, 3]); + a[0] := a[0] xor F3(a[1], Kr[9, 2], Km[9, 2]); + a[1] := a[1] xor F2(a[2], Kr[9, 1], Km[9, 1]); + a[2] := a[2] xor F1(a[3], Kr[9, 0], Km[9, 0]); + a[3] := a[3] xor F1(a[0], Kr[10, 3], Km[10, 3]); + a[0] := a[0] xor F3(a[1], Kr[10, 2], Km[10, 2]); + a[1] := a[1] xor F2(a[2], Kr[10, 1], Km[10, 1]); + a[2] := a[2] xor F1(a[3], Kr[10, 0], Km[10, 0]); + a[3] := a[3] xor F1(a[0], Kr[11, 3], Km[11, 3]); + a[0] := a[0] xor F3(a[1], Kr[11, 2], Km[11, 2]); + a[1] := a[1] xor F2(a[2], Kr[11, 1], Km[11, 1]); + a[2] := a[2] xor F1(a[3], Kr[11, 0], Km[11, 0]); + a[0] := SwapUInt32(a[0]); + a[1] := SwapUInt32(a[1]); + a[2] := SwapUInt32(a[2]); + a[3] := SwapUInt32(a[3]); + + PUInt32(@OutData)^ := a[0]; + PUInt32(NativeUInt(@OutData) + 4)^ := a[1]; + PUInt32(NativeUInt(@OutData) + 8)^ := a[2]; + PUInt32(NativeUInt(@OutData) + 12)^ := a[3]; +end; + +procedure TncEnc_cast256.DecryptECB(const InData; var OutData); +var + a: array [0 .. 3] of UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + a[0] := PUInt32(@InData)^; + a[1] := PUInt32(NativeUInt(@InData) + 4)^; + a[2] := PUInt32(NativeUInt(@InData) + 8)^; + a[3] := PUInt32(NativeUInt(@InData) + 12)^; + + a[0] := SwapUInt32(a[0]); + a[1] := SwapUInt32(a[1]); + a[2] := SwapUInt32(a[2]); + a[3] := SwapUInt32(a[3]); + a[2] := a[2] xor F1(a[3], Kr[11, 0], Km[11, 0]); + a[1] := a[1] xor F2(a[2], Kr[11, 1], Km[11, 1]); + a[0] := a[0] xor F3(a[1], Kr[11, 2], Km[11, 2]); + a[3] := a[3] xor F1(a[0], Kr[11, 3], Km[11, 3]); + a[2] := a[2] xor F1(a[3], Kr[10, 0], Km[10, 0]); + a[1] := a[1] xor F2(a[2], Kr[10, 1], Km[10, 1]); + a[0] := a[0] xor F3(a[1], Kr[10, 2], Km[10, 2]); + a[3] := a[3] xor F1(a[0], Kr[10, 3], Km[10, 3]); + a[2] := a[2] xor F1(a[3], Kr[9, 0], Km[9, 0]); + a[1] := a[1] xor F2(a[2], Kr[9, 1], Km[9, 1]); + a[0] := a[0] xor F3(a[1], Kr[9, 2], Km[9, 2]); + a[3] := a[3] xor F1(a[0], Kr[9, 3], Km[9, 3]); + a[2] := a[2] xor F1(a[3], Kr[8, 0], Km[8, 0]); + a[1] := a[1] xor F2(a[2], Kr[8, 1], Km[8, 1]); + a[0] := a[0] xor F3(a[1], Kr[8, 2], Km[8, 2]); + a[3] := a[3] xor F1(a[0], Kr[8, 3], Km[8, 3]); + a[2] := a[2] xor F1(a[3], Kr[7, 0], Km[7, 0]); + a[1] := a[1] xor F2(a[2], Kr[7, 1], Km[7, 1]); + a[0] := a[0] xor F3(a[1], Kr[7, 2], Km[7, 2]); + a[3] := a[3] xor F1(a[0], Kr[7, 3], Km[7, 3]); + a[2] := a[2] xor F1(a[3], Kr[6, 0], Km[6, 0]); + a[1] := a[1] xor F2(a[2], Kr[6, 1], Km[6, 1]); + a[0] := a[0] xor F3(a[1], Kr[6, 2], Km[6, 2]); + a[3] := a[3] xor F1(a[0], Kr[6, 3], Km[6, 3]); + + a[3] := a[3] xor F1(a[0], Kr[5, 3], Km[5, 3]); + a[0] := a[0] xor F3(a[1], Kr[5, 2], Km[5, 2]); + a[1] := a[1] xor F2(a[2], Kr[5, 1], Km[5, 1]); + a[2] := a[2] xor F1(a[3], Kr[5, 0], Km[5, 0]); + a[3] := a[3] xor F1(a[0], Kr[4, 3], Km[4, 3]); + a[0] := a[0] xor F3(a[1], Kr[4, 2], Km[4, 2]); + a[1] := a[1] xor F2(a[2], Kr[4, 1], Km[4, 1]); + a[2] := a[2] xor F1(a[3], Kr[4, 0], Km[4, 0]); + a[3] := a[3] xor F1(a[0], Kr[3, 3], Km[3, 3]); + a[0] := a[0] xor F3(a[1], Kr[3, 2], Km[3, 2]); + a[1] := a[1] xor F2(a[2], Kr[3, 1], Km[3, 1]); + a[2] := a[2] xor F1(a[3], Kr[3, 0], Km[3, 0]); + a[3] := a[3] xor F1(a[0], Kr[2, 3], Km[2, 3]); + a[0] := a[0] xor F3(a[1], Kr[2, 2], Km[2, 2]); + a[1] := a[1] xor F2(a[2], Kr[2, 1], Km[2, 1]); + a[2] := a[2] xor F1(a[3], Kr[2, 0], Km[2, 0]); + a[3] := a[3] xor F1(a[0], Kr[1, 3], Km[1, 3]); + a[0] := a[0] xor F3(a[1], Kr[1, 2], Km[1, 2]); + a[1] := a[1] xor F2(a[2], Kr[1, 1], Km[1, 1]); + a[2] := a[2] xor F1(a[3], Kr[1, 0], Km[1, 0]); + a[3] := a[3] xor F1(a[0], Kr[0, 3], Km[0, 3]); + a[0] := a[0] xor F3(a[1], Kr[0, 2], Km[0, 2]); + a[1] := a[1] xor F2(a[2], Kr[0, 1], Km[0, 1]); + a[2] := a[2] xor F1(a[3], Kr[0, 0], Km[0, 0]); + a[0] := SwapUInt32(a[0]); + a[1] := SwapUInt32(a[1]); + a[2] := SwapUInt32(a[2]); + a[3] := SwapUInt32(a[3]); + + PUInt32(@OutData)^ := a[0]; + PUInt32(NativeUInt(@OutData) + 4)^ := a[1]; + PUInt32(NativeUInt(@OutData) + 8)^ := a[2]; + PUInt32(NativeUInt(@OutData) + 12)^ := a[3]; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncCrypt2.pas b/Source_using_TMonitor/Encryption/ncEncCrypt2.pas new file mode 100644 index 0000000..c41ad6f --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncCrypt2.pas @@ -0,0 +1,444 @@ +{$R-} +{$Q-} +unit ncEncCrypt2; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + Classes, Sysutils; + +resourcestring + rsHashNotInitialised = 'Hash not initialized'; + rsCipherNotInitialised = 'Cipher not initialized'; + rsCipherInvalidKeySize = 'Invalid key size'; + rsCipherInsufficientMemory = 'Unable to allocate sufficient memory for hash digest'; + +type + UInt32Array = array of UInt32; + PUInt32Array = ^UInt32Array; + + // ****************************************************************************** + // The base class from which all hash algorithms are to be derived + + EEncHashException = class(Exception); + + TncEncHash = class(TComponent) + protected + FInitialized: Boolean; // Whether or not the algorithm has been initialized + public + destructor Destroy; override; + + // Initialize the hash algorithm + procedure Init; virtual; abstract; + + // Update the hash buffer with Size bytes of data from Buffer + procedure Update(const aBuffer; aSize: NativeUInt); virtual; abstract; + // Update the hash buffer with Size bytes of data from the stream + procedure UpdateStream(const aStream: TStream; aSize: UInt64); + // Update the hash buffer with the string + procedure UpdateStr(const aStr: AnsiString); + + // Create the final digest and clear the stored information + // The size of the Digest var must be at least equal to the hash size + procedure Final(var aDigest); virtual; abstract; + + // Clear any stored information with out creating the final digest + procedure Burn; virtual; abstract; + + // Get the algorithm id + // Get the algorithm name + class function GetAlgorithm: string; virtual; abstract; + + // Get the size of the digest produced - in bits + class function GetHashSize: Integer; virtual; abstract; + + // Tests the implementation with several test vectors + class function SelfTest: Boolean; virtual; abstract; + function SelfTestProp: Boolean; + + property Initialized: Boolean read FInitialized; + published + property Algorithm: string read GetAlgorithm; + property HashSize: Integer read GetHashSize; + end; + + TncEncHashClass = class of TncEncHash; + + // ****************************************************************************** + // The base class from which all encryption components will be derived. + // Stream ciphers will be derived directly from this class where as + // Block ciphers will have a further foundation class TncEnc_blockcipher. + + EEncCipherException = class(Exception); + + TncEncCipher = class(TComponent) + protected + FInitialized: Boolean; // Whether or not the key setup has been done yet + public + constructor Create(aOwner: TComponent); override; + destructor Destroy; override; + + // Do key setup based on the data in Key, size is in bits + procedure Init(const Key; Size: NativeUInt; InitVector: Pointer); virtual; + // Do key setup based on a hash of the key string + procedure InitStr(const aKey: AnsiString; const aHashType: TncEncHashClass); + // Clear all stored key information + procedure Burn; virtual; + // Reset any stored chaining information + procedure Reset; virtual; abstract; + + // Encrypt size bytes of data and place in Outdata + procedure Encrypt(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Decrypt size bytes of data and place in Outdata + procedure Decrypt(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Encrypt size bytes of data from InStream and place in OutStream + function EncryptStream(InStream, OutStream: TStream; Size: UInt64): UInt64; + // Decrypt size bytes of data from InStream and place in OutStream + function DecryptStream(InStream, OutStream: TStream; Size: UInt64): UInt64; + + // Get the algorithm name + class function GetAlgorithm: string; virtual; abstract; + // Get the maximum key size (in bits) + class function GetMaxKeySize: Integer; virtual; abstract; + function GetMaxKeySizeProp: Integer; + // Tests the implementation with several test vectors + class function SelfTest: Boolean; virtual; abstract; + function SelfTestProp: Boolean; + + property Initialized: Boolean read FInitialized; + published + property Algorithm: string read GetAlgorithm; + property MaxKeySize: Integer read GetMaxKeySize; + end; + + TncEncCipherClass = class of TncEncCipher; + + // ****************************************************************************** + // The base class from which all block ciphers are to be derived, this + // extra class takes care of the different block encryption modes. + + EEncBlockcipherException = class(EEncHashException); + TncEncCipherMode = (cmCBC, cmCFB8bit, cmCFBblock, cmOFB, cmCTR); + + TncEncBlockCipher = class(TncEncCipher) + protected + FCipherMode: TncEncCipherMode; // The cipher mode the encrypt method uses + procedure InitKey(const Key; Size: LongWord); virtual; abstract; + public + constructor Create(aOwner: TComponent); override; + + // Encrypt size bytes of data and place in Outdata using CipherMode + procedure Encrypt(const Indata; var Outdata; Size: NativeUInt); override; + // Decrypt size bytes of data and place in Outdata using CipherMode + procedure Decrypt(const Indata; var Outdata; Size: NativeUInt); override; + // Encrypt a block of data using the ECB method of encryption + procedure EncryptECB(const Indata; var Outdata); virtual; abstract; + // Decrypt a block of data using the ECB method of decryption + procedure DecryptECB(const Indata; var Outdata); virtual; abstract; + // Encrypt size bytes of data using the CBC method of encryption + procedure EncryptCBC(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Decrypt size bytes of data using the CBC method of decryption + procedure DecryptCBC(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Encrypt size bytes of data using the CFB (8 bit) method of encryption + procedure EncryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Decrypt size bytes of data using the CFB (8 bit) method of decryption + procedure DecryptCFB8bit(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Encrypt size bytes of data using the CFB (block) method of encryption + procedure EncryptCFBblock(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Decrypt size bytes of data using the CFB (block) method of decryption + procedure DecryptCFBblock(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Encrypt size bytes of data using the OFB method of encryption + procedure EncryptOFB(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Decrypt size bytes of data using the OFB method of decryption + procedure DecryptOFB(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Encrypt size bytes of data using the CTR method of encryption + procedure EncryptCTR(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + // Decrypt size bytes of data using the CTR method of decryption + procedure DecryptCTR(const Indata; var Outdata; Size: NativeUInt); virtual; abstract; + + // Get the block size of the cipher (in bits) + class function GetBlockSize: Integer; virtual; abstract; + function GetBlockSizeProp: Integer; + + // Returns the current chaining information, not the actual IV + procedure GetIV(var Value); virtual; abstract; + // Sets the IV to Value and performs a reset + procedure SetIV(const Value); virtual; abstract; + published + property BlockSize: Integer read GetBlockSizeProp; + property CipherMode: TncEncCipherMode read FCipherMode write FCipherMode default cmCBC; + end; + + TncEncBlockCipherClass = class of TncEncBlockCipher; + +procedure XorBlock(var InData1, InData2; const aSize: NativeUInt); inline; + +implementation + +uses ncEncryption; + +{ TncEncHash } + +destructor TncEncHash.Destroy; +begin + if FInitialized then + Burn; + + inherited Destroy; +end; + +procedure TncEncHash.UpdateStream(const aStream: TStream; aSize: UInt64); +var + Buffer: array [0 .. 8191] of Byte; + i, Read: Integer; +begin + for i := 1 to (aSize div Sizeof(Buffer)) do + begin + Read := aStream.Read(Buffer, Sizeof(Buffer)); + Update(Buffer, Read); + end; + if (aSize mod Sizeof(Buffer)) <> 0 then + begin + Read := aStream.Read(Buffer, aSize mod Sizeof(Buffer)); + Update(Buffer, Read); + end; +end; + +procedure TncEncHash.UpdateStr(const aStr: AnsiString); +begin + if Length(aStr) > 0 then + Update(aStr[1], Length(aStr)); +end; + +{ TncEncCipher } + +constructor TncEncCipher.Create(aOwner: TComponent); +begin + inherited Create(aOwner); + Burn; +end; + +destructor TncEncCipher.Destroy; +begin + if FInitialized then + Burn; + inherited Destroy; +end; + +procedure TncEncCipher.Init(const Key; Size: NativeUInt; InitVector: Pointer); +begin + if FInitialized then + Burn; + if (Size <= 0) or ((Size and 3) <> 0) or (Size > NativeUInt(GetMaxKeySize)) then + raise EEncBlockcipherException.Create(rsCipherInvalidKeySize) + else + FInitialized := true; +end; + +procedure TncEncCipher.InitStr(const aKey: AnsiString; const aHashType: TncEncHashClass); +var + Hash: TncEncHash; + Digest: Pointer; +begin + if FInitialized then + Burn; + try + GetMem(Digest, aHashType.GetHashSize div 8); + Hash := aHashType.Create(Self); + Hash.Init; + Hash.UpdateStr(aKey); + Hash.Final(Digest^); + Hash.Free; + if MaxKeySize < aHashType.GetHashSize then + Init(Digest^, MaxKeySize, nil) + else + Init(Digest^, aHashType.GetHashSize, nil); + FillChar(Digest^, aHashType.GetHashSize div 8, $FF); + FreeMem(Digest); + except + raise EEncBlockcipherException.Create(rsCipherInsufficientMemory); + end; +end; + +procedure TncEncCipher.Burn; +begin + FInitialized := false; +end; + +function TncEncCipher.EncryptStream(InStream, OutStream: TStream; Size: UInt64): UInt64; +var + Buffer: array [0 .. 8191] of Byte; + i, Read: Integer; +begin + Result := 0; + for i := 1 to (Size div Sizeof(Buffer)) do + begin + Read := InStream.Read(Buffer, Sizeof(Buffer)); + Inc(Result, Read); + Encrypt(Buffer, Buffer, Read); + OutStream.Write(Buffer, Read); + end; + if (Size mod Sizeof(Buffer)) <> 0 then + begin + Read := InStream.Read(Buffer, Size mod Sizeof(Buffer)); + Inc(Result, Read); + Encrypt(Buffer, Buffer, Read); + OutStream.Write(Buffer, Read); + end; +end; + +function TncEncCipher.DecryptStream(InStream, OutStream: TStream; Size: UInt64): UInt64; +var + Buffer: array [0 .. 8191] of Byte; + i, Read: Integer; +begin + Result := 0; + for i := 1 to (Size div Sizeof(Buffer)) do + begin + Read := InStream.Read(Buffer, Sizeof(Buffer)); + Inc(Result, Read); + Decrypt(Buffer, Buffer, Read); + OutStream.Write(Buffer, Read); + end; + if (Size mod Sizeof(Buffer)) <> 0 then + begin + Read := InStream.Read(Buffer, Size mod Sizeof(Buffer)); + Inc(Result, Read); + Decrypt(Buffer, Buffer, Read); + OutStream.Write(Buffer, Read); + end; +end; + +{ TncEncBlockCipher } + +constructor TncEncBlockCipher.Create(aOwner: TComponent); +begin + inherited Create(aOwner); + FCipherMode := cmCBC; +end; + +procedure TncEncBlockCipher.Encrypt(const Indata; var Outdata; Size: NativeUInt); +begin + case FCipherMode of + cmCBC: + EncryptCBC(Indata, Outdata, Size); + cmCFB8bit: + EncryptCFB8bit(Indata, Outdata, Size); + cmCFBblock: + EncryptCFBblock(Indata, Outdata, Size); + cmOFB: + EncryptOFB(Indata, Outdata, Size); + cmCTR: + EncryptCTR(Indata, Outdata, Size); + end; +end; + +procedure TncEncBlockCipher.Decrypt(const Indata; var Outdata; Size: NativeUInt); +begin + case FCipherMode of + cmCBC: + DecryptCBC(Indata, Outdata, Size); + cmCFB8bit: + DecryptCFB8bit(Indata, Outdata, Size); + cmCFBblock: + DecryptCFBblock(Indata, Outdata, Size); + cmOFB: + DecryptOFB(Indata, Outdata, Size); + cmCTR: + DecryptCTR(Indata, Outdata, Size); + end; +end; + +function TncEncHash.SelfTestProp: Boolean; +begin + Result := SelfTest; +end; + +function TncEncCipher.GetMaxKeySizeProp: Integer; +begin + Result := GetMaxKeySize; +end; + +function TncEncCipher.SelfTestProp: Boolean; +begin + Result := SelfTest; +end; + +function TncEncBlockCipher.GetBlockSizeProp: Integer; +begin + Result := GetBlockSize; +end; + +// Helpher functions + +procedure XorBlock(var InData1, InData2; const aSize: NativeUInt); +var + i: NativeUInt; +begin + for i := 1 to aSize do + PByte(NativeUInt(@InData1) + i - 1)^ := PByte(NativeUInt(@InData1) + i - 1)^ xor PByte(NativeUInt(@InData2) + i - 1)^; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncDes.pas b/Source_using_TMonitor/Encryption/ncEncDes.pas new file mode 100644 index 0000000..8b56a4d --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncDes.pas @@ -0,0 +1,508 @@ +{$R-} +{$Q-} +unit ncEncDes; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_customdes = class(TncEnc_blockcipher64) + protected + procedure DoInit(KeyB: PByteArray; KeyData: PUInt32Array); + procedure EncryptBlock(const InData; var OutData; KeyData: PUInt32Array); + procedure DecryptBlock(const InData; var OutData; KeyData: PUInt32Array); + end; + +type + TncEnc_des = class(TncEnc_customdes) + protected + KeyData: array [0 .. 31] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + TncEnc_3des = class(TncEnc_customdes) + protected + KeyData: array [0 .. 2, 0 .. 31] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + shifts2: array [0 .. 15] of Byte = (0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0); + + des_skb: array [0 .. 7, 0 .. 63] of UInt32 = (( + (* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 *) + $00000000, $00000010, $20000000, $20000010, $00010000, $00010010, $20010000, $20010010, $00000800, $00000810, $20000800, $20000810, $00010800, $00010810, $20010800, $20010810, $00000020, $00000030, $20000020, $20000030, $00010020, $00010030, $20010020, $20010030, $00000820, $00000830, $20000820, $20000830, + $00010820, $00010830, $20010820, $20010830, $00080000, $00080010, $20080000, $20080010, $00090000, $00090010, $20090000, $20090010, $00080800, $00080810, $20080800, $20080810, $00090800, $00090810, $20090800, $20090810, $00080020, $00080030, $20080020, $20080030, $00090020, $00090030, $20090020, $20090030, + $00080820, $00080830, $20080820, $20080830, $00090820, $00090830, $20090820, $20090830), ( + (* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 *) + $00000000, $02000000, $00002000, $02002000, $00200000, $02200000, $00202000, $02202000, $00000004, $02000004, $00002004, $02002004, $00200004, $02200004, $00202004, $02202004, $00000400, $02000400, $00002400, $02002400, $00200400, $02200400, $00202400, $02202400, $00000404, $02000404, $00002404, $02002404, + $00200404, $02200404, $00202404, $02202404, $10000000, $12000000, $10002000, $12002000, $10200000, $12200000, $10202000, $12202000, $10000004, $12000004, $10002004, $12002004, $10200004, $12200004, $10202004, $12202004, $10000400, $12000400, $10002400, $12002400, $10200400, $12200400, $10202400, $12202400, + $10000404, $12000404, $10002404, $12002404, $10200404, $12200404, $10202404, $12202404), ( + (* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 *) + $00000000, $00000001, $00040000, $00040001, $01000000, $01000001, $01040000, $01040001, $00000002, $00000003, $00040002, $00040003, $01000002, $01000003, $01040002, $01040003, $00000200, $00000201, $00040200, $00040201, $01000200, $01000201, $01040200, $01040201, $00000202, $00000203, $00040202, $00040203, + $01000202, $01000203, $01040202, $01040203, $08000000, $08000001, $08040000, $08040001, $09000000, $09000001, $09040000, $09040001, $08000002, $08000003, $08040002, $08040003, $09000002, $09000003, $09040002, $09040003, $08000200, $08000201, $08040200, $08040201, $09000200, $09000201, $09040200, $09040201, + $08000202, $08000203, $08040202, $08040203, $09000202, $09000203, $09040202, $09040203), ( + (* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 *) + $00000000, $00100000, $00000100, $00100100, $00000008, $00100008, $00000108, $00100108, $00001000, $00101000, $00001100, $00101100, $00001008, $00101008, $00001108, $00101108, $04000000, $04100000, $04000100, $04100100, $04000008, $04100008, $04000108, $04100108, $04001000, $04101000, $04001100, $04101100, + $04001008, $04101008, $04001108, $04101108, $00020000, $00120000, $00020100, $00120100, $00020008, $00120008, $00020108, $00120108, $00021000, $00121000, $00021100, $00121100, $00021008, $00121008, $00021108, $00121108, $04020000, $04120000, $04020100, $04120100, $04020008, $04120008, $04020108, $04120108, + $04021000, $04121000, $04021100, $04121100, $04021008, $04121008, $04021108, $04121108), ( + (* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 *) + $00000000, $10000000, $00010000, $10010000, $00000004, $10000004, $00010004, $10010004, $20000000, $30000000, $20010000, $30010000, $20000004, $30000004, $20010004, $30010004, $00100000, $10100000, $00110000, $10110000, $00100004, $10100004, $00110004, $10110004, $20100000, $30100000, $20110000, $30110000, + $20100004, $30100004, $20110004, $30110004, $00001000, $10001000, $00011000, $10011000, $00001004, $10001004, $00011004, $10011004, $20001000, $30001000, $20011000, $30011000, $20001004, $30001004, $20011004, $30011004, $00101000, $10101000, $00111000, $10111000, $00101004, $10101004, $00111004, $10111004, + $20101000, $30101000, $20111000, $30111000, $20101004, $30101004, $20111004, $30111004), ( + (* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 *) + $00000000, $08000000, $00000008, $08000008, $00000400, $08000400, $00000408, $08000408, $00020000, $08020000, $00020008, $08020008, $00020400, $08020400, $00020408, $08020408, $00000001, $08000001, $00000009, $08000009, $00000401, $08000401, $00000409, $08000409, $00020001, $08020001, $00020009, $08020009, + $00020401, $08020401, $00020409, $08020409, $02000000, $0A000000, $02000008, $0A000008, $02000400, $0A000400, $02000408, $0A000408, $02020000, $0A020000, $02020008, $0A020008, $02020400, $0A020400, $02020408, $0A020408, $02000001, $0A000001, $02000009, $0A000009, $02000401, $0A000401, $02000409, $0A000409, + $02020001, $0A020001, $02020009, $0A020009, $02020401, $0A020401, $02020409, $0A020409), ( + (* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 *) + $00000000, $00000100, $00080000, $00080100, $01000000, $01000100, $01080000, $01080100, $00000010, $00000110, $00080010, $00080110, $01000010, $01000110, $01080010, $01080110, $00200000, $00200100, $00280000, $00280100, $01200000, $01200100, $01280000, $01280100, $00200010, $00200110, $00280010, $00280110, + $01200010, $01200110, $01280010, $01280110, $00000200, $00000300, $00080200, $00080300, $01000200, $01000300, $01080200, $01080300, $00000210, $00000310, $00080210, $00080310, $01000210, $01000310, $01080210, $01080310, $00200200, $00200300, $00280200, $00280300, $01200200, $01200300, $01280200, $01280300, + $00200210, $00200310, $00280210, $00280310, $01200210, $01200310, $01280210, $01280310), ( + (* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 *) + $00000000, $04000000, $00040000, $04040000, $00000002, $04000002, $00040002, $04040002, $00002000, $04002000, $00042000, $04042000, $00002002, $04002002, $00042002, $04042002, $00000020, $04000020, $00040020, $04040020, $00000022, $04000022, $00040022, $04040022, $00002020, $04002020, $00042020, $04042020, + $00002022, $04002022, $00042022, $04042022, $00000800, $04000800, $00040800, $04040800, $00000802, $04000802, $00040802, $04040802, $00002800, $04002800, $00042800, $04042800, $00002802, $04002802, $00042802, $04042802, $00000820, $04000820, $00040820, $04040820, $00000822, $04000822, $00040822, $04040822, + $00002820, $04002820, $00042820, $04042820, $00002822, $04002822, $00042822, $04042822)); + + des_sptrans: array [0 .. 7, 0 .. 63] of UInt32 = (( + (* nibble 0 *) + $02080800, $00080000, $02000002, $02080802, $02000000, $00080802, $00080002, $02000002, $00080802, $02080800, $02080000, $00000802, $02000802, $02000000, $00000000, $00080002, $00080000, $00000002, $02000800, $00080800, $02080802, $02080000, $00000802, $02000800, $00000002, $00000800, $00080800, $02080002, + $00000800, $02000802, $02080002, $00000000, $00000000, $02080802, $02000800, $00080002, $02080800, $00080000, $00000802, $02000800, $02080002, $00000800, $00080800, $02000002, $00080802, $00000002, $02000002, $02080000, $02080802, $00080800, $02080000, $02000802, $02000000, $00000802, $00080002, $00000000, + $00080000, $02000000, $02000802, $02080800, $00000002, $02080002, $00000800, $00080802), ( + (* nibble 1 *) + $40108010, $00000000, $00108000, $40100000, $40000010, $00008010, $40008000, $00108000, $00008000, $40100010, $00000010, $40008000, $00100010, $40108000, $40100000, $00000010, $00100000, $40008010, $40100010, $00008000, $00108010, $40000000, $00000000, $00100010, $40008010, $00108010, $40108000, $40000010, + $40000000, $00100000, $00008010, $40108010, $00100010, $40108000, $40008000, $00108010, $40108010, $00100010, $40000010, $00000000, $40000000, $00008010, $00100000, $40100010, $00008000, $40000000, $00108010, $40008010, $40108000, $00008000, $00000000, $40000010, $00000010, $40108010, $00108000, $40100000, + $40100010, $00100000, $00008010, $40008000, $40008010, $00000010, $40100000, $00108000), ( + (* nibble 2 *) + $04000001, $04040100, $00000100, $04000101, $00040001, $04000000, $04000101, $00040100, $04000100, $00040000, $04040000, $00000001, $04040101, $00000101, $00000001, $04040001, $00000000, $00040001, $04040100, $00000100, $00000101, $04040101, $00040000, $04000001, $04040001, $04000100, $00040101, $04040000, + $00040100, $00000000, $04000000, $00040101, $04040100, $00000100, $00000001, $00040000, $00000101, $00040001, $04040000, $04000101, $00000000, $04040100, $00040100, $04040001, $00040001, $04000000, $04040101, $00000001, $00040101, $04000001, $04000000, $04040101, $00040000, $04000100, $04000101, $00040100, + $04000100, $00000000, $04040001, $00000101, $04000001, $00040101, $00000100, $04040000), ( + (* nibble 3 *) + $00401008, $10001000, $00000008, $10401008, $00000000, $10400000, $10001008, $00400008, $10401000, $10000008, $10000000, $00001008, $10000008, $00401008, $00400000, $10000000, $10400008, $00401000, $00001000, $00000008, $00401000, $10001008, $10400000, $00001000, $00001008, $00000000, $00400008, $10401000, + $10001000, $10400008, $10401008, $00400000, $10400008, $00001008, $00400000, $10000008, $00401000, $10001000, $00000008, $10400000, $10001008, $00000000, $00001000, $00400008, $00000000, $10400008, $10401000, $00001000, $10000000, $10401008, $00401008, $00400000, $10401008, $00000008, $10001000, $00401008, + $00400008, $00401000, $10400000, $10001008, $00001008, $10000000, $10000008, $10401000), ( + (* nibble 4 *) + $08000000, $00010000, $00000400, $08010420, $08010020, $08000400, $00010420, $08010000, $00010000, $00000020, $08000020, $00010400, $08000420, $08010020, $08010400, $00000000, $00010400, $08000000, $00010020, $00000420, $08000400, $00010420, $00000000, $08000020, $00000020, $08000420, $08010420, $00010020, + $08010000, $00000400, $00000420, $08010400, $08010400, $08000420, $00010020, $08010000, $00010000, $00000020, $08000020, $08000400, $08000000, $00010400, $08010420, $00000000, $00010420, $08000000, $00000400, $00010020, $08000420, $00000400, $00000000, $08010420, $08010020, $08010400, $00000420, $00010000, + $00010400, $08010020, $08000400, $00000420, $00000020, $00010420, $08010000, $08000020), ( + (* nibble 5 *) + $80000040, $00200040, $00000000, $80202000, $00200040, $00002000, $80002040, $00200000, $00002040, $80202040, $00202000, $80000000, $80002000, $80000040, $80200000, $00202040, $00200000, $80002040, $80200040, $00000000, $00002000, $00000040, $80202000, $80200040, $80202040, $80200000, $80000000, $00002040, + $00000040, $00202000, $00202040, $80002000, $00002040, $80000000, $80002000, $00202040, $80202000, $00200040, $00000000, $80002000, $80000000, $00002000, $80200040, $00200000, $00200040, $80202040, $00202000, $00000040, $80202040, $00202000, $00200000, $80002040, $80000040, $80200000, $00202040, $00000000, + $00002000, $80000040, $80002040, $80202000, $80200000, $00002040, $00000040, $80200040), ( + (* nibble 6 *) + $00004000, $00000200, $01000200, $01000004, $01004204, $00004004, $00004200, $00000000, $01000000, $01000204, $00000204, $01004000, $00000004, $01004200, $01004000, $00000204, $01000204, $00004000, $00004004, $01004204, $00000000, $01000200, $01000004, $00004200, $01004004, $00004204, $01004200, $00000004, + $00004204, $01004004, $00000200, $01000000, $00004204, $01004000, $01004004, $00000204, $00004000, $00000200, $01000000, $01004004, $01000204, $00004204, $00004200, $00000000, $00000200, $01000004, $00000004, $01000200, $00000000, $01000204, $01000200, $00004200, $00000204, $00004000, $01004204, $01000000, + $01004200, $00000004, $00004004, $01004204, $01000004, $01004200, $01004000, $00004004), ( + (* nibble 7 *) + $20800080, $20820000, $00020080, $00000000, $20020000, $00800080, $20800000, $20820080, $00000080, $20000000, $00820000, $00020080, $00820080, $20020080, $20000080, $20800000, $00020000, $00820080, $00800080, $20020000, $20820080, $20000080, $00000000, $00820000, $20000000, $00800000, $20020080, $20800080, + $00800000, $00020000, $20820000, $00000080, $00800000, $00020000, $20000080, $20820080, $00020080, $20000000, $00000000, $00820000, $20800080, $20020080, $20020000, $00800080, $20820000, $00000080, $00800080, $20020000, $20820080, $00800000, $20800000, $20000080, $00820000, $00020080, $20020080, $20800000, + $00000080, $20820000, $00820080, $00000000, $20000000, $20800080, $00020000, $00820080)); + +procedure hperm_op(var a, t: UInt32; const n, m: UInt32); inline; +begin + t := ((a shl (16 - n)) xor a) and m; + a := a xor t xor (t shr (16 - n)); +end; + +procedure perm_op(var a, b, t: UInt32; const n, m: UInt32); inline; +begin + t := ((a shr n) xor b) and m; + b := b xor t; + a := a xor (t shl n); +end; + +procedure TncEnc_customdes.DoInit(KeyB: PByteArray; KeyData: PUInt32Array); +var + c, d, t, s, t2, i: UInt32; +begin + c := KeyB^[0] or (KeyB^[1] shl 8) or (KeyB^[2] shl 16) or (KeyB^[3] shl 24); + d := KeyB^[4] or (KeyB^[5] shl 8) or (KeyB^[6] shl 16) or (KeyB^[7] shl 24); + perm_op(d, c, t, 4, $0F0F0F0F); + hperm_op(c, t, UInt32(-2), $CCCC0000); + hperm_op(d, t, UInt32(-2), $CCCC0000); + perm_op(d, c, t, 1, $55555555); + perm_op(c, d, t, 8, $00FF00FF); + perm_op(d, c, t, 1, $55555555); + d := ((d and $FF) shl 16) or (d and $FF00) or ((d and $FF0000) shr 16) or ((c and $F0000000) shr 4); + c := c and $FFFFFFF; + for i := 0 to 15 do + begin + if shifts2[i] <> 0 then + begin + c := ((c shr 2) or (c shl 26)); + d := ((d shr 2) or (d shl 26)); + end + else + begin + c := ((c shr 1) or (c shl 27)); + d := ((d shr 1) or (d shl 27)); + end; + c := c and $FFFFFFF; + d := d and $FFFFFFF; + s := des_skb[0, c and $3F] or des_skb[1, ((c shr 6) and $03) or ((c shr 7) and $3C)] or des_skb[2, ((c shr 13) and $0F) or ((c shr 14) and $30)] or des_skb[3, ((c shr 20) and $01) or ((c shr 21) and $06) or ((c shr 22) and $38)]; + t := des_skb[4, d and $3F] or des_skb[5, ((d shr 7) and $03) or ((d shr 8) and $3C)] or des_skb[6, (d shr 15) and $3F] or des_skb[7, ((d shr 21) and $0F) or ((d shr 22) and $30)]; + t2 := ((t shl 16) or (s and $FFFF)); + KeyData^[(i shl 1)] := ((t2 shl 2) or (t2 shr 30)); + t2 := ((s shr 16) or (t and $FFFF0000)); + KeyData^[(i shl 1) + 1] := ((t2 shl 6) or (t2 shr 26)); + end; +end; + +procedure TncEnc_customdes.EncryptBlock(const InData; var OutData; KeyData: PUInt32Array); +var + l, r, t, u: UInt32; + i: longint; +begin + r := PUInt32(@InData)^; + l := PUInt32(NativeUInt(@InData) + 4)^; + t := ((l shr 4) xor r) and $0F0F0F0F; + r := r xor t; + l := l xor (t shl 4); + t := ((r shr 16) xor l) and $0000FFFF; + l := l xor t; + r := r xor (t shl 16); + t := ((l shr 2) xor r) and $33333333; + r := r xor t; + l := l xor (t shl 2); + t := ((r shr 8) xor l) and $00FF00FF; + l := l xor t; + r := r xor (t shl 8); + t := ((l shr 1) xor r) and $55555555; + r := r xor t; + l := l xor (t shl 1); + r := (r shr 29) or (r shl 3); + l := (l shr 29) or (l shl 3); + i := 0; + while i < 32 do + begin + u := r xor KeyData^[i]; + t := r xor KeyData^[i + 1]; + t := (t shr 4) or (t shl 28); + l := l xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + u := l xor KeyData^[i + 2]; + t := l xor KeyData^[i + 3]; + t := (t shr 4) or (t shl 28); + r := r xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + u := r xor KeyData^[i + 4]; + t := r xor KeyData^[i + 5]; + t := (t shr 4) or (t shl 28); + l := l xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + u := l xor KeyData^[i + 6]; + t := l xor KeyData^[i + 7]; + t := (t shr 4) or (t shl 28); + r := r xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + Inc(i, 8); + end; + r := (r shr 3) or (r shl 29); + l := (l shr 3) or (l shl 29); + t := ((r shr 1) xor l) and $55555555; + l := l xor t; + r := r xor (t shl 1); + t := ((l shr 8) xor r) and $00FF00FF; + r := r xor t; + l := l xor (t shl 8); + t := ((r shr 2) xor l) and $33333333; + l := l xor t; + r := r xor (t shl 2); + t := ((l shr 16) xor r) and $0000FFFF; + r := r xor t; + l := l xor (t shl 16); + t := ((r shr 4) xor l) and $0F0F0F0F; + l := l xor t; + r := r xor (t shl 4); + PUInt32(@OutData)^ := l; + PUInt32(NativeUInt(@OutData) + 4)^ := r; +end; + +procedure TncEnc_customdes.DecryptBlock(const InData; var OutData; KeyData: PUInt32Array); +var + l, r, t, u: UInt32; + i: longint; +begin + r := PUInt32(@InData)^; + l := PUInt32(NativeUInt(@InData) + 4)^; + t := ((l shr 4) xor r) and $0F0F0F0F; + r := r xor t; + l := l xor (t shl 4); + t := ((r shr 16) xor l) and $0000FFFF; + l := l xor t; + r := r xor (t shl 16); + t := ((l shr 2) xor r) and $33333333; + r := r xor t; + l := l xor (t shl 2); + t := ((r shr 8) xor l) and $00FF00FF; + l := l xor t; + r := r xor (t shl 8); + t := ((l shr 1) xor r) and $55555555; + r := r xor t; + l := l xor (t shl 1); + r := (r shr 29) or (r shl 3); + l := (l shr 29) or (l shl 3); + i := 30; + while i > 0 do + begin + u := r xor KeyData^[i]; + t := r xor KeyData^[i + 1]; + t := (t shr 4) or (t shl 28); + l := l xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + u := l xor KeyData^[i - 2]; + t := l xor KeyData^[i - 1]; + t := (t shr 4) or (t shl 28); + r := r xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + u := r xor KeyData^[i - 4]; + t := r xor KeyData^[i - 3]; + t := (t shr 4) or (t shl 28); + l := l xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + u := l xor KeyData^[i - 6]; + t := l xor KeyData^[i - 5]; + t := (t shr 4) or (t shl 28); + r := r xor des_sptrans[0, (u shr 2) and $3F] xor des_sptrans[2, (u shr 10) and $3F] xor des_sptrans[4, (u shr 18) and $3F] xor des_sptrans[6, (u shr 26) and $3F] xor des_sptrans[1, (t shr 2) and $3F] xor des_sptrans[3, (t shr 10) and $3F] xor des_sptrans[5, (t shr 18) and $3F] xor des_sptrans + [7, (t shr 26) and $3F]; + Dec(i, 8); + end; + r := (r shr 3) or (r shl 29); + l := (l shr 3) or (l shl 29); + t := ((r shr 1) xor l) and $55555555; + l := l xor t; + r := r xor (t shl 1); + t := ((l shr 8) xor r) and $00FF00FF; + r := r xor t; + l := l xor (t shl 8); + t := ((r shr 2) xor l) and $33333333; + l := l xor t; + r := r xor (t shl 2); + t := ((l shr 16) xor r) and $0000FFFF; + r := r xor t; + l := l xor (t shl 16); + t := ((r shr 4) xor l) and $0F0F0F0F; + l := l xor t; + r := r xor (t shl 4); + PUInt32(@OutData)^ := l; + PUInt32(NativeUInt(@OutData) + 4)^ := r; +end; + +class function TncEnc_des.GetMaxKeySize: integer; +begin + Result := 64; +end; + +class function TncEnc_des.GetAlgorithm: string; +begin + Result := 'DES'; +end; + +class function TncEnc_des.SelfTest: boolean; +const + InData1: array [0 .. 7] of Byte = ($07, $56, $D8, $E0, $77, $47, $61, $D2); + OutData1: array [0 .. 7] of Byte = ($0C, $D3, $DA, $02, $00, $21, $DC, $09); + Key1: array [0 .. 7] of Byte = ($01, $70, $F1, $75, $46, $8F, $B5, $E6); + InData2: array [0 .. 7] of Byte = ($48, $0D, $39, $00, $6E, $E7, $62, $F2); + OutData2: array [0 .. 7] of Byte = ($A1, $F9, $91, $55, $41, $02, $0B, $56); + Key2: array [0 .. 7] of Byte = ($02, $58, $16, $16, $46, $29, $B0, $07); +var + Cipher: TncEnc_des; + Data: array [0 .. 7] of Byte; +begin + Cipher := TncEnc_des.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Data); + Result := boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and boolean(CompareMem(@Data, @InData1, Sizeof(Data))); + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(InData2, Data); + Result := Result and boolean(CompareMem(@Data, @OutData2, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and boolean(CompareMem(@Data, @InData2, Sizeof(Data))); + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_des.InitKey(const Key; Size: longword); +var + KeyB: array [0 .. 7] of Byte; +begin + FillChar(KeyB, Sizeof(KeyB), 0); + Move(Key, KeyB, Size div 8); + DoInit(@KeyB, @KeyData); +end; + +procedure TncEnc_des.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), 0); + inherited Burn; +end; + +procedure TncEnc_des.EncryptECB(const InData; var OutData); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + EncryptBlock(InData, OutData, @KeyData); +end; + +procedure TncEnc_des.DecryptECB(const InData; var OutData); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + DecryptBlock(InData, OutData, @KeyData); +end; + +{ ****************************************************************************** } +class function TncEnc_3des.GetMaxKeySize: integer; +begin + Result := 192; +end; + +class function TncEnc_3des.GetAlgorithm: string; +begin + Result := '3DES'; +end; + +class function TncEnc_3des.SelfTest: boolean; +const + Key: array [0 .. 23] of Byte = ($01, $23, $45, $67, $89, $AB, $CD, $EF, $FE, $DC, $BA, $98, $76, $54, $32, $10, $89, $AB, $CD, $EF, $01, $23, $45, $67); + PlainText: array [0 .. 7] of Byte = ($01, $23, $45, $67, $89, $AB, $CD, $E7); + CipherText: array [0 .. 7] of Byte = ($DE, $0B, $7C, $06, $AE, $5E, $0E, $D5); +var + Cipher: TncEnc_3des; + Block: array [0 .. 7] of Byte; +begin + Cipher := TncEnc_3des.Create(nil); + Cipher.Init(Key, Sizeof(Key) * 8, nil); + Cipher.EncryptECB(PlainText, Block); + Result := CompareMem(@Block, @CipherText, Sizeof(CipherText)); + Cipher.DecryptECB(Block, Block); + Result := Result and CompareMem(@Block, @PlainText, Sizeof(PlainText)); + Cipher.Free; +end; + +procedure TncEnc_3des.InitKey(const Key; Size: longword); +var + KeyB: array [0 .. 2, 0 .. 7] of Byte; +begin + FillChar(KeyB, Sizeof(KeyB), 0); + Move(Key, KeyB, Size div 8); + DoInit(@KeyB[0], @KeyData[0]); + DoInit(@KeyB[1], @KeyData[1]); + if Size > 128 then + DoInit(@KeyB[2], @KeyData[2]) + else + Move(KeyData[0], KeyData[2], 128); +end; + +procedure TncEnc_3des.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), 0); + inherited Burn; +end; + +procedure TncEnc_3des.EncryptECB(const InData; var OutData); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + EncryptBlock(InData, OutData, @KeyData[0]); + DecryptBlock(OutData, OutData, @KeyData[1]); + EncryptBlock(OutData, OutData, @KeyData[2]); +end; + +procedure TncEnc_3des.DecryptECB(const InData; var OutData); +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + DecryptBlock(InData, OutData, @KeyData[2]); + EncryptBlock(OutData, OutData, @KeyData[1]); + DecryptBlock(OutData, OutData, @KeyData[0]); +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncHaval.pas b/Source_using_TMonitor/Encryption/ncEncHaval.pas new file mode 100644 index 0000000..7bd5ca4 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncHaval.pas @@ -0,0 +1,1308 @@ +{$R-} +{$Q-} +unit ncEncHaval; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_haval = class(TncEncHash) + protected + LenHi, LenLo: UInt32; + Index: UInt32; + CurrentHash: array [0 .. 7] of UInt32; + HashBuffer: array [0 .. 127] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const Buffer; Size: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { Choose how many passes (previous versions of ncEnccrypt uses 5 passes) } + { ONLY UNCOMMENT ONE! } + // {$DEFINE PASS3} + // {$DEFINE PASS4} +{$DEFINE PASS5} + { Choose digest length (previous versions of ncEnccrypt uses 256bits) } + { ONLY UNCOMMENT ONE! } + // {$DEFINE DIGEST128} + // {$DEFINE DIGEST160} + // {$DEFINE DIGEST192} + // {$DEFINE DIGEST224} +{$DEFINE DIGEST256} + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +procedure TncEnc_haval.Compress; +var + t7, t6, t5, t4, t3, t2, t1, t0: UInt32; + W: array [0 .. 31] of UInt32; + Temp: UInt32; +begin + t0 := CurrentHash[0]; + t1 := CurrentHash[1]; + t2 := CurrentHash[2]; + t3 := CurrentHash[3]; + t4 := CurrentHash[4]; + t5 := CurrentHash[5]; + t6 := CurrentHash[6]; + t7 := CurrentHash[7]; + Move(HashBuffer, W, Sizeof(W)); +{$IFDEF PASS3} + Temp := (t2 and (t4 xor t3) xor t6 and t0 xor t5 and t1 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[0]; + Temp := (t1 and (t3 xor t2) xor t5 and t7 xor t4 and t0 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[1]; + Temp := (t0 and (t2 xor t1) xor t4 and t6 xor t3 and t7 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[2]; + Temp := (t7 and (t1 xor t0) xor t3 and t5 xor t2 and t6 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[3]; + Temp := (t6 and (t0 xor t7) xor t2 and t4 xor t1 and t5 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[4]; + Temp := (t5 and (t7 xor t6) xor t1 and t3 xor t0 and t4 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[5]; + Temp := (t4 and (t6 xor t5) xor t0 and t2 xor t7 and t3 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[6]; + Temp := (t3 and (t5 xor t4) xor t7 and t1 xor t6 and t2 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[7]; + + Temp := (t2 and (t4 xor t3) xor t6 and t0 xor t5 and t1 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[8]; + Temp := (t1 and (t3 xor t2) xor t5 and t7 xor t4 and t0 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[9]; + Temp := (t0 and (t2 xor t1) xor t4 and t6 xor t3 and t7 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[10]; + Temp := (t7 and (t1 xor t0) xor t3 and t5 xor t2 and t6 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[11]; + Temp := (t6 and (t0 xor t7) xor t2 and t4 xor t1 and t5 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[12]; + Temp := (t5 and (t7 xor t6) xor t1 and t3 xor t0 and t4 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[13]; + Temp := (t4 and (t6 xor t5) xor t0 and t2 xor t7 and t3 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[14]; + Temp := (t3 and (t5 xor t4) xor t7 and t1 xor t6 and t2 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[15]; + + Temp := (t2 and (t4 xor t3) xor t6 and t0 xor t5 and t1 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[16]; + Temp := (t1 and (t3 xor t2) xor t5 and t7 xor t4 and t0 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[17]; + Temp := (t0 and (t2 xor t1) xor t4 and t6 xor t3 and t7 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[18]; + Temp := (t7 and (t1 xor t0) xor t3 and t5 xor t2 and t6 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[19]; + Temp := (t6 and (t0 xor t7) xor t2 and t4 xor t1 and t5 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[20]; + Temp := (t5 and (t7 xor t6) xor t1 and t3 xor t0 and t4 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[21]; + Temp := (t4 and (t6 xor t5) xor t0 and t2 xor t7 and t3 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[22]; + Temp := (t3 and (t5 xor t4) xor t7 and t1 xor t6 and t2 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[23]; + + Temp := (t2 and (t4 xor t3) xor t6 and t0 xor t5 and t1 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[24]; + Temp := (t1 and (t3 xor t2) xor t5 and t7 xor t4 and t0 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[25]; + Temp := (t0 and (t2 xor t1) xor t4 and t6 xor t3 and t7 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[26]; + Temp := (t7 and (t1 xor t0) xor t3 and t5 xor t2 and t6 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[27]; + Temp := (t6 and (t0 xor t7) xor t2 and t4 xor t1 and t5 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[28]; + Temp := (t5 and (t7 xor t6) xor t1 and t3 xor t0 and t4 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[29]; + Temp := (t4 and (t6 xor t5) xor t0 and t2 xor t7 and t3 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[30]; + Temp := (t3 and (t5 xor t4) xor t7 and t1 xor t6 and t2 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[31]; + + Temp := (t5 and (t3 and not t0 xor t1 and t2 xor t4 xor t6) xor t1 and (t3 xor t2) xor t0 and t2 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[5] + $452821E6; + Temp := (t4 and (t2 and not t7 xor t0 and t1 xor t3 xor t5) xor t0 and (t2 xor t1) xor t7 and t1 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[14] + $38D01377; + Temp := (t3 and (t1 and not t6 xor t7 and t0 xor t2 xor t4) xor t7 and (t1 xor t0) xor t6 and t0 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[26] + $BE5466CF; + Temp := (t2 and (t0 and not t5 xor t6 and t7 xor t1 xor t3) xor t6 and (t0 xor t7) xor t5 and t7 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[18] + $34E90C6C; + Temp := (t1 and (t7 and not t4 xor t5 and t6 xor t0 xor t2) xor t5 and (t7 xor t6) xor t4 and t6 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[11] + $C0AC29B7; + Temp := (t0 and (t6 and not t3 xor t4 and t5 xor t7 xor t1) xor t4 and (t6 xor t5) xor t3 and t5 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[28] + $C97C50DD; + Temp := (t7 and (t5 and not t2 xor t3 and t4 xor t6 xor t0) xor t3 and (t5 xor t4) xor t2 and t4 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[7] + $3F84D5B5; + Temp := (t6 and (t4 and not t1 xor t2 and t3 xor t5 xor t7) xor t2 and (t4 xor t3) xor t1 and t3 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[16] + $B5470917; + + Temp := (t5 and (t3 and not t0 xor t1 and t2 xor t4 xor t6) xor t1 and (t3 xor t2) xor t0 and t2 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[0] + $9216D5D9; + Temp := (t4 and (t2 and not t7 xor t0 and t1 xor t3 xor t5) xor t0 and (t2 xor t1) xor t7 and t1 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[23] + $8979FB1B; + Temp := (t3 and (t1 and not t6 xor t7 and t0 xor t2 xor t4) xor t7 and (t1 xor t0) xor t6 and t0 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[20] + $D1310BA6; + Temp := (t2 and (t0 and not t5 xor t6 and t7 xor t1 xor t3) xor t6 and (t0 xor t7) xor t5 and t7 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[22] + $98DFB5AC; + Temp := (t1 and (t7 and not t4 xor t5 and t6 xor t0 xor t2) xor t5 and (t7 xor t6) xor t4 and t6 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[1] + $2FFD72DB; + Temp := (t0 and (t6 and not t3 xor t4 and t5 xor t7 xor t1) xor t4 and (t6 xor t5) xor t3 and t5 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[10] + $D01ADFB7; + Temp := (t7 and (t5 and not t2 xor t3 and t4 xor t6 xor t0) xor t3 and (t5 xor t4) xor t2 and t4 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[4] + $B8E1AFED; + Temp := (t6 and (t4 and not t1 xor t2 and t3 xor t5 xor t7) xor t2 and (t4 xor t3) xor t1 and t3 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[8] + $6A267E96; + + Temp := (t5 and (t3 and not t0 xor t1 and t2 xor t4 xor t6) xor t1 and (t3 xor t2) xor t0 and t2 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[30] + $BA7C9045; + Temp := (t4 and (t2 and not t7 xor t0 and t1 xor t3 xor t5) xor t0 and (t2 xor t1) xor t7 and t1 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[3] + $F12C7F99; + Temp := (t3 and (t1 and not t6 xor t7 and t0 xor t2 xor t4) xor t7 and (t1 xor t0) xor t6 and t0 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[21] + $24A19947; + Temp := (t2 and (t0 and not t5 xor t6 and t7 xor t1 xor t3) xor t6 and (t0 xor t7) xor t5 and t7 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[9] + $B3916CF7; + Temp := (t1 and (t7 and not t4 xor t5 and t6 xor t0 xor t2) xor t5 and (t7 xor t6) xor t4 and t6 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[17] + $0801F2E2; + Temp := (t0 and (t6 and not t3 xor t4 and t5 xor t7 xor t1) xor t4 and (t6 xor t5) xor t3 and t5 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[24] + $858EFC16; + Temp := (t7 and (t5 and not t2 xor t3 and t4 xor t6 xor t0) xor t3 and (t5 xor t4) xor t2 and t4 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[29] + $636920D8; + Temp := (t6 and (t4 and not t1 xor t2 and t3 xor t5 xor t7) xor t2 and (t4 xor t3) xor t1 and t3 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[6] + $71574E69; + + Temp := (t5 and (t3 and not t0 xor t1 and t2 xor t4 xor t6) xor t1 and (t3 xor t2) xor t0 and t2 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[19] + $A458FEA3; + Temp := (t4 and (t2 and not t7 xor t0 and t1 xor t3 xor t5) xor t0 and (t2 xor t1) xor t7 and t1 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[12] + $F4933D7E; + Temp := (t3 and (t1 and not t6 xor t7 and t0 xor t2 xor t4) xor t7 and (t1 xor t0) xor t6 and t0 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[15] + $0D95748F; + Temp := (t2 and (t0 and not t5 xor t6 and t7 xor t1 xor t3) xor t6 and (t0 xor t7) xor t5 and t7 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[13] + $728EB658; + Temp := (t1 and (t7 and not t4 xor t5 and t6 xor t0 xor t2) xor t5 and (t7 xor t6) xor t4 and t6 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[2] + $718BCD58; + Temp := (t0 and (t6 and not t3 xor t4 and t5 xor t7 xor t1) xor t4 and (t6 xor t5) xor t3 and t5 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[25] + $82154AEE; + Temp := (t7 and (t5 and not t2 xor t3 and t4 xor t6 xor t0) xor t3 and (t5 xor t4) xor t2 and t4 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[31] + $7B54A41D; + Temp := (t6 and (t4 and not t1 xor t2 and t3 xor t5 xor t7) xor t2 and (t4 xor t3) xor t1 and t3 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[27] + $C25A59B5; + + Temp := (t3 and (t5 and t4 xor t6 xor t0) xor t5 and t2 xor t4 and t1 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[19] + $9C30D539; + Temp := (t2 and (t4 and t3 xor t5 xor t7) xor t4 and t1 xor t3 and t0 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[9] + $2AF26013; + Temp := (t1 and (t3 and t2 xor t4 xor t6) xor t3 and t0 xor t2 and t7 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[4] + $C5D1B023; + Temp := (t0 and (t2 and t1 xor t3 xor t5) xor t2 and t7 xor t1 and t6 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[20] + $286085F0; + Temp := (t7 and (t1 and t0 xor t2 xor t4) xor t1 and t6 xor t0 and t5 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[28] + $CA417918; + Temp := (t6 and (t0 and t7 xor t1 xor t3) xor t0 and t5 xor t7 and t4 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[17] + $B8DB38EF; + Temp := (t5 and (t7 and t6 xor t0 xor t2) xor t7 and t4 xor t6 and t3 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[8] + $8E79DCB0; + Temp := (t4 and (t6 and t5 xor t7 xor t1) xor t6 and t3 xor t5 and t2 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[22] + $603A180E; + + Temp := (t3 and (t5 and t4 xor t6 xor t0) xor t5 and t2 xor t4 and t1 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[29] + $6C9E0E8B; + Temp := (t2 and (t4 and t3 xor t5 xor t7) xor t4 and t1 xor t3 and t0 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[14] + $B01E8A3E; + Temp := (t1 and (t3 and t2 xor t4 xor t6) xor t3 and t0 xor t2 and t7 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[25] + $D71577C1; + Temp := (t0 and (t2 and t1 xor t3 xor t5) xor t2 and t7 xor t1 and t6 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[12] + $BD314B27; + Temp := (t7 and (t1 and t0 xor t2 xor t4) xor t1 and t6 xor t0 and t5 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[24] + $78AF2FDA; + Temp := (t6 and (t0 and t7 xor t1 xor t3) xor t0 and t5 xor t7 and t4 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[30] + $55605C60; + Temp := (t5 and (t7 and t6 xor t0 xor t2) xor t7 and t4 xor t6 and t3 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[16] + $E65525F3; + Temp := (t4 and (t6 and t5 xor t7 xor t1) xor t6 and t3 xor t5 and t2 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[26] + $AA55AB94; + + Temp := (t3 and (t5 and t4 xor t6 xor t0) xor t5 and t2 xor t4 and t1 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[31] + $57489862; + Temp := (t2 and (t4 and t3 xor t5 xor t7) xor t4 and t1 xor t3 and t0 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[15] + $63E81440; + Temp := (t1 and (t3 and t2 xor t4 xor t6) xor t3 and t0 xor t2 and t7 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[7] + $55CA396A; + Temp := (t0 and (t2 and t1 xor t3 xor t5) xor t2 and t7 xor t1 and t6 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[3] + $2AAB10B6; + Temp := (t7 and (t1 and t0 xor t2 xor t4) xor t1 and t6 xor t0 and t5 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[1] + $B4CC5C34; + Temp := (t6 and (t0 and t7 xor t1 xor t3) xor t0 and t5 xor t7 and t4 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[0] + $1141E8CE; + Temp := (t5 and (t7 and t6 xor t0 xor t2) xor t7 and t4 xor t6 and t3 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[18] + $A15486AF; + Temp := (t4 and (t6 and t5 xor t7 xor t1) xor t6 and t3 xor t5 and t2 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[27] + $7C72E993; + + Temp := (t3 and (t5 and t4 xor t6 xor t0) xor t5 and t2 xor t4 and t1 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[13] + $B3EE1411; + Temp := (t2 and (t4 and t3 xor t5 xor t7) xor t4 and t1 xor t3 and t0 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[6] + $636FBC2A; + Temp := (t1 and (t3 and t2 xor t4 xor t6) xor t3 and t0 xor t2 and t7 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[21] + $2BA9C55D; + Temp := (t0 and (t2 and t1 xor t3 xor t5) xor t2 and t7 xor t1 and t6 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[10] + $741831F6; + Temp := (t7 and (t1 and t0 xor t2 xor t4) xor t1 and t6 xor t0 and t5 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[23] + $CE5C3E16; + Temp := (t6 and (t0 and t7 xor t1 xor t3) xor t0 and t5 xor t7 and t4 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[11] + $9B87931E; + Temp := (t5 and (t7 and t6 xor t0 xor t2) xor t7 and t4 xor t6 and t3 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[5] + $AFD6BA33; + Temp := (t4 and (t6 and t5 xor t7 xor t1) xor t6 and t3 xor t5 and t2 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[2] + $6C24CF5C; +{$ELSE} +{$IFDEF PASS4} + Temp := (t3 and (t0 xor t1) xor t5 and t6 xor t4 and t2 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[0]; + Temp := (t2 and (t7 xor t0) xor t4 and t5 xor t3 and t1 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[1]; + Temp := (t1 and (t6 xor t7) xor t3 and t4 xor t2 and t0 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[2]; + Temp := (t0 and (t5 xor t6) xor t2 and t3 xor t1 and t7 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[3]; + Temp := (t7 and (t4 xor t5) xor t1 and t2 xor t0 and t6 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[4]; + Temp := (t6 and (t3 xor t4) xor t0 and t1 xor t7 and t5 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[5]; + Temp := (t5 and (t2 xor t3) xor t7 and t0 xor t6 and t4 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[6]; + Temp := (t4 and (t1 xor t2) xor t6 and t7 xor t5 and t3 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[7]; + + Temp := (t3 and (t0 xor t1) xor t5 and t6 xor t4 and t2 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[8]; + Temp := (t2 and (t7 xor t0) xor t4 and t5 xor t3 and t1 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[9]; + Temp := (t1 and (t6 xor t7) xor t3 and t4 xor t2 and t0 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[10]; + Temp := (t0 and (t5 xor t6) xor t2 and t3 xor t1 and t7 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[11]; + Temp := (t7 and (t4 xor t5) xor t1 and t2 xor t0 and t6 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[12]; + Temp := (t6 and (t3 xor t4) xor t0 and t1 xor t7 and t5 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[13]; + Temp := (t5 and (t2 xor t3) xor t7 and t0 xor t6 and t4 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[14]; + Temp := (t4 and (t1 xor t2) xor t6 and t7 xor t5 and t3 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[15]; + + Temp := (t3 and (t0 xor t1) xor t5 and t6 xor t4 and t2 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[16]; + Temp := (t2 and (t7 xor t0) xor t4 and t5 xor t3 and t1 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[17]; + Temp := (t1 and (t6 xor t7) xor t3 and t4 xor t2 and t0 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[18]; + Temp := (t0 and (t5 xor t6) xor t2 and t3 xor t1 and t7 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[19]; + Temp := (t7 and (t4 xor t5) xor t1 and t2 xor t0 and t6 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[20]; + Temp := (t6 and (t3 xor t4) xor t0 and t1 xor t7 and t5 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[21]; + Temp := (t5 and (t2 xor t3) xor t7 and t0 xor t6 and t4 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[22]; + Temp := (t4 and (t1 xor t2) xor t6 and t7 xor t5 and t3 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[23]; + + Temp := (t3 and (t0 xor t1) xor t5 and t6 xor t4 and t2 xor t0); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[24]; + Temp := (t2 and (t7 xor t0) xor t4 and t5 xor t3 and t1 xor t7); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[25]; + Temp := (t1 and (t6 xor t7) xor t3 and t4 xor t2 and t0 xor t6); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[26]; + Temp := (t0 and (t5 xor t6) xor t2 and t3 xor t1 and t7 xor t5); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[27]; + Temp := (t7 and (t4 xor t5) xor t1 and t2 xor t0 and t6 xor t4); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[28]; + Temp := (t6 and (t3 xor t4) xor t0 and t1 xor t7 and t5 xor t3); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[29]; + Temp := (t5 and (t2 xor t3) xor t7 and t0 xor t6 and t4 xor t2); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[30]; + Temp := (t4 and (t1 xor t2) xor t6 and t7 xor t5 and t3 xor t1); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[31]; + + Temp := (t1 and (t6 and not t0 xor t2 and t5 xor t3 xor t4) xor t2 and (t6 xor t5) xor t0 and t5 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[5] + $452821E6; + Temp := (t0 and (t5 and not t7 xor t1 and t4 xor t2 xor t3) xor t1 and (t5 xor t4) xor t7 and t4 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[14] + $38D01377; + Temp := (t7 and (t4 and not t6 xor t0 and t3 xor t1 xor t2) xor t0 and (t4 xor t3) xor t6 and t3 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[26] + $BE5466CF; + Temp := (t6 and (t3 and not t5 xor t7 and t2 xor t0 xor t1) xor t7 and (t3 xor t2) xor t5 and t2 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[18] + $34E90C6C; + Temp := (t5 and (t2 and not t4 xor t6 and t1 xor t7 xor t0) xor t6 and (t2 xor t1) xor t4 and t1 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[11] + $C0AC29B7; + Temp := (t4 and (t1 and not t3 xor t5 and t0 xor t6 xor t7) xor t5 and (t1 xor t0) xor t3 and t0 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[28] + $C97C50DD; + Temp := (t3 and (t0 and not t2 xor t4 and t7 xor t5 xor t6) xor t4 and (t0 xor t7) xor t2 and t7 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[7] + $3F84D5B5; + Temp := (t2 and (t7 and not t1 xor t3 and t6 xor t4 xor t5) xor t3 and (t7 xor t6) xor t1 and t6 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[16] + $B5470917; + + Temp := (t1 and (t6 and not t0 xor t2 and t5 xor t3 xor t4) xor t2 and (t6 xor t5) xor t0 and t5 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[0] + $9216D5D9; + Temp := (t0 and (t5 and not t7 xor t1 and t4 xor t2 xor t3) xor t1 and (t5 xor t4) xor t7 and t4 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[23] + $8979FB1B; + Temp := (t7 and (t4 and not t6 xor t0 and t3 xor t1 xor t2) xor t0 and (t4 xor t3) xor t6 and t3 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[20] + $D1310BA6; + Temp := (t6 and (t3 and not t5 xor t7 and t2 xor t0 xor t1) xor t7 and (t3 xor t2) xor t5 and t2 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[22] + $98DFB5AC; + Temp := (t5 and (t2 and not t4 xor t6 and t1 xor t7 xor t0) xor t6 and (t2 xor t1) xor t4 and t1 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[1] + $2FFD72DB; + Temp := (t4 and (t1 and not t3 xor t5 and t0 xor t6 xor t7) xor t5 and (t1 xor t0) xor t3 and t0 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[10] + $D01ADFB7; + Temp := (t3 and (t0 and not t2 xor t4 and t7 xor t5 xor t6) xor t4 and (t0 xor t7) xor t2 and t7 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[4] + $B8E1AFED; + Temp := (t2 and (t7 and not t1 xor t3 and t6 xor t4 xor t5) xor t3 and (t7 xor t6) xor t1 and t6 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[8] + $6A267E96; + + Temp := (t1 and (t6 and not t0 xor t2 and t5 xor t3 xor t4) xor t2 and (t6 xor t5) xor t0 and t5 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[30] + $BA7C9045; + Temp := (t0 and (t5 and not t7 xor t1 and t4 xor t2 xor t3) xor t1 and (t5 xor t4) xor t7 and t4 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[3] + $F12C7F99; + Temp := (t7 and (t4 and not t6 xor t0 and t3 xor t1 xor t2) xor t0 and (t4 xor t3) xor t6 and t3 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[21] + $24A19947; + Temp := (t6 and (t3 and not t5 xor t7 and t2 xor t0 xor t1) xor t7 and (t3 xor t2) xor t5 and t2 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[9] + $B3916CF7; + Temp := (t5 and (t2 and not t4 xor t6 and t1 xor t7 xor t0) xor t6 and (t2 xor t1) xor t4 and t1 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[17] + $0801F2E2; + Temp := (t4 and (t1 and not t3 xor t5 and t0 xor t6 xor t7) xor t5 and (t1 xor t0) xor t3 and t0 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[24] + $858EFC16; + Temp := (t3 and (t0 and not t2 xor t4 and t7 xor t5 xor t6) xor t4 and (t0 xor t7) xor t2 and t7 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[29] + $636920D8; + Temp := (t2 and (t7 and not t1 xor t3 and t6 xor t4 xor t5) xor t3 and (t7 xor t6) xor t1 and t6 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[6] + $71574E69; + + Temp := (t1 and (t6 and not t0 xor t2 and t5 xor t3 xor t4) xor t2 and (t6 xor t5) xor t0 and t5 xor t4); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[19] + $A458FEA3; + Temp := (t0 and (t5 and not t7 xor t1 and t4 xor t2 xor t3) xor t1 and (t5 xor t4) xor t7 and t4 xor t3); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[12] + $F4933D7E; + Temp := (t7 and (t4 and not t6 xor t0 and t3 xor t1 xor t2) xor t0 and (t4 xor t3) xor t6 and t3 xor t2); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[15] + $0D95748F; + Temp := (t6 and (t3 and not t5 xor t7 and t2 xor t0 xor t1) xor t7 and (t3 xor t2) xor t5 and t2 xor t1); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[13] + $728EB658; + Temp := (t5 and (t2 and not t4 xor t6 and t1 xor t7 xor t0) xor t6 and (t2 xor t1) xor t4 and t1 xor t0); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[2] + $718BCD58; + Temp := (t4 and (t1 and not t3 xor t5 and t0 xor t6 xor t7) xor t5 and (t1 xor t0) xor t3 and t0 xor t7); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[25] + $82154AEE; + Temp := (t3 and (t0 and not t2 xor t4 and t7 xor t5 xor t6) xor t4 and (t0 xor t7) xor t2 and t7 xor t6); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[31] + $7B54A41D; + Temp := (t2 and (t7 and not t1 xor t3 and t6 xor t4 xor t5) xor t3 and (t7 xor t6) xor t1 and t6 xor t5); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[27] + $C25A59B5; + + Temp := (t6 and (t2 and t0 xor t1 xor t5) xor t2 and t3 xor t0 and t4 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[19] + $9C30D539; + Temp := (t5 and (t1 and t7 xor t0 xor t4) xor t1 and t2 xor t7 and t3 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[9] + $2AF26013; + Temp := (t4 and (t0 and t6 xor t7 xor t3) xor t0 and t1 xor t6 and t2 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[4] + $C5D1B023; + Temp := (t3 and (t7 and t5 xor t6 xor t2) xor t7 and t0 xor t5 and t1 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[20] + $286085F0; + Temp := (t2 and (t6 and t4 xor t5 xor t1) xor t6 and t7 xor t4 and t0 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[28] + $CA417918; + Temp := (t1 and (t5 and t3 xor t4 xor t0) xor t5 and t6 xor t3 and t7 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[17] + $B8DB38EF; + Temp := (t0 and (t4 and t2 xor t3 xor t7) xor t4 and t5 xor t2 and t6 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[8] + $8E79DCB0; + Temp := (t7 and (t3 and t1 xor t2 xor t6) xor t3 and t4 xor t1 and t5 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[22] + $603A180E; + + Temp := (t6 and (t2 and t0 xor t1 xor t5) xor t2 and t3 xor t0 and t4 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[29] + $6C9E0E8B; + Temp := (t5 and (t1 and t7 xor t0 xor t4) xor t1 and t2 xor t7 and t3 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[14] + $B01E8A3E; + Temp := (t4 and (t0 and t6 xor t7 xor t3) xor t0 and t1 xor t6 and t2 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[25] + $D71577C1; + Temp := (t3 and (t7 and t5 xor t6 xor t2) xor t7 and t0 xor t5 and t1 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[12] + $BD314B27; + Temp := (t2 and (t6 and t4 xor t5 xor t1) xor t6 and t7 xor t4 and t0 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[24] + $78AF2FDA; + Temp := (t1 and (t5 and t3 xor t4 xor t0) xor t5 and t6 xor t3 and t7 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[30] + $55605C60; + Temp := (t0 and (t4 and t2 xor t3 xor t7) xor t4 and t5 xor t2 and t6 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[16] + $E65525F3; + Temp := (t7 and (t3 and t1 xor t2 xor t6) xor t3 and t4 xor t1 and t5 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[26] + $AA55AB94; + + Temp := (t6 and (t2 and t0 xor t1 xor t5) xor t2 and t3 xor t0 and t4 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[31] + $57489862; + Temp := (t5 and (t1 and t7 xor t0 xor t4) xor t1 and t2 xor t7 and t3 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[15] + $63E81440; + Temp := (t4 and (t0 and t6 xor t7 xor t3) xor t0 and t1 xor t6 and t2 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[7] + $55CA396A; + Temp := (t3 and (t7 and t5 xor t6 xor t2) xor t7 and t0 xor t5 and t1 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[3] + $2AAB10B6; + Temp := (t2 and (t6 and t4 xor t5 xor t1) xor t6 and t7 xor t4 and t0 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[1] + $B4CC5C34; + Temp := (t1 and (t5 and t3 xor t4 xor t0) xor t5 and t6 xor t3 and t7 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[0] + $1141E8CE; + Temp := (t0 and (t4 and t2 xor t3 xor t7) xor t4 and t5 xor t2 and t6 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[18] + $A15486AF; + Temp := (t7 and (t3 and t1 xor t2 xor t6) xor t3 and t4 xor t1 and t5 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[27] + $7C72E993; + + Temp := (t6 and (t2 and t0 xor t1 xor t5) xor t2 and t3 xor t0 and t4 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[13] + $B3EE1411; + Temp := (t5 and (t1 and t7 xor t0 xor t4) xor t1 and t2 xor t7 and t3 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[6] + $636FBC2A; + Temp := (t4 and (t0 and t6 xor t7 xor t3) xor t0 and t1 xor t6 and t2 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[21] + $2BA9C55D; + Temp := (t3 and (t7 and t5 xor t6 xor t2) xor t7 and t0 xor t5 and t1 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[10] + $741831F6; + Temp := (t2 and (t6 and t4 xor t5 xor t1) xor t6 and t7 xor t4 and t0 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[23] + $CE5C3E16; + Temp := (t1 and (t5 and t3 xor t4 xor t0) xor t5 and t6 xor t3 and t7 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[11] + $9B87931E; + Temp := (t0 and (t4 and t2 xor t3 xor t7) xor t4 and t5 xor t2 and t6 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[5] + $AFD6BA33; + Temp := (t7 and (t3 and t1 xor t2 xor t6) xor t3 and t4 xor t1 and t5 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[2] + $6C24CF5C; + + Temp := (t0 and (t4 and not t2 xor t5 and not t6 xor t1 xor t6 xor t3) xor t5 and (t1 and t2 xor t4 xor t6) xor t2 and t6 xor t3); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[24] + $7A325381; + Temp := (t7 and (t3 and not t1 xor t4 and not t5 xor t0 xor t5 xor t2) xor t4 and (t0 and t1 xor t3 xor t5) xor t1 and t5 xor t2); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[4] + $28958677; + Temp := (t6 and (t2 and not t0 xor t3 and not t4 xor t7 xor t4 xor t1) xor t3 and (t7 and t0 xor t2 xor t4) xor t0 and t4 xor t1); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[0] + $3B8F4898; + Temp := (t5 and (t1 and not t7 xor t2 and not t3 xor t6 xor t3 xor t0) xor t2 and (t6 and t7 xor t1 xor t3) xor t7 and t3 xor t0); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[14] + $6B4BB9AF; + Temp := (t4 and (t0 and not t6 xor t1 and not t2 xor t5 xor t2 xor t7) xor t1 and (t5 and t6 xor t0 xor t2) xor t6 and t2 xor t7); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[2] + $C4BFE81B; + Temp := (t3 and (t7 and not t5 xor t0 and not t1 xor t4 xor t1 xor t6) xor t0 and (t4 and t5 xor t7 xor t1) xor t5 and t1 xor t6); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[7] + $66282193; + Temp := (t2 and (t6 and not t4 xor t7 and not t0 xor t3 xor t0 xor t5) xor t7 and (t3 and t4 xor t6 xor t0) xor t4 and t0 xor t5); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[28] + $61D809CC; + Temp := (t1 and (t5 and not t3 xor t6 and not t7 xor t2 xor t7 xor t4) xor t6 and (t2 and t3 xor t5 xor t7) xor t3 and t7 xor t4); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[23] + $FB21A991; + + Temp := (t0 and (t4 and not t2 xor t5 and not t6 xor t1 xor t6 xor t3) xor t5 and (t1 and t2 xor t4 xor t6) xor t2 and t6 xor t3); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[26] + $487CAC60; + Temp := (t7 and (t3 and not t1 xor t4 and not t5 xor t0 xor t5 xor t2) xor t4 and (t0 and t1 xor t3 xor t5) xor t1 and t5 xor t2); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[6] + $5DEC8032; + Temp := (t6 and (t2 and not t0 xor t3 and not t4 xor t7 xor t4 xor t1) xor t3 and (t7 and t0 xor t2 xor t4) xor t0 and t4 xor t1); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[30] + $EF845D5D; + Temp := (t5 and (t1 and not t7 xor t2 and not t3 xor t6 xor t3 xor t0) xor t2 and (t6 and t7 xor t1 xor t3) xor t7 and t3 xor t0); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[20] + $E98575B1; + Temp := (t4 and (t0 and not t6 xor t1 and not t2 xor t5 xor t2 xor t7) xor t1 and (t5 and t6 xor t0 xor t2) xor t6 and t2 xor t7); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[18] + $DC262302; + Temp := (t3 and (t7 and not t5 xor t0 and not t1 xor t4 xor t1 xor t6) xor t0 and (t4 and t5 xor t7 xor t1) xor t5 and t1 xor t6); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[25] + $EB651B88; + Temp := (t2 and (t6 and not t4 xor t7 and not t0 xor t3 xor t0 xor t5) xor t7 and (t3 and t4 xor t6 xor t0) xor t4 and t0 xor t5); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[19] + $23893E81; + Temp := (t1 and (t5 and not t3 xor t6 and not t7 xor t2 xor t7 xor t4) xor t6 and (t2 and t3 xor t5 xor t7) xor t3 and t7 xor t4); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[3] + $D396ACC5; + + Temp := (t0 and (t4 and not t2 xor t5 and not t6 xor t1 xor t6 xor t3) xor t5 and (t1 and t2 xor t4 xor t6) xor t2 and t6 xor t3); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[22] + $0F6D6FF3; + Temp := (t7 and (t3 and not t1 xor t4 and not t5 xor t0 xor t5 xor t2) xor t4 and (t0 and t1 xor t3 xor t5) xor t1 and t5 xor t2); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[11] + $83F44239; + Temp := (t6 and (t2 and not t0 xor t3 and not t4 xor t7 xor t4 xor t1) xor t3 and (t7 and t0 xor t2 xor t4) xor t0 and t4 xor t1); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[31] + $2E0B4482; + Temp := (t5 and (t1 and not t7 xor t2 and not t3 xor t6 xor t3 xor t0) xor t2 and (t6 and t7 xor t1 xor t3) xor t7 and t3 xor t0); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[21] + $A4842004; + Temp := (t4 and (t0 and not t6 xor t1 and not t2 xor t5 xor t2 xor t7) xor t1 and (t5 and t6 xor t0 xor t2) xor t6 and t2 xor t7); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[8] + $69C8F04A; + Temp := (t3 and (t7 and not t5 xor t0 and not t1 xor t4 xor t1 xor t6) xor t0 and (t4 and t5 xor t7 xor t1) xor t5 and t1 xor t6); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[27] + $9E1F9B5E; + Temp := (t2 and (t6 and not t4 xor t7 and not t0 xor t3 xor t0 xor t5) xor t7 and (t3 and t4 xor t6 xor t0) xor t4 and t0 xor t5); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[12] + $21C66842; + Temp := (t1 and (t5 and not t3 xor t6 and not t7 xor t2 xor t7 xor t4) xor t6 and (t2 and t3 xor t5 xor t7) xor t3 and t7 xor t4); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[9] + $F6E96C9A; + + Temp := (t0 and (t4 and not t2 xor t5 and not t6 xor t1 xor t6 xor t3) xor t5 and (t1 and t2 xor t4 xor t6) xor t2 and t6 xor t3); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[1] + $670C9C61; + Temp := (t7 and (t3 and not t1 xor t4 and not t5 xor t0 xor t5 xor t2) xor t4 and (t0 and t1 xor t3 xor t5) xor t1 and t5 xor t2); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[29] + $ABD388F0; + Temp := (t6 and (t2 and not t0 xor t3 and not t4 xor t7 xor t4 xor t1) xor t3 and (t7 and t0 xor t2 xor t4) xor t0 and t4 xor t1); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[5] + $6A51A0D2; + Temp := (t5 and (t1 and not t7 xor t2 and not t3 xor t6 xor t3 xor t0) xor t2 and (t6 and t7 xor t1 xor t3) xor t7 and t3 xor t0); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[15] + $D8542F68; + Temp := (t4 and (t0 and not t6 xor t1 and not t2 xor t5 xor t2 xor t7) xor t1 and (t5 and t6 xor t0 xor t2) xor t6 and t2 xor t7); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[17] + $960FA728; + Temp := (t3 and (t7 and not t5 xor t0 and not t1 xor t4 xor t1 xor t6) xor t0 and (t4 and t5 xor t7 xor t1) xor t5 and t1 xor t6); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[10] + $AB5133A3; + Temp := (t2 and (t6 and not t4 xor t7 and not t0 xor t3 xor t0 xor t5) xor t7 and (t3 and t4 xor t6 xor t0) xor t4 and t0 xor t5); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[16] + $6EEF0B6C; + Temp := (t1 and (t5 and not t3 xor t6 and not t7 xor t2 xor t7 xor t4) xor t6 and (t2 and t3 xor t5 xor t7) xor t3 and t7 xor t4); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[13] + $137A3BE4; +{$ELSE} + Temp := (t2 and (t6 xor t1) xor t5 and t4 xor t0 and t3 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[0]; + Temp := (t1 and (t5 xor t0) xor t4 and t3 xor t7 and t2 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[1]; + Temp := (t0 and (t4 xor t7) xor t3 and t2 xor t6 and t1 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[2]; + Temp := (t7 and (t3 xor t6) xor t2 and t1 xor t5 and t0 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[3]; + Temp := (t6 and (t2 xor t5) xor t1 and t0 xor t4 and t7 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[4]; + Temp := (t5 and (t1 xor t4) xor t0 and t7 xor t3 and t6 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[5]; + Temp := (t4 and (t0 xor t3) xor t7 and t6 xor t2 and t5 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[6]; + Temp := (t3 and (t7 xor t2) xor t6 and t5 xor t1 and t4 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[7]; + + Temp := (t2 and (t6 xor t1) xor t5 and t4 xor t0 and t3 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[8]; + Temp := (t1 and (t5 xor t0) xor t4 and t3 xor t7 and t2 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[9]; + Temp := (t0 and (t4 xor t7) xor t3 and t2 xor t6 and t1 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[10]; + Temp := (t7 and (t3 xor t6) xor t2 and t1 xor t5 and t0 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[11]; + Temp := (t6 and (t2 xor t5) xor t1 and t0 xor t4 and t7 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[12]; + Temp := (t5 and (t1 xor t4) xor t0 and t7 xor t3 and t6 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[13]; + Temp := (t4 and (t0 xor t3) xor t7 and t6 xor t2 and t5 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[14]; + Temp := (t3 and (t7 xor t2) xor t6 and t5 xor t1 and t4 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[15]; + + Temp := (t2 and (t6 xor t1) xor t5 and t4 xor t0 and t3 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[16]; + Temp := (t1 and (t5 xor t0) xor t4 and t3 xor t7 and t2 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[17]; + Temp := (t0 and (t4 xor t7) xor t3 and t2 xor t6 and t1 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[18]; + Temp := (t7 and (t3 xor t6) xor t2 and t1 xor t5 and t0 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[19]; + Temp := (t6 and (t2 xor t5) xor t1 and t0 xor t4 and t7 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[20]; + Temp := (t5 and (t1 xor t4) xor t0 and t7 xor t3 and t6 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[21]; + Temp := (t4 and (t0 xor t3) xor t7 and t6 xor t2 and t5 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[22]; + Temp := (t3 and (t7 xor t2) xor t6 and t5 xor t1 and t4 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[23]; + + Temp := (t2 and (t6 xor t1) xor t5 and t4 xor t0 and t3 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[24]; + Temp := (t1 and (t5 xor t0) xor t4 and t3 xor t7 and t2 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[25]; + Temp := (t0 and (t4 xor t7) xor t3 and t2 xor t6 and t1 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[26]; + Temp := (t7 and (t3 xor t6) xor t2 and t1 xor t5 and t0 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[27]; + Temp := (t6 and (t2 xor t5) xor t1 and t0 xor t4 and t7 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[28]; + Temp := (t5 and (t1 xor t4) xor t0 and t7 xor t3 and t6 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[29]; + Temp := (t4 and (t0 xor t3) xor t7 and t6 xor t2 and t5 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[30]; + Temp := (t3 and (t7 xor t2) xor t6 and t5 xor t1 and t4 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[31]; + + Temp := (t3 and (t4 and not t0 xor t1 and t2 xor t6 xor t5) xor t1 and (t4 xor t2) xor t0 and t2 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[5] + $452821E6; + Temp := (t2 and (t3 and not t7 xor t0 and t1 xor t5 xor t4) xor t0 and (t3 xor t1) xor t7 and t1 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[14] + $38D01377; + Temp := (t1 and (t2 and not t6 xor t7 and t0 xor t4 xor t3) xor t7 and (t2 xor t0) xor t6 and t0 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[26] + $BE5466CF; + Temp := (t0 and (t1 and not t5 xor t6 and t7 xor t3 xor t2) xor t6 and (t1 xor t7) xor t5 and t7 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[18] + $34E90C6C; + Temp := (t7 and (t0 and not t4 xor t5 and t6 xor t2 xor t1) xor t5 and (t0 xor t6) xor t4 and t6 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[11] + $C0AC29B7; + Temp := (t6 and (t7 and not t3 xor t4 and t5 xor t1 xor t0) xor t4 and (t7 xor t5) xor t3 and t5 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[28] + $C97C50DD; + Temp := (t5 and (t6 and not t2 xor t3 and t4 xor t0 xor t7) xor t3 and (t6 xor t4) xor t2 and t4 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[7] + $3F84D5B5; + Temp := (t4 and (t5 and not t1 xor t2 and t3 xor t7 xor t6) xor t2 and (t5 xor t3) xor t1 and t3 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[16] + $B5470917; + + Temp := (t3 and (t4 and not t0 xor t1 and t2 xor t6 xor t5) xor t1 and (t4 xor t2) xor t0 and t2 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[0] + $9216D5D9; + Temp := (t2 and (t3 and not t7 xor t0 and t1 xor t5 xor t4) xor t0 and (t3 xor t1) xor t7 and t1 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[23] + $8979FB1B; + Temp := (t1 and (t2 and not t6 xor t7 and t0 xor t4 xor t3) xor t7 and (t2 xor t0) xor t6 and t0 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[20] + $D1310BA6; + Temp := (t0 and (t1 and not t5 xor t6 and t7 xor t3 xor t2) xor t6 and (t1 xor t7) xor t5 and t7 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[22] + $98DFB5AC; + Temp := (t7 and (t0 and not t4 xor t5 and t6 xor t2 xor t1) xor t5 and (t0 xor t6) xor t4 and t6 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[1] + $2FFD72DB; + Temp := (t6 and (t7 and not t3 xor t4 and t5 xor t1 xor t0) xor t4 and (t7 xor t5) xor t3 and t5 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[10] + $D01ADFB7; + Temp := (t5 and (t6 and not t2 xor t3 and t4 xor t0 xor t7) xor t3 and (t6 xor t4) xor t2 and t4 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[4] + $B8E1AFED; + Temp := (t4 and (t5 and not t1 xor t2 and t3 xor t7 xor t6) xor t2 and (t5 xor t3) xor t1 and t3 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[8] + $6A267E96; + + Temp := (t3 and (t4 and not t0 xor t1 and t2 xor t6 xor t5) xor t1 and (t4 xor t2) xor t0 and t2 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[30] + $BA7C9045; + Temp := (t2 and (t3 and not t7 xor t0 and t1 xor t5 xor t4) xor t0 and (t3 xor t1) xor t7 and t1 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[3] + $F12C7F99; + Temp := (t1 and (t2 and not t6 xor t7 and t0 xor t4 xor t3) xor t7 and (t2 xor t0) xor t6 and t0 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[21] + $24A19947; + Temp := (t0 and (t1 and not t5 xor t6 and t7 xor t3 xor t2) xor t6 and (t1 xor t7) xor t5 and t7 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[9] + $B3916CF7; + Temp := (t7 and (t0 and not t4 xor t5 and t6 xor t2 xor t1) xor t5 and (t0 xor t6) xor t4 and t6 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[17] + $0801F2E2; + Temp := (t6 and (t7 and not t3 xor t4 and t5 xor t1 xor t0) xor t4 and (t7 xor t5) xor t3 and t5 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[24] + $858EFC16; + Temp := (t5 and (t6 and not t2 xor t3 and t4 xor t0 xor t7) xor t3 and (t6 xor t4) xor t2 and t4 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[29] + $636920D8; + Temp := (t4 and (t5 and not t1 xor t2 and t3 xor t7 xor t6) xor t2 and (t5 xor t3) xor t1 and t3 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[6] + $71574E69; + + Temp := (t3 and (t4 and not t0 xor t1 and t2 xor t6 xor t5) xor t1 and (t4 xor t2) xor t0 and t2 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[19] + $A458FEA3; + Temp := (t2 and (t3 and not t7 xor t0 and t1 xor t5 xor t4) xor t0 and (t3 xor t1) xor t7 and t1 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[12] + $F4933D7E; + Temp := (t1 and (t2 and not t6 xor t7 and t0 xor t4 xor t3) xor t7 and (t2 xor t0) xor t6 and t0 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[15] + $0D95748F; + Temp := (t0 and (t1 and not t5 xor t6 and t7 xor t3 xor t2) xor t6 and (t1 xor t7) xor t5 and t7 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[13] + $728EB658; + Temp := (t7 and (t0 and not t4 xor t5 and t6 xor t2 xor t1) xor t5 and (t0 xor t6) xor t4 and t6 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[2] + $718BCD58; + Temp := (t6 and (t7 and not t3 xor t4 and t5 xor t1 xor t0) xor t4 and (t7 xor t5) xor t3 and t5 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[25] + $82154AEE; + Temp := (t5 and (t6 and not t2 xor t3 and t4 xor t0 xor t7) xor t3 and (t6 xor t4) xor t2 and t4 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[31] + $7B54A41D; + Temp := (t4 and (t5 and not t1 xor t2 and t3 xor t7 xor t6) xor t2 and (t5 xor t3) xor t1 and t3 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[27] + $C25A59B5; + + Temp := (t4 and (t1 and t3 xor t2 xor t5) xor t1 and t0 xor t3 and t6 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[19] + $9C30D539; + Temp := (t3 and (t0 and t2 xor t1 xor t4) xor t0 and t7 xor t2 and t5 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[9] + $2AF26013; + Temp := (t2 and (t7 and t1 xor t0 xor t3) xor t7 and t6 xor t1 and t4 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[4] + $C5D1B023; + Temp := (t1 and (t6 and t0 xor t7 xor t2) xor t6 and t5 xor t0 and t3 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[20] + $286085F0; + Temp := (t0 and (t5 and t7 xor t6 xor t1) xor t5 and t4 xor t7 and t2 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[28] + $CA417918; + Temp := (t7 and (t4 and t6 xor t5 xor t0) xor t4 and t3 xor t6 and t1 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[17] + $B8DB38EF; + Temp := (t6 and (t3 and t5 xor t4 xor t7) xor t3 and t2 xor t5 and t0 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[8] + $8E79DCB0; + Temp := (t5 and (t2 and t4 xor t3 xor t6) xor t2 and t1 xor t4 and t7 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[22] + $603A180E; + + Temp := (t4 and (t1 and t3 xor t2 xor t5) xor t1 and t0 xor t3 and t6 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[29] + $6C9E0E8B; + Temp := (t3 and (t0 and t2 xor t1 xor t4) xor t0 and t7 xor t2 and t5 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[14] + $B01E8A3E; + Temp := (t2 and (t7 and t1 xor t0 xor t3) xor t7 and t6 xor t1 and t4 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[25] + $D71577C1; + Temp := (t1 and (t6 and t0 xor t7 xor t2) xor t6 and t5 xor t0 and t3 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[12] + $BD314B27; + Temp := (t0 and (t5 and t7 xor t6 xor t1) xor t5 and t4 xor t7 and t2 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[24] + $78AF2FDA; + Temp := (t7 and (t4 and t6 xor t5 xor t0) xor t4 and t3 xor t6 and t1 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[30] + $55605C60; + Temp := (t6 and (t3 and t5 xor t4 xor t7) xor t3 and t2 xor t5 and t0 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[16] + $E65525F3; + Temp := (t5 and (t2 and t4 xor t3 xor t6) xor t2 and t1 xor t4 and t7 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[26] + $AA55AB94; + + Temp := (t4 and (t1 and t3 xor t2 xor t5) xor t1 and t0 xor t3 and t6 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[31] + $57489862; + Temp := (t3 and (t0 and t2 xor t1 xor t4) xor t0 and t7 xor t2 and t5 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[15] + $63E81440; + Temp := (t2 and (t7 and t1 xor t0 xor t3) xor t7 and t6 xor t1 and t4 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[7] + $55CA396A; + Temp := (t1 and (t6 and t0 xor t7 xor t2) xor t6 and t5 xor t0 and t3 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[3] + $2AAB10B6; + Temp := (t0 and (t5 and t7 xor t6 xor t1) xor t5 and t4 xor t7 and t2 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[1] + $B4CC5C34; + Temp := (t7 and (t4 and t6 xor t5 xor t0) xor t4 and t3 xor t6 and t1 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[0] + $1141E8CE; + Temp := (t6 and (t3 and t5 xor t4 xor t7) xor t3 and t2 xor t5 and t0 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[18] + $A15486AF; + Temp := (t5 and (t2 and t4 xor t3 xor t6) xor t2 and t1 xor t4 and t7 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[27] + $7C72E993; + + Temp := (t4 and (t1 and t3 xor t2 xor t5) xor t1 and t0 xor t3 and t6 xor t5); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[13] + $B3EE1411; + Temp := (t3 and (t0 and t2 xor t1 xor t4) xor t0 and t7 xor t2 and t5 xor t4); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[6] + $636FBC2A; + Temp := (t2 and (t7 and t1 xor t0 xor t3) xor t7 and t6 xor t1 and t4 xor t3); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[21] + $2BA9C55D; + Temp := (t1 and (t6 and t0 xor t7 xor t2) xor t6 and t5 xor t0 and t3 xor t2); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[10] + $741831F6; + Temp := (t0 and (t5 and t7 xor t6 xor t1) xor t5 and t4 xor t7 and t2 xor t1); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[23] + $CE5C3E16; + Temp := (t7 and (t4 and t6 xor t5 xor t0) xor t4 and t3 xor t6 and t1 xor t0); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[11] + $9B87931E; + Temp := (t6 and (t3 and t5 xor t4 xor t7) xor t3 and t2 xor t5 and t0 xor t7); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[5] + $AFD6BA33; + Temp := (t5 and (t2 and t4 xor t3 xor t6) xor t2 and t1 xor t4 and t7 xor t6); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[2] + $6C24CF5C; + + Temp := (t3 and (t5 and not t0 xor t2 and not t1 xor t4 xor t1 xor t6) xor t2 and (t4 and t0 xor t5 xor t1) xor t0 and t1 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[24] + $7A325381; + Temp := (t2 and (t4 and not t7 xor t1 and not t0 xor t3 xor t0 xor t5) xor t1 and (t3 and t7 xor t4 xor t0) xor t7 and t0 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[4] + $28958677; + Temp := (t1 and (t3 and not t6 xor t0 and not t7 xor t2 xor t7 xor t4) xor t0 and (t2 and t6 xor t3 xor t7) xor t6 and t7 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[0] + $3B8F4898; + Temp := (t0 and (t2 and not t5 xor t7 and not t6 xor t1 xor t6 xor t3) xor t7 and (t1 and t5 xor t2 xor t6) xor t5 and t6 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[14] + $6B4BB9AF; + Temp := (t7 and (t1 and not t4 xor t6 and not t5 xor t0 xor t5 xor t2) xor t6 and (t0 and t4 xor t1 xor t5) xor t4 and t5 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[2] + $C4BFE81B; + Temp := (t6 and (t0 and not t3 xor t5 and not t4 xor t7 xor t4 xor t1) xor t5 and (t7 and t3 xor t0 xor t4) xor t3 and t4 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[7] + $66282193; + Temp := (t5 and (t7 and not t2 xor t4 and not t3 xor t6 xor t3 xor t0) xor t4 and (t6 and t2 xor t7 xor t3) xor t2 and t3 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[28] + $61D809CC; + Temp := (t4 and (t6 and not t1 xor t3 and not t2 xor t5 xor t2 xor t7) xor t3 and (t5 and t1 xor t6 xor t2) xor t1 and t2 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[23] + $FB21A991; + + Temp := (t3 and (t5 and not t0 xor t2 and not t1 xor t4 xor t1 xor t6) xor t2 and (t4 and t0 xor t5 xor t1) xor t0 and t1 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[26] + $487CAC60; + Temp := (t2 and (t4 and not t7 xor t1 and not t0 xor t3 xor t0 xor t5) xor t1 and (t3 and t7 xor t4 xor t0) xor t7 and t0 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[6] + $5DEC8032; + Temp := (t1 and (t3 and not t6 xor t0 and not t7 xor t2 xor t7 xor t4) xor t0 and (t2 and t6 xor t3 xor t7) xor t6 and t7 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[30] + $EF845D5D; + Temp := (t0 and (t2 and not t5 xor t7 and not t6 xor t1 xor t6 xor t3) xor t7 and (t1 and t5 xor t2 xor t6) xor t5 and t6 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[20] + $E98575B1; + Temp := (t7 and (t1 and not t4 xor t6 and not t5 xor t0 xor t5 xor t2) xor t6 and (t0 and t4 xor t1 xor t5) xor t4 and t5 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[18] + $DC262302; + Temp := (t6 and (t0 and not t3 xor t5 and not t4 xor t7 xor t4 xor t1) xor t5 and (t7 and t3 xor t0 xor t4) xor t3 and t4 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[25] + $EB651B88; + Temp := (t5 and (t7 and not t2 xor t4 and not t3 xor t6 xor t3 xor t0) xor t4 and (t6 and t2 xor t7 xor t3) xor t2 and t3 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[19] + $23893E81; + Temp := (t4 and (t6 and not t1 xor t3 and not t2 xor t5 xor t2 xor t7) xor t3 and (t5 and t1 xor t6 xor t2) xor t1 and t2 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[3] + $D396ACC5; + + Temp := (t3 and (t5 and not t0 xor t2 and not t1 xor t4 xor t1 xor t6) xor t2 and (t4 and t0 xor t5 xor t1) xor t0 and t1 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[22] + $0F6D6FF3; + Temp := (t2 and (t4 and not t7 xor t1 and not t0 xor t3 xor t0 xor t5) xor t1 and (t3 and t7 xor t4 xor t0) xor t7 and t0 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[11] + $83F44239; + Temp := (t1 and (t3 and not t6 xor t0 and not t7 xor t2 xor t7 xor t4) xor t0 and (t2 and t6 xor t3 xor t7) xor t6 and t7 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[31] + $2E0B4482; + Temp := (t0 and (t2 and not t5 xor t7 and not t6 xor t1 xor t6 xor t3) xor t7 and (t1 and t5 xor t2 xor t6) xor t5 and t6 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[21] + $A4842004; + Temp := (t7 and (t1 and not t4 xor t6 and not t5 xor t0 xor t5 xor t2) xor t6 and (t0 and t4 xor t1 xor t5) xor t4 and t5 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[8] + $69C8F04A; + Temp := (t6 and (t0 and not t3 xor t5 and not t4 xor t7 xor t4 xor t1) xor t5 and (t7 and t3 xor t0 xor t4) xor t3 and t4 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[27] + $9E1F9B5E; + Temp := (t5 and (t7 and not t2 xor t4 and not t3 xor t6 xor t3 xor t0) xor t4 and (t6 and t2 xor t7 xor t3) xor t2 and t3 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[12] + $21C66842; + Temp := (t4 and (t6 and not t1 xor t3 and not t2 xor t5 xor t2 xor t7) xor t3 and (t5 and t1 xor t6 xor t2) xor t1 and t2 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[9] + $F6E96C9A; + + Temp := (t3 and (t5 and not t0 xor t2 and not t1 xor t4 xor t1 xor t6) xor t2 and (t4 and t0 xor t5 xor t1) xor t0 and t1 xor t6); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[1] + $670C9C61; + Temp := (t2 and (t4 and not t7 xor t1 and not t0 xor t3 xor t0 xor t5) xor t1 and (t3 and t7 xor t4 xor t0) xor t7 and t0 xor t5); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[29] + $ABD388F0; + Temp := (t1 and (t3 and not t6 xor t0 and not t7 xor t2 xor t7 xor t4) xor t0 and (t2 and t6 xor t3 xor t7) xor t6 and t7 xor t4); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[5] + $6A51A0D2; + Temp := (t0 and (t2 and not t5 xor t7 and not t6 xor t1 xor t6 xor t3) xor t7 and (t1 and t5 xor t2 xor t6) xor t5 and t6 xor t3); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[15] + $D8542F68; + Temp := (t7 and (t1 and not t4 xor t6 and not t5 xor t0 xor t5 xor t2) xor t6 and (t0 and t4 xor t1 xor t5) xor t4 and t5 xor t2); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[17] + $960FA728; + Temp := (t6 and (t0 and not t3 xor t5 and not t4 xor t7 xor t4 xor t1) xor t5 and (t7 and t3 xor t0 xor t4) xor t3 and t4 xor t1); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[10] + $AB5133A3; + Temp := (t5 and (t7 and not t2 xor t4 and not t3 xor t6 xor t3 xor t0) xor t4 and (t6 and t2 xor t7 xor t3) xor t2 and t3 xor t0); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[16] + $6EEF0B6C; + Temp := (t4 and (t6 and not t1 xor t3 and not t2 xor t5 xor t2 xor t7) xor t3 and (t5 and t1 xor t6 xor t2) xor t1 and t2 xor t7); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[13] + $137A3BE4; + + Temp := (t1 and (t3 and t4 and t6 xor not t5) xor t3 and t0 xor t4 and t5 xor t6 and t2); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[27] + $BA3BF050; + Temp := (t0 and (t2 and t3 and t5 xor not t4) xor t2 and t7 xor t3 and t4 xor t5 and t1); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[3] + $7EFB2A98; + Temp := (t7 and (t1 and t2 and t4 xor not t3) xor t1 and t6 xor t2 and t3 xor t4 and t0); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[21] + $A1F1651D; + Temp := (t6 and (t0 and t1 and t3 xor not t2) xor t0 and t5 xor t1 and t2 xor t3 and t7); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[26] + $39AF0176; + Temp := (t5 and (t7 and t0 and t2 xor not t1) xor t7 and t4 xor t0 and t1 xor t2 and t6); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[17] + $66CA593E; + Temp := (t4 and (t6 and t7 and t1 xor not t0) xor t6 and t3 xor t7 and t0 xor t1 and t5); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[11] + $82430E88; + Temp := (t3 and (t5 and t6 and t0 xor not t7) xor t5 and t2 xor t6 and t7 xor t0 and t4); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[20] + $8CEE8619; + Temp := (t2 and (t4 and t5 and t7 xor not t6) xor t4 and t1 xor t5 and t6 xor t7 and t3); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[29] + $456F9FB4; + + Temp := (t1 and (t3 and t4 and t6 xor not t5) xor t3 and t0 xor t4 and t5 xor t6 and t2); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[19] + $7D84A5C3; + Temp := (t0 and (t2 and t3 and t5 xor not t4) xor t2 and t7 xor t3 and t4 xor t5 and t1); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[0] + $3B8B5EBE; + Temp := (t7 and (t1 and t2 and t4 xor not t3) xor t1 and t6 xor t2 and t3 xor t4 and t0); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[12] + $E06F75D8; + Temp := (t6 and (t0 and t1 and t3 xor not t2) xor t0 and t5 xor t1 and t2 xor t3 and t7); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[7] + $85C12073; + Temp := (t5 and (t7 and t0 and t2 xor not t1) xor t7 and t4 xor t0 and t1 xor t2 and t6); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[13] + $401A449F; + Temp := (t4 and (t6 and t7 and t1 xor not t0) xor t6 and t3 xor t7 and t0 xor t1 and t5); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[8] + $56C16AA6; + Temp := (t3 and (t5 and t6 and t0 xor not t7) xor t5 and t2 xor t6 and t7 xor t0 and t4); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[31] + $4ED3AA62; + Temp := (t2 and (t4 and t5 and t7 xor not t6) xor t4 and t1 xor t5 and t6 xor t7 and t3); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[10] + $363F7706; + + Temp := (t1 and (t3 and t4 and t6 xor not t5) xor t3 and t0 xor t4 and t5 xor t6 and t2); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[5] + $1BFEDF72; + Temp := (t0 and (t2 and t3 and t5 xor not t4) xor t2 and t7 xor t3 and t4 xor t5 and t1); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[9] + $429B023D; + Temp := (t7 and (t1 and t2 and t4 xor not t3) xor t1 and t6 xor t2 and t3 xor t4 and t0); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[14] + $37D0D724; + Temp := (t6 and (t0 and t1 and t3 xor not t2) xor t0 and t5 xor t1 and t2 xor t3 and t7); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[30] + $D00A1248; + Temp := (t5 and (t7 and t0 and t2 xor not t1) xor t7 and t4 xor t0 and t1 xor t2 and t6); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[18] + $DB0FEAD3; + Temp := (t4 and (t6 and t7 and t1 xor not t0) xor t6 and t3 xor t7 and t0 xor t1 and t5); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[6] + $49F1C09B; + Temp := (t3 and (t5 and t6 and t0 xor not t7) xor t5 and t2 xor t6 and t7 xor t0 and t4); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[28] + $075372C9; + Temp := (t2 and (t4 and t5 and t7 xor not t6) xor t4 and t1 xor t5 and t6 xor t7 and t3); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[24] + $80991B7B; + + Temp := (t1 and (t3 and t4 and t6 xor not t5) xor t3 and t0 xor t4 and t5 xor t6 and t2); + t7 := ((Temp shr 7) or (Temp shl 25)) + ((t7 shr 11) or (t7 shl 21)) + W[2] + $25D479D8; + Temp := (t0 and (t2 and t3 and t5 xor not t4) xor t2 and t7 xor t3 and t4 xor t5 and t1); + t6 := ((Temp shr 7) or (Temp shl 25)) + ((t6 shr 11) or (t6 shl 21)) + W[23] + $F6E8DEF7; + Temp := (t7 and (t1 and t2 and t4 xor not t3) xor t1 and t6 xor t2 and t3 xor t4 and t0); + t5 := ((Temp shr 7) or (Temp shl 25)) + ((t5 shr 11) or (t5 shl 21)) + W[16] + $E3FE501A; + Temp := (t6 and (t0 and t1 and t3 xor not t2) xor t0 and t5 xor t1 and t2 xor t3 and t7); + t4 := ((Temp shr 7) or (Temp shl 25)) + ((t4 shr 11) or (t4 shl 21)) + W[22] + $B6794C3B; + Temp := (t5 and (t7 and t0 and t2 xor not t1) xor t7 and t4 xor t0 and t1 xor t2 and t6); + t3 := ((Temp shr 7) or (Temp shl 25)) + ((t3 shr 11) or (t3 shl 21)) + W[4] + $976CE0BD; + Temp := (t4 and (t6 and t7 and t1 xor not t0) xor t6 and t3 xor t7 and t0 xor t1 and t5); + t2 := ((Temp shr 7) or (Temp shl 25)) + ((t2 shr 11) or (t2 shl 21)) + W[1] + $04C006BA; + Temp := (t3 and (t5 and t6 and t0 xor not t7) xor t5 and t2 xor t6 and t7 xor t0 and t4); + t1 := ((Temp shr 7) or (Temp shl 25)) + ((t1 shr 11) or (t1 shl 21)) + W[25] + $C1A94FB6; + Temp := (t2 and (t4 and t5 and t7 xor not t6) xor t4 and t1 xor t5 and t6 xor t7 and t3); + t0 := ((Temp shr 7) or (Temp shl 25)) + ((t0 shr 11) or (t0 shl 21)) + W[15] + $409F60C4; +{$ENDIF} +{$ENDIF} + Inc(CurrentHash[0], t0); + Inc(CurrentHash[1], t1); + Inc(CurrentHash[2], t2); + Inc(CurrentHash[3], t3); + Inc(CurrentHash[4], t4); + Inc(CurrentHash[5], t5); + Inc(CurrentHash[6], t6); + Inc(CurrentHash[7], t7); + FillChar(W, Sizeof(W), 0); + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_haval.GetHashSize: Integer; +begin +{$IFDEF DIGEST128} + Result := 128; +{$ELSE} +{$IFDEF DIGEST160} + Result := 160; +{$ELSE} +{$IFDEF DIGEST192} + Result := 192; +{$ELSE} +{$IFDEF DIGEST224} + Result := 224; +{$ELSE} + Result := 256; +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} +end; + +class function TncEnc_haval.GetAlgorithm: string; +begin + Result := 'Haval ('; +{$IFDEF DIGEST128} + Result := Result + '128bit, '; +{$ELSE} +{$IFDEF DIGEST160} + Result := Result + '160bit, '; +{$ELSE} +{$IFDEF DIGEST192} + Result := Result + '192bit, '; +{$ELSE} +{$IFDEF DIGEST224} + Result := Result + '224bit, '; +{$ELSE} + Result := Result + '256bit, '; +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$IFDEF PASS3} + Result := Result + '3 passes)'; +{$ELSE} +{$IFDEF PASS4} + Result := Result + '4 passes)'; +{$ELSE} + Result := Result + '5 passes)'; +{$ENDIF} +{$ENDIF} +end; + +class function TncEnc_haval.SelfTest: Boolean; +{$IFDEF PASS3} +{$IFDEF DIGEST128} +const + Test1Out: array [0 .. 15] of Byte = ($1B, $DC, $55, $6B, $29, $AD, $02, $EC, $09, $AF, $8C, $66, $47, $7F, $2A, $87); +var + TestHash: TncEnc_haval; + TestOut: array [0 .. 15] of Byte; +begin + TestHash := TncEnc_haval.Create(nil); + TestHash.Init; + TestHash.UpdateStr(''); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Free; +{$ELSE} +{$IFDEF DIGEST160} +const + Test1Out: array [0 .. 19] of Byte = ($5E, $16, $10, $FC, $ED, $1D, $3A, $DB, $0B, $B1, $8E, $92, $AC, $2B, $11, $F0, $BD, $99, $D8, $ED); + +var + TestHash: TncEnc_haval; + TestOut: array [0 .. 19] of Byte; +begin + TestHash := TncEnc_haval.Create(nil); + TestHash.Init; + TestHash.UpdateStr('a'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Free; +{$ELSE} +begin + Result := true; +{$ENDIF} +{$ENDIF} +{$ELSE} +{$IFDEF PASS4} +{$IFDEF DIGEST192} +const + Test1Out: array [0 .. 23] of Byte = ($74, $AA, $31, $18, $2F, $F0, $9B, $CC, $E4, $53, $A7, $F7, $1B, $5A, $7C, $5E, $80, $87, $2F, $A9, $0C, $D9, $3A, $E4); + +var + TestHash: TncEnc_haval; + TestOut: array [0 .. 23] of Byte; +begin + TestHash := TncEnc_haval.Create(nil); + TestHash.Init; + TestHash.UpdateStr('HAVAL'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Free; +{$ELSE} +{$IFDEF DIGEST224} +const + Test1Out: array [0 .. 27] of Byte = ($14, $4C, $B2, $DE, $11, $F0, $5D, $F7, $C3, $56, $28, $2A, $3B, $48, $57, $96, $DA, $65, $3F, $6B, $70, $28, $68, $C7, $DC, $F4, $AE, $76); + +var + TestHash: TncEnc_haval; + TestOut: array [0 .. 27] of Byte; +begin + TestHash := TncEnc_haval.Create(nil); + TestHash.Init; + TestHash.UpdateStr('0123456789'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Free; +{$ELSE} +begin + Result := true; +{$ENDIF} +{$ENDIF} +{$ELSE} +{$IFDEF DIGEST256} +const + Test1Out: array [0 .. 31] of Byte = ($1A, $1D, $C8, $09, $9B, $DA, $A7, $F3, $5B, $4D, $A4, $E8, $05, $F1, $A2, $8F, $EE, $90, $9D, $8D, $EE, $92, $01, $98, $18, $5C, $BC, $AE, $D8, $A1, $0A, $8D); + Test2Out: array [0 .. 31] of Byte = ($C5, $64, $7F, $C6, $C1, $87, $7F, $FF, $96, $74, $2F, $27, $E9, $26, $6B, $68, $74, $89, $4F, $41, $A0, $8F, $59, $13, $03, $3D, $9D, $53, $2A, $ED, $DB, $39); + +var + TestHash: TncEnc_haval; + TestOut: array [0 .. 31] of Byte; +begin + TestHash := TncEnc_haval.Create(nil); + TestHash.Init; + TestHash.UpdateStr('abcdefghijklmnopqrstuvwxyz'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Init; + TestHash.UpdateStr('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out)) and Result; + TestHash.Free; +{$ELSE} +begin + Result := true; +{$ENDIF} +{$ENDIF} +{$ENDIF} +end; + +procedure TncEnc_haval.Init; +begin + Burn; + CurrentHash[0] := $243F6A88; + CurrentHash[1] := $85A308D3; + CurrentHash[2] := $13198A2E; + CurrentHash[3] := $03707344; + CurrentHash[4] := $A4093822; + CurrentHash[5] := $299F31D0; + CurrentHash[6] := $082EFA98; + CurrentHash[7] := $EC4E6C89; + FInitialized := true; +end; + +procedure TncEnc_haval.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_haval.Update(const Buffer; Size: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenHi, Size shr 29); + Inc(LenLo, Size * 8); + if LenLo < (Size * 8) then + Inc(LenHi); + + PBuf := @Buffer; + while Size > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= Size then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(Size, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], Size); + Inc(Index, Size); + Size := 0; + end; + end; +end; + +procedure TncEnc_haval.Final(var Digest); +{$IFNDEF DIGEST256} +{$IFNDEF DIGEST224} +var + Temp: UInt32; +{$ENDIF} +{$ENDIF} +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 118 then + Compress; +{$IFDEF PASS3} +{$IFDEF DIGEST128} + HashBuffer[118] := ((128 and 3) shl 6) or (3 shl 3) or 1; + HashBuffer[119] := (128 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST160} + HashBuffer[118] := ((160 and 3) shl 6) or (3 shl 3) or 1; + HashBuffer[119] := (160 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST192} + HashBuffer[118] := ((192 and 3) shl 6) or (3 shl 3) or 1; + HashBuffer[119] := (192 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST224} + HashBuffer[118] := ((224 and 3) shl 6) or (3 shl 3) or 1; + HashBuffer[119] := (224 shr 2) and $FF; +{$ELSE} + HashBuffer[118] := ((256 and 3) shl 6) or (3 shl 3) or 1; + HashBuffer[119] := (256 shr 2) and $FF; +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ELSE} +{$IFDEF PASS4} +{$IFDEF DIGEST128} + HashBuffer[118] := ((128 and 3) shl 6) or (4 shl 3) or 1; + HashBuffer[119] := (128 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST160} + HashBuffer[118] := ((160 and 3) shl 6) or (4 shl 3) or 1; + HashBuffer[119] := (160 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST192} + HashBuffer[118] := ((192 and 3) shl 6) or (4 shl 3) or 1; + HashBuffer[119] := (192 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST224} + HashBuffer[118] := ((224 and 3) shl 6) or (4 shl 3) or 1; + HashBuffer[119] := (224 shr 2) and $FF; +{$ELSE} + HashBuffer[118] := ((256 and 3) shl 6) or (4 shl 3) or 1; + HashBuffer[119] := (256 shr 2) and $FF; +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ELSE} +{$IFDEF DIGEST128} + HashBuffer[118] := ((128 and 3) shl 6) or (5 shl 3) or 1; + HashBuffer[119] := (2128 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST160} + HashBuffer[118] := ((160 and 3) shl 6) or (5 shl 3) or 1; + HashBuffer[119] := (160 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST192} + HashBuffer[118] := ((192 and 3) shl 6) or (5 shl 3) or 1; + HashBuffer[119] := (192 shr 2) and $FF; +{$ELSE} +{$IFDEF DIGEST224} + HashBuffer[118] := ((224 and 3) shl 6) or (5 shl 3) or 1; + HashBuffer[119] := (224 shr 2) and $FF; +{$ELSE} + HashBuffer[118] := ((256 and 3) shl 6) or (5 shl 3) or 1; + HashBuffer[119] := (256 shr 2) and $FF; +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} + PUInt32(@HashBuffer[120])^ := LenLo; + PUInt32(@HashBuffer[124])^ := LenHi; + Compress; +{$IFDEF DIGEST128} + Temp := (CurrentHash[7] and $000000FF) or (CurrentHash[6] and $FF000000) or (CurrentHash[5] and $00FF0000) or (CurrentHash[4] and $0000FF00); + Inc(CurrentHash[0], (Temp shr 8) or (Temp shl 24)); + Temp := (CurrentHash[7] and $0000FF00) or (CurrentHash[6] and $000000FF) or (CurrentHash[5] and $FF000000) or (CurrentHash[4] and $00FF0000); + Inc(CurrentHash[1], (Temp shr 16) or (Temp shl 16)); + Temp := (CurrentHash[7] and $00FF0000) or (CurrentHash[6] and $0000FF00) or (CurrentHash[5] and $000000FF) or (CurrentHash[4] and $FF000000); + Inc(CurrentHash[2], (Temp shr 24) or (Temp shl 8)); + Temp := (CurrentHash[7] and $FF000000) or (CurrentHash[6] and $00FF0000) or (CurrentHash[5] and $0000FF00) or (CurrentHash[4] and $000000FF); + Inc(CurrentHash[3], Temp); + Move(CurrentHash, Digest, 128 div 8); +{$ELSE} +{$IFDEF DIGEST160} + Temp := (CurrentHash[7] and $3F) or (CurrentHash[6] and ($7F shl 25)) or (CurrentHash[5] and ($3F shl 19)); + Inc(CurrentHash[0], (Temp shr 19) or (Temp shl 13)); + Temp := (CurrentHash[7] and ($3F shl 6)) or (CurrentHash[6] and $3F) or (CurrentHash[5] and ($7F shl 25)); + Inc(CurrentHash[1], (Temp shr 25) or (Temp shl 7)); + Temp := (CurrentHash[7] and ($7F shl 12)) or (CurrentHash[6] and ($3F shl 6)) or (CurrentHash[5] and $3F); + Inc(CurrentHash[2], Temp); + Temp := (CurrentHash[7] and ($3F shl 19)) or (CurrentHash[6] and ($7F shl 12)) or (CurrentHash[5] and ($3F shl 6)); + Inc(CurrentHash[3], Temp shr 6); + Temp := (CurrentHash[7] and ($7F shl 25)) or (CurrentHash[6] and ($3F shl 19)) or (CurrentHash[5] and ($7F shl 12)); + Inc(CurrentHash[4], Temp shr 12); + Move(CurrentHash, Digest, 160 div 8); +{$ELSE} +{$IFDEF DIGEST192} + Temp := (CurrentHash[7] and $1F) or (CurrentHash[6] and ($3F shl 26)); + Inc(CurrentHash[0], (Temp shr 26) or (Temp shl 6)); + Temp := (CurrentHash[7] and ($1F shl 5)) or (CurrentHash[6] and $1F); + Inc(CurrentHash[1], Temp); + Temp := (CurrentHash[7] and ($3F shl 10)) or (CurrentHash[6] and ($1F shl 5)); + Inc(CurrentHash[2], Temp shr 5); + Temp := (CurrentHash[7] and ($1F shl 16)) or (CurrentHash[6] and ($3F shl 10)); + Inc(CurrentHash[3], Temp shr 10); + Temp := (CurrentHash[7] and ($1F shl 21)) or (CurrentHash[6] and ($1F shl 16)); + Inc(CurrentHash[4], Temp shr 16); + Temp := (CurrentHash[7] and ($3F shl 26)) or (CurrentHash[6] and ($1F shl 21)); + Inc(CurrentHash[5], Temp shr 21); + Move(CurrentHash, Digest, 192 div 8); +{$ELSE} +{$IFDEF DIGEST224} + Inc(CurrentHash[0], (CurrentHash[7] shr 27) and $1F); + Inc(CurrentHash[1], (CurrentHash[7] shr 22) and $1F); + Inc(CurrentHash[2], (CurrentHash[7] shr 18) and $F); + Inc(CurrentHash[3], (CurrentHash[7] shr 13) and $1F); + Inc(CurrentHash[4], (CurrentHash[7] shr 9) and $F); + Inc(CurrentHash[5], (CurrentHash[7] shr 4) and $1F); + Inc(CurrentHash[6], CurrentHash[7] and $F); + Move(CurrentHash, Digest, 224 div 8); +{$ELSE} + Move(CurrentHash, Digest, 256 div 8); +{$ENDIF} +{$ENDIF} +{$ENDIF} +{$ENDIF} + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncIce.pas b/Source_using_TMonitor/Encryption/ncEncIce.pas new file mode 100644 index 0000000..2b96e81 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncIce.pas @@ -0,0 +1,445 @@ +{$R-} +{$Q-} +unit ncEncIce; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_customice = class(TncEnc_blockcipher64) + protected + rounds: UInt32; + ik_keysched: array [0 .. 31, 0 .. 2] of UInt32; + function f(const p, sk: UInt32): UInt32; + procedure key_sched_build(kb: pwordarray; n: UInt32; keyrot: PUInt32Array); + procedure InitIce(const Key; Size: longword; n: UInt32); + public + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + constructor Create(AOwner: TComponent); override; + end; + + TncEnc_ice = class(TncEnc_customice) + protected + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + end; + + TncEnc_thinice = class(TncEnc_customice) + protected + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + end; + + TncEnc_ice2 = class(TncEnc_customice) + protected + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +var + ice_sbox: array [0 .. 3, 0 .. 1023] of UInt32; + ice_sboxdone: boolean; + +const + ice_smod: array [0 .. 3, 0 .. 3] of UInt32 = ((333, 313, 505, 369), (379, 375, 319, 391), (361, 445, 451, 397), (397, 425, 395, 505)); + ice_sxor: array [0 .. 3, 0 .. 3] of UInt32 = (($83, $85, $9B, $CD), ($CC, $A7, $AD, $41), ($4B, $2E, $D4, $33), ($EA, $CB, $2E, $04)); + ice_keyrot: array [0 .. 15] of UInt32 = (0, 1, 2, 3, 2, 1, 3, 0, 1, 3, 2, 0, 3, 1, 0, 2); + ice_pbox: array [0 .. 31] of UInt32 = ($00000001, $00000080, $00000400, $00002000, $00080000, $00200000, $01000000, $40000000, $00000008, $00000020, $00000100, $00004000, $00010000, $00800000, $04000000, $20000000, $00000004, $00000010, $00000200, $00008000, $00020000, $00400000, $08000000, $10000000, $00000002, + $00000040, $00000800, $00001000, $00040000, $00100000, $02000000, $80000000); + +function SwapUInt32(const a: UInt32): UInt32; inline; +begin + Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); +end; + +{ ****************************************************************************** } +function gf_mult(a, b, m: UInt32): UInt32; inline; +begin + Result := 0; + while b <> 0 do + begin + if (b and 1) <> 0 then + Result := Result xor a; + a := a shl 1; + b := b shr 1; + if a >= 256 then + a := a xor m; + end; +end; + +function gf_exp7(const b, m: UInt32): UInt32; inline; +var + x: UInt32; +begin + if b = 0 then + Result := 0 + else + begin + x := gf_mult(b, b, m); + x := gf_mult(b, x, m); + x := gf_mult(x, x, m); + Result := gf_mult(b, x, m); + end; +end; + +function ice_perm32(x: UInt32): UInt32; inline; +var + res: UInt32; + pbox: PUInt32; +begin + res := 0; + pbox := @ice_pbox; + while x <> 0 do + begin + if (x and 1) <> 0 then + res := res or pbox^; + Inc(pbox); + x := x shr 1; + end; + Result := res; +end; + +procedure ice_sboxes_init; +var + i, col, row: UInt32; + x: UInt32; +begin + for i := 0 to 1023 do + begin + col := (i shr 1) and $FF; + row := (i and 1) or ((i and $200) shr 8); + x := gf_exp7(col xor ice_sxor[0, row], ice_smod[0, row]) shl 24; + ice_sbox[0, i] := ice_perm32(x); + x := gf_exp7(col xor ice_sxor[1, row], ice_smod[1, row]) shl 16; + ice_sbox[1, i] := ice_perm32(x); + x := gf_exp7(col xor ice_sxor[2, row], ice_smod[2, row]) shl 8; + ice_sbox[2, i] := ice_perm32(x); + x := gf_exp7(col xor ice_sxor[3, row], ice_smod[3, row]); + ice_sbox[3, i] := ice_perm32(x); + end; +end; + +function TncEnc_customice.f(const p, sk: UInt32): UInt32; +var + tl, tr, al, ar: UInt32; +begin + tl := ((p shr 16) and $3FF) or (((p shr 14) or (p shl 18)) and $FFC00); + tr := (p and $3FF) or ((p shl 2) and $FFC00); + al := ik_keysched[sk, 2] and (tl xor tr); + ar := al xor tr; + al := al xor tl; + al := al xor ik_keysched[sk, 0]; + ar := ar xor ik_keysched[sk, 1]; + Result := ice_sbox[0, al shr 10] or ice_sbox[1, al and $3FF] or ice_sbox[2, ar shr 10] or ice_sbox[3, ar and $3FF]; +end; + +procedure TncEnc_customice.key_sched_build(kb: pwordarray; n: UInt32; keyrot: PUInt32Array); +var + i, j, k, kr: UInt32; + keys: PUInt32Array; + currentsk: PUInt32; + currentkb: PUInt32; + bit: UInt32; +begin + for i := 0 to 7 do + begin + kr := keyrot^[i]; + keys := @ik_keysched[n + i]; + for j := 0 to 2 do + keys^[j] := 0; + for j := 0 to 14 do + begin + currentsk := @keys^[j mod 3]; + for k := 0 to 3 do + begin + currentkb := @kb^[(kr + k) and 3]; + bit := currentkb^ and 1; + currentsk^ := (currentsk^ shl 1) or bit; + currentkb^ := (currentkb^ shr 1) or ((bit xor 1) shl 15); + end; + end; + end; +end; + +procedure TncEnc_customice.InitIce(const Key; Size: longword; n: UInt32); +var + i, j: UInt32; + kb: array [0 .. 3] of word; + keyb: array [0 .. 15] of byte; +begin + FillChar(keyb, Sizeof(keyb), 0); + Move(Key, keyb, Size div 8); + if n > 0 then + rounds := 16 * n + else + rounds := 8; + + if rounds = 8 then + begin + for i := 0 to 4 do + kb[3 - i] := (keyb[i * 2] shl 8) or keyb[i * 2 + 1]; + key_sched_build(@kb, 0, @ice_keyrot); + end + else + begin + for i := 0 to (n - 1) do + begin + for j := 0 to 3 do + kb[3 - j] := (keyb[i * 8 + j * 2] shl 8) or keyb[i * 8 + j * 2 + 1]; + key_sched_build(@kb, i * 8, @ice_keyrot); + key_sched_build(@kb, rounds - 8 - i * 8, @ice_keyrot[8]); + end; + end; +end; + +procedure TncEnc_customice.Burn; +begin + FillChar(ik_keysched, Sizeof(ik_keysched), 0); + rounds := 0; + inherited Burn; +end; + +procedure TncEnc_customice.EncryptECB(const InData; var OutData); +var + i, l, r: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + + l := SwapUInt32(PUInt32(@InData)^); + r := SwapUInt32(PUInt32(NativeUInt(@InData) + 4)^); + i := 0; + while i < rounds do + begin + l := l xor f(r, i); + r := r xor f(l, i + 1); + Inc(i, 2); + end; + PUInt32(@OutData)^ := SwapUInt32(r); + PUInt32(NativeUInt(@OutData) + 4)^ := SwapUInt32(l); +end; + +procedure TncEnc_customice.DecryptECB(const InData; var OutData); +var + l, r: UInt32; + i: integer; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + l := SwapUInt32(PUInt32(@InData)^); + r := SwapUInt32(PUInt32(NativeUInt(@InData) + 4)^); + i := rounds - 1; + while i > 0 do + begin + l := l xor f(r, i); + r := r xor f(l, i - 1); + Dec(i, 2); + end; + PUInt32(@OutData)^ := SwapUInt32(r); + PUInt32(NativeUInt(@OutData) + 4)^ := SwapUInt32(l); +end; + +constructor TncEnc_customice.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + if not ice_sboxdone then + begin + ice_sboxes_init; + ice_sboxdone := true; + end; +end; + +{ ****************************************************************************** } +class function TncEnc_ice.GetMaxKeySize: integer; +begin + Result := 64; +end; + +class function TncEnc_ice.GetAlgorithm: string; +begin + Result := 'Ice'; +end; + +class function TncEnc_ice.SelfTest: boolean; +const + Key1: array [0 .. 7] of byte = ($DE, $AD, $BE, $EF, $01, $23, $45, $67); + InData1: array [0 .. 7] of byte = ($FE, $DC, $BA, $98, $76, $54, $32, $10); + OutData1: array [0 .. 7] of byte = ($7D, $6E, $F1, $EF, $30, $D4, $7A, $96); +var + Cipher: TncEnc_ice; + Data: array [0 .. 7] of byte; +begin + Cipher := TncEnc_ice.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Data); + Result := boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.Reset; + Cipher.DecryptECB(Data, Data); + Result := boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_ice.InitKey(const Key; Size: longword); +begin + InitIce(Key, Size, 1); +end; + +{ ****************************************************************************** } +class function TncEnc_thinice.GetMaxKeySize: integer; +begin + Result := 64; +end; + +class function TncEnc_thinice.GetAlgorithm: string; +begin + Result := 'Thin Ice'; +end; + +class function TncEnc_thinice.SelfTest: boolean; +const + Key1: array [0 .. 7] of byte = ($DE, $AD, $BE, $EF, $01, $23, $45, $67); + InData1: array [0 .. 7] of byte = ($FE, $DC, $BA, $98, $76, $54, $32, $10); + OutData1: array [0 .. 7] of byte = ($DE, $24, $0D, $83, $A0, $0A, $9C, $C0); +var + Cipher: TncEnc_thinice; + Data: array [0 .. 7] of byte; +begin + Cipher := TncEnc_thinice.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Data); + Result := boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.Reset; + Cipher.DecryptECB(Data, Data); + Result := boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_thinice.InitKey(const Key; Size: longword); +begin + InitIce(Key, Size, 0); +end; + +{ ****************************************************************************** } +class function TncEnc_ice2.GetMaxKeySize: integer; +begin + Result := 128; +end; + +class function TncEnc_ice2.GetAlgorithm: string; +begin + Result := 'Ice2'; +end; + +class function TncEnc_ice2.SelfTest: boolean; +const + Key1: array [0 .. 15] of byte = ($00, $11, $22, $33, $44, $55, $66, $77, $88, $99, $AA, $BB, $CC, $DD, $EE, $FF); + InData1: array [0 .. 7] of byte = ($FE, $DC, $BA, $98, $76, $54, $32, $10); + OutData1: array [0 .. 7] of byte = ($F9, $48, $40, $D8, $69, $72, $F2, $1C); +var + Cipher: TncEnc_ice2; + Data: array [0 .. 7] of byte; +begin + Cipher := TncEnc_ice2.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Data); + Result := boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.Reset; + Cipher.DecryptECB(Data, Data); + Result := boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_ice2.InitKey(const Key; Size: longword); +begin + InitIce(Key, Size, 2); +end; + +initialization + +ice_sboxdone := false; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncIdea.pas b/Source_using_TMonitor/Encryption/ncEncIdea.pas new file mode 100644 index 0000000..bccb61a --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncIdea.pas @@ -0,0 +1,323 @@ +{$R-} +{$Q-} +unit ncEncIdea; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_idea = class(TncEnc_blockcipher64) + protected + EK, DK: array [0 .. 51] of word; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +class function TncEnc_idea.GetMaxKeySize: integer; +begin + Result := 128; +end; + +class function TncEnc_idea.GetAlgorithm: string; +begin + Result := 'IDEA'; +end; + +class function TncEnc_idea.SelfTest: boolean; +const + Key1: array [0 .. 15] of byte = ($3A, $98, $4E, $20, $00, $19, $5D, $B3, $2E, $E5, $01, $C8, $C4, $7C, $EA, $60); + InData1: array [0 .. 7] of byte = ($01, $02, $03, $04, $05, $06, $07, $08); + OutData1: array [0 .. 7] of byte = ($97, $BC, $D8, $20, $07, $80, $DA, $86); + Key2: array [0 .. 15] of byte = ($00, $64, $00, $C8, $01, $2C, $01, $90, $01, $F4, $02, $58, $02, $BC, $03, $20); + InData2: array [0 .. 7] of byte = ($05, $32, $0A, $64, $14, $C8, $19, $FA); + OutData2: array [0 .. 7] of byte = ($65, $BE, $87, $E7, $A2, $53, $8A, $ED); +var + Cipher: TncEnc_idea; + Data: array [0 .. 7] of byte; +begin + Cipher := TncEnc_idea.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Data); + Result := boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and boolean(CompareMem(@Data, @InData1, Sizeof(Data))); + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(InData2, Data); + Result := Result and boolean(CompareMem(@Data, @OutData2, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and boolean(CompareMem(@Data, @InData2, Sizeof(Data))); + Cipher.Burn; + Cipher.Free; +end; + +function MulInv(x: word): word; +var + t0, t1, q, y: word; +begin + if x <= 1 then + begin + Result := x; + Exit; + end; + t1 := UInt32($10001) div x; + y := UInt32($10001) mod x; + if y = 1 then + begin + Result := (1 - t1) and $FFFF; + Exit; + end; + t0 := 1; + repeat + q := x div y; + x := x mod y; + t0 := t0 + (q * t1); + if x = 1 then + begin + Result := t0; + Exit; + end; + q := y div x; + y := y mod x; + t1 := t1 + (q * t0); + until y = 1; + Result := (1 - t1) and $FFFF; +end; + +procedure TncEnc_idea.InitKey(const Key; Size: longword); +var + i: integer; +begin + Size := Size div 8; + + FillChar(EK, Sizeof(EK), 0); + Move(Key, EK, Size); + for i := 0 to 7 do + EK[i] := (EK[i] shl 8) or (EK[i] shr 8); + for i := 1 to 5 do + begin + EK[(i * 8) + 0] := (EK[((i - 1) * 8) + 1] shl 9) or (EK[((i - 1) * 8) + 2] shr 7); + EK[(i * 8) + 1] := (EK[((i - 1) * 8) + 2] shl 9) or (EK[((i - 1) * 8) + 3] shr 7); + EK[(i * 8) + 2] := (EK[((i - 1) * 8) + 3] shl 9) or (EK[((i - 1) * 8) + 4] shr 7); + EK[(i * 8) + 3] := (EK[((i - 1) * 8) + 4] shl 9) or (EK[((i - 1) * 8) + 5] shr 7); + EK[(i * 8) + 4] := (EK[((i - 1) * 8) + 5] shl 9) or (EK[((i - 1) * 8) + 6] shr 7); + EK[(i * 8) + 5] := (EK[((i - 1) * 8) + 6] shl 9) or (EK[((i - 1) * 8) + 7] shr 7); + EK[(i * 8) + 6] := (EK[((i - 1) * 8) + 7] shl 9) or (EK[((i - 1) * 8) + 0] shr 7); + EK[(i * 8) + 7] := (EK[((i - 1) * 8) + 0] shl 9) or (EK[((i - 1) * 8) + 1] shr 7); + end; + EK[48] := (EK[41] shl 9) or (EK[42] shr 7); + EK[49] := (EK[42] shl 9) or (EK[43] shr 7); + EK[50] := (EK[43] shl 9) or (EK[44] shr 7); + EK[51] := (EK[44] shl 9) or (EK[45] shr 7); + + DK[51] := MulInv(EK[3]); + DK[50] := -EK[2]; + DK[49] := -EK[1]; + DK[48] := MulInv(EK[0]); + for i := 0 to 6 do + begin + DK[47 - i * 6] := EK[i * 6 + 5]; + DK[46 - i * 6] := EK[i * 6 + 4]; + DK[45 - i * 6] := MulInv(EK[i * 6 + 9]); + DK[44 - i * 6] := -EK[i * 6 + 7]; + DK[43 - i * 6] := -EK[i * 6 + 8]; + DK[42 - i * 6] := MulInv(EK[i * 6 + 6]); + end; + DK[5] := EK[47]; + DK[4] := EK[46]; + DK[3] := MulInv(EK[51]); + DK[2] := -EK[50]; + DK[1] := -EK[49]; + DK[0] := MulInv(EK[48]); +end; + +procedure TncEnc_idea.Burn; +begin + FillChar(EK, Sizeof(EK), 0); + FillChar(DK, Sizeof(DK), 0); + inherited Burn; +end; + +procedure Mul(var x: word; const y: word); +var + p: UInt32; + t16: word; +begin + p := UInt32(x) * y; + if p = 0 then + x := 1 - x - y + else + begin + x := p shr 16; + t16 := p and $FFFF; + x := t16 - x; + if (t16 < x) then + Inc(x); + end; +end; + +procedure TncEnc_idea.EncryptECB(const InData; var OutData); +var + x: array [1 .. 4] of word; + s3, s2: word; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + PUInt32(@x[1])^ := PUInt32(@InData)^; + PUInt32(@x[3])^ := PUInt32(NativeUInt(@InData) + 4)^; + for i := 1 to 4 do + x[i] := (x[i] shl 8) or (x[i] shr 8); + for i := 0 to 7 do + begin + Mul(x[1], EK[(i * 6) + 0]); + Inc(x[2], EK[(i * 6) + 1]); + Inc(x[3], EK[(i * 6) + 2]); + Mul(x[4], EK[(i * 6) + 3]); + s3 := x[3]; + x[3] := x[3] xor x[1]; + Mul(x[3], EK[(i * 6) + 4]); + s2 := x[2]; + x[2] := x[2] xor x[4]; + Inc(x[2], x[3]); + Mul(x[2], EK[(i * 6) + 5]); + Inc(x[3], x[2]); + x[1] := x[1] xor x[2]; + x[4] := x[4] xor x[3]; + x[2] := x[2] xor s3; + x[3] := x[3] xor s2; + end; + Mul(x[1], EK[48]); + Inc(x[3], EK[49]); + Inc(x[2], EK[50]); + Mul(x[4], EK[51]); + x[1] := (x[1] shl 8) or (x[1] shr 8); + s2 := (x[3] shl 8) or (x[3] shr 8); + x[3] := (x[2] shl 8) or (x[2] shr 8); + x[4] := (x[4] shl 8) or (x[4] shr 8); + x[2] := s2; + PUInt32(@OutData)^ := PUInt32(@x[1])^; + PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@x[3])^; +end; + +procedure TncEnc_idea.DecryptECB(const InData; var OutData); +var + x: array [1 .. 4] of word; + s3, s2: word; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + PUInt32(@x[1])^ := PUInt32(@InData)^; + PUInt32(@x[3])^ := PUInt32(NativeUInt(@InData) + 4)^; + for i := 1 to 4 do + x[i] := (x[i] shl 8) or (x[i] shr 8); + for i := 0 to 7 do + begin + Mul(x[1], DK[(i * 6) + 0]); + Inc(x[2], DK[(i * 6) + 1]); + Inc(x[3], DK[(i * 6) + 2]); + Mul(x[4], DK[(i * 6) + 3]); + s3 := x[3]; + x[3] := x[3] xor x[1]; + Mul(x[3], DK[(i * 6) + 4]); + s2 := x[2]; + x[2] := x[2] xor x[4]; + Inc(x[2], x[3]); + Mul(x[2], DK[(i * 6) + 5]); + Inc(x[3], x[2]); + x[1] := x[1] xor x[2]; + x[4] := x[4] xor x[3]; + x[2] := x[2] xor s3; + x[3] := x[3] xor s2; + end; + Mul(x[1], DK[48]); + Inc(x[3], DK[49]); + Inc(x[2], DK[50]); + Mul(x[4], DK[51]); + x[1] := (x[1] shl 8) or (x[1] shr 8); + s2 := (x[3] shl 8) or (x[3] shr 8); + x[3] := (x[2] shl 8) or (x[2] shr 8); + x[4] := (x[4] shl 8) or (x[4] shr 8); + x[2] := s2; + PUInt32(@OutData)^ := PUInt32(@x[1])^; + PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@x[3])^; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncMars.pas b/Source_using_TMonitor/Encryption/ncEncMars.pas new file mode 100644 index 0000000..c5c8c48 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncMars.pas @@ -0,0 +1,947 @@ +{$R-} +{$Q-} +unit ncEncMars; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_mars = class(TncEnc_blockcipher128) + protected + KeyData: array [0 .. 39] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + S_Box: array [0 .. 511] of UInt32 = ($09D0C479, $28C8FFE0, $84AA6C39, $9DAD7287, $7DFF9BE3, $D4268361, $C96DA1D4, $7974CC93, $85D0582E, $2A4B5705, $1CA16A62, $C3BD279D, $0F1F25E5, $5160372F, $C695C1FB, $4D7FF1E4, $AE5F6BF4, $0D72EE46, $FF23DE8A, $B1CF8E83, $F14902E2, $3E981E42, $8BF53EB6, $7F4BF8AC, $83631F83, + $25970205, $76AFE784, $3A7931D4, $4F846450, $5C64C3F6, $210A5F18, $C6986A26, $28F4E826, $3A60A81C, $D340A664, $7EA820C4, $526687C5, $7EDDD12B, $32A11D1D, $9C9EF086, $80F6E831, $AB6F04AD, $56FB9B53, $8B2E095C, $B68556AE, $D2250B0D, $294A7721, $E21FB253, $AE136749, $E82AAE86, $93365104, $99404A66, $78A784DC, + $B69BA84B, $04046793, $23DB5C1E, $46CAE1D6, $2FE28134, $5A223942, $1863CD5B, $C190C6E3, $07DFB846, $6EB88816, $2D0DCC4A, $A4CCAE59, $3798670D, $CBFA9493, $4F481D45, $EAFC8CA8, $DB1129D6, $B0449E20, $0F5407FB, $6167D9A8, $D1F45763, $4DAA96C3, $3BEC5958, $ABABA014, $B6CCD201, $38D6279F, $02682215, $8F376CD5, + $092C237E, $BFC56593, $32889D2C, $854B3E95, $05BB9B43, $7DCD5DCD, $A02E926C, $FAE527E5, $36A1C330, $3412E1AE, $F257F462, $3C4F1D71, $30A2E809, $68E5F551, $9C61BA44, $5DED0AB8, $75CE09C8, $9654F93E, $698C0CCA, $243CB3E4, $2B062B97, $0F3B8D9E, $00E050DF, $FC5D6166, $E35F9288, $C079550D, $0591AEE8, $8E531E74, + $75FE3578, $2F6D829A, $F60B21AE, $95E8EB8D, $6699486B, $901D7D9B, $FD6D6E31, $1090ACEF, $E0670DD8, $DAB2E692, $CD6D4365, $E5393514, $3AF345F0, $6241FC4D, $460DA3A3, $7BCF3729, $8BF1D1E0, $14AAC070, $1587ED55, $3AFD7D3E, $D2F29E01, $29A9D1F6, $EFB10C53, $CF3B870F, $B414935C, $664465ED, $024ACAC7, $59A744C1, + $1D2936A7, $DC580AA6, $CF574CA8, $040A7A10, $6CD81807, $8A98BE4C, $ACCEA063, $C33E92B5, $D1E0E03D, $B322517E, $2092BD13, $386B2C4A, $52E8DD58, $58656DFB, $50820371, $41811896, $E337EF7E, $D39FB119, $C97F0DF6, $68FEA01B, $A150A6E5, $55258962, $EB6FF41B, $D7C9CD7A, $A619CD9E, $BCF09576, $2672C073, $F003FB3C, + $4AB7A50B, $1484126A, $487BA9B1, $A64FC9C6, $F6957D49, $38B06A75, $DD805FCD, $63D094CF, $F51C999E, $1AA4D343, $B8495294, $CE9F8E99, $BFFCD770, $C7C275CC, $378453A7, $7B21BE33, $397F41BD, $4E94D131, $92CC1F98, $5915EA51, $99F861B7, $C9980A88, $1D74FD5F, $B0A495F8, $614DEED0, $B5778EEA, $5941792D, $FA90C1F8, + $33F824B4, $C4965372, $3FF6D550, $4CA5FEC0, $8630E964, $5B3FBBD6, $7DA26A48, $B203231A, $04297514, $2D639306, $2EB13149, $16A45272, $532459A0, $8E5F4872, $F966C7D9, $07128DC0, $0D44DB62, $AFC8D52D, $06316131, $D838E7CE, $1BC41D00, $3A2E8C0F, $EA83837E, $B984737D, $13BA4891, $C4F8B949, $A6D6ACB3, $A215CDCE, + $8359838B, $6BD1AA31, $F579DD52, $21B93F93, $F5176781, $187DFDDE, $E94AEB76, $2B38FD54, $431DE1DA, $AB394825, $9AD3048F, $DFEA32AA, $659473E3, $623F7863, $F3346C59, $AB3AB685, $3346A90B, $6B56443E, $C6DE01F8, $8D421FC0, $9B0ED10C, $88F1A1E9, $54C1F029, $7DEAD57B, $8D7BA426, $4CF5178A, $551A7CCA, $1A9A5F08, + $FCD651B9, $25605182, $E11FC6C3, $B6FD9676, $337B3027, $B7C8EB14, $9E5FD030, $6B57E354, $AD913CF7, $7E16688D, $58872A69, $2C2FC7DF, $E389CCC6, $30738DF1, $0824A734, $E1797A8B, $A4A8D57B, $5B5D193B, $C8A8309B, $73F9A978, $73398D32, $0F59573E, $E9DF2B03, $E8A5B6C8, $848D0704, $98DF93C2, $720A1DC3, $684F259A, + $943BA848, $A6370152, $863B5EA3, $D17B978B, $6D9B58EF, $0A700DD4, $A73D36BF, $8E6A0829, $8695BC14, $E35B3447, $933AC568, $8894B022, $2F511C27, $DDFBCC3C, $006662B6, $117C83FE, $4E12B414, $C2BCA766, $3A2FEC10, $F4562420, $55792E2A, $46F5D857, $CEDA25CE, $C3601D3B, $6C00AB46, $EFAC9C28, $B3C35047, $611DFEE3, + $257C3207, $FDD58482, $3B14D84F, $23BECB64, $A075F3A3, $088F8EAD, $07ADF158, $7796943C, $FACABF3D, $C09730CD, $F7679969, $DA44E9ED, $2C854C12, $35935FA3, $2F057D9F, $690624F8, $1CB0BAFD, $7B0DBDC6, $810F23BB, $FA929A1A, $6D969A17, $6742979B, $74AC7D05, $010E65C4, $86A3D963, $F907B5A0, $D0042BD3, $158D7D03, + $287A8255, $BBA8366F, $096EDC33, $21916A7B, $77B56B86, $951622F9, $A6C5E650, $8CEA17D1, $CD8C62BC, $A3D63433, $358A68FD, $0F9B9D3C, $D6AA295B, $FE33384A, $C000738E, $CD67EB2F, $E2EB6DC2, $97338B02, $06C9F246, $419CF1AD, $2B83C045, $3723F18A, $CB5B3089, $160BEAD7, $5D494656, $35F8A74B, $1E4E6C9E, $000399BD, + $67466880, $B4174831, $ACF423B2, $CA815AB3, $5A6395E7, $302A67C5, $8BDB446B, $108F8FA4, $10223EDA, $92B8B48B, $7F38D0EE, $AB2701D4, $0262D415, $AF224A30, $B3D88ABA, $F8B2C3AF, $DAF7EF70, $CC97D3B7, $E9614B6C, $2BAEBFF4, $70F687CF, $386C9156, $CE092EE5, $01E87DA6, $6CE91E6A, $BB7BCC84, $C7922C20, $9D3B71FD, + $060E41C6, $D7590F15, $4E03BB47, $183C198E, $63EEB240, $2DDBF49A, $6D5CBA54, $923750AF, $F9E14236, $7838162B, $59726C72, $81B66760, $BB2926C1, $48A0CE0D, $A6C0496D, $AD43507B, $718D496A, $9DF057AF, $44B1BDE6, $054356DC, $DE7CED35, $D51A138B, $62088CC9, $35830311, $C96EFCA2, $686F86EC, $8E77CB68, $63E1D6B8, + $C80F9778, $79C491FD, $1B4C67F2, $72698D7D, $5E368C31, $F7D95E2E, $A1D3493F, $DCD9433E, $896F1552, $4BC4CA7A, $A6D1BAF4, $A5A96DCC, $0BEF8B46, $A169FDA7, $74DF40B7, $4E208804, $9A756607, $038E87C8, $20211E44, $8B7AD4BF, $C6403F35, $1848E36D, $80BDB038, $1E62891C, $643D2107, $BF04D6F8, $21092C8C, $F644F389, + $0778404E, $7B78ADB8, $A2C52D53, $42157ABE, $A2253E2E, $7BF3F4AE, $80F594F9, $953194E7, $77EB92ED, $B3816930, $DA8D9336, $BF447469, $F26D9483, $EE6FAED5, $71371235, $DE425F73, $B4E59F43, $7DBE2D4E, $2D37B185, $49DC9A63, $98C39D98, $1301C9A2, $389B1BBF, $0C18588D, $A421C1BA, $7AA3865C, $71E08558, $3C5CFCAA, + $7D239CA4, $0297D9DD, $D7DC2830, $4B37802B, $7428AB54, $AEEE0347, $4B3FBB85, $692F2F08, $134E578E, $36D9E0BF, $AE8B5FCF, $EDB93ECF, $2B27248E, $170EB1EF, $7DC57FD6, $1E760F16, $B1136601, $864E1B9B, $D7EA7319, $3AB871BD, $CFA4D76F, $E31BD782, $0DBEB469, $ABB96061, $5370F85D, $FFB07E37, $DA30D0FB, $EBC977B6, + $0B98B40F, $3A4D0FE6, $DF4FC26B, $159CF22A, $C298D6E2, $2B78EF6A, $61A94AC0, $AB561187, $14EEA0F0, $DF0D4164, $19AF70EE); + + vk: array [0 .. 6] of UInt32 = ($09D0C479, $28C8FFE0, $84AA6C39, $9DAD7287, $7DFF9BE3, $D4268361, $C96DA1D4); + +function LRot32(const X: UInt32; const c: longword): UInt32; inline; +begin + Result := (X shl c) or (X shr (32 - c)); +end; + +function RRot32(const X: UInt32; const c: longword): UInt32; inline; +begin + Result := (X shr c) or (X shl (32 - c)); +end; + +class function TncEnc_mars.GetAlgorithm: string; +begin + Result := 'Mars'; +end; + +class function TncEnc_mars.GetMaxKeySize: Integer; +begin + Result := 1248; +end; + +class function TncEnc_mars.SelfTest: Boolean; +const + Key1: array [0 .. 3] of UInt32 = ($DEB35132, $83C296DE, $39069E6B, $994C2438); + Key2: array [0 .. 5] of UInt32 = ($A5391779, $1A58048B, $A853A993, $1D41102C, $088658D1, $954D8738); + Key3: array [0 .. 7] of UInt32 = ($9867A1FB, $22EF7A3E, $8CE27C31, $A3E1AA02, $3CCCE5E8, $2AA8BEED, $9AC3DB99, $27725ED6); + Plain1: array [0 .. 3] of UInt32 = ($DEB35132, $83C296DE, $39069E6B, $994C2438); + Plain2: array [0 .. 3] of UInt32 = ($2DC46167, $D242613E, $ADBF4FA8, $8F1583B3); + Plain3: array [0 .. 3] of UInt32 = ($A4AB4413, $0847C4D3, $1621A7A8, $8493F4D4); + Cipher1: array [0 .. 3] of UInt32 = ($A91245F9, $4E032DB4, $042279C4, $9BA608D7); + Cipher2: array [0 .. 3] of UInt32 = ($260334CB, $6D587F45, $E0D2BD54, $BD191C57); + Cipher3: array [0 .. 3] of UInt32 = ($67A1ACDD, $BE3163E3, $5F9F1C2C, $B8A48FE3); +var + Cipher: TncEnc_mars; + Block: array [0 .. 3] of UInt32; +begin + Cipher := TncEnc_mars.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(Plain1, Block); + Result := CompareMem(@Cipher1, @Block, Sizeof(Block)); + Cipher.DecryptECB(Block, Block); + Result := Result and CompareMem(@Plain1, @Block, Sizeof(Block)); + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(Plain2, Block); + Result := Result and CompareMem(@Cipher2, @Block, Sizeof(Block)); + Cipher.DecryptECB(Block, Block); + Result := Result and CompareMem(@Plain2, @Block, Sizeof(Block)); + Cipher.Burn; + Cipher.Init(Key3, Sizeof(Key3) * 8, nil); + Cipher.EncryptECB(Plain3, Block); + Result := Result and CompareMem(@Cipher3, @Block, Sizeof(Block)); + Cipher.DecryptECB(Block, Block); + Result := Result and CompareMem(@Plain3, @Block, Sizeof(Block)); + Cipher.Burn; + Cipher.Free; +end; + +procedure gen_mask(var X, m: UInt32); +var + u: UInt32; +begin + u := X and (X shr 1); + u := u and (u shr 2); + u := u and (u shr 4); + u := u and (u shr 1) and (u shr 2); + m := u; + u := (X xor $FFFFFFFF) and ((X xor $FFFFFFFF) shr 1); + u := u and (u shr 2); + u := u and (u shr 4); + u := u and (u shr 1) and (u shr 2); + u := u or m; + m := (u shl 1) or (u shl 2) or (u shl 3) or (u shl 4) or (u shl 5) or (u shl 6) or (u shl 7) or (u shl 8); + m := (m or u or (u shl 9)) and ((X xor $FFFFFFFF) xor (X shl 1)) and ((X xor $FFFFFFFF) xor (X shr 1)); + m := m and $FFFFFFFC; +end; + +procedure TncEnc_mars.InitKey(const Key; Size: longword); +var + i, j, m, u, w: UInt32; + t: array [-7 .. 39] of UInt32; + KeyB: array [0 .. 39] of UInt32; +begin + Size := Size div 8; + FillChar(KeyB, Sizeof(KeyB), 0); + Move(Key, KeyB, Size); + Size := Size div 4; + Move(vk, t, Sizeof(vk)); + for i := 0 to 38 do + begin + u := t[i - 7] xor t[i - 2]; + t[i] := LRot32(u, 3) xor KeyB[i mod Size] xor i; + end; + t[39] := Size; + for j := 0 to 6 do + begin + for i := 1 to 39 do + begin + u := t[i] + S_Box[t[i - 1] and $1FF]; + t[i] := LRot32(u, 9); + end; + u := t[0] + S_Box[t[39] and $1FF]; + t[0] := LRot32(u, 9); + end; + for i := 0 to 39 do + KeyData[(7 * i) mod 40] := t[i]; + i := 5; + repeat + u := S_Box[265 + (KeyData[i] and $3)]; + j := KeyData[i + 3] and $1F; + w := KeyData[i] or $3; + gen_mask(w, m); + KeyData[i] := w xor (LRot32(u, j) and m); + Inc(i, 2); + until i >= 37; +end; + +procedure TncEnc_mars.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), $FF); + inherited Burn; +end; + +procedure TncEnc_mars.EncryptECB(const InData; var OutData); +var + l, m, r, t: UInt32; + blk: array [0 .. 3] of UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + blk[0] := PUInt32(@InData)^; + blk[1] := PUInt32(NativeUInt(@InData) + 4)^; + blk[2] := PUInt32(NativeUInt(@InData) + 8)^; + blk[3] := PUInt32(NativeUInt(@InData) + 12)^; + + blk[0] := blk[0] + KeyData[0]; + blk[1] := blk[1] + KeyData[1]; + blk[2] := blk[2] + KeyData[2]; + blk[3] := blk[3] + KeyData[3]; + blk[1] := blk[1] xor S_Box[blk[0] and $FF]; + blk[1] := blk[1] + S_Box[((blk[0] shr 8) and $FF) + 256]; + blk[2] := blk[2] + S_Box[(blk[0] shr 16) and $FF]; + blk[3] := blk[3] xor S_Box[((blk[0] shr 24) and $FF) + 256]; + blk[0] := RRot32(blk[0], 24); + blk[0] := blk[0] + blk[3]; + blk[2] := blk[2] xor S_Box[blk[1] and $FF]; + blk[2] := blk[2] + S_Box[((blk[1] shr 8) and $FF) + 256]; + blk[3] := blk[3] + S_Box[(blk[1] shr 16) and $FF]; + blk[0] := blk[0] xor S_Box[((blk[1] shr 24) and $FF) + 256]; + blk[1] := RRot32(blk[1], 24); + blk[1] := blk[1] + blk[2]; + blk[3] := blk[3] xor S_Box[blk[2] and $FF]; + blk[3] := blk[3] + S_Box[((blk[2] shr 8) and $FF) + 256]; + blk[0] := blk[0] + S_Box[(blk[2] shr 16) and $FF]; + blk[1] := blk[1] xor S_Box[((blk[2] shr 24) and $FF) + 256]; + blk[2] := RRot32(blk[2], 24); + blk[0] := blk[0] xor S_Box[blk[3] and $FF]; + blk[0] := blk[0] + S_Box[((blk[3] shr 8) and $FF) + 256]; + blk[1] := blk[1] + S_Box[(blk[3] shr 16) and $FF]; + blk[2] := blk[2] xor S_Box[((blk[3] shr 24) and $FF) + 256]; + blk[3] := RRot32(blk[3], 24); + blk[1] := blk[1] xor S_Box[blk[0] and $FF]; + blk[1] := blk[1] + S_Box[((blk[0] shr 8) and $FF) + 256]; + blk[2] := blk[2] + S_Box[(blk[0] shr 16) and $FF]; + blk[3] := blk[3] xor S_Box[((blk[0] shr 24) and $FF) + 256]; + blk[0] := RRot32(blk[0], 24); + blk[0] := blk[0] + blk[3]; + blk[2] := blk[2] xor S_Box[blk[1] and $FF]; + blk[2] := blk[2] + S_Box[((blk[1] shr 8) and $FF) + 256]; + blk[3] := blk[3] + S_Box[(blk[1] shr 16) and $FF]; + blk[0] := blk[0] xor S_Box[((blk[1] shr 24) and $FF) + 256]; + blk[1] := RRot32(blk[1], 24); + blk[1] := blk[1] + blk[2]; + blk[3] := blk[3] xor S_Box[blk[2] and $FF]; + blk[3] := blk[3] + S_Box[((blk[2] shr 8) and $FF) + 256]; + blk[0] := blk[0] + S_Box[(blk[2] shr 16) and $FF]; + blk[1] := blk[1] xor S_Box[((blk[2] shr 24) and $FF) + 256]; + blk[2] := RRot32(blk[2], 24); + blk[0] := blk[0] xor S_Box[blk[3] and $FF]; + blk[0] := blk[0] + S_Box[((blk[3] shr 8) and $FF) + 256]; + blk[1] := blk[1] + S_Box[(blk[3] shr 16) and $FF]; + blk[2] := blk[2] xor S_Box[((blk[3] shr 24) and $FF) + 256]; + blk[3] := RRot32(blk[3], 24); + m := blk[0] + KeyData[4]; + r := LRot32(blk[0], 13) * KeyData[5]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := LRot32(blk[0], 13); + blk[1] := blk[1] + l; + blk[2] := blk[2] + m; + blk[3] := blk[3] xor r; + m := blk[1] + KeyData[6]; + r := LRot32(blk[1], 13) * KeyData[7]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := LRot32(blk[1], 13); + blk[2] := blk[2] + l; + blk[3] := blk[3] + m; + blk[0] := blk[0] xor r; + m := blk[2] + KeyData[8]; + r := LRot32(blk[2], 13) * KeyData[9]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := LRot32(blk[2], 13); + blk[3] := blk[3] + l; + blk[0] := blk[0] + m; + blk[1] := blk[1] xor r; + m := blk[3] + KeyData[10]; + r := LRot32(blk[3], 13) * KeyData[11]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := LRot32(blk[3], 13); + blk[0] := blk[0] + l; + blk[1] := blk[1] + m; + blk[2] := blk[2] xor r; + m := blk[0] + KeyData[12]; + r := LRot32(blk[0], 13) * KeyData[13]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := LRot32(blk[0], 13); + blk[1] := blk[1] + l; + blk[2] := blk[2] + m; + blk[3] := blk[3] xor r; + m := blk[1] + KeyData[14]; + r := LRot32(blk[1], 13) * KeyData[15]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := LRot32(blk[1], 13); + blk[2] := blk[2] + l; + blk[3] := blk[3] + m; + blk[0] := blk[0] xor r; + m := blk[2] + KeyData[16]; + r := LRot32(blk[2], 13) * KeyData[17]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := LRot32(blk[2], 13); + blk[3] := blk[3] + l; + blk[0] := blk[0] + m; + blk[1] := blk[1] xor r; + m := blk[3] + KeyData[18]; + r := LRot32(blk[3], 13) * KeyData[19]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := LRot32(blk[3], 13); + blk[0] := blk[0] + l; + blk[1] := blk[1] + m; + blk[2] := blk[2] xor r; + m := blk[0] + KeyData[20]; + r := LRot32(blk[0], 13) * KeyData[21]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := LRot32(blk[0], 13); + blk[3] := blk[3] + l; + blk[2] := blk[2] + m; + blk[1] := blk[1] xor r; + m := blk[1] + KeyData[22]; + r := LRot32(blk[1], 13) * KeyData[23]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := LRot32(blk[1], 13); + blk[0] := blk[0] + l; + blk[3] := blk[3] + m; + blk[2] := blk[2] xor r; + m := blk[2] + KeyData[24]; + r := LRot32(blk[2], 13) * KeyData[25]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := LRot32(blk[2], 13); + blk[1] := blk[1] + l; + blk[0] := blk[0] + m; + blk[3] := blk[3] xor r; + m := blk[3] + KeyData[26]; + r := LRot32(blk[3], 13) * KeyData[27]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := LRot32(blk[3], 13); + blk[2] := blk[2] + l; + blk[1] := blk[1] + m; + blk[0] := blk[0] xor r; + m := blk[0] + KeyData[28]; + r := LRot32(blk[0], 13) * KeyData[29]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := LRot32(blk[0], 13); + blk[3] := blk[3] + l; + blk[2] := blk[2] + m; + blk[1] := blk[1] xor r; + m := blk[1] + KeyData[30]; + r := LRot32(blk[1], 13) * KeyData[31]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := LRot32(blk[1], 13); + blk[0] := blk[0] + l; + blk[3] := blk[3] + m; + blk[2] := blk[2] xor r; + m := blk[2] + KeyData[32]; + r := LRot32(blk[2], 13) * KeyData[33]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := LRot32(blk[2], 13); + blk[1] := blk[1] + l; + blk[0] := blk[0] + m; + blk[3] := blk[3] xor r; + m := blk[3] + KeyData[34]; + r := LRot32(blk[3], 13) * KeyData[35]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := LRot32(blk[3], 13); + blk[2] := blk[2] + l; + blk[1] := blk[1] + m; + blk[0] := blk[0] xor r; + blk[1] := blk[1] xor S_Box[(blk[0] and $FF) + 256]; + blk[2] := blk[2] - S_Box[(blk[0] shr 24) and $FF]; + blk[3] := blk[3] - S_Box[((blk[0] shr 16) and $FF) + 256]; + blk[3] := blk[3] xor S_Box[(blk[0] shr 8) and $FF]; + blk[0] := LRot32(blk[0], 24); + blk[2] := blk[2] xor S_Box[(blk[1] and $FF) + 256]; + blk[3] := blk[3] - S_Box[(blk[1] shr 24) and $FF]; + blk[0] := blk[0] - S_Box[((blk[1] shr 16) and $FF) + 256]; + blk[0] := blk[0] xor S_Box[(blk[1] shr 8) and $FF]; + blk[1] := LRot32(blk[1], 24); + blk[2] := blk[2] - blk[1]; + blk[3] := blk[3] xor S_Box[(blk[2] and $FF) + 256]; + blk[0] := blk[0] - S_Box[(blk[2] shr 24) and $FF]; + blk[1] := blk[1] - S_Box[((blk[2] shr 16) and $FF) + 256]; + blk[1] := blk[1] xor S_Box[(blk[2] shr 8) and $FF]; + blk[2] := LRot32(blk[2], 24); + blk[3] := blk[3] - blk[0]; + blk[0] := blk[0] xor S_Box[(blk[3] and $FF) + 256]; + blk[1] := blk[1] - S_Box[(blk[3] shr 24) and $FF]; + blk[2] := blk[2] - S_Box[((blk[3] shr 16) and $FF) + 256]; + blk[2] := blk[2] xor S_Box[(blk[3] shr 8) and $FF]; + blk[3] := LRot32(blk[3], 24); + blk[1] := blk[1] xor S_Box[(blk[0] and $FF) + 256]; + blk[2] := blk[2] - S_Box[(blk[0] shr 24) and $FF]; + blk[3] := blk[3] - S_Box[((blk[0] shr 16) and $FF) + 256]; + blk[3] := blk[3] xor S_Box[(blk[0] shr 8) and $FF]; + blk[0] := LRot32(blk[0], 24); + blk[2] := blk[2] xor S_Box[(blk[1] and $FF) + 256]; + blk[3] := blk[3] - S_Box[(blk[1] shr 24) and $FF]; + blk[0] := blk[0] - S_Box[((blk[1] shr 16) and $FF) + 256]; + blk[0] := blk[0] xor S_Box[(blk[1] shr 8) and $FF]; + blk[1] := LRot32(blk[1], 24); + blk[2] := blk[2] - blk[1]; + blk[3] := blk[3] xor S_Box[(blk[2] and $FF) + 256]; + blk[0] := blk[0] - S_Box[(blk[2] shr 24) and $FF]; + blk[1] := blk[1] - S_Box[((blk[2] shr 16) and $FF) + 256]; + blk[1] := blk[1] xor S_Box[(blk[2] shr 8) and $FF]; + blk[2] := LRot32(blk[2], 24); + blk[3] := blk[3] - blk[0]; + blk[0] := blk[0] xor S_Box[(blk[3] and $FF) + 256]; + blk[1] := blk[1] - S_Box[(blk[3] shr 24) and $FF]; + blk[2] := blk[2] - S_Box[((blk[3] shr 16) and $FF) + 256]; + blk[2] := blk[2] xor S_Box[(blk[3] shr 8) and $FF]; + blk[3] := LRot32(blk[3], 24); + blk[0] := blk[0] - KeyData[36]; + blk[1] := blk[1] - KeyData[37]; + blk[2] := blk[2] - KeyData[38]; + blk[3] := blk[3] - KeyData[39]; + + PUInt32(@OutData)^ := blk[0]; + PUInt32(NativeUInt(@OutData) + 4)^ := blk[1]; + PUInt32(NativeUInt(@OutData) + 8)^ := blk[2]; + PUInt32(NativeUInt(@OutData) + 12)^ := blk[3]; +end; + +procedure TncEnc_mars.DecryptECB(const InData; var OutData); +var + l, m, r, t: UInt32; + blk: array [0 .. 3] of UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + blk[0] := PUInt32(@InData)^; + blk[1] := PUInt32(NativeUInt(@InData) + 4)^; + blk[2] := PUInt32(NativeUInt(@InData) + 8)^; + blk[3] := PUInt32(NativeUInt(@InData) + 12)^; + + blk[0] := blk[0] + KeyData[36]; + blk[1] := blk[1] + KeyData[37]; + blk[2] := blk[2] + KeyData[38]; + blk[3] := blk[3] + KeyData[39]; + blk[3] := RRot32(blk[3], 24); + blk[2] := blk[2] xor S_Box[(blk[3] shr 8) and $FF]; + blk[2] := blk[2] + S_Box[((blk[3] shr 16) and $FF) + 256]; + blk[1] := blk[1] + S_Box[(blk[3] shr 24) and $FF]; + blk[0] := blk[0] xor S_Box[(blk[3] and $FF) + 256]; + blk[3] := blk[3] + blk[0]; + blk[2] := RRot32(blk[2], 24); + blk[1] := blk[1] xor S_Box[(blk[2] shr 8) and $FF]; + blk[1] := blk[1] + S_Box[((blk[2] shr 16) and $FF) + 256]; + blk[0] := blk[0] + S_Box[(blk[2] shr 24) and $FF]; + blk[3] := blk[3] xor S_Box[(blk[2] and $FF) + 256]; + blk[2] := blk[2] + blk[1]; + blk[1] := RRot32(blk[1], 24); + blk[0] := blk[0] xor S_Box[(blk[1] shr 8) and $FF]; + blk[0] := blk[0] + S_Box[((blk[1] shr 16) and $FF) + 256]; + blk[3] := blk[3] + S_Box[(blk[1] shr 24) and $FF]; + blk[2] := blk[2] xor S_Box[(blk[1] and $FF) + 256]; + blk[0] := RRot32(blk[0], 24); + blk[3] := blk[3] xor S_Box[(blk[0] shr 8) and $FF]; + blk[3] := blk[3] + S_Box[((blk[0] shr 16) and $FF) + 256]; + blk[2] := blk[2] + S_Box[(blk[0] shr 24) and $FF]; + blk[1] := blk[1] xor S_Box[(blk[0] and $FF) + 256]; + blk[3] := RRot32(blk[3], 24); + blk[2] := blk[2] xor S_Box[(blk[3] shr 8) and $FF]; + blk[2] := blk[2] + S_Box[((blk[3] shr 16) and $FF) + 256]; + blk[1] := blk[1] + S_Box[(blk[3] shr 24) and $FF]; + blk[0] := blk[0] xor S_Box[(blk[3] and $FF) + 256]; + blk[3] := blk[3] + blk[0]; + blk[2] := RRot32(blk[2], 24); + blk[1] := blk[1] xor S_Box[(blk[2] shr 8) and $FF]; + blk[1] := blk[1] + S_Box[((blk[2] shr 16) and $FF) + 256]; + blk[0] := blk[0] + S_Box[(blk[2] shr 24) and $FF]; + blk[3] := blk[3] xor S_Box[(blk[2] and $FF) + 256]; + blk[2] := blk[2] + blk[1]; + blk[1] := RRot32(blk[1], 24); + blk[0] := blk[0] xor S_Box[(blk[1] shr 8) and $FF]; + blk[0] := blk[0] + S_Box[((blk[1] shr 16) and $FF) + 256]; + blk[3] := blk[3] + S_Box[(blk[1] shr 24) and $FF]; + blk[2] := blk[2] xor S_Box[(blk[1] and $FF) + 256]; + blk[0] := RRot32(blk[0], 24); + blk[3] := blk[3] xor S_Box[(blk[0] shr 8) and $FF]; + blk[3] := blk[3] + S_Box[((blk[0] shr 16) and $FF) + 256]; + blk[2] := blk[2] + S_Box[(blk[0] shr 24) and $FF]; + blk[1] := blk[1] xor S_Box[(blk[0] and $FF) + 256]; + blk[3] := RRot32(blk[3], 13); + m := blk[3] + KeyData[34]; + r := LRot32(blk[3], 13) * KeyData[35]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := blk[2] - l; + blk[1] := blk[1] - m; + blk[0] := blk[0] xor r; + blk[2] := RRot32(blk[2], 13); + m := blk[2] + KeyData[32]; + r := LRot32(blk[2], 13) * KeyData[33]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := blk[1] - l; + blk[0] := blk[0] - m; + blk[3] := blk[3] xor r; + blk[1] := RRot32(blk[1], 13); + m := blk[1] + KeyData[30]; + r := LRot32(blk[1], 13) * KeyData[31]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := blk[0] - l; + blk[3] := blk[3] - m; + blk[2] := blk[2] xor r; + blk[0] := RRot32(blk[0], 13); + m := blk[0] + KeyData[28]; + r := LRot32(blk[0], 13) * KeyData[29]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := blk[3] - l; + blk[2] := blk[2] - m; + blk[1] := blk[1] xor r; + blk[3] := RRot32(blk[3], 13); + m := blk[3] + KeyData[26]; + r := LRot32(blk[3], 13) * KeyData[27]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := blk[2] - l; + blk[1] := blk[1] - m; + blk[0] := blk[0] xor r; + blk[2] := RRot32(blk[2], 13); + m := blk[2] + KeyData[24]; + r := LRot32(blk[2], 13) * KeyData[25]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := blk[1] - l; + blk[0] := blk[0] - m; + blk[3] := blk[3] xor r; + blk[1] := RRot32(blk[1], 13); + m := blk[1] + KeyData[22]; + r := LRot32(blk[1], 13) * KeyData[23]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := blk[0] - l; + blk[3] := blk[3] - m; + blk[2] := blk[2] xor r; + blk[0] := RRot32(blk[0], 13); + m := blk[0] + KeyData[20]; + r := LRot32(blk[0], 13) * KeyData[21]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := blk[3] - l; + blk[2] := blk[2] - m; + blk[1] := blk[1] xor r; + blk[3] := RRot32(blk[3], 13); + m := blk[3] + KeyData[18]; + r := LRot32(blk[3], 13) * KeyData[19]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := blk[0] - l; + blk[1] := blk[1] - m; + blk[2] := blk[2] xor r; + blk[2] := RRot32(blk[2], 13); + m := blk[2] + KeyData[16]; + r := LRot32(blk[2], 13) * KeyData[17]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := blk[3] - l; + blk[0] := blk[0] - m; + blk[1] := blk[1] xor r; + blk[1] := RRot32(blk[1], 13); + m := blk[1] + KeyData[14]; + r := LRot32(blk[1], 13) * KeyData[15]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := blk[2] - l; + blk[3] := blk[3] - m; + blk[0] := blk[0] xor r; + blk[0] := RRot32(blk[0], 13); + m := blk[0] + KeyData[12]; + r := LRot32(blk[0], 13) * KeyData[13]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := blk[1] - l; + blk[2] := blk[2] - m; + blk[3] := blk[3] xor r; + blk[3] := RRot32(blk[3], 13); + m := blk[3] + KeyData[10]; + r := LRot32(blk[3], 13) * KeyData[11]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[0] := blk[0] - l; + blk[1] := blk[1] - m; + blk[2] := blk[2] xor r; + blk[2] := RRot32(blk[2], 13); + m := blk[2] + KeyData[8]; + r := LRot32(blk[2], 13) * KeyData[9]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[3] := blk[3] - l; + blk[0] := blk[0] - m; + blk[1] := blk[1] xor r; + blk[1] := RRot32(blk[1], 13); + m := blk[1] + KeyData[6]; + r := LRot32(blk[1], 13) * KeyData[7]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[2] := blk[2] - l; + blk[3] := blk[3] - m; + blk[0] := blk[0] xor r; + blk[0] := RRot32(blk[0], 13); + m := blk[0] + KeyData[4]; + r := LRot32(blk[0], 13) * KeyData[5]; + l := S_Box[m and $1FF]; + r := LRot32(r, 5); + t := r and $1F; + m := LRot32(m, t); + l := l xor r; + r := LRot32(r, 5); + l := l xor r; + t := r and $1F; + l := LRot32(l, t); + blk[1] := blk[1] - l; + blk[2] := blk[2] - m; + blk[3] := blk[3] xor r; + blk[3] := LRot32(blk[3], 24); + blk[2] := blk[2] xor S_Box[((blk[3] shr 24) and $FF) + 256]; + blk[1] := blk[1] - S_Box[(blk[3] shr 16) and $FF]; + blk[0] := blk[0] - S_Box[((blk[3] shr 8) and $FF) + 256]; + blk[0] := blk[0] xor S_Box[blk[3] and $FF]; + blk[2] := LRot32(blk[2], 24); + blk[1] := blk[1] xor S_Box[((blk[2] shr 24) and $FF) + 256]; + blk[0] := blk[0] - S_Box[(blk[2] shr 16) and $FF]; + blk[3] := blk[3] - S_Box[((blk[2] shr 8) and $FF) + 256]; + blk[3] := blk[3] xor S_Box[blk[2] and $FF]; + blk[1] := blk[1] - blk[2]; + blk[1] := LRot32(blk[1], 24); + blk[0] := blk[0] xor S_Box[((blk[1] shr 24) and $FF) + 256]; + blk[3] := blk[3] - S_Box[(blk[1] shr 16) and $FF]; + blk[2] := blk[2] - S_Box[((blk[1] shr 8) and $FF) + 256]; + blk[2] := blk[2] xor S_Box[blk[1] and $FF]; + blk[0] := blk[0] - blk[3]; + blk[0] := LRot32(blk[0], 24); + blk[3] := blk[3] xor S_Box[((blk[0] shr 24) and $FF) + 256]; + blk[2] := blk[2] - S_Box[(blk[0] shr 16) and $FF]; + blk[1] := blk[1] - S_Box[((blk[0] shr 8) and $FF) + 256]; + blk[1] := blk[1] xor S_Box[blk[0] and $FF]; + blk[3] := LRot32(blk[3], 24); + blk[2] := blk[2] xor S_Box[((blk[3] shr 24) and $FF) + 256]; + blk[1] := blk[1] - S_Box[(blk[3] shr 16) and $FF]; + blk[0] := blk[0] - S_Box[((blk[3] shr 8) and $FF) + 256]; + blk[0] := blk[0] xor S_Box[blk[3] and $FF]; + blk[2] := LRot32(blk[2], 24); + blk[1] := blk[1] xor S_Box[((blk[2] shr 24) and $FF) + 256]; + blk[0] := blk[0] - S_Box[(blk[2] shr 16) and $FF]; + blk[3] := blk[3] - S_Box[((blk[2] shr 8) and $FF) + 256]; + blk[3] := blk[3] xor S_Box[blk[2] and $FF]; + blk[1] := blk[1] - blk[2]; + blk[1] := LRot32(blk[1], 24); + blk[0] := blk[0] xor S_Box[((blk[1] shr 24) and $FF) + 256]; + blk[3] := blk[3] - S_Box[(blk[1] shr 16) and $FF]; + blk[2] := blk[2] - S_Box[((blk[1] shr 8) and $FF) + 256]; + blk[2] := blk[2] xor S_Box[blk[1] and $FF]; + blk[0] := blk[0] - blk[3]; + blk[0] := LRot32(blk[0], 24); + blk[3] := blk[3] xor S_Box[((blk[0] shr 24) and $FF) + 256]; + blk[2] := blk[2] - S_Box[(blk[0] shr 16) and $FF]; + blk[1] := blk[1] - S_Box[((blk[0] shr 8) and $FF) + 256]; + blk[1] := blk[1] xor S_Box[blk[0] and $FF]; + blk[0] := blk[0] - KeyData[0]; + blk[1] := blk[1] - KeyData[1]; + blk[2] := blk[2] - KeyData[2]; + blk[3] := blk[3] - KeyData[3]; + + PUInt32(@OutData)^ := blk[0]; + PUInt32(NativeUInt(@OutData) + 4)^ := blk[1]; + PUInt32(NativeUInt(@OutData) + 8)^ := blk[2]; + PUInt32(NativeUInt(@OutData) + 12)^ := blk[3]; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncMd4.pas b/Source_using_TMonitor/Encryption/ncEncMd4.pas new file mode 100644 index 0000000..db5fae2 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncMd4.pas @@ -0,0 +1,267 @@ +{$R-} +{$Q-} +unit ncEncMd4; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_md4 = class(TncEncHash) + protected + LenHi, LenLo: UInt32; + Index: UInt32; + CurrentHash: array [0 .. 3] of UInt32; + HashBuffer: array [0 .. 63] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const Buffer; Size: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +function LRot32(const AVal: UInt32; AShift: Byte): UInt32; inline; +begin + Result := (AVal shl AShift) or (AVal shr (32 - AShift)); +end; + +procedure TncEnc_md4.Compress; +var + Data: array [0 .. 15] of UInt32; + a, b, C, D: UInt32; +begin + Move(HashBuffer, Data, Sizeof(Data)); + a := CurrentHash[0]; + b := CurrentHash[1]; + C := CurrentHash[2]; + D := CurrentHash[3]; + + a := LRot32(a + (D xor (b and (C xor D))) + Data[0], 3); + D := LRot32(D + (C xor (a and (b xor C))) + Data[1], 7); + C := LRot32(C + (b xor (D and (a xor b))) + Data[2], 11); + b := LRot32(b + (a xor (C and (D xor a))) + Data[3], 19); + a := LRot32(a + (D xor (b and (C xor D))) + Data[4], 3); + D := LRot32(D + (C xor (a and (b xor C))) + Data[5], 7); + C := LRot32(C + (b xor (D and (a xor b))) + Data[6], 11); + b := LRot32(b + (a xor (C and (D xor a))) + Data[7], 19); + a := LRot32(a + (D xor (b and (C xor D))) + Data[8], 3); + D := LRot32(D + (C xor (a and (b xor C))) + Data[9], 7); + C := LRot32(C + (b xor (D and (a xor b))) + Data[10], 11); + b := LRot32(b + (a xor (C and (D xor a))) + Data[11], 19); + a := LRot32(a + (D xor (b and (C xor D))) + Data[12], 3); + D := LRot32(D + (C xor (a and (b xor C))) + Data[13], 7); + C := LRot32(C + (b xor (D and (a xor b))) + Data[14], 11); + b := LRot32(b + (a xor (C and (D xor a))) + Data[15], 19); + + a := LRot32(a + ((b and C) or (b and D) or (C and D)) + Data[0] + $5A827999, 3); + D := LRot32(D + ((a and b) or (a and C) or (b and C)) + Data[4] + $5A827999, 5); + C := LRot32(C + ((D and a) or (D and b) or (a and b)) + Data[8] + $5A827999, 9); + b := LRot32(b + ((C and D) or (C and a) or (D and a)) + Data[12] + $5A827999, 13); + a := LRot32(a + ((b and C) or (b and D) or (C and D)) + Data[1] + $5A827999, 3); + D := LRot32(D + ((a and b) or (a and C) or (b and C)) + Data[5] + $5A827999, 5); + C := LRot32(C + ((D and a) or (D and b) or (a and b)) + Data[9] + $5A827999, 9); + b := LRot32(b + ((C and D) or (C and a) or (D and a)) + Data[13] + $5A827999, 13); + a := LRot32(a + ((b and C) or (b and D) or (C and D)) + Data[2] + $5A827999, 3); + D := LRot32(D + ((a and b) or (a and C) or (b and C)) + Data[6] + $5A827999, 5); + C := LRot32(C + ((D and a) or (D and b) or (a and b)) + Data[10] + $5A827999, 9); + b := LRot32(b + ((C and D) or (C and a) or (D and a)) + Data[14] + $5A827999, 13); + a := LRot32(a + ((b and C) or (b and D) or (C and D)) + Data[3] + $5A827999, 3); + D := LRot32(D + ((a and b) or (a and C) or (b and C)) + Data[7] + $5A827999, 5); + C := LRot32(C + ((D and a) or (D and b) or (a and b)) + Data[11] + $5A827999, 9); + b := LRot32(b + ((C and D) or (C and a) or (D and a)) + Data[15] + $5A827999, 13); + + a := LRot32(a + (b xor C xor D) + Data[0] + $6ED9EBA1, 3); + D := LRot32(D + (a xor b xor C) + Data[8] + $6ED9EBA1, 9); + C := LRot32(C + (D xor a xor b) + Data[4] + $6ED9EBA1, 11); + b := LRot32(b + (C xor D xor a) + Data[12] + $6ED9EBA1, 15); + a := LRot32(a + (b xor C xor D) + Data[2] + $6ED9EBA1, 3); + D := LRot32(D + (a xor b xor C) + Data[10] + $6ED9EBA1, 9); + C := LRot32(C + (D xor a xor b) + Data[6] + $6ED9EBA1, 11); + b := LRot32(b + (C xor D xor a) + Data[14] + $6ED9EBA1, 15); + a := LRot32(a + (b xor C xor D) + Data[1] + $6ED9EBA1, 3); + D := LRot32(D + (a xor b xor C) + Data[9] + $6ED9EBA1, 9); + C := LRot32(C + (D xor a xor b) + Data[5] + $6ED9EBA1, 11); + b := LRot32(b + (C xor D xor a) + Data[13] + $6ED9EBA1, 15); + a := LRot32(a + (b xor C xor D) + Data[3] + $6ED9EBA1, 3); + D := LRot32(D + (a xor b xor C) + Data[11] + $6ED9EBA1, 9); + C := LRot32(C + (D xor a xor b) + Data[7] + $6ED9EBA1, 11); + b := LRot32(b + (C xor D xor a) + Data[15] + $6ED9EBA1, 15); + + Inc(CurrentHash[0], a); + Inc(CurrentHash[1], b); + Inc(CurrentHash[2], C); + Inc(CurrentHash[3], D); + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_md4.GetHashSize: Integer; +begin + Result := 128; +end; + +class function TncEnc_md4.GetAlgorithm: string; +begin + Result := 'MD4'; +end; + +class function TncEnc_md4.SelfTest: Boolean; +const + Test1Out: array [0 .. 15] of Byte = ($A4, $48, $01, $7A, $AF, $21, $D8, $52, $5F, $C1, $0A, $E8, $7A, $A6, $72, $9D); + Test2Out: array [0 .. 15] of Byte = ($D7, $9E, $1C, $30, $8A, $A5, $BB, $CD, $EE, $A8, $ED, $63, $DF, $41, $2D, $A9); +var + TestHash: TncEnc_md4; + TestOut: array [0 .. 19] of Byte; +begin + TestHash := TncEnc_md4.Create(nil); + TestHash.Init; + TestHash.UpdateStr('abc'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Init; + TestHash.UpdateStr('abcdefghijklmnopqrstuvwxyz'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out)) and Result; + TestHash.Free; +end; + +procedure TncEnc_md4.Init; +begin + Burn; + CurrentHash[0] := $67452301; + CurrentHash[1] := $EFCDAB89; + CurrentHash[2] := $98BADCFE; + CurrentHash[3] := $10325476; + FInitialized := true; +end; + +procedure TncEnc_md4.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_md4.Update(const Buffer; Size: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenHi, Size shr 29); + Inc(LenLo, Size * 8); + if LenLo < (Size * 8) then + Inc(LenHi); + + PBuf := @Buffer; + while Size > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= Size then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(Size, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], Size); + Inc(Index, Size); + Size := 0; + end; + end; +end; + +procedure TncEnc_md4.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 56 then + Compress; + PUInt32(@HashBuffer[56])^ := LenLo; + PUInt32(@HashBuffer[60])^ := LenHi; + Compress; + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncMd5.pas b/Source_using_TMonitor/Encryption/ncEncMd5.pas new file mode 100644 index 0000000..548a617 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncMd5.pas @@ -0,0 +1,284 @@ +{$R-} +{$Q-} +unit ncEncMd5; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_md5 = class(TncEncHash) + protected + LenHi, LenLo: UInt32; + Index: UInt32; + CurrentHash: array [0 .. 3] of UInt32; + HashBuffer: array [0 .. 63] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const Buffer; Size: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +function LRot32(const AVal: UInt32; AShift: Byte): UInt32; inline; +begin + Result := (AVal shl AShift) or (AVal shr (32 - AShift)); +end; + +procedure TncEnc_md5.Compress; +var + Data: array [0 .. 15] of UInt32; + A, B, C, D: UInt32; +begin + Move(HashBuffer, Data, Sizeof(Data)); + A := CurrentHash[0]; + B := CurrentHash[1]; + C := CurrentHash[2]; + D := CurrentHash[3]; + + A := B + LRot32(A + (D xor (B and (C xor D))) + Data[0] + $D76AA478, 7); + D := A + LRot32(D + (C xor (A and (B xor C))) + Data[1] + $E8C7B756, 12); + C := D + LRot32(C + (B xor (D and (A xor B))) + Data[2] + $242070DB, 17); + B := C + LRot32(B + (A xor (C and (D xor A))) + Data[3] + $C1BDCEEE, 22); + A := B + LRot32(A + (D xor (B and (C xor D))) + Data[4] + $F57C0FAF, 7); + D := A + LRot32(D + (C xor (A and (B xor C))) + Data[5] + $4787C62A, 12); + C := D + LRot32(C + (B xor (D and (A xor B))) + Data[6] + $A8304613, 17); + B := C + LRot32(B + (A xor (C and (D xor A))) + Data[7] + $FD469501, 22); + A := B + LRot32(A + (D xor (B and (C xor D))) + Data[8] + $698098D8, 7); + D := A + LRot32(D + (C xor (A and (B xor C))) + Data[9] + $8B44F7AF, 12); + C := D + LRot32(C + (B xor (D and (A xor B))) + Data[10] + $FFFF5BB1, 17); + B := C + LRot32(B + (A xor (C and (D xor A))) + Data[11] + $895CD7BE, 22); + A := B + LRot32(A + (D xor (B and (C xor D))) + Data[12] + $6B901122, 7); + D := A + LRot32(D + (C xor (A and (B xor C))) + Data[13] + $FD987193, 12); + C := D + LRot32(C + (B xor (D and (A xor B))) + Data[14] + $A679438E, 17); + B := C + LRot32(B + (A xor (C and (D xor A))) + Data[15] + $49B40821, 22); + + A := B + LRot32(A + (C xor (D and (B xor C))) + Data[1] + $F61E2562, 5); + D := A + LRot32(D + (B xor (C and (A xor B))) + Data[6] + $C040B340, 9); + C := D + LRot32(C + (A xor (B and (D xor A))) + Data[11] + $265E5A51, 14); + B := C + LRot32(B + (D xor (A and (C xor D))) + Data[0] + $E9B6C7AA, 20); + A := B + LRot32(A + (C xor (D and (B xor C))) + Data[5] + $D62F105D, 5); + D := A + LRot32(D + (B xor (C and (A xor B))) + Data[10] + $02441453, 9); + C := D + LRot32(C + (A xor (B and (D xor A))) + Data[15] + $D8A1E681, 14); + B := C + LRot32(B + (D xor (A and (C xor D))) + Data[4] + $E7D3FBC8, 20); + A := B + LRot32(A + (C xor (D and (B xor C))) + Data[9] + $21E1CDE6, 5); + D := A + LRot32(D + (B xor (C and (A xor B))) + Data[14] + $C33707D6, 9); + C := D + LRot32(C + (A xor (B and (D xor A))) + Data[3] + $F4D50D87, 14); + B := C + LRot32(B + (D xor (A and (C xor D))) + Data[8] + $455A14ED, 20); + A := B + LRot32(A + (C xor (D and (B xor C))) + Data[13] + $A9E3E905, 5); + D := A + LRot32(D + (B xor (C and (A xor B))) + Data[2] + $FCEFA3F8, 9); + C := D + LRot32(C + (A xor (B and (D xor A))) + Data[7] + $676F02D9, 14); + B := C + LRot32(B + (D xor (A and (C xor D))) + Data[12] + $8D2A4C8A, 20); + + A := B + LRot32(A + (B xor C xor D) + Data[5] + $FFFA3942, 4); + D := A + LRot32(D + (A xor B xor C) + Data[8] + $8771F681, 11); + C := D + LRot32(C + (D xor A xor B) + Data[11] + $6D9D6122, 16); + B := C + LRot32(B + (C xor D xor A) + Data[14] + $FDE5380C, 23); + A := B + LRot32(A + (B xor C xor D) + Data[1] + $A4BEEA44, 4); + D := A + LRot32(D + (A xor B xor C) + Data[4] + $4BDECFA9, 11); + C := D + LRot32(C + (D xor A xor B) + Data[7] + $F6BB4B60, 16); + B := C + LRot32(B + (C xor D xor A) + Data[10] + $BEBFBC70, 23); + A := B + LRot32(A + (B xor C xor D) + Data[13] + $289B7EC6, 4); + D := A + LRot32(D + (A xor B xor C) + Data[0] + $EAA127FA, 11); + C := D + LRot32(C + (D xor A xor B) + Data[3] + $D4EF3085, 16); + B := C + LRot32(B + (C xor D xor A) + Data[6] + $04881D05, 23); + A := B + LRot32(A + (B xor C xor D) + Data[9] + $D9D4D039, 4); + D := A + LRot32(D + (A xor B xor C) + Data[12] + $E6DB99E5, 11); + C := D + LRot32(C + (D xor A xor B) + Data[15] + $1FA27CF8, 16); + B := C + LRot32(B + (C xor D xor A) + Data[2] + $C4AC5665, 23); + + A := B + LRot32(A + (C xor (B or (not D))) + Data[0] + $F4292244, 6); + D := A + LRot32(D + (B xor (A or (not C))) + Data[7] + $432AFF97, 10); + C := D + LRot32(C + (A xor (D or (not B))) + Data[14] + $AB9423A7, 15); + B := C + LRot32(B + (D xor (C or (not A))) + Data[5] + $FC93A039, 21); + A := B + LRot32(A + (C xor (B or (not D))) + Data[12] + $655B59C3, 6); + D := A + LRot32(D + (B xor (A or (not C))) + Data[3] + $8F0CCC92, 10); + C := D + LRot32(C + (A xor (D or (not B))) + Data[10] + $FFEFF47D, 15); + B := C + LRot32(B + (D xor (C or (not A))) + Data[1] + $85845DD1, 21); + A := B + LRot32(A + (C xor (B or (not D))) + Data[8] + $6FA87E4F, 6); + D := A + LRot32(D + (B xor (A or (not C))) + Data[15] + $FE2CE6E0, 10); + C := D + LRot32(C + (A xor (D or (not B))) + Data[6] + $A3014314, 15); + B := C + LRot32(B + (D xor (C or (not A))) + Data[13] + $4E0811A1, 21); + A := B + LRot32(A + (C xor (B or (not D))) + Data[4] + $F7537E82, 6); + D := A + LRot32(D + (B xor (A or (not C))) + Data[11] + $BD3AF235, 10); + C := D + LRot32(C + (A xor (D or (not B))) + Data[2] + $2AD7D2BB, 15); + B := C + LRot32(B + (D xor (C or (not A))) + Data[9] + $EB86D391, 21); + + Inc(CurrentHash[0], A); + Inc(CurrentHash[1], B); + Inc(CurrentHash[2], C); + Inc(CurrentHash[3], D); + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_md5.GetHashSize: Integer; +begin + Result := 128; +end; + +class function TncEnc_md5.GetAlgorithm: string; +begin + Result := 'MD5'; +end; + +class function TncEnc_md5.SelfTest: Boolean; +const + Test1Out: array [0 .. 15] of Byte = ($90, $01, $50, $98, $3C, $D2, $4F, $B0, $D6, $96, $3F, $7D, $28, $E1, $7F, $72); + Test2Out: array [0 .. 15] of Byte = ($C3, $FC, $D3, $D7, $61, $92, $E4, $00, $7D, $FB, $49, $6C, $CA, $67, $E1, $3B); +var + TestHash: TncEnc_md5; + TestOut: array [0 .. 19] of Byte; +begin + TestHash := TncEnc_md5.Create(nil); + TestHash.Init; + TestHash.UpdateStr('abc'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Init; + TestHash.UpdateStr('abcdefghijklmnopqrstuvwxyz'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out)) and Result; + TestHash.Free; +end; + +procedure TncEnc_md5.Init; +begin + Burn; + CurrentHash[0] := $67452301; + CurrentHash[1] := $EFCDAB89; + CurrentHash[2] := $98BADCFE; + CurrentHash[3] := $10325476; + FInitialized := true; +end; + +procedure TncEnc_md5.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_md5.Update(const Buffer; Size: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenHi, Size shr 29); + Inc(LenLo, Size * 8); + if LenLo < (Size * 8) then + Inc(LenHi); + + PBuf := @Buffer; + while Size > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= Size then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(Size, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], Size); + Inc(Index, Size); + Size := 0; + end; + end; +end; + +procedure TncEnc_md5.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 56 then + Compress; + PUInt32(@HashBuffer[56])^ := LenLo; + PUInt32(@HashBuffer[60])^ := LenHi; + Compress; + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncMisty1.pas b/Source_using_TMonitor/Encryption/ncEncMisty1.pas new file mode 100644 index 0000000..f68cc48 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncMisty1.pas @@ -0,0 +1,307 @@ +{$R-} +{$Q-} +unit ncEncMisty1; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +const + NUMROUNDS = 8; + +type + TncEnc_misty1 = class(TncEnc_blockcipher64) + protected + KeyData: array [0 .. 31] of UInt32; + function FI(const FI_IN, FI_KEY: UInt32): UInt32; + function FO(const FO_IN: UInt32; const k: longword): UInt32; inline; + function FL(const FL_IN: UInt32; const k: longword): UInt32; inline; + function FLINV(const FL_IN: UInt32; const k: longword): UInt32; inline; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + S7TABLE: array [0 .. $7F] of Byte = ($1B, $32, $33, $5A, $3B, $10, $17, $54, $5B, $1A, $72, $73, $6B, $2C, $66, $49, $1F, $24, $13, $6C, $37, $2E, $3F, $4A, $5D, $0F, $40, $56, $25, $51, $1C, $04, $0B, $46, $20, $0D, $7B, $35, $44, $42, $2B, $1E, $41, $14, $4B, $79, $15, $6F, $0E, $55, $09, $36, $74, $0C, $67, $53, + $28, $0A, $7E, $38, $02, $07, $60, $29, $19, $12, $65, $2F, $30, $39, $08, $68, $5F, $78, $2A, $4C, $64, $45, $75, $3D, $59, $48, $03, $57, $7C, $4F, $62, $3C, $1D, $21, $5E, $27, $6A, $70, $4D, $3A, $01, $6D, $6E, $63, $18, $77, $23, $05, $26, $76, $00, $31, $2D, $7A, $7F, $61, $50, $22, $11, $06, $47, $16, $52, + $4E, $71, $3E, $69, $43, $34, $5C, $58, $7D); + + S9TABLE: array [0 .. $1FF] of UInt32 = ($1C3, $0CB, $153, $19F, $1E3, $0E9, $0FB, $035, $181, $0B9, $117, $1EB, $133, $009, $02D, $0D3, $0C7, $14A, $037, $07E, $0EB, $164, $193, $1D8, $0A3, $11E, $055, $02C, $01D, $1A2, $163, $118, $14B, $152, $1D2, $00F, $02B, $030, $13A, $0E5, $111, $138, $18E, $063, $0E3, $0C8, + $1F4, $01B, $001, $09D, $0F8, $1A0, $16D, $1F3, $01C, $146, $07D, $0D1, $082, $1EA, $183, $12D, $0F4, $19E, $1D3, $0DD, $1E2, $128, $1E0, $0EC, $059, $091, $011, $12F, $026, $0DC, $0B0, $18C, $10F, $1F7, $0E7, $16C, $0B6, $0F9, $0D8, $151, $101, $14C, $103, $0B8, $154, $12B, $1AE, $017, $071, $00C, $047, $058, + $07F, $1A4, $134, $129, $084, $15D, $19D, $1B2, $1A3, $048, $07C, $051, $1CA, $023, $13D, $1A7, $165, $03B, $042, $0DA, $192, $0CE, $0C1, $06B, $09F, $1F1, $12C, $184, $0FA, $196, $1E1, $169, $17D, $031, $180, $10A, $094, $1DA, $186, $13E, $11C, $060, $175, $1CF, $067, $119, $065, $068, $099, $150, $008, $007, + $17C, $0B7, $024, $019, $0DE, $127, $0DB, $0E4, $1A9, $052, $109, $090, $19C, $1C1, $028, $1B3, $135, $16A, $176, $0DF, $1E5, $188, $0C5, $16E, $1DE, $1B1, $0C3, $1DF, $036, $0EE, $1EE, $0F0, $093, $049, $09A, $1B6, $069, $081, $125, $00B, $05E, $0B4, $149, $1C7, $174, $03E, $13B, $1B7, $08E, $1C6, $0AE, $010, + $095, $1EF, $04E, $0F2, $1FD, $085, $0FD, $0F6, $0A0, $16F, $083, $08A, $156, $09B, $13C, $107, $167, $098, $1D0, $1E9, $003, $1FE, $0BD, $122, $089, $0D2, $18F, $012, $033, $06A, $142, $0ED, $170, $11B, $0E2, $14F, $158, $131, $147, $05D, $113, $1CD, $079, $161, $1A5, $179, $09E, $1B4, $0CC, $022, $132, $01A, + $0E8, $004, $187, $1ED, $197, $039, $1BF, $1D7, $027, $18B, $0C6, $09C, $0D0, $14E, $06C, $034, $1F2, $06E, $0CA, $025, $0BA, $191, $0FE, $013, $106, $02F, $1AD, $172, $1DB, $0C0, $10B, $1D6, $0F5, $1EC, $10D, $076, $114, $1AB, $075, $10C, $1E4, $159, $054, $11F, $04B, $0C4, $1BE, $0F7, $029, $0A4, $00E, $1F0, + $077, $04D, $17A, $086, $08B, $0B3, $171, $0BF, $10E, $104, $097, $15B, $160, $168, $0D7, $0BB, $066, $1CE, $0FC, $092, $1C5, $06F, $016, $04A, $0A1, $139, $0AF, $0F1, $190, $00A, $1AA, $143, $17B, $056, $18D, $166, $0D4, $1FB, $14D, $194, $19A, $087, $1F8, $123, $0A7, $1B8, $141, $03C, $1F9, $140, $02A, $155, + $11A, $1A1, $198, $0D5, $126, $1AF, $061, $12E, $157, $1DC, $072, $18A, $0AA, $096, $115, $0EF, $045, $07B, $08D, $145, $053, $05F, $178, $0B2, $02E, $020, $1D5, $03F, $1C9, $1E7, $1AC, $044, $038, $014, $0B1, $16B, $0AB, $0B5, $05A, $182, $1C8, $1D4, $018, $177, $064, $0CF, $06D, $100, $199, $130, $15A, $005, + $120, $1BB, $1BD, $0E0, $04F, $0D6, $13F, $1C4, $12A, $015, $006, $0FF, $19B, $0A6, $043, $088, $050, $15F, $1E8, $121, $073, $17E, $0BC, $0C2, $0C9, $173, $189, $1F5, $074, $1CC, $1E6, $1A8, $195, $01F, $041, $00D, $1BA, $032, $03D, $1D1, $080, $0A8, $057, $1B9, $162, $148, $0D9, $105, $062, $07A, $021, $1FF, + $112, $108, $1C0, $0A9, $11D, $1B0, $1A6, $0CD, $0F3, $05C, $102, $05B, $1D9, $144, $1F6, $0AD, $0A5, $03A, $1CB, $136, $17F, $046, $0E1, $01E, $1DD, $0E6, $137, $1FA, $185, $08C, $08F, $040, $1B5, $0BE, $078, $000, $0AC, $110, $15E, $124, $002, $1BC, $0A2, $0EA, $070, $1FC, $116, $15C, $04C, $1C2); + +function SwapUInt32(const a: UInt32): UInt32; inline; +begin + Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); +end; + +class function TncEnc_misty1.GetAlgorithm: string; +begin + Result := 'Misty1'; +end; + +class function TncEnc_misty1.GetMaxKeySize: Integer; +begin + Result := 128; +end; + +class function TncEnc_misty1.SelfTest: Boolean; +const + Key: array [0 .. 15] of Byte = ($00, $11, $22, $33, $44, $55, $66, $77, $88, $99, $AA, $BB, $CC, $DD, $EE, $FF); + Plain1: array [0 .. 7] of Byte = ($01, $23, $45, $67, $89, $AB, $CD, $EF); + Plain2: array [0 .. 7] of Byte = ($FE, $DC, $BA, $98, $76, $54, $32, $10); + Cipher1: array [0 .. 7] of Byte = ($8B, $1D, $A5, $F5, $6A, $B3, $D0, $7C); + Cipher2: array [0 .. 7] of Byte = ($04, $B6, $82, $40, $B1, $3B, $E9, $5D); +var + Cipher: TncEnc_misty1; + Block: array [0 .. 7] of Byte; +begin + Cipher := TncEnc_misty1.Create(nil); + Cipher.Init(Key, Sizeof(Key) * 8, nil); + Cipher.EncryptECB(Plain1, Block); + Result := CompareMem(@Cipher1, @Block, Sizeof(Block)); + Cipher.DecryptECB(Block, Block); + Result := Result and CompareMem(@Plain1, @Block, Sizeof(Block)); + Cipher.EncryptECB(Plain2, Block); + Result := Result and CompareMem(@Cipher2, @Block, Sizeof(Block)); + Cipher.DecryptECB(Block, Block); + Result := Result and CompareMem(@Plain2, @Block, Sizeof(Block)); + Cipher.Burn; + Cipher.Free; +end; + +function TncEnc_misty1.FI(const FI_IN, FI_KEY: UInt32): UInt32; +var + d7, d9: UInt32; +begin + d9 := (FI_IN shr 7) and $1FF; + d7 := FI_IN and $7F; + d9 := S9TABLE[d9] xor d7; + d7 := (S7TABLE[d7] xor d9) and $7F; + d7 := d7 xor ((FI_KEY shr 9) and $7F); + d9 := d9 xor (FI_KEY and $1FF); + d9 := S9TABLE[d9] xor d7; + Result := (d7 shl 9) or d9; +end; + +function TncEnc_misty1.FO(const FO_IN: UInt32; const k: longword): UInt32; +var + t0, t1: UInt32; +begin + t0 := FO_IN shr 16; + t1 := FO_IN and $FFFF; + t0 := t0 xor KeyData[k]; + t0 := FI(t0, KeyData[((k + 5) mod 8) + 8]); + t0 := t0 xor t1; + t1 := t1 xor KeyData[(k + 2) mod 8]; + t1 := FI(t1, KeyData[((k + 1) mod 8) + 8]); + t1 := t1 xor t0; + t0 := t0 xor KeyData[(k + 7) mod 8]; + t0 := FI(t0, KeyData[((k + 3) mod 8) + 8]); + t0 := t0 xor t1; + t1 := t1 xor KeyData[(k + 4) mod 8]; + Result := (t1 shl 16) or t0; +end; + +function TncEnc_misty1.FL(const FL_IN: UInt32; const k: longword): UInt32; +var + d0, d1: UInt32; + t: Byte; +begin + d0 := FL_IN shr 16; + d1 := FL_IN and $FFFF; + if (k mod 2) <> 0 then + begin + t := (k - 1) div 2; + d1 := d1 xor (d0 and KeyData[((t + 2) mod 8) + 8]); + d0 := d0 xor (d1 or KeyData[(t + 4) mod 8]); + end + else + begin + t := k div 2; + d1 := d1 xor (d0 and KeyData[t]); + d0 := d0 xor (d1 or KeyData[((t + 6) mod 8) + 8]); + end; + Result := (d0 shl 16) or d1; +end; + +function TncEnc_misty1.FLINV(const FL_IN: UInt32; const k: longword): UInt32; +var + d0, d1: UInt32; + t: Byte; +begin + d0 := FL_IN shr 16; + d1 := FL_IN and $FFFF; + if (k mod 2) <> 0 then + begin + t := (k - 1) div 2; + d0 := d0 xor (d1 or KeyData[(t + 4) mod 8]); + d1 := d1 xor (d0 and KeyData[((t + 2) mod 8) + 8]); + end + else + begin + t := k div 2; + d0 := d0 xor (d1 or KeyData[((t + 6) mod 8) + 8]); + d1 := d1 xor (d0 and KeyData[t]); + end; + Result := (d0 shl 16) or d1; +end; + +procedure TncEnc_misty1.InitKey(const Key; Size: longword); +var + KeyB: array [0 .. 15] of Byte; + i: longword; +begin + FillChar(KeyB, Sizeof(KeyB), 0); + Move(Key, KeyB, Size div 8); + for i := 0 to 7 do + KeyData[i] := (KeyB[i * 2] * 256) + KeyB[i * 2 + 1]; + for i := 0 to 7 do + begin + KeyData[i + 8] := FI(KeyData[i], KeyData[(i + 1) mod 8]); + KeyData[i + 16] := KeyData[i + 8] and $1FF; + KeyData[i + 24] := KeyData[i + 8] shr 9; + end; +end; + +procedure TncEnc_misty1.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), 0); + inherited Burn; +end; + +procedure TncEnc_misty1.EncryptECB(const InData; var OutData); +var + d0, d1: UInt32; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + d0 := SwapUInt32(PUInt32(@InData)^); + d1 := SwapUInt32(PUInt32(NativeUInt(@InData) + 4)^); + for i := 0 to NUMROUNDS - 1 do + begin + if (i mod 2) = 0 then + begin + d0 := FL(d0, i); + d1 := FL(d1, i + 1); + d1 := d1 xor FO(d0, i); + end + else + d0 := d0 xor FO(d1, i); + end; + d0 := FL(d0, NUMROUNDS); + d1 := FL(d1, NUMROUNDS + 1); + PUInt32(@OutData)^ := SwapUInt32(d1); + PUInt32(NativeUInt(@OutData) + 4)^ := SwapUInt32(d0); +end; + +procedure TncEnc_misty1.DecryptECB(const InData; var OutData); +var + d0, d1: UInt32; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + d1 := SwapUInt32(PUInt32(@InData)^); + d0 := SwapUInt32(PUInt32(NativeUInt(@InData) + 4)^); + d1 := FLINV(d1, NUMROUNDS + 1); + d0 := FLINV(d0, NUMROUNDS); + for i := NUMROUNDS - 1 downto 0 do + begin + if (i mod 2) = 0 then + begin + d1 := d1 xor FO(d0, i); + d0 := FLINV(d0, i); + d1 := FLINV(d1, i + 1); + end + else + d0 := d0 xor FO(d1, i); + end; + PUInt32(@OutData)^ := SwapUInt32(d0); + PUInt32(NativeUInt(@OutData) + 4)^ := SwapUInt32(d1); +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncRc2.pas b/Source_using_TMonitor/Encryption/ncEncRc2.pas new file mode 100644 index 0000000..93fedbb --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncRc2.pas @@ -0,0 +1,221 @@ +{$R-} +{$Q-} +unit ncEncRc2; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + Classes, Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_rc2 = class(TncEnc_blockcipher64) + protected + KeyData: array [0 .. 63] of Word; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + 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, + $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, + $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, + $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, + $9C, $77, $0A, $A6, $20, $68, $FE, $7F, $C1, $AD); + +function LRot16(a, n: Word): Word; +begin + Result := (a shl n) or (a shr (16 - n)); +end; + +function RRot16(a, n: Word): Word; +begin + Result := (a shr n) or (a shl (16 - n)); +end; + +class function TncEnc_rc2.GetMaxKeySize: integer; +begin + Result := 1024; +end; + +class function TncEnc_rc2.GetAlgorithm: string; +begin + Result := 'RC2'; +end; + +class function TncEnc_rc2.SelfTest: boolean; +const + Key1: array [0 .. 15] of byte = ($00, $01, $02, $03, $04, $05, $06, $07, $08, $09, $0A, $0B, $0C, $0D, $0E, $0F); + InData1: array [0 .. 7] of byte = ($00, $00, $00, $00, $00, $00, $00, $00); + OutData1: array [0 .. 7] of byte = ($50, $DC, $01, $62, $BD, $75, $7F, $31); + Key2: array [0 .. 15] of byte = ($00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $01); + InData2: array [0 .. 7] of byte = ($00, $00, $00, $00, $00, $00, $00, $00); + OutData2: array [0 .. 7] of byte = ($21, $82, $9C, $78, $A9, $F9, $C0, $74); +var + Cipher: TncEnc_rc2; + Data: array [0 .. 7] of byte; +begin + Cipher := TncEnc_rc2.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Data); + Result := boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(InData2, Data); + Result := boolean(CompareMem(@Data, @OutData2, Sizeof(Data))) and Result; + Cipher.DecryptECB(Data, Data); + Result := boolean(CompareMem(@Data, @InData2, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_rc2.InitKey(const Key; Size: longword); +var + i: longword; + KeyB: array [0 .. 127] of byte; +begin + Move(Key, KeyB, Size div 8); + for i := (Size div 8) to 127 do + KeyB[i] := sBox[(KeyB[i - (Size div 8)] + KeyB[i - 1]) and $FF]; + KeyB[0] := sBox[KeyB[0]]; + Move(KeyB, KeyData, Sizeof(KeyData)); +end; + +procedure TncEnc_rc2.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), 0); + inherited Burn; +end; + +procedure TncEnc_rc2.EncryptECB(const InData; var OutData); +var + i, j: longword; + w: array [0 .. 3] of Word; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + PUInt32(@w[0])^ := PUInt32(@InData)^; + PUInt32(@w[2])^ := PUInt32(NativeUInt(@InData) + 4)^; + for i := 0 to 15 do + begin + j := i * 4; + w[0] := LRot16((w[0] + (w[1] and (not w[3])) + (w[2] and w[3]) + KeyData[j + 0]), 1); + w[1] := LRot16((w[1] + (w[2] and (not w[0])) + (w[3] and w[0]) + KeyData[j + 1]), 2); + w[2] := LRot16((w[2] + (w[3] and (not w[1])) + (w[0] and w[1]) + KeyData[j + 2]), 3); + w[3] := LRot16((w[3] + (w[0] and (not w[2])) + (w[1] and w[2]) + KeyData[j + 3]), 5); + if (i = 4) or (i = 10) then + begin + w[0] := w[0] + KeyData[w[3] and 63]; + w[1] := w[1] + KeyData[w[0] and 63]; + w[2] := w[2] + KeyData[w[1] and 63]; + w[3] := w[3] + KeyData[w[2] and 63]; + end; + end; + PUInt32(@OutData)^ := PUInt32(@w[0])^; + PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@w[2])^; +end; + +procedure TncEnc_rc2.DecryptECB(const InData; var OutData); +var + i, j: longword; + w: array [0 .. 3] of Word; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + PUInt32(@w[0])^ := PUInt32(@InData)^; + PUInt32(@w[2])^ := PUInt32(NativeUInt(@InData) + 4)^; + for i := 15 downto 0 do + begin + j := i * 4; + w[3] := RRot16(w[3], 5) - (w[0] and (not w[2])) - (w[1] and w[2]) - KeyData[j + 3]; + w[2] := RRot16(w[2], 3) - (w[3] and (not w[1])) - (w[0] and w[1]) - KeyData[j + 2]; + w[1] := RRot16(w[1], 2) - (w[2] and (not w[0])) - (w[3] and w[0]) - KeyData[j + 1]; + w[0] := RRot16(w[0], 1) - (w[1] and (not w[3])) - (w[2] and w[3]) - KeyData[j + 0]; + if (i = 5) or (i = 11) then + begin + w[3] := w[3] - KeyData[w[2] and 63]; + w[2] := w[2] - KeyData[w[1] and 63]; + w[1] := w[1] - KeyData[w[0] and 63]; + w[0] := w[0] - KeyData[w[3] and 63]; + end; + end; + PUInt32(@OutData)^ := PUInt32(@w[0])^; + PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@w[2])^; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncRc4.pas b/Source_using_TMonitor/Encryption/ncEncRc4.pas new file mode 100644 index 0000000..0073b70 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncRc4.pas @@ -0,0 +1,246 @@ +{$R-} +{$Q-} +unit ncEncRc4; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_rc4 = class(TncEncCipher) + protected + KeyData, KeyOrg: array [0 .. 255] of Byte; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init(const Key; Size: NativeUInt; InitVector: Pointer); override; + procedure Reset; override; + procedure Burn; override; + procedure Encrypt(const InData; var OutData; Size: NativeUInt); override; + procedure Decrypt(const InData; var OutData; Size: NativeUInt); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +class function TncEnc_rc4.GetAlgorithm: string; +begin + Result := 'RC4'; +end; + +class function TncEnc_rc4.GetMaxKeySize: Integer; +begin + Result := 2048; +end; + +class function TncEnc_rc4.SelfTest: Boolean; +const + Key1: array [0 .. 4] of Byte = ($61, $8A, $63, $D2, $FB); + InData1: array [0 .. 4] of Byte = ($DC, $EE, $4C, $F9, $2C); + OutData1: array [0 .. 4] of Byte = ($F1, $38, $29, $C9, $DE); +var + Cipher: TncEnc_rc4; + Data: array [0 .. 4] of Byte; +begin + Cipher := TncEnc_rc4.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.Encrypt(InData1, Data, Sizeof(Data)); + Result := Boolean(CompareMem(@Data, @OutData1, Sizeof(Data))); + Cipher.Reset; + Cipher.Decrypt(Data, Data, Sizeof(Data)); + Result := Boolean(CompareMem(@Data, @InData1, Sizeof(Data))) and Result; + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_rc4.Init(const Key; Size: NativeUInt; InitVector: Pointer); +var + i, j, t: NativeUInt; + xKey: array [0 .. 255] of Byte; +begin + if FInitialized then + Burn; + inherited Init(Key, Size, nil); + Size := Size div 8; + i := 0; + while i < 255 do + begin + KeyData[i] := i; + xKey[i] := PByte(NativeUInt(@Key) + (i mod Size))^; + KeyData[i + 1] := i + 1; + xKey[i + 1] := PByte(NativeUInt(@Key) + ((i + 1) mod Size))^; + KeyData[i + 2] := i + 2; + xKey[i + 2] := PByte(NativeUInt(@Key) + ((i + 2) mod Size))^; + KeyData[i + 3] := i + 3; + xKey[i + 3] := PByte(NativeUInt(@Key) + ((i + 3) mod Size))^; + KeyData[i + 4] := i + 4; + xKey[i + 4] := PByte(NativeUInt(@Key) + ((i + 4) mod Size))^; + KeyData[i + 5] := i + 5; + xKey[i + 5] := PByte(NativeUInt(@Key) + ((i + 5) mod Size))^; + KeyData[i + 6] := i + 6; + xKey[i + 6] := PByte(NativeUInt(@Key) + ((i + 6) mod Size))^; + KeyData[i + 7] := i + 7; + xKey[i + 7] := PByte(NativeUInt(@Key) + ((i + 7) mod Size))^; + Inc(i, 8); + end; + j := 0; + i := 0; + while i < 255 do + begin + j := (j + KeyData[i] + xKey[i]) and $FF; + t := KeyData[i]; + KeyData[i] := KeyData[j]; + KeyData[j] := t; + j := (j + KeyData[i + 1] + xKey[i + 1]) and $FF; + t := KeyData[i + 1]; + KeyData[i + 1] := KeyData[j]; + KeyData[j] := t; + j := (j + KeyData[i + 2] + xKey[i + 2]) and $FF; + t := KeyData[i + 2]; + KeyData[i + 2] := KeyData[j]; + KeyData[j] := t; + j := (j + KeyData[i + 3] + xKey[i + 3]) and $FF; + t := KeyData[i + 3]; + KeyData[i + 3] := KeyData[j]; + KeyData[j] := t; + j := (j + KeyData[i + 4] + xKey[i + 4]) and $FF; + t := KeyData[i + 4]; + KeyData[i + 4] := KeyData[j]; + KeyData[j] := t; + j := (j + KeyData[i + 5] + xKey[i + 5]) and $FF; + t := KeyData[i + 5]; + KeyData[i + 5] := KeyData[j]; + KeyData[j] := t; + j := (j + KeyData[i + 6] + xKey[i + 6]) and $FF; + t := KeyData[i + 6]; + KeyData[i + 6] := KeyData[j]; + KeyData[j] := t; + j := (j + KeyData[i + 7] + xKey[i + 7]) and $FF; + t := KeyData[i + 7]; + KeyData[i + 7] := KeyData[j]; + KeyData[j] := t; + Inc(i, 8); + end; + Move(KeyData, KeyOrg, Sizeof(KeyOrg)); +end; + +procedure TncEnc_rc4.Reset; +begin + Move(KeyOrg, KeyData, Sizeof(KeyData)); +end; + +procedure TncEnc_rc4.Burn; +begin + FillChar(KeyOrg, Sizeof(KeyOrg), $FF); + FillChar(KeyData, Sizeof(KeyData), $FF); + inherited Burn; +end; + +procedure TncEnc_rc4.Encrypt(const InData; var OutData; Size: NativeUInt); +var + i, j, t, k: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + i := 0; + j := 0; + for k := 0 to Size - 1 do + begin + i := (i + 1) and $FF; + t := KeyData[i]; + j := (j + t) and $FF; + KeyData[i] := KeyData[j]; + KeyData[j] := t; + t := (t + KeyData[i]) and $FF; + Pbytearray(@OutData)^[k] := Pbytearray(@InData)^[k] xor KeyData[t]; + end; +end; + +procedure TncEnc_rc4.Decrypt(const InData; var OutData; Size: NativeUInt); +var + i, j, t, k: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + i := 0; + j := 0; + for k := 0 to Size - 1 do + begin + i := (i + 1) and $FF; + t := KeyData[i]; + j := (j + t) and $FF; + KeyData[i] := KeyData[j]; + KeyData[j] := t; + t := (t + KeyData[i]) and $FF; + Pbytearray(@OutData)^[k] := Pbytearray(@InData)^[k] xor KeyData[t]; + end; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncRc5.pas b/Source_using_TMonitor/Encryption/ncEncRc5.pas new file mode 100644 index 0000000..1042821 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncRc5.pas @@ -0,0 +1,226 @@ +{$R-} +{$Q-} +unit ncEncRc5; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +const + NUMROUNDS = 12; { number of rounds must be between 12-16 } + +type + TncEnc_rc5 = class(TncEnc_blockcipher64) + protected + KeyData: array [0 .. ((NUMROUNDS * 2) + 1)] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + 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, + $2B4C3474, $C983AE2D, $67BB27E6, $05F2A19F, $A42A1B58, $42619511, $E0990ECA, $7ED08883, $1D08023C); + +function LRot32(const a, b: UInt32): UInt32; inline; +begin + Result := (a shl b) or (a shr (32 - b)); +end; + +function RRot32(const a, b: UInt32): UInt32; inline; +begin + Result := (a shr b) or (a shl (32 - b)); +end; + +class function TncEnc_rc5.GetAlgorithm: string; +begin + Result := 'RC5'; +end; + +class function TncEnc_rc5.GetMaxKeySize: Integer; +begin + Result := 2048; +end; + +class function TncEnc_rc5.SelfTest: Boolean; +const + Key1: array [0 .. 15] of byte = ($DC, $49, $DB, $13, $75, $A5, $58, $4F, $64, $85, $B4, $13, $B5, $F1, $2B, $AF); + Plain1: array [0 .. 1] of UInt32 = ($B7B3422F, $92FC6903); + Cipher1: array [0 .. 1] of UInt32 = ($B278C165, $CC97D184); + Key2: array [0 .. 15] of byte = ($52, $69, $F1, $49, $D4, $1B, $A0, $15, $24, $97, $57, $4D, $7F, $15, $31, $25); + Plain2: array [0 .. 1] of UInt32 = ($B278C165, $CC97D184); + Cipher2: array [0 .. 1] of UInt32 = ($15E444EB, $249831DA); +var + Cipher: TncEnc_rc5; + Data: array [0 .. 1] of UInt32; +begin + Cipher := TncEnc_rc5.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(Plain1, Data); + Result := Boolean(CompareMem(@Data, @Cipher1, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and Boolean(CompareMem(@Data, @Plain1, Sizeof(Data))); + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(Plain2, Data); + Result := Result and Boolean(CompareMem(@Data, @Cipher2, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and Boolean(CompareMem(@Data, @Plain2, Sizeof(Data))); + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_rc5.InitKey(const Key; Size: longword); +var + xKeyD: array [0 .. 63] of UInt32; + i, j, k, xKeyLen: longword; + a, b: UInt32; +begin + FillChar(xKeyD, Sizeof(xKeyD), 0); + Size := Size div 8; + Move(Key, xKeyD, Size); + xKeyLen := Size div 4; + if (Size mod 4) <> 0 then + Inc(xKeyLen); + Move(sBox, KeyData, (NUMROUNDS + 1) * 8); + i := 0; + j := 0; + a := 0; + b := 0; + if xKeyLen > ((NUMROUNDS + 1) * 2) then + k := xKeyLen * 3 + else + k := (NUMROUNDS + 1) * 6; + for k := k downto 1 do + begin + a := LRot32(KeyData[i] + a + b, 3); + KeyData[i] := a; + b := LRot32(xKeyD[j] + a + b, a + b); + xKeyD[j] := b; + i := (i + 1) mod ((NUMROUNDS + 1) * 2); + j := (j + 1) mod xKeyLen; + end; + FillChar(xKeyD, Sizeof(xKeyD), 0); +end; + +procedure TncEnc_rc5.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), $FF); + inherited Burn; +end; + +procedure TncEnc_rc5.EncryptECB(const InData; var OutData); +var + a, b: UInt32; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + a := PUInt32(@InData)^ + KeyData[0]; + b := PUInt32(NativeUInt(@InData) + 4)^ + KeyData[1]; + for i := 1 to NUMROUNDS do + begin + a := a xor b; + a := LRot32(a, b) + KeyData[2 * i]; + b := b xor a; + b := LRot32(b, a) + KeyData[(2 * i) + 1]; + end; + PUInt32(@OutData)^ := a; + PUInt32(NativeUInt(@OutData) + 4)^ := b; +end; + +procedure TncEnc_rc5.DecryptECB(const InData; var OutData); +var + a, b: UInt32; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + a := PUInt32(@InData)^; + b := PUInt32(NativeUInt(@InData) + 4)^; + for i := NUMROUNDS downto 1 do + begin + b := RRot32(b - KeyData[(2 * i) + 1], a); + b := b xor a; + a := RRot32(a - KeyData[2 * i], b); + a := a xor b; + end; + PUInt32(@OutData)^ := a - KeyData[0]; + PUInt32(NativeUInt(@OutData) + 4)^ := b - KeyData[1]; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncRc6.pas b/Source_using_TMonitor/Encryption/ncEncRc6.pas new file mode 100644 index 0000000..77f4b00 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncRc6.pas @@ -0,0 +1,254 @@ +{$R-} +{$Q-} +unit ncEncRc6; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +const + NUMROUNDS = 20; { number of rounds must be between 16-24 } + +type + TncEnc_rc6 = class(TncEnc_blockcipher128) + protected + KeyData: array [0 .. ((NUMROUNDS * 2) + 3)] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + 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, + $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); + +function LRot32(const X: UInt32; const c: integer): UInt32; inline; +begin + LRot32 := (X shl c) or (X shr (32 - c)); +end; + +function RRot32(const X: UInt32; const c: integer): UInt32; inline; +begin + RRot32 := (X shr c) or (X shl (32 - c)); +end; + +class function TncEnc_rc6.GetAlgorithm: string; +begin + Result := 'RC6'; +end; + +class function TncEnc_rc6.GetMaxKeySize: integer; +begin + Result := 2048; +end; + +class function TncEnc_rc6.SelfTest: boolean; +const + Key1: array [0 .. 15] of byte = ($01, $23, $45, $67, $89, $AB, $CD, $EF, $01, $12, $23, $34, $45, $56, $67, $78); + Plain1: array [0 .. 15] of byte = ($02, $13, $24, $35, $46, $57, $68, $79, $8A, $9B, $AC, $BD, $CE, $DF, $E0, $F1); + Cipher1: array [0 .. 15] of byte = ($52, $4E, $19, $2F, $47, $15, $C6, $23, $1F, $51, $F6, $36, $7E, $A4, $3F, $18); + 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); + Plain2: array [0 .. 15] of byte = ($02, $13, $24, $35, $46, $57, $68, $79, $8A, $9B, $AC, $BD, $CE, $DF, $E0, $F1); + Cipher2: array [0 .. 15] of byte = ($C8, $24, $18, $16, $F0, $D7, $E4, $89, $20, $AD, $16, $A1, $67, $4E, $5D, $48); +var + Cipher: TncEnc_rc6; + Data: array [0 .. 15] of byte; +begin + Cipher := TncEnc_rc6.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(Plain1, Data); + Result := boolean(CompareMem(@Data, @Cipher1, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and boolean(CompareMem(@Data, @Plain1, Sizeof(Data))); + Cipher.Burn; + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(Plain2, Data); + Result := Result and boolean(CompareMem(@Data, @Cipher2, Sizeof(Data))); + Cipher.DecryptECB(Data, Data); + Result := Result and boolean(CompareMem(@Data, @Plain2, Sizeof(Data))); + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_rc6.InitKey(const Key; Size: longword); +var + xKeyD: array [0 .. 63] of UInt32; + i, j, k, xKeyLen: longword; + A, B: UInt32; +begin + Size := Size div 8; + FillChar(xKeyD, Sizeof(xKeyD), 0); + Move(Key, xKeyD, Size); + xKeyLen := Size div 4; + if (Size mod 4) <> 0 then + Inc(xKeyLen); + Move(sBox, KeyData, ((NUMROUNDS * 2) + 4) * 4); + i := 0; + j := 0; + A := 0; + B := 0; + if xKeyLen > ((NUMROUNDS * 2) + 4) then + k := xKeyLen * 3 + else + k := ((NUMROUNDS * 2) + 4) * 3; + for k := 1 to k do + begin + A := LRot32(KeyData[i] + A + B, 3); + KeyData[i] := A; + B := LRot32(xKeyD[j] + A + B, A + B); + xKeyD[j] := B; + i := (i + 1) mod ((NUMROUNDS * 2) + 4); + j := (j + 1) mod xKeyLen; + end; + FillChar(xKeyD, Sizeof(xKeyD), 0); +end; + +procedure TncEnc_rc6.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), $FF); + inherited Burn; +end; + +procedure TncEnc_rc6.EncryptECB(const InData; var OutData); +var + x0, x1, x2, x3: UInt32; + u, t: UInt32; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + x0 := PUInt32(@InData)^; + x1 := PUInt32(NativeUInt(@InData) + 4)^; + x2 := PUInt32(NativeUInt(@InData) + 8)^; + x3 := PUInt32(NativeUInt(@InData) + 12)^; + x1 := x1 + KeyData[0]; + x3 := x3 + KeyData[1]; + for i := 1 to NUMROUNDS do + begin + t := LRot32(x1 * (2 * x1 + 1), 5); + u := LRot32(x3 * (2 * x3 + 1), 5); + x0 := LRot32(x0 xor t, u) + KeyData[2 * i]; + x2 := LRot32(x2 xor u, t) + KeyData[2 * i + 1]; + t := x0; + x0 := x1; + x1 := x2; + x2 := x3; + x3 := t; + end; + x0 := x0 + KeyData[(2 * NUMROUNDS) + 2]; + x2 := x2 + KeyData[(2 * NUMROUNDS) + 3]; + PUInt32(@OutData)^ := x0; + PUInt32(NativeUInt(@OutData) + 4)^ := x1; + PUInt32(NativeUInt(@OutData) + 8)^ := x2; + PUInt32(NativeUInt(@OutData) + 12)^ := x3; +end; + +procedure TncEnc_rc6.DecryptECB(const InData; var OutData); +var + x0, x1, x2, x3: UInt32; + u, t: UInt32; + i: longword; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + x0 := PUInt32(@InData)^; + x1 := PUInt32(NativeUInt(@InData) + 4)^; + x2 := PUInt32(NativeUInt(@InData) + 8)^; + x3 := PUInt32(NativeUInt(@InData) + 12)^; + x2 := x2 - KeyData[(2 * NUMROUNDS) + 3]; + x0 := x0 - KeyData[(2 * NUMROUNDS) + 2]; + for i := NUMROUNDS downto 1 do + begin + t := x0; + x0 := x3; + x3 := x2; + x2 := x1; + x1 := t; + u := LRot32(x3 * (2 * x3 + 1), 5); + t := LRot32(x1 * (2 * x1 + 1), 5); + x2 := RRot32(x2 - KeyData[2 * i + 1], t) xor u; + x0 := RRot32(x0 - KeyData[2 * i], u) xor t; + end; + x3 := x3 - KeyData[1]; + x1 := x1 - KeyData[0]; + PUInt32(@OutData)^ := x0; + PUInt32(NativeUInt(@OutData) + 4)^ := x1; + PUInt32(NativeUInt(@OutData) + 8)^ := x2; + PUInt32(NativeUInt(@OutData) + 12)^ := x3; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncRijndael.pas b/Source_using_TMonitor/Encryption/ncEncRijndael.pas new file mode 100644 index 0000000..9828899 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncRijndael.pas @@ -0,0 +1,612 @@ +{$R-} +{$Q-} +unit ncEncRijndael; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +const + BC = 4; + MAXROUNDS = 14; + +type + TncEnc_rijndael = class(TncEnc_blockcipher128) + protected + numrounds: longword; + rk, drk: array [0 .. MAXROUNDS, 0 .. 7] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + MAXBC = 8; + MAXKC = 8; + + S: array [0 .. 255] of Byte = (99, 124, 119, 123, 242, 107, 111, 197, 48, 1, 103, 43, 254, 215, 171, 118, 202, 130, 201, 125, 250, 89, 71, 240, 173, 212, 162, 175, 156, 164, 114, 192, 183, 253, 147, 38, 54, 63, 247, 204, 52, 165, 229, 241, 113, 216, 49, 21, 4, 199, 35, 195, 24, 150, 5, 154, 7, 18, 128, 226, 235, 39, + 178, 117, 9, 131, 44, 26, 27, 110, 90, 160, 82, 59, 214, 179, 41, 227, 47, 132, 83, 209, 0, 237, 32, 252, 177, 91, 106, 203, 190, 57, 74, 76, 88, 207, 208, 239, 170, 251, 67, 77, 51, 133, 69, 249, 2, 127, 80, 60, 159, 168, 81, 163, 64, 143, 146, 157, 56, 245, 188, 182, 218, 33, 16, 255, 243, 210, 205, 12, 19, 236, + 95, 151, 68, 23, 196, 167, 126, 61, 100, 93, 25, 115, 96, 129, 79, 220, 34, 42, 144, 136, 70, 238, 184, 20, 222, 94, 11, 219, 224, 50, 58, 10, 73, 6, 36, 92, 194, 211, 172, 98, 145, 149, 228, 121, 231, 200, 55, 109, 141, 213, 78, 169, 108, 86, 244, 234, 101, 122, 174, 8, 186, 120, 37, 46, 28, 166, 180, 198, 232, + 221, 116, 31, 75, 189, 139, 138, 112, 62, 181, 102, 72, 3, 246, 14, 97, 53, 87, 185, 134, 193, 29, 158, 225, 248, 152, 17, 105, 217, 142, 148, 155, 30, 135, 233, 206, 85, 40, 223, 140, 161, 137, 13, 191, 230, 66, 104, 65, 153, 45, 15, 176, 84, 187, 22); + + T1: array [0 .. 255, 0 .. 3] of Byte = (($C6, $63, $63, $A5), ($F8, $7C, $7C, $84), ($EE, $77, $77, $99), ($F6, $7B, $7B, $8D), ($FF, $F2, $F2, $0D), ($D6, $6B, $6B, $BD), ($DE, $6F, $6F, $B1), ($91, $C5, $C5, $54), ($60, $30, $30, $50), ($02, $01, $01, $03), ($CE, $67, $67, $A9), ($56, $2B, $2B, $7D), + ($E7, $FE, $FE, $19), ($B5, $D7, $D7, $62), ($4D, $AB, $AB, $E6), ($EC, $76, $76, $9A), ($8F, $CA, $CA, $45), ($1F, $82, $82, $9D), ($89, $C9, $C9, $40), ($FA, $7D, $7D, $87), ($EF, $FA, $FA, $15), ($B2, $59, $59, $EB), ($8E, $47, $47, $C9), ($FB, $F0, $F0, $0B), ($41, $AD, $AD, $EC), ($B3, $D4, $D4, $67), + ($5F, $A2, $A2, $FD), ($45, $AF, $AF, $EA), ($23, $9C, $9C, $BF), ($53, $A4, $A4, $F7), ($E4, $72, $72, $96), ($9B, $C0, $C0, $5B), ($75, $B7, $B7, $C2), ($E1, $FD, $FD, $1C), ($3D, $93, $93, $AE), ($4C, $26, $26, $6A), ($6C, $36, $36, $5A), ($7E, $3F, $3F, $41), ($F5, $F7, $F7, $02), ($83, $CC, $CC, $4F), + ($68, $34, $34, $5C), ($51, $A5, $A5, $F4), ($D1, $E5, $E5, $34), ($F9, $F1, $F1, $08), ($E2, $71, $71, $93), ($AB, $D8, $D8, $73), ($62, $31, $31, $53), ($2A, $15, $15, $3F), ($08, $04, $04, $0C), ($95, $C7, $C7, $52), ($46, $23, $23, $65), ($9D, $C3, $C3, $5E), ($30, $18, $18, $28), ($37, $96, $96, $A1), + ($0A, $05, $05, $0F), ($2F, $9A, $9A, $B5), ($0E, $07, $07, $09), ($24, $12, $12, $36), ($1B, $80, $80, $9B), ($DF, $E2, $E2, $3D), ($CD, $EB, $EB, $26), ($4E, $27, $27, $69), ($7F, $B2, $B2, $CD), ($EA, $75, $75, $9F), ($12, $09, $09, $1B), ($1D, $83, $83, $9E), ($58, $2C, $2C, $74), ($34, $1A, $1A, $2E), + ($36, $1B, $1B, $2D), ($DC, $6E, $6E, $B2), ($B4, $5A, $5A, $EE), ($5B, $A0, $A0, $FB), ($A4, $52, $52, $F6), ($76, $3B, $3B, $4D), ($B7, $D6, $D6, $61), ($7D, $B3, $B3, $CE), ($52, $29, $29, $7B), ($DD, $E3, $E3, $3E), ($5E, $2F, $2F, $71), ($13, $84, $84, $97), ($A6, $53, $53, $F5), ($B9, $D1, $D1, $68), + ($00, $00, $00, $00), ($C1, $ED, $ED, $2C), ($40, $20, $20, $60), ($E3, $FC, $FC, $1F), ($79, $B1, $B1, $C8), ($B6, $5B, $5B, $ED), ($D4, $6A, $6A, $BE), ($8D, $CB, $CB, $46), ($67, $BE, $BE, $D9), ($72, $39, $39, $4B), ($94, $4A, $4A, $DE), ($98, $4C, $4C, $D4), ($B0, $58, $58, $E8), ($85, $CF, $CF, $4A), + ($BB, $D0, $D0, $6B), ($C5, $EF, $EF, $2A), ($4F, $AA, $AA, $E5), ($ED, $FB, $FB, $16), ($86, $43, $43, $C5), ($9A, $4D, $4D, $D7), ($66, $33, $33, $55), ($11, $85, $85, $94), ($8A, $45, $45, $CF), ($E9, $F9, $F9, $10), ($04, $02, $02, $06), ($FE, $7F, $7F, $81), ($A0, $50, $50, $F0), ($78, $3C, $3C, $44), + ($25, $9F, $9F, $BA), ($4B, $A8, $A8, $E3), ($A2, $51, $51, $F3), ($5D, $A3, $A3, $FE), ($80, $40, $40, $C0), ($05, $8F, $8F, $8A), ($3F, $92, $92, $AD), ($21, $9D, $9D, $BC), ($70, $38, $38, $48), ($F1, $F5, $F5, $04), ($63, $BC, $BC, $DF), ($77, $B6, $B6, $C1), ($AF, $DA, $DA, $75), ($42, $21, $21, $63), + ($20, $10, $10, $30), ($E5, $FF, $FF, $1A), ($FD, $F3, $F3, $0E), ($BF, $D2, $D2, $6D), ($81, $CD, $CD, $4C), ($18, $0C, $0C, $14), ($26, $13, $13, $35), ($C3, $EC, $EC, $2F), ($BE, $5F, $5F, $E1), ($35, $97, $97, $A2), ($88, $44, $44, $CC), ($2E, $17, $17, $39), ($93, $C4, $C4, $57), ($55, $A7, $A7, $F2), + ($FC, $7E, $7E, $82), ($7A, $3D, $3D, $47), ($C8, $64, $64, $AC), ($BA, $5D, $5D, $E7), ($32, $19, $19, $2B), ($E6, $73, $73, $95), ($C0, $60, $60, $A0), ($19, $81, $81, $98), ($9E, $4F, $4F, $D1), ($A3, $DC, $DC, $7F), ($44, $22, $22, $66), ($54, $2A, $2A, $7E), ($3B, $90, $90, $AB), ($0B, $88, $88, $83), + ($8C, $46, $46, $CA), ($C7, $EE, $EE, $29), ($6B, $B8, $B8, $D3), ($28, $14, $14, $3C), ($A7, $DE, $DE, $79), ($BC, $5E, $5E, $E2), ($16, $0B, $0B, $1D), ($AD, $DB, $DB, $76), ($DB, $E0, $E0, $3B), ($64, $32, $32, $56), ($74, $3A, $3A, $4E), ($14, $0A, $0A, $1E), ($92, $49, $49, $DB), ($0C, $06, $06, $0A), + ($48, $24, $24, $6C), ($B8, $5C, $5C, $E4), ($9F, $C2, $C2, $5D), ($BD, $D3, $D3, $6E), ($43, $AC, $AC, $EF), ($C4, $62, $62, $A6), ($39, $91, $91, $A8), ($31, $95, $95, $A4), ($D3, $E4, $E4, $37), ($F2, $79, $79, $8B), ($D5, $E7, $E7, $32), ($8B, $C8, $C8, $43), ($6E, $37, $37, $59), ($DA, $6D, $6D, $B7), + ($01, $8D, $8D, $8C), ($B1, $D5, $D5, $64), ($9C, $4E, $4E, $D2), ($49, $A9, $A9, $E0), ($D8, $6C, $6C, $B4), ($AC, $56, $56, $FA), ($F3, $F4, $F4, $07), ($CF, $EA, $EA, $25), ($CA, $65, $65, $AF), ($F4, $7A, $7A, $8E), ($47, $AE, $AE, $E9), ($10, $08, $08, $18), ($6F, $BA, $BA, $D5), ($F0, $78, $78, $88), + ($4A, $25, $25, $6F), ($5C, $2E, $2E, $72), ($38, $1C, $1C, $24), ($57, $A6, $A6, $F1), ($73, $B4, $B4, $C7), ($97, $C6, $C6, $51), ($CB, $E8, $E8, $23), ($A1, $DD, $DD, $7C), ($E8, $74, $74, $9C), ($3E, $1F, $1F, $21), ($96, $4B, $4B, $DD), ($61, $BD, $BD, $DC), ($0D, $8B, $8B, $86), ($0F, $8A, $8A, $85), + ($E0, $70, $70, $90), ($7C, $3E, $3E, $42), ($71, $B5, $B5, $C4), ($CC, $66, $66, $AA), ($90, $48, $48, $D8), ($06, $03, $03, $05), ($F7, $F6, $F6, $01), ($1C, $0E, $0E, $12), ($C2, $61, $61, $A3), ($6A, $35, $35, $5F), ($AE, $57, $57, $F9), ($69, $B9, $B9, $D0), ($17, $86, $86, $91), ($99, $C1, $C1, $58), + ($3A, $1D, $1D, $27), ($27, $9E, $9E, $B9), ($D9, $E1, $E1, $38), ($EB, $F8, $F8, $13), ($2B, $98, $98, $B3), ($22, $11, $11, $33), ($D2, $69, $69, $BB), ($A9, $D9, $D9, $70), ($07, $8E, $8E, $89), ($33, $94, $94, $A7), ($2D, $9B, $9B, $B6), ($3C, $1E, $1E, $22), ($15, $87, $87, $92), ($C9, $E9, $E9, $20), + ($87, $CE, $CE, $49), ($AA, $55, $55, $FF), ($50, $28, $28, $78), ($A5, $DF, $DF, $7A), ($03, $8C, $8C, $8F), ($59, $A1, $A1, $F8), ($09, $89, $89, $80), ($1A, $0D, $0D, $17), ($65, $BF, $BF, $DA), ($D7, $E6, $E6, $31), ($84, $42, $42, $C6), ($D0, $68, $68, $B8), ($82, $41, $41, $C3), ($29, $99, $99, $B0), + ($5A, $2D, $2D, $77), ($1E, $0F, $0F, $11), ($7B, $B0, $B0, $CB), ($A8, $54, $54, $FC), ($6D, $BB, $BB, $D6), ($2C, $16, $16, $3A)); + + T2: array [0 .. 255, 0 .. 3] of Byte = (($A5, $C6, $63, $63), ($84, $F8, $7C, $7C), ($99, $EE, $77, $77), ($8D, $F6, $7B, $7B), ($0D, $FF, $F2, $F2), ($BD, $D6, $6B, $6B), ($B1, $DE, $6F, $6F), ($54, $91, $C5, $C5), ($50, $60, $30, $30), ($03, $02, $01, $01), ($A9, $CE, $67, $67), ($7D, $56, $2B, $2B), + ($19, $E7, $FE, $FE), ($62, $B5, $D7, $D7), ($E6, $4D, $AB, $AB), ($9A, $EC, $76, $76), ($45, $8F, $CA, $CA), ($9D, $1F, $82, $82), ($40, $89, $C9, $C9), ($87, $FA, $7D, $7D), ($15, $EF, $FA, $FA), ($EB, $B2, $59, $59), ($C9, $8E, $47, $47), ($0B, $FB, $F0, $F0), ($EC, $41, $AD, $AD), ($67, $B3, $D4, $D4), + ($FD, $5F, $A2, $A2), ($EA, $45, $AF, $AF), ($BF, $23, $9C, $9C), ($F7, $53, $A4, $A4), ($96, $E4, $72, $72), ($5B, $9B, $C0, $C0), ($C2, $75, $B7, $B7), ($1C, $E1, $FD, $FD), ($AE, $3D, $93, $93), ($6A, $4C, $26, $26), ($5A, $6C, $36, $36), ($41, $7E, $3F, $3F), ($02, $F5, $F7, $F7), ($4F, $83, $CC, $CC), + ($5C, $68, $34, $34), ($F4, $51, $A5, $A5), ($34, $D1, $E5, $E5), ($08, $F9, $F1, $F1), ($93, $E2, $71, $71), ($73, $AB, $D8, $D8), ($53, $62, $31, $31), ($3F, $2A, $15, $15), ($0C, $08, $04, $04), ($52, $95, $C7, $C7), ($65, $46, $23, $23), ($5E, $9D, $C3, $C3), ($28, $30, $18, $18), ($A1, $37, $96, $96), + ($0F, $0A, $05, $05), ($B5, $2F, $9A, $9A), ($09, $0E, $07, $07), ($36, $24, $12, $12), ($9B, $1B, $80, $80), ($3D, $DF, $E2, $E2), ($26, $CD, $EB, $EB), ($69, $4E, $27, $27), ($CD, $7F, $B2, $B2), ($9F, $EA, $75, $75), ($1B, $12, $09, $09), ($9E, $1D, $83, $83), ($74, $58, $2C, $2C), ($2E, $34, $1A, $1A), + ($2D, $36, $1B, $1B), ($B2, $DC, $6E, $6E), ($EE, $B4, $5A, $5A), ($FB, $5B, $A0, $A0), ($F6, $A4, $52, $52), ($4D, $76, $3B, $3B), ($61, $B7, $D6, $D6), ($CE, $7D, $B3, $B3), ($7B, $52, $29, $29), ($3E, $DD, $E3, $E3), ($71, $5E, $2F, $2F), ($97, $13, $84, $84), ($F5, $A6, $53, $53), ($68, $B9, $D1, $D1), + ($00, $00, $00, $00), ($2C, $C1, $ED, $ED), ($60, $40, $20, $20), ($1F, $E3, $FC, $FC), ($C8, $79, $B1, $B1), ($ED, $B6, $5B, $5B), ($BE, $D4, $6A, $6A), ($46, $8D, $CB, $CB), ($D9, $67, $BE, $BE), ($4B, $72, $39, $39), ($DE, $94, $4A, $4A), ($D4, $98, $4C, $4C), ($E8, $B0, $58, $58), ($4A, $85, $CF, $CF), + ($6B, $BB, $D0, $D0), ($2A, $C5, $EF, $EF), ($E5, $4F, $AA, $AA), ($16, $ED, $FB, $FB), ($C5, $86, $43, $43), ($D7, $9A, $4D, $4D), ($55, $66, $33, $33), ($94, $11, $85, $85), ($CF, $8A, $45, $45), ($10, $E9, $F9, $F9), ($06, $04, $02, $02), ($81, $FE, $7F, $7F), ($F0, $A0, $50, $50), ($44, $78, $3C, $3C), + ($BA, $25, $9F, $9F), ($E3, $4B, $A8, $A8), ($F3, $A2, $51, $51), ($FE, $5D, $A3, $A3), ($C0, $80, $40, $40), ($8A, $05, $8F, $8F), ($AD, $3F, $92, $92), ($BC, $21, $9D, $9D), ($48, $70, $38, $38), ($04, $F1, $F5, $F5), ($DF, $63, $BC, $BC), ($C1, $77, $B6, $B6), ($75, $AF, $DA, $DA), ($63, $42, $21, $21), + ($30, $20, $10, $10), ($1A, $E5, $FF, $FF), ($0E, $FD, $F3, $F3), ($6D, $BF, $D2, $D2), ($4C, $81, $CD, $CD), ($14, $18, $0C, $0C), ($35, $26, $13, $13), ($2F, $C3, $EC, $EC), ($E1, $BE, $5F, $5F), ($A2, $35, $97, $97), ($CC, $88, $44, $44), ($39, $2E, $17, $17), ($57, $93, $C4, $C4), ($F2, $55, $A7, $A7), + ($82, $FC, $7E, $7E), ($47, $7A, $3D, $3D), ($AC, $C8, $64, $64), ($E7, $BA, $5D, $5D), ($2B, $32, $19, $19), ($95, $E6, $73, $73), ($A0, $C0, $60, $60), ($98, $19, $81, $81), ($D1, $9E, $4F, $4F), ($7F, $A3, $DC, $DC), ($66, $44, $22, $22), ($7E, $54, $2A, $2A), ($AB, $3B, $90, $90), ($83, $0B, $88, $88), + ($CA, $8C, $46, $46), ($29, $C7, $EE, $EE), ($D3, $6B, $B8, $B8), ($3C, $28, $14, $14), ($79, $A7, $DE, $DE), ($E2, $BC, $5E, $5E), ($1D, $16, $0B, $0B), ($76, $AD, $DB, $DB), ($3B, $DB, $E0, $E0), ($56, $64, $32, $32), ($4E, $74, $3A, $3A), ($1E, $14, $0A, $0A), ($DB, $92, $49, $49), ($0A, $0C, $06, $06), + ($6C, $48, $24, $24), ($E4, $B8, $5C, $5C), ($5D, $9F, $C2, $C2), ($6E, $BD, $D3, $D3), ($EF, $43, $AC, $AC), ($A6, $C4, $62, $62), ($A8, $39, $91, $91), ($A4, $31, $95, $95), ($37, $D3, $E4, $E4), ($8B, $F2, $79, $79), ($32, $D5, $E7, $E7), ($43, $8B, $C8, $C8), ($59, $6E, $37, $37), ($B7, $DA, $6D, $6D), + ($8C, $01, $8D, $8D), ($64, $B1, $D5, $D5), ($D2, $9C, $4E, $4E), ($E0, $49, $A9, $A9), ($B4, $D8, $6C, $6C), ($FA, $AC, $56, $56), ($07, $F3, $F4, $F4), ($25, $CF, $EA, $EA), ($AF, $CA, $65, $65), ($8E, $F4, $7A, $7A), ($E9, $47, $AE, $AE), ($18, $10, $08, $08), ($D5, $6F, $BA, $BA), ($88, $F0, $78, $78), + ($6F, $4A, $25, $25), ($72, $5C, $2E, $2E), ($24, $38, $1C, $1C), ($F1, $57, $A6, $A6), ($C7, $73, $B4, $B4), ($51, $97, $C6, $C6), ($23, $CB, $E8, $E8), ($7C, $A1, $DD, $DD), ($9C, $E8, $74, $74), ($21, $3E, $1F, $1F), ($DD, $96, $4B, $4B), ($DC, $61, $BD, $BD), ($86, $0D, $8B, $8B), ($85, $0F, $8A, $8A), + ($90, $E0, $70, $70), ($42, $7C, $3E, $3E), ($C4, $71, $B5, $B5), ($AA, $CC, $66, $66), ($D8, $90, $48, $48), ($05, $06, $03, $03), ($01, $F7, $F6, $F6), ($12, $1C, $0E, $0E), ($A3, $C2, $61, $61), ($5F, $6A, $35, $35), ($F9, $AE, $57, $57), ($D0, $69, $B9, $B9), ($91, $17, $86, $86), ($58, $99, $C1, $C1), + ($27, $3A, $1D, $1D), ($B9, $27, $9E, $9E), ($38, $D9, $E1, $E1), ($13, $EB, $F8, $F8), ($B3, $2B, $98, $98), ($33, $22, $11, $11), ($BB, $D2, $69, $69), ($70, $A9, $D9, $D9), ($89, $07, $8E, $8E), ($A7, $33, $94, $94), ($B6, $2D, $9B, $9B), ($22, $3C, $1E, $1E), ($92, $15, $87, $87), ($20, $C9, $E9, $E9), + ($49, $87, $CE, $CE), ($FF, $AA, $55, $55), ($78, $50, $28, $28), ($7A, $A5, $DF, $DF), ($8F, $03, $8C, $8C), ($F8, $59, $A1, $A1), ($80, $09, $89, $89), ($17, $1A, $0D, $0D), ($DA, $65, $BF, $BF), ($31, $D7, $E6, $E6), ($C6, $84, $42, $42), ($B8, $D0, $68, $68), ($C3, $82, $41, $41), ($B0, $29, $99, $99), + ($77, $5A, $2D, $2D), ($11, $1E, $0F, $0F), ($CB, $7B, $B0, $B0), ($FC, $A8, $54, $54), ($D6, $6D, $BB, $BB), ($3A, $2C, $16, $16)); + + T3: array [0 .. 255, 0 .. 3] of Byte = (($63, $A5, $C6, $63), ($7C, $84, $F8, $7C), ($77, $99, $EE, $77), ($7B, $8D, $F6, $7B), ($F2, $0D, $FF, $F2), ($6B, $BD, $D6, $6B), ($6F, $B1, $DE, $6F), ($C5, $54, $91, $C5), ($30, $50, $60, $30), ($01, $03, $02, $01), ($67, $A9, $CE, $67), ($2B, $7D, $56, $2B), + ($FE, $19, $E7, $FE), ($D7, $62, $B5, $D7), ($AB, $E6, $4D, $AB), ($76, $9A, $EC, $76), ($CA, $45, $8F, $CA), ($82, $9D, $1F, $82), ($C9, $40, $89, $C9), ($7D, $87, $FA, $7D), ($FA, $15, $EF, $FA), ($59, $EB, $B2, $59), ($47, $C9, $8E, $47), ($F0, $0B, $FB, $F0), ($AD, $EC, $41, $AD), ($D4, $67, $B3, $D4), + ($A2, $FD, $5F, $A2), ($AF, $EA, $45, $AF), ($9C, $BF, $23, $9C), ($A4, $F7, $53, $A4), ($72, $96, $E4, $72), ($C0, $5B, $9B, $C0), ($B7, $C2, $75, $B7), ($FD, $1C, $E1, $FD), ($93, $AE, $3D, $93), ($26, $6A, $4C, $26), ($36, $5A, $6C, $36), ($3F, $41, $7E, $3F), ($F7, $02, $F5, $F7), ($CC, $4F, $83, $CC), + ($34, $5C, $68, $34), ($A5, $F4, $51, $A5), ($E5, $34, $D1, $E5), ($F1, $08, $F9, $F1), ($71, $93, $E2, $71), ($D8, $73, $AB, $D8), ($31, $53, $62, $31), ($15, $3F, $2A, $15), ($04, $0C, $08, $04), ($C7, $52, $95, $C7), ($23, $65, $46, $23), ($C3, $5E, $9D, $C3), ($18, $28, $30, $18), ($96, $A1, $37, $96), + ($05, $0F, $0A, $05), ($9A, $B5, $2F, $9A), ($07, $09, $0E, $07), ($12, $36, $24, $12), ($80, $9B, $1B, $80), ($E2, $3D, $DF, $E2), ($EB, $26, $CD, $EB), ($27, $69, $4E, $27), ($B2, $CD, $7F, $B2), ($75, $9F, $EA, $75), ($09, $1B, $12, $09), ($83, $9E, $1D, $83), ($2C, $74, $58, $2C), ($1A, $2E, $34, $1A), + ($1B, $2D, $36, $1B), ($6E, $B2, $DC, $6E), ($5A, $EE, $B4, $5A), ($A0, $FB, $5B, $A0), ($52, $F6, $A4, $52), ($3B, $4D, $76, $3B), ($D6, $61, $B7, $D6), ($B3, $CE, $7D, $B3), ($29, $7B, $52, $29), ($E3, $3E, $DD, $E3), ($2F, $71, $5E, $2F), ($84, $97, $13, $84), ($53, $F5, $A6, $53), ($D1, $68, $B9, $D1), + ($00, $00, $00, $00), ($ED, $2C, $C1, $ED), ($20, $60, $40, $20), ($FC, $1F, $E3, $FC), ($B1, $C8, $79, $B1), ($5B, $ED, $B6, $5B), ($6A, $BE, $D4, $6A), ($CB, $46, $8D, $CB), ($BE, $D9, $67, $BE), ($39, $4B, $72, $39), ($4A, $DE, $94, $4A), ($4C, $D4, $98, $4C), ($58, $E8, $B0, $58), ($CF, $4A, $85, $CF), + ($D0, $6B, $BB, $D0), ($EF, $2A, $C5, $EF), ($AA, $E5, $4F, $AA), ($FB, $16, $ED, $FB), ($43, $C5, $86, $43), ($4D, $D7, $9A, $4D), ($33, $55, $66, $33), ($85, $94, $11, $85), ($45, $CF, $8A, $45), ($F9, $10, $E9, $F9), ($02, $06, $04, $02), ($7F, $81, $FE, $7F), ($50, $F0, $A0, $50), ($3C, $44, $78, $3C), + ($9F, $BA, $25, $9F), ($A8, $E3, $4B, $A8), ($51, $F3, $A2, $51), ($A3, $FE, $5D, $A3), ($40, $C0, $80, $40), ($8F, $8A, $05, $8F), ($92, $AD, $3F, $92), ($9D, $BC, $21, $9D), ($38, $48, $70, $38), ($F5, $04, $F1, $F5), ($BC, $DF, $63, $BC), ($B6, $C1, $77, $B6), ($DA, $75, $AF, $DA), ($21, $63, $42, $21), + ($10, $30, $20, $10), ($FF, $1A, $E5, $FF), ($F3, $0E, $FD, $F3), ($D2, $6D, $BF, $D2), ($CD, $4C, $81, $CD), ($0C, $14, $18, $0C), ($13, $35, $26, $13), ($EC, $2F, $C3, $EC), ($5F, $E1, $BE, $5F), ($97, $A2, $35, $97), ($44, $CC, $88, $44), ($17, $39, $2E, $17), ($C4, $57, $93, $C4), ($A7, $F2, $55, $A7), + ($7E, $82, $FC, $7E), ($3D, $47, $7A, $3D), ($64, $AC, $C8, $64), ($5D, $E7, $BA, $5D), ($19, $2B, $32, $19), ($73, $95, $E6, $73), ($60, $A0, $C0, $60), ($81, $98, $19, $81), ($4F, $D1, $9E, $4F), ($DC, $7F, $A3, $DC), ($22, $66, $44, $22), ($2A, $7E, $54, $2A), ($90, $AB, $3B, $90), ($88, $83, $0B, $88), + ($46, $CA, $8C, $46), ($EE, $29, $C7, $EE), ($B8, $D3, $6B, $B8), ($14, $3C, $28, $14), ($DE, $79, $A7, $DE), ($5E, $E2, $BC, $5E), ($0B, $1D, $16, $0B), ($DB, $76, $AD, $DB), ($E0, $3B, $DB, $E0), ($32, $56, $64, $32), ($3A, $4E, $74, $3A), ($0A, $1E, $14, $0A), ($49, $DB, $92, $49), ($06, $0A, $0C, $06), + ($24, $6C, $48, $24), ($5C, $E4, $B8, $5C), ($C2, $5D, $9F, $C2), ($D3, $6E, $BD, $D3), ($AC, $EF, $43, $AC), ($62, $A6, $C4, $62), ($91, $A8, $39, $91), ($95, $A4, $31, $95), ($E4, $37, $D3, $E4), ($79, $8B, $F2, $79), ($E7, $32, $D5, $E7), ($C8, $43, $8B, $C8), ($37, $59, $6E, $37), ($6D, $B7, $DA, $6D), + ($8D, $8C, $01, $8D), ($D5, $64, $B1, $D5), ($4E, $D2, $9C, $4E), ($A9, $E0, $49, $A9), ($6C, $B4, $D8, $6C), ($56, $FA, $AC, $56), ($F4, $07, $F3, $F4), ($EA, $25, $CF, $EA), ($65, $AF, $CA, $65), ($7A, $8E, $F4, $7A), ($AE, $E9, $47, $AE), ($08, $18, $10, $08), ($BA, $D5, $6F, $BA), ($78, $88, $F0, $78), + ($25, $6F, $4A, $25), ($2E, $72, $5C, $2E), ($1C, $24, $38, $1C), ($A6, $F1, $57, $A6), ($B4, $C7, $73, $B4), ($C6, $51, $97, $C6), ($E8, $23, $CB, $E8), ($DD, $7C, $A1, $DD), ($74, $9C, $E8, $74), ($1F, $21, $3E, $1F), ($4B, $DD, $96, $4B), ($BD, $DC, $61, $BD), ($8B, $86, $0D, $8B), ($8A, $85, $0F, $8A), + ($70, $90, $E0, $70), ($3E, $42, $7C, $3E), ($B5, $C4, $71, $B5), ($66, $AA, $CC, $66), ($48, $D8, $90, $48), ($03, $05, $06, $03), ($F6, $01, $F7, $F6), ($0E, $12, $1C, $0E), ($61, $A3, $C2, $61), ($35, $5F, $6A, $35), ($57, $F9, $AE, $57), ($B9, $D0, $69, $B9), ($86, $91, $17, $86), ($C1, $58, $99, $C1), + ($1D, $27, $3A, $1D), ($9E, $B9, $27, $9E), ($E1, $38, $D9, $E1), ($F8, $13, $EB, $F8), ($98, $B3, $2B, $98), ($11, $33, $22, $11), ($69, $BB, $D2, $69), ($D9, $70, $A9, $D9), ($8E, $89, $07, $8E), ($94, $A7, $33, $94), ($9B, $B6, $2D, $9B), ($1E, $22, $3C, $1E), ($87, $92, $15, $87), ($E9, $20, $C9, $E9), + ($CE, $49, $87, $CE), ($55, $FF, $AA, $55), ($28, $78, $50, $28), ($DF, $7A, $A5, $DF), ($8C, $8F, $03, $8C), ($A1, $F8, $59, $A1), ($89, $80, $09, $89), ($0D, $17, $1A, $0D), ($BF, $DA, $65, $BF), ($E6, $31, $D7, $E6), ($42, $C6, $84, $42), ($68, $B8, $D0, $68), ($41, $C3, $82, $41), ($99, $B0, $29, $99), + ($2D, $77, $5A, $2D), ($0F, $11, $1E, $0F), ($B0, $CB, $7B, $B0), ($54, $FC, $A8, $54), ($BB, $D6, $6D, $BB), ($16, $3A, $2C, $16)); + + T4: array [0 .. 255, 0 .. 3] of Byte = (($63, $63, $A5, $C6), ($7C, $7C, $84, $F8), ($77, $77, $99, $EE), ($7B, $7B, $8D, $F6), ($F2, $F2, $0D, $FF), ($6B, $6B, $BD, $D6), ($6F, $6F, $B1, $DE), ($C5, $C5, $54, $91), ($30, $30, $50, $60), ($01, $01, $03, $02), ($67, $67, $A9, $CE), ($2B, $2B, $7D, $56), + ($FE, $FE, $19, $E7), ($D7, $D7, $62, $B5), ($AB, $AB, $E6, $4D), ($76, $76, $9A, $EC), ($CA, $CA, $45, $8F), ($82, $82, $9D, $1F), ($C9, $C9, $40, $89), ($7D, $7D, $87, $FA), ($FA, $FA, $15, $EF), ($59, $59, $EB, $B2), ($47, $47, $C9, $8E), ($F0, $F0, $0B, $FB), ($AD, $AD, $EC, $41), ($D4, $D4, $67, $B3), + ($A2, $A2, $FD, $5F), ($AF, $AF, $EA, $45), ($9C, $9C, $BF, $23), ($A4, $A4, $F7, $53), ($72, $72, $96, $E4), ($C0, $C0, $5B, $9B), ($B7, $B7, $C2, $75), ($FD, $FD, $1C, $E1), ($93, $93, $AE, $3D), ($26, $26, $6A, $4C), ($36, $36, $5A, $6C), ($3F, $3F, $41, $7E), ($F7, $F7, $02, $F5), ($CC, $CC, $4F, $83), + ($34, $34, $5C, $68), ($A5, $A5, $F4, $51), ($E5, $E5, $34, $D1), ($F1, $F1, $08, $F9), ($71, $71, $93, $E2), ($D8, $D8, $73, $AB), ($31, $31, $53, $62), ($15, $15, $3F, $2A), ($04, $04, $0C, $08), ($C7, $C7, $52, $95), ($23, $23, $65, $46), ($C3, $C3, $5E, $9D), ($18, $18, $28, $30), ($96, $96, $A1, $37), + ($05, $05, $0F, $0A), ($9A, $9A, $B5, $2F), ($07, $07, $09, $0E), ($12, $12, $36, $24), ($80, $80, $9B, $1B), ($E2, $E2, $3D, $DF), ($EB, $EB, $26, $CD), ($27, $27, $69, $4E), ($B2, $B2, $CD, $7F), ($75, $75, $9F, $EA), ($09, $09, $1B, $12), ($83, $83, $9E, $1D), ($2C, $2C, $74, $58), ($1A, $1A, $2E, $34), + ($1B, $1B, $2D, $36), ($6E, $6E, $B2, $DC), ($5A, $5A, $EE, $B4), ($A0, $A0, $FB, $5B), ($52, $52, $F6, $A4), ($3B, $3B, $4D, $76), ($D6, $D6, $61, $B7), ($B3, $B3, $CE, $7D), ($29, $29, $7B, $52), ($E3, $E3, $3E, $DD), ($2F, $2F, $71, $5E), ($84, $84, $97, $13), ($53, $53, $F5, $A6), ($D1, $D1, $68, $B9), + ($00, $00, $00, $00), ($ED, $ED, $2C, $C1), ($20, $20, $60, $40), ($FC, $FC, $1F, $E3), ($B1, $B1, $C8, $79), ($5B, $5B, $ED, $B6), ($6A, $6A, $BE, $D4), ($CB, $CB, $46, $8D), ($BE, $BE, $D9, $67), ($39, $39, $4B, $72), ($4A, $4A, $DE, $94), ($4C, $4C, $D4, $98), ($58, $58, $E8, $B0), ($CF, $CF, $4A, $85), + ($D0, $D0, $6B, $BB), ($EF, $EF, $2A, $C5), ($AA, $AA, $E5, $4F), ($FB, $FB, $16, $ED), ($43, $43, $C5, $86), ($4D, $4D, $D7, $9A), ($33, $33, $55, $66), ($85, $85, $94, $11), ($45, $45, $CF, $8A), ($F9, $F9, $10, $E9), ($02, $02, $06, $04), ($7F, $7F, $81, $FE), ($50, $50, $F0, $A0), ($3C, $3C, $44, $78), + ($9F, $9F, $BA, $25), ($A8, $A8, $E3, $4B), ($51, $51, $F3, $A2), ($A3, $A3, $FE, $5D), ($40, $40, $C0, $80), ($8F, $8F, $8A, $05), ($92, $92, $AD, $3F), ($9D, $9D, $BC, $21), ($38, $38, $48, $70), ($F5, $F5, $04, $F1), ($BC, $BC, $DF, $63), ($B6, $B6, $C1, $77), ($DA, $DA, $75, $AF), ($21, $21, $63, $42), + ($10, $10, $30, $20), ($FF, $FF, $1A, $E5), ($F3, $F3, $0E, $FD), ($D2, $D2, $6D, $BF), ($CD, $CD, $4C, $81), ($0C, $0C, $14, $18), ($13, $13, $35, $26), ($EC, $EC, $2F, $C3), ($5F, $5F, $E1, $BE), ($97, $97, $A2, $35), ($44, $44, $CC, $88), ($17, $17, $39, $2E), ($C4, $C4, $57, $93), ($A7, $A7, $F2, $55), + ($7E, $7E, $82, $FC), ($3D, $3D, $47, $7A), ($64, $64, $AC, $C8), ($5D, $5D, $E7, $BA), ($19, $19, $2B, $32), ($73, $73, $95, $E6), ($60, $60, $A0, $C0), ($81, $81, $98, $19), ($4F, $4F, $D1, $9E), ($DC, $DC, $7F, $A3), ($22, $22, $66, $44), ($2A, $2A, $7E, $54), ($90, $90, $AB, $3B), ($88, $88, $83, $0B), + ($46, $46, $CA, $8C), ($EE, $EE, $29, $C7), ($B8, $B8, $D3, $6B), ($14, $14, $3C, $28), ($DE, $DE, $79, $A7), ($5E, $5E, $E2, $BC), ($0B, $0B, $1D, $16), ($DB, $DB, $76, $AD), ($E0, $E0, $3B, $DB), ($32, $32, $56, $64), ($3A, $3A, $4E, $74), ($0A, $0A, $1E, $14), ($49, $49, $DB, $92), ($06, $06, $0A, $0C), + ($24, $24, $6C, $48), ($5C, $5C, $E4, $B8), ($C2, $C2, $5D, $9F), ($D3, $D3, $6E, $BD), ($AC, $AC, $EF, $43), ($62, $62, $A6, $C4), ($91, $91, $A8, $39), ($95, $95, $A4, $31), ($E4, $E4, $37, $D3), ($79, $79, $8B, $F2), ($E7, $E7, $32, $D5), ($C8, $C8, $43, $8B), ($37, $37, $59, $6E), ($6D, $6D, $B7, $DA), + ($8D, $8D, $8C, $01), ($D5, $D5, $64, $B1), ($4E, $4E, $D2, $9C), ($A9, $A9, $E0, $49), ($6C, $6C, $B4, $D8), ($56, $56, $FA, $AC), ($F4, $F4, $07, $F3), ($EA, $EA, $25, $CF), ($65, $65, $AF, $CA), ($7A, $7A, $8E, $F4), ($AE, $AE, $E9, $47), ($08, $08, $18, $10), ($BA, $BA, $D5, $6F), ($78, $78, $88, $F0), + ($25, $25, $6F, $4A), ($2E, $2E, $72, $5C), ($1C, $1C, $24, $38), ($A6, $A6, $F1, $57), ($B4, $B4, $C7, $73), ($C6, $C6, $51, $97), ($E8, $E8, $23, $CB), ($DD, $DD, $7C, $A1), ($74, $74, $9C, $E8), ($1F, $1F, $21, $3E), ($4B, $4B, $DD, $96), ($BD, $BD, $DC, $61), ($8B, $8B, $86, $0D), ($8A, $8A, $85, $0F), + ($70, $70, $90, $E0), ($3E, $3E, $42, $7C), ($B5, $B5, $C4, $71), ($66, $66, $AA, $CC), ($48, $48, $D8, $90), ($03, $03, $05, $06), ($F6, $F6, $01, $F7), ($0E, $0E, $12, $1C), ($61, $61, $A3, $C2), ($35, $35, $5F, $6A), ($57, $57, $F9, $AE), ($B9, $B9, $D0, $69), ($86, $86, $91, $17), ($C1, $C1, $58, $99), + ($1D, $1D, $27, $3A), ($9E, $9E, $B9, $27), ($E1, $E1, $38, $D9), ($F8, $F8, $13, $EB), ($98, $98, $B3, $2B), ($11, $11, $33, $22), ($69, $69, $BB, $D2), ($D9, $D9, $70, $A9), ($8E, $8E, $89, $07), ($94, $94, $A7, $33), ($9B, $9B, $B6, $2D), ($1E, $1E, $22, $3C), ($87, $87, $92, $15), ($E9, $E9, $20, $C9), + ($CE, $CE, $49, $87), ($55, $55, $FF, $AA), ($28, $28, $78, $50), ($DF, $DF, $7A, $A5), ($8C, $8C, $8F, $03), ($A1, $A1, $F8, $59), ($89, $89, $80, $09), ($0D, $0D, $17, $1A), ($BF, $BF, $DA, $65), ($E6, $E6, $31, $D7), ($42, $42, $C6, $84), ($68, $68, $B8, $D0), ($41, $41, $C3, $82), ($99, $99, $B0, $29), + ($2D, $2D, $77, $5A), ($0F, $0F, $11, $1E), ($B0, $B0, $CB, $7B), ($54, $54, $FC, $A8), ($BB, $BB, $D6, $6D), ($16, $16, $3A, $2C)); + + T5: array [0 .. 255, 0 .. 3] of Byte = (($51, $F4, $A7, $50), ($7E, $41, $65, $53), ($1A, $17, $A4, $C3), ($3A, $27, $5E, $96), ($3B, $AB, $6B, $CB), ($1F, $9D, $45, $F1), ($AC, $FA, $58, $AB), ($4B, $E3, $03, $93), ($20, $30, $FA, $55), ($AD, $76, $6D, $F6), ($88, $CC, $76, $91), ($F5, $02, $4C, $25), + ($4F, $E5, $D7, $FC), ($C5, $2A, $CB, $D7), ($26, $35, $44, $80), ($B5, $62, $A3, $8F), ($DE, $B1, $5A, $49), ($25, $BA, $1B, $67), ($45, $EA, $0E, $98), ($5D, $FE, $C0, $E1), ($C3, $2F, $75, $02), ($81, $4C, $F0, $12), ($8D, $46, $97, $A3), ($6B, $D3, $F9, $C6), ($03, $8F, $5F, $E7), ($15, $92, $9C, $95), + ($BF, $6D, $7A, $EB), ($95, $52, $59, $DA), ($D4, $BE, $83, $2D), ($58, $74, $21, $D3), ($49, $E0, $69, $29), ($8E, $C9, $C8, $44), ($75, $C2, $89, $6A), ($F4, $8E, $79, $78), ($99, $58, $3E, $6B), ($27, $B9, $71, $DD), ($BE, $E1, $4F, $B6), ($F0, $88, $AD, $17), ($C9, $20, $AC, $66), ($7D, $CE, $3A, $B4), + ($63, $DF, $4A, $18), ($E5, $1A, $31, $82), ($97, $51, $33, $60), ($62, $53, $7F, $45), ($B1, $64, $77, $E0), ($BB, $6B, $AE, $84), ($FE, $81, $A0, $1C), ($F9, $08, $2B, $94), ($70, $48, $68, $58), ($8F, $45, $FD, $19), ($94, $DE, $6C, $87), ($52, $7B, $F8, $B7), ($AB, $73, $D3, $23), ($72, $4B, $02, $E2), + ($E3, $1F, $8F, $57), ($66, $55, $AB, $2A), ($B2, $EB, $28, $07), ($2F, $B5, $C2, $03), ($86, $C5, $7B, $9A), ($D3, $37, $08, $A5), ($30, $28, $87, $F2), ($23, $BF, $A5, $B2), ($02, $03, $6A, $BA), ($ED, $16, $82, $5C), ($8A, $CF, $1C, $2B), ($A7, $79, $B4, $92), ($F3, $07, $F2, $F0), ($4E, $69, $E2, $A1), + ($65, $DA, $F4, $CD), ($06, $05, $BE, $D5), ($D1, $34, $62, $1F), ($C4, $A6, $FE, $8A), ($34, $2E, $53, $9D), ($A2, $F3, $55, $A0), ($05, $8A, $E1, $32), ($A4, $F6, $EB, $75), ($0B, $83, $EC, $39), ($40, $60, $EF, $AA), ($5E, $71, $9F, $06), ($BD, $6E, $10, $51), ($3E, $21, $8A, $F9), ($96, $DD, $06, $3D), + ($DD, $3E, $05, $AE), ($4D, $E6, $BD, $46), ($91, $54, $8D, $B5), ($71, $C4, $5D, $05), ($04, $06, $D4, $6F), ($60, $50, $15, $FF), ($19, $98, $FB, $24), ($D6, $BD, $E9, $97), ($89, $40, $43, $CC), ($67, $D9, $9E, $77), ($B0, $E8, $42, $BD), ($07, $89, $8B, $88), ($E7, $19, $5B, $38), ($79, $C8, $EE, $DB), + ($A1, $7C, $0A, $47), ($7C, $42, $0F, $E9), ($F8, $84, $1E, $C9), ($00, $00, $00, $00), ($09, $80, $86, $83), ($32, $2B, $ED, $48), ($1E, $11, $70, $AC), ($6C, $5A, $72, $4E), ($FD, $0E, $FF, $FB), ($0F, $85, $38, $56), ($3D, $AE, $D5, $1E), ($36, $2D, $39, $27), ($0A, $0F, $D9, $64), ($68, $5C, $A6, $21), + ($9B, $5B, $54, $D1), ($24, $36, $2E, $3A), ($0C, $0A, $67, $B1), ($93, $57, $E7, $0F), ($B4, $EE, $96, $D2), ($1B, $9B, $91, $9E), ($80, $C0, $C5, $4F), ($61, $DC, $20, $A2), ($5A, $77, $4B, $69), ($1C, $12, $1A, $16), ($E2, $93, $BA, $0A), ($C0, $A0, $2A, $E5), ($3C, $22, $E0, $43), ($12, $1B, $17, $1D), + ($0E, $09, $0D, $0B), ($F2, $8B, $C7, $AD), ($2D, $B6, $A8, $B9), ($14, $1E, $A9, $C8), ($57, $F1, $19, $85), ($AF, $75, $07, $4C), ($EE, $99, $DD, $BB), ($A3, $7F, $60, $FD), ($F7, $01, $26, $9F), ($5C, $72, $F5, $BC), ($44, $66, $3B, $C5), ($5B, $FB, $7E, $34), ($8B, $43, $29, $76), ($CB, $23, $C6, $DC), + ($B6, $ED, $FC, $68), ($B8, $E4, $F1, $63), ($D7, $31, $DC, $CA), ($42, $63, $85, $10), ($13, $97, $22, $40), ($84, $C6, $11, $20), ($85, $4A, $24, $7D), ($D2, $BB, $3D, $F8), ($AE, $F9, $32, $11), ($C7, $29, $A1, $6D), ($1D, $9E, $2F, $4B), ($DC, $B2, $30, $F3), ($0D, $86, $52, $EC), ($77, $C1, $E3, $D0), + ($2B, $B3, $16, $6C), ($A9, $70, $B9, $99), ($11, $94, $48, $FA), ($47, $E9, $64, $22), ($A8, $FC, $8C, $C4), ($A0, $F0, $3F, $1A), ($56, $7D, $2C, $D8), ($22, $33, $90, $EF), ($87, $49, $4E, $C7), ($D9, $38, $D1, $C1), ($8C, $CA, $A2, $FE), ($98, $D4, $0B, $36), ($A6, $F5, $81, $CF), ($A5, $7A, $DE, $28), + ($DA, $B7, $8E, $26), ($3F, $AD, $BF, $A4), ($2C, $3A, $9D, $E4), ($50, $78, $92, $0D), ($6A, $5F, $CC, $9B), ($54, $7E, $46, $62), ($F6, $8D, $13, $C2), ($90, $D8, $B8, $E8), ($2E, $39, $F7, $5E), ($82, $C3, $AF, $F5), ($9F, $5D, $80, $BE), ($69, $D0, $93, $7C), ($6F, $D5, $2D, $A9), ($CF, $25, $12, $B3), + ($C8, $AC, $99, $3B), ($10, $18, $7D, $A7), ($E8, $9C, $63, $6E), ($DB, $3B, $BB, $7B), ($CD, $26, $78, $09), ($6E, $59, $18, $F4), ($EC, $9A, $B7, $01), ($83, $4F, $9A, $A8), ($E6, $95, $6E, $65), ($AA, $FF, $E6, $7E), ($21, $BC, $CF, $08), ($EF, $15, $E8, $E6), ($BA, $E7, $9B, $D9), ($4A, $6F, $36, $CE), + ($EA, $9F, $09, $D4), ($29, $B0, $7C, $D6), ($31, $A4, $B2, $AF), ($2A, $3F, $23, $31), ($C6, $A5, $94, $30), ($35, $A2, $66, $C0), ($74, $4E, $BC, $37), ($FC, $82, $CA, $A6), ($E0, $90, $D0, $B0), ($33, $A7, $D8, $15), ($F1, $04, $98, $4A), ($41, $EC, $DA, $F7), ($7F, $CD, $50, $0E), ($17, $91, $F6, $2F), + ($76, $4D, $D6, $8D), ($43, $EF, $B0, $4D), ($CC, $AA, $4D, $54), ($E4, $96, $04, $DF), ($9E, $D1, $B5, $E3), ($4C, $6A, $88, $1B), ($C1, $2C, $1F, $B8), ($46, $65, $51, $7F), ($9D, $5E, $EA, $04), ($01, $8C, $35, $5D), ($FA, $87, $74, $73), ($FB, $0B, $41, $2E), ($B3, $67, $1D, $5A), ($92, $DB, $D2, $52), + ($E9, $10, $56, $33), ($6D, $D6, $47, $13), ($9A, $D7, $61, $8C), ($37, $A1, $0C, $7A), ($59, $F8, $14, $8E), ($EB, $13, $3C, $89), ($CE, $A9, $27, $EE), ($B7, $61, $C9, $35), ($E1, $1C, $E5, $ED), ($7A, $47, $B1, $3C), ($9C, $D2, $DF, $59), ($55, $F2, $73, $3F), ($18, $14, $CE, $79), ($73, $C7, $37, $BF), + ($53, $F7, $CD, $EA), ($5F, $FD, $AA, $5B), ($DF, $3D, $6F, $14), ($78, $44, $DB, $86), ($CA, $AF, $F3, $81), ($B9, $68, $C4, $3E), ($38, $24, $34, $2C), ($C2, $A3, $40, $5F), ($16, $1D, $C3, $72), ($BC, $E2, $25, $0C), ($28, $3C, $49, $8B), ($FF, $0D, $95, $41), ($39, $A8, $01, $71), ($08, $0C, $B3, $DE), + ($D8, $B4, $E4, $9C), ($64, $56, $C1, $90), ($7B, $CB, $84, $61), ($D5, $32, $B6, $70), ($48, $6C, $5C, $74), ($D0, $B8, $57, $42)); + + T6: array [0 .. 255, 0 .. 3] of Byte = (($50, $51, $F4, $A7), ($53, $7E, $41, $65), ($C3, $1A, $17, $A4), ($96, $3A, $27, $5E), ($CB, $3B, $AB, $6B), ($F1, $1F, $9D, $45), ($AB, $AC, $FA, $58), ($93, $4B, $E3, $03), ($55, $20, $30, $FA), ($F6, $AD, $76, $6D), ($91, $88, $CC, $76), ($25, $F5, $02, $4C), + ($FC, $4F, $E5, $D7), ($D7, $C5, $2A, $CB), ($80, $26, $35, $44), ($8F, $B5, $62, $A3), ($49, $DE, $B1, $5A), ($67, $25, $BA, $1B), ($98, $45, $EA, $0E), ($E1, $5D, $FE, $C0), ($02, $C3, $2F, $75), ($12, $81, $4C, $F0), ($A3, $8D, $46, $97), ($C6, $6B, $D3, $F9), ($E7, $03, $8F, $5F), ($95, $15, $92, $9C), + ($EB, $BF, $6D, $7A), ($DA, $95, $52, $59), ($2D, $D4, $BE, $83), ($D3, $58, $74, $21), ($29, $49, $E0, $69), ($44, $8E, $C9, $C8), ($6A, $75, $C2, $89), ($78, $F4, $8E, $79), ($6B, $99, $58, $3E), ($DD, $27, $B9, $71), ($B6, $BE, $E1, $4F), ($17, $F0, $88, $AD), ($66, $C9, $20, $AC), ($B4, $7D, $CE, $3A), + ($18, $63, $DF, $4A), ($82, $E5, $1A, $31), ($60, $97, $51, $33), ($45, $62, $53, $7F), ($E0, $B1, $64, $77), ($84, $BB, $6B, $AE), ($1C, $FE, $81, $A0), ($94, $F9, $08, $2B), ($58, $70, $48, $68), ($19, $8F, $45, $FD), ($87, $94, $DE, $6C), ($B7, $52, $7B, $F8), ($23, $AB, $73, $D3), ($E2, $72, $4B, $02), + ($57, $E3, $1F, $8F), ($2A, $66, $55, $AB), ($07, $B2, $EB, $28), ($03, $2F, $B5, $C2), ($9A, $86, $C5, $7B), ($A5, $D3, $37, $08), ($F2, $30, $28, $87), ($B2, $23, $BF, $A5), ($BA, $02, $03, $6A), ($5C, $ED, $16, $82), ($2B, $8A, $CF, $1C), ($92, $A7, $79, $B4), ($F0, $F3, $07, $F2), ($A1, $4E, $69, $E2), + ($CD, $65, $DA, $F4), ($D5, $06, $05, $BE), ($1F, $D1, $34, $62), ($8A, $C4, $A6, $FE), ($9D, $34, $2E, $53), ($A0, $A2, $F3, $55), ($32, $05, $8A, $E1), ($75, $A4, $F6, $EB), ($39, $0B, $83, $EC), ($AA, $40, $60, $EF), ($06, $5E, $71, $9F), ($51, $BD, $6E, $10), ($F9, $3E, $21, $8A), ($3D, $96, $DD, $06), + ($AE, $DD, $3E, $05), ($46, $4D, $E6, $BD), ($B5, $91, $54, $8D), ($05, $71, $C4, $5D), ($6F, $04, $06, $D4), ($FF, $60, $50, $15), ($24, $19, $98, $FB), ($97, $D6, $BD, $E9), ($CC, $89, $40, $43), ($77, $67, $D9, $9E), ($BD, $B0, $E8, $42), ($88, $07, $89, $8B), ($38, $E7, $19, $5B), ($DB, $79, $C8, $EE), + ($47, $A1, $7C, $0A), ($E9, $7C, $42, $0F), ($C9, $F8, $84, $1E), ($00, $00, $00, $00), ($83, $09, $80, $86), ($48, $32, $2B, $ED), ($AC, $1E, $11, $70), ($4E, $6C, $5A, $72), ($FB, $FD, $0E, $FF), ($56, $0F, $85, $38), ($1E, $3D, $AE, $D5), ($27, $36, $2D, $39), ($64, $0A, $0F, $D9), ($21, $68, $5C, $A6), + ($D1, $9B, $5B, $54), ($3A, $24, $36, $2E), ($B1, $0C, $0A, $67), ($0F, $93, $57, $E7), ($D2, $B4, $EE, $96), ($9E, $1B, $9B, $91), ($4F, $80, $C0, $C5), ($A2, $61, $DC, $20), ($69, $5A, $77, $4B), ($16, $1C, $12, $1A), ($0A, $E2, $93, $BA), ($E5, $C0, $A0, $2A), ($43, $3C, $22, $E0), ($1D, $12, $1B, $17), + ($0B, $0E, $09, $0D), ($AD, $F2, $8B, $C7), ($B9, $2D, $B6, $A8), ($C8, $14, $1E, $A9), ($85, $57, $F1, $19), ($4C, $AF, $75, $07), ($BB, $EE, $99, $DD), ($FD, $A3, $7F, $60), ($9F, $F7, $01, $26), ($BC, $5C, $72, $F5), ($C5, $44, $66, $3B), ($34, $5B, $FB, $7E), ($76, $8B, $43, $29), ($DC, $CB, $23, $C6), + ($68, $B6, $ED, $FC), ($63, $B8, $E4, $F1), ($CA, $D7, $31, $DC), ($10, $42, $63, $85), ($40, $13, $97, $22), ($20, $84, $C6, $11), ($7D, $85, $4A, $24), ($F8, $D2, $BB, $3D), ($11, $AE, $F9, $32), ($6D, $C7, $29, $A1), ($4B, $1D, $9E, $2F), ($F3, $DC, $B2, $30), ($EC, $0D, $86, $52), ($D0, $77, $C1, $E3), + ($6C, $2B, $B3, $16), ($99, $A9, $70, $B9), ($FA, $11, $94, $48), ($22, $47, $E9, $64), ($C4, $A8, $FC, $8C), ($1A, $A0, $F0, $3F), ($D8, $56, $7D, $2C), ($EF, $22, $33, $90), ($C7, $87, $49, $4E), ($C1, $D9, $38, $D1), ($FE, $8C, $CA, $A2), ($36, $98, $D4, $0B), ($CF, $A6, $F5, $81), ($28, $A5, $7A, $DE), + ($26, $DA, $B7, $8E), ($A4, $3F, $AD, $BF), ($E4, $2C, $3A, $9D), ($0D, $50, $78, $92), ($9B, $6A, $5F, $CC), ($62, $54, $7E, $46), ($C2, $F6, $8D, $13), ($E8, $90, $D8, $B8), ($5E, $2E, $39, $F7), ($F5, $82, $C3, $AF), ($BE, $9F, $5D, $80), ($7C, $69, $D0, $93), ($A9, $6F, $D5, $2D), ($B3, $CF, $25, $12), + ($3B, $C8, $AC, $99), ($A7, $10, $18, $7D), ($6E, $E8, $9C, $63), ($7B, $DB, $3B, $BB), ($09, $CD, $26, $78), ($F4, $6E, $59, $18), ($01, $EC, $9A, $B7), ($A8, $83, $4F, $9A), ($65, $E6, $95, $6E), ($7E, $AA, $FF, $E6), ($08, $21, $BC, $CF), ($E6, $EF, $15, $E8), ($D9, $BA, $E7, $9B), ($CE, $4A, $6F, $36), + ($D4, $EA, $9F, $09), ($D6, $29, $B0, $7C), ($AF, $31, $A4, $B2), ($31, $2A, $3F, $23), ($30, $C6, $A5, $94), ($C0, $35, $A2, $66), ($37, $74, $4E, $BC), ($A6, $FC, $82, $CA), ($B0, $E0, $90, $D0), ($15, $33, $A7, $D8), ($4A, $F1, $04, $98), ($F7, $41, $EC, $DA), ($0E, $7F, $CD, $50), ($2F, $17, $91, $F6), + ($8D, $76, $4D, $D6), ($4D, $43, $EF, $B0), ($54, $CC, $AA, $4D), ($DF, $E4, $96, $04), ($E3, $9E, $D1, $B5), ($1B, $4C, $6A, $88), ($B8, $C1, $2C, $1F), ($7F, $46, $65, $51), ($04, $9D, $5E, $EA), ($5D, $01, $8C, $35), ($73, $FA, $87, $74), ($2E, $FB, $0B, $41), ($5A, $B3, $67, $1D), ($52, $92, $DB, $D2), + ($33, $E9, $10, $56), ($13, $6D, $D6, $47), ($8C, $9A, $D7, $61), ($7A, $37, $A1, $0C), ($8E, $59, $F8, $14), ($89, $EB, $13, $3C), ($EE, $CE, $A9, $27), ($35, $B7, $61, $C9), ($ED, $E1, $1C, $E5), ($3C, $7A, $47, $B1), ($59, $9C, $D2, $DF), ($3F, $55, $F2, $73), ($79, $18, $14, $CE), ($BF, $73, $C7, $37), + ($EA, $53, $F7, $CD), ($5B, $5F, $FD, $AA), ($14, $DF, $3D, $6F), ($86, $78, $44, $DB), ($81, $CA, $AF, $F3), ($3E, $B9, $68, $C4), ($2C, $38, $24, $34), ($5F, $C2, $A3, $40), ($72, $16, $1D, $C3), ($0C, $BC, $E2, $25), ($8B, $28, $3C, $49), ($41, $FF, $0D, $95), ($71, $39, $A8, $01), ($DE, $08, $0C, $B3), + ($9C, $D8, $B4, $E4), ($90, $64, $56, $C1), ($61, $7B, $CB, $84), ($70, $D5, $32, $B6), ($74, $48, $6C, $5C), ($42, $D0, $B8, $57)); + + T7: array [0 .. 255, 0 .. 3] of Byte = (($A7, $50, $51, $F4), ($65, $53, $7E, $41), ($A4, $C3, $1A, $17), ($5E, $96, $3A, $27), ($6B, $CB, $3B, $AB), ($45, $F1, $1F, $9D), ($58, $AB, $AC, $FA), ($03, $93, $4B, $E3), ($FA, $55, $20, $30), ($6D, $F6, $AD, $76), ($76, $91, $88, $CC), ($4C, $25, $F5, $02), + ($D7, $FC, $4F, $E5), ($CB, $D7, $C5, $2A), ($44, $80, $26, $35), ($A3, $8F, $B5, $62), ($5A, $49, $DE, $B1), ($1B, $67, $25, $BA), ($0E, $98, $45, $EA), ($C0, $E1, $5D, $FE), ($75, $02, $C3, $2F), ($F0, $12, $81, $4C), ($97, $A3, $8D, $46), ($F9, $C6, $6B, $D3), ($5F, $E7, $03, $8F), ($9C, $95, $15, $92), + ($7A, $EB, $BF, $6D), ($59, $DA, $95, $52), ($83, $2D, $D4, $BE), ($21, $D3, $58, $74), ($69, $29, $49, $E0), ($C8, $44, $8E, $C9), ($89, $6A, $75, $C2), ($79, $78, $F4, $8E), ($3E, $6B, $99, $58), ($71, $DD, $27, $B9), ($4F, $B6, $BE, $E1), ($AD, $17, $F0, $88), ($AC, $66, $C9, $20), ($3A, $B4, $7D, $CE), + ($4A, $18, $63, $DF), ($31, $82, $E5, $1A), ($33, $60, $97, $51), ($7F, $45, $62, $53), ($77, $E0, $B1, $64), ($AE, $84, $BB, $6B), ($A0, $1C, $FE, $81), ($2B, $94, $F9, $08), ($68, $58, $70, $48), ($FD, $19, $8F, $45), ($6C, $87, $94, $DE), ($F8, $B7, $52, $7B), ($D3, $23, $AB, $73), ($02, $E2, $72, $4B), + ($8F, $57, $E3, $1F), ($AB, $2A, $66, $55), ($28, $07, $B2, $EB), ($C2, $03, $2F, $B5), ($7B, $9A, $86, $C5), ($08, $A5, $D3, $37), ($87, $F2, $30, $28), ($A5, $B2, $23, $BF), ($6A, $BA, $02, $03), ($82, $5C, $ED, $16), ($1C, $2B, $8A, $CF), ($B4, $92, $A7, $79), ($F2, $F0, $F3, $07), ($E2, $A1, $4E, $69), + ($F4, $CD, $65, $DA), ($BE, $D5, $06, $05), ($62, $1F, $D1, $34), ($FE, $8A, $C4, $A6), ($53, $9D, $34, $2E), ($55, $A0, $A2, $F3), ($E1, $32, $05, $8A), ($EB, $75, $A4, $F6), ($EC, $39, $0B, $83), ($EF, $AA, $40, $60), ($9F, $06, $5E, $71), ($10, $51, $BD, $6E), ($8A, $F9, $3E, $21), ($06, $3D, $96, $DD), + ($05, $AE, $DD, $3E), ($BD, $46, $4D, $E6), ($8D, $B5, $91, $54), ($5D, $05, $71, $C4), ($D4, $6F, $04, $06), ($15, $FF, $60, $50), ($FB, $24, $19, $98), ($E9, $97, $D6, $BD), ($43, $CC, $89, $40), ($9E, $77, $67, $D9), ($42, $BD, $B0, $E8), ($8B, $88, $07, $89), ($5B, $38, $E7, $19), ($EE, $DB, $79, $C8), + ($0A, $47, $A1, $7C), ($0F, $E9, $7C, $42), ($1E, $C9, $F8, $84), ($00, $00, $00, $00), ($86, $83, $09, $80), ($ED, $48, $32, $2B), ($70, $AC, $1E, $11), ($72, $4E, $6C, $5A), ($FF, $FB, $FD, $0E), ($38, $56, $0F, $85), ($D5, $1E, $3D, $AE), ($39, $27, $36, $2D), ($D9, $64, $0A, $0F), ($A6, $21, $68, $5C), + ($54, $D1, $9B, $5B), ($2E, $3A, $24, $36), ($67, $B1, $0C, $0A), ($E7, $0F, $93, $57), ($96, $D2, $B4, $EE), ($91, $9E, $1B, $9B), ($C5, $4F, $80, $C0), ($20, $A2, $61, $DC), ($4B, $69, $5A, $77), ($1A, $16, $1C, $12), ($BA, $0A, $E2, $93), ($2A, $E5, $C0, $A0), ($E0, $43, $3C, $22), ($17, $1D, $12, $1B), + ($0D, $0B, $0E, $09), ($C7, $AD, $F2, $8B), ($A8, $B9, $2D, $B6), ($A9, $C8, $14, $1E), ($19, $85, $57, $F1), ($07, $4C, $AF, $75), ($DD, $BB, $EE, $99), ($60, $FD, $A3, $7F), ($26, $9F, $F7, $01), ($F5, $BC, $5C, $72), ($3B, $C5, $44, $66), ($7E, $34, $5B, $FB), ($29, $76, $8B, $43), ($C6, $DC, $CB, $23), + ($FC, $68, $B6, $ED), ($F1, $63, $B8, $E4), ($DC, $CA, $D7, $31), ($85, $10, $42, $63), ($22, $40, $13, $97), ($11, $20, $84, $C6), ($24, $7D, $85, $4A), ($3D, $F8, $D2, $BB), ($32, $11, $AE, $F9), ($A1, $6D, $C7, $29), ($2F, $4B, $1D, $9E), ($30, $F3, $DC, $B2), ($52, $EC, $0D, $86), ($E3, $D0, $77, $C1), + ($16, $6C, $2B, $B3), ($B9, $99, $A9, $70), ($48, $FA, $11, $94), ($64, $22, $47, $E9), ($8C, $C4, $A8, $FC), ($3F, $1A, $A0, $F0), ($2C, $D8, $56, $7D), ($90, $EF, $22, $33), ($4E, $C7, $87, $49), ($D1, $C1, $D9, $38), ($A2, $FE, $8C, $CA), ($0B, $36, $98, $D4), ($81, $CF, $A6, $F5), ($DE, $28, $A5, $7A), + ($8E, $26, $DA, $B7), ($BF, $A4, $3F, $AD), ($9D, $E4, $2C, $3A), ($92, $0D, $50, $78), ($CC, $9B, $6A, $5F), ($46, $62, $54, $7E), ($13, $C2, $F6, $8D), ($B8, $E8, $90, $D8), ($F7, $5E, $2E, $39), ($AF, $F5, $82, $C3), ($80, $BE, $9F, $5D), ($93, $7C, $69, $D0), ($2D, $A9, $6F, $D5), ($12, $B3, $CF, $25), + ($99, $3B, $C8, $AC), ($7D, $A7, $10, $18), ($63, $6E, $E8, $9C), ($BB, $7B, $DB, $3B), ($78, $09, $CD, $26), ($18, $F4, $6E, $59), ($B7, $01, $EC, $9A), ($9A, $A8, $83, $4F), ($6E, $65, $E6, $95), ($E6, $7E, $AA, $FF), ($CF, $08, $21, $BC), ($E8, $E6, $EF, $15), ($9B, $D9, $BA, $E7), ($36, $CE, $4A, $6F), + ($09, $D4, $EA, $9F), ($7C, $D6, $29, $B0), ($B2, $AF, $31, $A4), ($23, $31, $2A, $3F), ($94, $30, $C6, $A5), ($66, $C0, $35, $A2), ($BC, $37, $74, $4E), ($CA, $A6, $FC, $82), ($D0, $B0, $E0, $90), ($D8, $15, $33, $A7), ($98, $4A, $F1, $04), ($DA, $F7, $41, $EC), ($50, $0E, $7F, $CD), ($F6, $2F, $17, $91), + ($D6, $8D, $76, $4D), ($B0, $4D, $43, $EF), ($4D, $54, $CC, $AA), ($04, $DF, $E4, $96), ($B5, $E3, $9E, $D1), ($88, $1B, $4C, $6A), ($1F, $B8, $C1, $2C), ($51, $7F, $46, $65), ($EA, $04, $9D, $5E), ($35, $5D, $01, $8C), ($74, $73, $FA, $87), ($41, $2E, $FB, $0B), ($1D, $5A, $B3, $67), ($D2, $52, $92, $DB), + ($56, $33, $E9, $10), ($47, $13, $6D, $D6), ($61, $8C, $9A, $D7), ($0C, $7A, $37, $A1), ($14, $8E, $59, $F8), ($3C, $89, $EB, $13), ($27, $EE, $CE, $A9), ($C9, $35, $B7, $61), ($E5, $ED, $E1, $1C), ($B1, $3C, $7A, $47), ($DF, $59, $9C, $D2), ($73, $3F, $55, $F2), ($CE, $79, $18, $14), ($37, $BF, $73, $C7), + ($CD, $EA, $53, $F7), ($AA, $5B, $5F, $FD), ($6F, $14, $DF, $3D), ($DB, $86, $78, $44), ($F3, $81, $CA, $AF), ($C4, $3E, $B9, $68), ($34, $2C, $38, $24), ($40, $5F, $C2, $A3), ($C3, $72, $16, $1D), ($25, $0C, $BC, $E2), ($49, $8B, $28, $3C), ($95, $41, $FF, $0D), ($01, $71, $39, $A8), ($B3, $DE, $08, $0C), + ($E4, $9C, $D8, $B4), ($C1, $90, $64, $56), ($84, $61, $7B, $CB), ($B6, $70, $D5, $32), ($5C, $74, $48, $6C), ($57, $42, $D0, $B8)); + + T8: array [0 .. 255, 0 .. 3] of Byte = (($F4, $A7, $50, $51), ($41, $65, $53, $7E), ($17, $A4, $C3, $1A), ($27, $5E, $96, $3A), ($AB, $6B, $CB, $3B), ($9D, $45, $F1, $1F), ($FA, $58, $AB, $AC), ($E3, $03, $93, $4B), ($30, $FA, $55, $20), ($76, $6D, $F6, $AD), ($CC, $76, $91, $88), ($02, $4C, $25, $F5), + ($E5, $D7, $FC, $4F), ($2A, $CB, $D7, $C5), ($35, $44, $80, $26), ($62, $A3, $8F, $B5), ($B1, $5A, $49, $DE), ($BA, $1B, $67, $25), ($EA, $0E, $98, $45), ($FE, $C0, $E1, $5D), ($2F, $75, $02, $C3), ($4C, $F0, $12, $81), ($46, $97, $A3, $8D), ($D3, $F9, $C6, $6B), ($8F, $5F, $E7, $03), ($92, $9C, $95, $15), + ($6D, $7A, $EB, $BF), ($52, $59, $DA, $95), ($BE, $83, $2D, $D4), ($74, $21, $D3, $58), ($E0, $69, $29, $49), ($C9, $C8, $44, $8E), ($C2, $89, $6A, $75), ($8E, $79, $78, $F4), ($58, $3E, $6B, $99), ($B9, $71, $DD, $27), ($E1, $4F, $B6, $BE), ($88, $AD, $17, $F0), ($20, $AC, $66, $C9), ($CE, $3A, $B4, $7D), + ($DF, $4A, $18, $63), ($1A, $31, $82, $E5), ($51, $33, $60, $97), ($53, $7F, $45, $62), ($64, $77, $E0, $B1), ($6B, $AE, $84, $BB), ($81, $A0, $1C, $FE), ($08, $2B, $94, $F9), ($48, $68, $58, $70), ($45, $FD, $19, $8F), ($DE, $6C, $87, $94), ($7B, $F8, $B7, $52), ($73, $D3, $23, $AB), ($4B, $02, $E2, $72), + ($1F, $8F, $57, $E3), ($55, $AB, $2A, $66), ($EB, $28, $07, $B2), ($B5, $C2, $03, $2F), ($C5, $7B, $9A, $86), ($37, $08, $A5, $D3), ($28, $87, $F2, $30), ($BF, $A5, $B2, $23), ($03, $6A, $BA, $02), ($16, $82, $5C, $ED), ($CF, $1C, $2B, $8A), ($79, $B4, $92, $A7), ($07, $F2, $F0, $F3), ($69, $E2, $A1, $4E), + ($DA, $F4, $CD, $65), ($05, $BE, $D5, $06), ($34, $62, $1F, $D1), ($A6, $FE, $8A, $C4), ($2E, $53, $9D, $34), ($F3, $55, $A0, $A2), ($8A, $E1, $32, $05), ($F6, $EB, $75, $A4), ($83, $EC, $39, $0B), ($60, $EF, $AA, $40), ($71, $9F, $06, $5E), ($6E, $10, $51, $BD), ($21, $8A, $F9, $3E), ($DD, $06, $3D, $96), + ($3E, $05, $AE, $DD), ($E6, $BD, $46, $4D), ($54, $8D, $B5, $91), ($C4, $5D, $05, $71), ($06, $D4, $6F, $04), ($50, $15, $FF, $60), ($98, $FB, $24, $19), ($BD, $E9, $97, $D6), ($40, $43, $CC, $89), ($D9, $9E, $77, $67), ($E8, $42, $BD, $B0), ($89, $8B, $88, $07), ($19, $5B, $38, $E7), ($C8, $EE, $DB, $79), + ($7C, $0A, $47, $A1), ($42, $0F, $E9, $7C), ($84, $1E, $C9, $F8), ($00, $00, $00, $00), ($80, $86, $83, $09), ($2B, $ED, $48, $32), ($11, $70, $AC, $1E), ($5A, $72, $4E, $6C), ($0E, $FF, $FB, $FD), ($85, $38, $56, $0F), ($AE, $D5, $1E, $3D), ($2D, $39, $27, $36), ($0F, $D9, $64, $0A), ($5C, $A6, $21, $68), + ($5B, $54, $D1, $9B), ($36, $2E, $3A, $24), ($0A, $67, $B1, $0C), ($57, $E7, $0F, $93), ($EE, $96, $D2, $B4), ($9B, $91, $9E, $1B), ($C0, $C5, $4F, $80), ($DC, $20, $A2, $61), ($77, $4B, $69, $5A), ($12, $1A, $16, $1C), ($93, $BA, $0A, $E2), ($A0, $2A, $E5, $C0), ($22, $E0, $43, $3C), ($1B, $17, $1D, $12), + ($09, $0D, $0B, $0E), ($8B, $C7, $AD, $F2), ($B6, $A8, $B9, $2D), ($1E, $A9, $C8, $14), ($F1, $19, $85, $57), ($75, $07, $4C, $AF), ($99, $DD, $BB, $EE), ($7F, $60, $FD, $A3), ($01, $26, $9F, $F7), ($72, $F5, $BC, $5C), ($66, $3B, $C5, $44), ($FB, $7E, $34, $5B), ($43, $29, $76, $8B), ($23, $C6, $DC, $CB), + ($ED, $FC, $68, $B6), ($E4, $F1, $63, $B8), ($31, $DC, $CA, $D7), ($63, $85, $10, $42), ($97, $22, $40, $13), ($C6, $11, $20, $84), ($4A, $24, $7D, $85), ($BB, $3D, $F8, $D2), ($F9, $32, $11, $AE), ($29, $A1, $6D, $C7), ($9E, $2F, $4B, $1D), ($B2, $30, $F3, $DC), ($86, $52, $EC, $0D), ($C1, $E3, $D0, $77), + ($B3, $16, $6C, $2B), ($70, $B9, $99, $A9), ($94, $48, $FA, $11), ($E9, $64, $22, $47), ($FC, $8C, $C4, $A8), ($F0, $3F, $1A, $A0), ($7D, $2C, $D8, $56), ($33, $90, $EF, $22), ($49, $4E, $C7, $87), ($38, $D1, $C1, $D9), ($CA, $A2, $FE, $8C), ($D4, $0B, $36, $98), ($F5, $81, $CF, $A6), ($7A, $DE, $28, $A5), + ($B7, $8E, $26, $DA), ($AD, $BF, $A4, $3F), ($3A, $9D, $E4, $2C), ($78, $92, $0D, $50), ($5F, $CC, $9B, $6A), ($7E, $46, $62, $54), ($8D, $13, $C2, $F6), ($D8, $B8, $E8, $90), ($39, $F7, $5E, $2E), ($C3, $AF, $F5, $82), ($5D, $80, $BE, $9F), ($D0, $93, $7C, $69), ($D5, $2D, $A9, $6F), ($25, $12, $B3, $CF), + ($AC, $99, $3B, $C8), ($18, $7D, $A7, $10), ($9C, $63, $6E, $E8), ($3B, $BB, $7B, $DB), ($26, $78, $09, $CD), ($59, $18, $F4, $6E), ($9A, $B7, $01, $EC), ($4F, $9A, $A8, $83), ($95, $6E, $65, $E6), ($FF, $E6, $7E, $AA), ($BC, $CF, $08, $21), ($15, $E8, $E6, $EF), ($E7, $9B, $D9, $BA), ($6F, $36, $CE, $4A), + ($9F, $09, $D4, $EA), ($B0, $7C, $D6, $29), ($A4, $B2, $AF, $31), ($3F, $23, $31, $2A), ($A5, $94, $30, $C6), ($A2, $66, $C0, $35), ($4E, $BC, $37, $74), ($82, $CA, $A6, $FC), ($90, $D0, $B0, $E0), ($A7, $D8, $15, $33), ($04, $98, $4A, $F1), ($EC, $DA, $F7, $41), ($CD, $50, $0E, $7F), ($91, $F6, $2F, $17), + ($4D, $D6, $8D, $76), ($EF, $B0, $4D, $43), ($AA, $4D, $54, $CC), ($96, $04, $DF, $E4), ($D1, $B5, $E3, $9E), ($6A, $88, $1B, $4C), ($2C, $1F, $B8, $C1), ($65, $51, $7F, $46), ($5E, $EA, $04, $9D), ($8C, $35, $5D, $01), ($87, $74, $73, $FA), ($0B, $41, $2E, $FB), ($67, $1D, $5A, $B3), ($DB, $D2, $52, $92), + ($10, $56, $33, $E9), ($D6, $47, $13, $6D), ($D7, $61, $8C, $9A), ($A1, $0C, $7A, $37), ($F8, $14, $8E, $59), ($13, $3C, $89, $EB), ($A9, $27, $EE, $CE), ($61, $C9, $35, $B7), ($1C, $E5, $ED, $E1), ($47, $B1, $3C, $7A), ($D2, $DF, $59, $9C), ($F2, $73, $3F, $55), ($14, $CE, $79, $18), ($C7, $37, $BF, $73), + ($F7, $CD, $EA, $53), ($FD, $AA, $5B, $5F), ($3D, $6F, $14, $DF), ($44, $DB, $86, $78), ($AF, $F3, $81, $CA), ($68, $C4, $3E, $B9), ($24, $34, $2C, $38), ($A3, $40, $5F, $C2), ($1D, $C3, $72, $16), ($E2, $25, $0C, $BC), ($3C, $49, $8B, $28), ($0D, $95, $41, $FF), ($A8, $01, $71, $39), ($0C, $B3, $DE, $08), + ($B4, $E4, $9C, $D8), ($56, $C1, $90, $64), ($CB, $84, $61, $7B), ($32, $B6, $70, $D5), ($6C, $5C, $74, $48), ($B8, $57, $42, $D0)); + + S5: array [0 .. 255] of Byte = ($52, $09, $6A, $D5, $30, $36, $A5, $38, $BF, $40, $A3, $9E, $81, $F3, $D7, $FB, $7C, $E3, $39, $82, $9B, $2F, $FF, $87, $34, $8E, $43, $44, $C4, $DE, $E9, $CB, $54, $7B, $94, $32, $A6, $C2, $23, $3D, $EE, $4C, $95, $0B, $42, $FA, $C3, $4E, $08, $2E, $A1, $66, $28, $D9, $24, $B2, $76, + $5B, $A2, $49, $6D, $8B, $D1, $25, $72, $F8, $F6, $64, $86, $68, $98, $16, $D4, $A4, $5C, $CC, $5D, $65, $B6, $92, $6C, $70, $48, $50, $FD, $ED, $B9, $DA, $5E, $15, $46, $57, $A7, $8D, $9D, $84, $90, $D8, $AB, $00, $8C, $BC, $D3, $0A, $F7, $E4, $58, $05, $B8, $B3, $45, $06, $D0, $2C, $1E, $8F, $CA, $3F, $0F, $02, + $C1, $AF, $BD, $03, $01, $13, $8A, $6B, $3A, $91, $11, $41, $4F, $67, $DC, $EA, $97, $F2, $CF, $CE, $F0, $B4, $E6, $73, $96, $AC, $74, $22, $E7, $AD, $35, $85, $E2, $F9, $37, $E8, $1C, $75, $DF, $6E, $47, $F1, $1A, $71, $1D, $29, $C5, $89, $6F, $B7, $62, $0E, $AA, $18, $BE, $1B, $FC, $56, $3E, $4B, $C6, $D2, $79, + $20, $9A, $DB, $C0, $FE, $78, $CD, $5A, $F4, $1F, $DD, $A8, $33, $88, $07, $C7, $31, $B1, $12, $10, $59, $27, $80, $EC, $5F, $60, $51, $7F, $A9, $19, $B5, $4A, $0D, $2D, $E5, $7A, $9F, $93, $C9, $9C, $EF, $A0, $E0, $3B, $4D, $AE, $2A, $F5, $B0, $C8, $EB, $BB, $3C, $83, $53, $99, $61, $17, $2B, $04, $7E, $BA, $77, + $D6, $26, $E1, $69, $14, $63, $55, $21, $0C, $7D); + + U1: array [0 .. 255, 0 .. 3] of Byte = (($00, $00, $00, $00), ($0E, $09, $0D, $0B), ($1C, $12, $1A, $16), ($12, $1B, $17, $1D), ($38, $24, $34, $2C), ($36, $2D, $39, $27), ($24, $36, $2E, $3A), ($2A, $3F, $23, $31), ($70, $48, $68, $58), ($7E, $41, $65, $53), ($6C, $5A, $72, $4E), ($62, $53, $7F, $45), + ($48, $6C, $5C, $74), ($46, $65, $51, $7F), ($54, $7E, $46, $62), ($5A, $77, $4B, $69), ($E0, $90, $D0, $B0), ($EE, $99, $DD, $BB), ($FC, $82, $CA, $A6), ($F2, $8B, $C7, $AD), ($D8, $B4, $E4, $9C), ($D6, $BD, $E9, $97), ($C4, $A6, $FE, $8A), ($CA, $AF, $F3, $81), ($90, $D8, $B8, $E8), ($9E, $D1, $B5, $E3), + ($8C, $CA, $A2, $FE), ($82, $C3, $AF, $F5), ($A8, $FC, $8C, $C4), ($A6, $F5, $81, $CF), ($B4, $EE, $96, $D2), ($BA, $E7, $9B, $D9), ($DB, $3B, $BB, $7B), ($D5, $32, $B6, $70), ($C7, $29, $A1, $6D), ($C9, $20, $AC, $66), ($E3, $1F, $8F, $57), ($ED, $16, $82, $5C), ($FF, $0D, $95, $41), ($F1, $04, $98, $4A), + ($AB, $73, $D3, $23), ($A5, $7A, $DE, $28), ($B7, $61, $C9, $35), ($B9, $68, $C4, $3E), ($93, $57, $E7, $0F), ($9D, $5E, $EA, $04), ($8F, $45, $FD, $19), ($81, $4C, $F0, $12), ($3B, $AB, $6B, $CB), ($35, $A2, $66, $C0), ($27, $B9, $71, $DD), ($29, $B0, $7C, $D6), ($03, $8F, $5F, $E7), ($0D, $86, $52, $EC), + ($1F, $9D, $45, $F1), ($11, $94, $48, $FA), ($4B, $E3, $03, $93), ($45, $EA, $0E, $98), ($57, $F1, $19, $85), ($59, $F8, $14, $8E), ($73, $C7, $37, $BF), ($7D, $CE, $3A, $B4), ($6F, $D5, $2D, $A9), ($61, $DC, $20, $A2), ($AD, $76, $6D, $F6), ($A3, $7F, $60, $FD), ($B1, $64, $77, $E0), ($BF, $6D, $7A, $EB), + ($95, $52, $59, $DA), ($9B, $5B, $54, $D1), ($89, $40, $43, $CC), ($87, $49, $4E, $C7), ($DD, $3E, $05, $AE), ($D3, $37, $08, $A5), ($C1, $2C, $1F, $B8), ($CF, $25, $12, $B3), ($E5, $1A, $31, $82), ($EB, $13, $3C, $89), ($F9, $08, $2B, $94), ($F7, $01, $26, $9F), ($4D, $E6, $BD, $46), ($43, $EF, $B0, $4D), + ($51, $F4, $A7, $50), ($5F, $FD, $AA, $5B), ($75, $C2, $89, $6A), ($7B, $CB, $84, $61), ($69, $D0, $93, $7C), ($67, $D9, $9E, $77), ($3D, $AE, $D5, $1E), ($33, $A7, $D8, $15), ($21, $BC, $CF, $08), ($2F, $B5, $C2, $03), ($05, $8A, $E1, $32), ($0B, $83, $EC, $39), ($19, $98, $FB, $24), ($17, $91, $F6, $2F), + ($76, $4D, $D6, $8D), ($78, $44, $DB, $86), ($6A, $5F, $CC, $9B), ($64, $56, $C1, $90), ($4E, $69, $E2, $A1), ($40, $60, $EF, $AA), ($52, $7B, $F8, $B7), ($5C, $72, $F5, $BC), ($06, $05, $BE, $D5), ($08, $0C, $B3, $DE), ($1A, $17, $A4, $C3), ($14, $1E, $A9, $C8), ($3E, $21, $8A, $F9), ($30, $28, $87, $F2), + ($22, $33, $90, $EF), ($2C, $3A, $9D, $E4), ($96, $DD, $06, $3D), ($98, $D4, $0B, $36), ($8A, $CF, $1C, $2B), ($84, $C6, $11, $20), ($AE, $F9, $32, $11), ($A0, $F0, $3F, $1A), ($B2, $EB, $28, $07), ($BC, $E2, $25, $0C), ($E6, $95, $6E, $65), ($E8, $9C, $63, $6E), ($FA, $87, $74, $73), ($F4, $8E, $79, $78), + ($DE, $B1, $5A, $49), ($D0, $B8, $57, $42), ($C2, $A3, $40, $5F), ($CC, $AA, $4D, $54), ($41, $EC, $DA, $F7), ($4F, $E5, $D7, $FC), ($5D, $FE, $C0, $E1), ($53, $F7, $CD, $EA), ($79, $C8, $EE, $DB), ($77, $C1, $E3, $D0), ($65, $DA, $F4, $CD), ($6B, $D3, $F9, $C6), ($31, $A4, $B2, $AF), ($3F, $AD, $BF, $A4), + ($2D, $B6, $A8, $B9), ($23, $BF, $A5, $B2), ($09, $80, $86, $83), ($07, $89, $8B, $88), ($15, $92, $9C, $95), ($1B, $9B, $91, $9E), ($A1, $7C, $0A, $47), ($AF, $75, $07, $4C), ($BD, $6E, $10, $51), ($B3, $67, $1D, $5A), ($99, $58, $3E, $6B), ($97, $51, $33, $60), ($85, $4A, $24, $7D), ($8B, $43, $29, $76), + ($D1, $34, $62, $1F), ($DF, $3D, $6F, $14), ($CD, $26, $78, $09), ($C3, $2F, $75, $02), ($E9, $10, $56, $33), ($E7, $19, $5B, $38), ($F5, $02, $4C, $25), ($FB, $0B, $41, $2E), ($9A, $D7, $61, $8C), ($94, $DE, $6C, $87), ($86, $C5, $7B, $9A), ($88, $CC, $76, $91), ($A2, $F3, $55, $A0), ($AC, $FA, $58, $AB), + ($BE, $E1, $4F, $B6), ($B0, $E8, $42, $BD), ($EA, $9F, $09, $D4), ($E4, $96, $04, $DF), ($F6, $8D, $13, $C2), ($F8, $84, $1E, $C9), ($D2, $BB, $3D, $F8), ($DC, $B2, $30, $F3), ($CE, $A9, $27, $EE), ($C0, $A0, $2A, $E5), ($7A, $47, $B1, $3C), ($74, $4E, $BC, $37), ($66, $55, $AB, $2A), ($68, $5C, $A6, $21), + ($42, $63, $85, $10), ($4C, $6A, $88, $1B), ($5E, $71, $9F, $06), ($50, $78, $92, $0D), ($0A, $0F, $D9, $64), ($04, $06, $D4, $6F), ($16, $1D, $C3, $72), ($18, $14, $CE, $79), ($32, $2B, $ED, $48), ($3C, $22, $E0, $43), ($2E, $39, $F7, $5E), ($20, $30, $FA, $55), ($EC, $9A, $B7, $01), ($E2, $93, $BA, $0A), + ($F0, $88, $AD, $17), ($FE, $81, $A0, $1C), ($D4, $BE, $83, $2D), ($DA, $B7, $8E, $26), ($C8, $AC, $99, $3B), ($C6, $A5, $94, $30), ($9C, $D2, $DF, $59), ($92, $DB, $D2, $52), ($80, $C0, $C5, $4F), ($8E, $C9, $C8, $44), ($A4, $F6, $EB, $75), ($AA, $FF, $E6, $7E), ($B8, $E4, $F1, $63), ($B6, $ED, $FC, $68), + ($0C, $0A, $67, $B1), ($02, $03, $6A, $BA), ($10, $18, $7D, $A7), ($1E, $11, $70, $AC), ($34, $2E, $53, $9D), ($3A, $27, $5E, $96), ($28, $3C, $49, $8B), ($26, $35, $44, $80), ($7C, $42, $0F, $E9), ($72, $4B, $02, $E2), ($60, $50, $15, $FF), ($6E, $59, $18, $F4), ($44, $66, $3B, $C5), ($4A, $6F, $36, $CE), + ($58, $74, $21, $D3), ($56, $7D, $2C, $D8), ($37, $A1, $0C, $7A), ($39, $A8, $01, $71), ($2B, $B3, $16, $6C), ($25, $BA, $1B, $67), ($0F, $85, $38, $56), ($01, $8C, $35, $5D), ($13, $97, $22, $40), ($1D, $9E, $2F, $4B), ($47, $E9, $64, $22), ($49, $E0, $69, $29), ($5B, $FB, $7E, $34), ($55, $F2, $73, $3F), + ($7F, $CD, $50, $0E), ($71, $C4, $5D, $05), ($63, $DF, $4A, $18), ($6D, $D6, $47, $13), ($D7, $31, $DC, $CA), ($D9, $38, $D1, $C1), ($CB, $23, $C6, $DC), ($C5, $2A, $CB, $D7), ($EF, $15, $E8, $E6), ($E1, $1C, $E5, $ED), ($F3, $07, $F2, $F0), ($FD, $0E, $FF, $FB), ($A7, $79, $B4, $92), ($A9, $70, $B9, $99), + ($BB, $6B, $AE, $84), ($B5, $62, $A3, $8F), ($9F, $5D, $80, $BE), ($91, $54, $8D, $B5), ($83, $4F, $9A, $A8), ($8D, $46, $97, $A3)); + + U2: array [0 .. 255, 0 .. 3] of Byte = (($00, $00, $00, $00), ($0B, $0E, $09, $0D), ($16, $1C, $12, $1A), ($1D, $12, $1B, $17), ($2C, $38, $24, $34), ($27, $36, $2D, $39), ($3A, $24, $36, $2E), ($31, $2A, $3F, $23), ($58, $70, $48, $68), ($53, $7E, $41, $65), ($4E, $6C, $5A, $72), ($45, $62, $53, $7F), + ($74, $48, $6C, $5C), ($7F, $46, $65, $51), ($62, $54, $7E, $46), ($69, $5A, $77, $4B), ($B0, $E0, $90, $D0), ($BB, $EE, $99, $DD), ($A6, $FC, $82, $CA), ($AD, $F2, $8B, $C7), ($9C, $D8, $B4, $E4), ($97, $D6, $BD, $E9), ($8A, $C4, $A6, $FE), ($81, $CA, $AF, $F3), ($E8, $90, $D8, $B8), ($E3, $9E, $D1, $B5), + ($FE, $8C, $CA, $A2), ($F5, $82, $C3, $AF), ($C4, $A8, $FC, $8C), ($CF, $A6, $F5, $81), ($D2, $B4, $EE, $96), ($D9, $BA, $E7, $9B), ($7B, $DB, $3B, $BB), ($70, $D5, $32, $B6), ($6D, $C7, $29, $A1), ($66, $C9, $20, $AC), ($57, $E3, $1F, $8F), ($5C, $ED, $16, $82), ($41, $FF, $0D, $95), ($4A, $F1, $04, $98), + ($23, $AB, $73, $D3), ($28, $A5, $7A, $DE), ($35, $B7, $61, $C9), ($3E, $B9, $68, $C4), ($0F, $93, $57, $E7), ($04, $9D, $5E, $EA), ($19, $8F, $45, $FD), ($12, $81, $4C, $F0), ($CB, $3B, $AB, $6B), ($C0, $35, $A2, $66), ($DD, $27, $B9, $71), ($D6, $29, $B0, $7C), ($E7, $03, $8F, $5F), ($EC, $0D, $86, $52), + ($F1, $1F, $9D, $45), ($FA, $11, $94, $48), ($93, $4B, $E3, $03), ($98, $45, $EA, $0E), ($85, $57, $F1, $19), ($8E, $59, $F8, $14), ($BF, $73, $C7, $37), ($B4, $7D, $CE, $3A), ($A9, $6F, $D5, $2D), ($A2, $61, $DC, $20), ($F6, $AD, $76, $6D), ($FD, $A3, $7F, $60), ($E0, $B1, $64, $77), ($EB, $BF, $6D, $7A), + ($DA, $95, $52, $59), ($D1, $9B, $5B, $54), ($CC, $89, $40, $43), ($C7, $87, $49, $4E), ($AE, $DD, $3E, $05), ($A5, $D3, $37, $08), ($B8, $C1, $2C, $1F), ($B3, $CF, $25, $12), ($82, $E5, $1A, $31), ($89, $EB, $13, $3C), ($94, $F9, $08, $2B), ($9F, $F7, $01, $26), ($46, $4D, $E6, $BD), ($4D, $43, $EF, $B0), + ($50, $51, $F4, $A7), ($5B, $5F, $FD, $AA), ($6A, $75, $C2, $89), ($61, $7B, $CB, $84), ($7C, $69, $D0, $93), ($77, $67, $D9, $9E), ($1E, $3D, $AE, $D5), ($15, $33, $A7, $D8), ($08, $21, $BC, $CF), ($03, $2F, $B5, $C2), ($32, $05, $8A, $E1), ($39, $0B, $83, $EC), ($24, $19, $98, $FB), ($2F, $17, $91, $F6), + ($8D, $76, $4D, $D6), ($86, $78, $44, $DB), ($9B, $6A, $5F, $CC), ($90, $64, $56, $C1), ($A1, $4E, $69, $E2), ($AA, $40, $60, $EF), ($B7, $52, $7B, $F8), ($BC, $5C, $72, $F5), ($D5, $06, $05, $BE), ($DE, $08, $0C, $B3), ($C3, $1A, $17, $A4), ($C8, $14, $1E, $A9), ($F9, $3E, $21, $8A), ($F2, $30, $28, $87), + ($EF, $22, $33, $90), ($E4, $2C, $3A, $9D), ($3D, $96, $DD, $06), ($36, $98, $D4, $0B), ($2B, $8A, $CF, $1C), ($20, $84, $C6, $11), ($11, $AE, $F9, $32), ($1A, $A0, $F0, $3F), ($07, $B2, $EB, $28), ($0C, $BC, $E2, $25), ($65, $E6, $95, $6E), ($6E, $E8, $9C, $63), ($73, $FA, $87, $74), ($78, $F4, $8E, $79), + ($49, $DE, $B1, $5A), ($42, $D0, $B8, $57), ($5F, $C2, $A3, $40), ($54, $CC, $AA, $4D), ($F7, $41, $EC, $DA), ($FC, $4F, $E5, $D7), ($E1, $5D, $FE, $C0), ($EA, $53, $F7, $CD), ($DB, $79, $C8, $EE), ($D0, $77, $C1, $E3), ($CD, $65, $DA, $F4), ($C6, $6B, $D3, $F9), ($AF, $31, $A4, $B2), ($A4, $3F, $AD, $BF), + ($B9, $2D, $B6, $A8), ($B2, $23, $BF, $A5), ($83, $09, $80, $86), ($88, $07, $89, $8B), ($95, $15, $92, $9C), ($9E, $1B, $9B, $91), ($47, $A1, $7C, $0A), ($4C, $AF, $75, $07), ($51, $BD, $6E, $10), ($5A, $B3, $67, $1D), ($6B, $99, $58, $3E), ($60, $97, $51, $33), ($7D, $85, $4A, $24), ($76, $8B, $43, $29), + ($1F, $D1, $34, $62), ($14, $DF, $3D, $6F), ($09, $CD, $26, $78), ($02, $C3, $2F, $75), ($33, $E9, $10, $56), ($38, $E7, $19, $5B), ($25, $F5, $02, $4C), ($2E, $FB, $0B, $41), ($8C, $9A, $D7, $61), ($87, $94, $DE, $6C), ($9A, $86, $C5, $7B), ($91, $88, $CC, $76), ($A0, $A2, $F3, $55), ($AB, $AC, $FA, $58), + ($B6, $BE, $E1, $4F), ($BD, $B0, $E8, $42), ($D4, $EA, $9F, $09), ($DF, $E4, $96, $04), ($C2, $F6, $8D, $13), ($C9, $F8, $84, $1E), ($F8, $D2, $BB, $3D), ($F3, $DC, $B2, $30), ($EE, $CE, $A9, $27), ($E5, $C0, $A0, $2A), ($3C, $7A, $47, $B1), ($37, $74, $4E, $BC), ($2A, $66, $55, $AB), ($21, $68, $5C, $A6), + ($10, $42, $63, $85), ($1B, $4C, $6A, $88), ($06, $5E, $71, $9F), ($0D, $50, $78, $92), ($64, $0A, $0F, $D9), ($6F, $04, $06, $D4), ($72, $16, $1D, $C3), ($79, $18, $14, $CE), ($48, $32, $2B, $ED), ($43, $3C, $22, $E0), ($5E, $2E, $39, $F7), ($55, $20, $30, $FA), ($01, $EC, $9A, $B7), ($0A, $E2, $93, $BA), + ($17, $F0, $88, $AD), ($1C, $FE, $81, $A0), ($2D, $D4, $BE, $83), ($26, $DA, $B7, $8E), ($3B, $C8, $AC, $99), ($30, $C6, $A5, $94), ($59, $9C, $D2, $DF), ($52, $92, $DB, $D2), ($4F, $80, $C0, $C5), ($44, $8E, $C9, $C8), ($75, $A4, $F6, $EB), ($7E, $AA, $FF, $E6), ($63, $B8, $E4, $F1), ($68, $B6, $ED, $FC), + ($B1, $0C, $0A, $67), ($BA, $02, $03, $6A), ($A7, $10, $18, $7D), ($AC, $1E, $11, $70), ($9D, $34, $2E, $53), ($96, $3A, $27, $5E), ($8B, $28, $3C, $49), ($80, $26, $35, $44), ($E9, $7C, $42, $0F), ($E2, $72, $4B, $02), ($FF, $60, $50, $15), ($F4, $6E, $59, $18), ($C5, $44, $66, $3B), ($CE, $4A, $6F, $36), + ($D3, $58, $74, $21), ($D8, $56, $7D, $2C), ($7A, $37, $A1, $0C), ($71, $39, $A8, $01), ($6C, $2B, $B3, $16), ($67, $25, $BA, $1B), ($56, $0F, $85, $38), ($5D, $01, $8C, $35), ($40, $13, $97, $22), ($4B, $1D, $9E, $2F), ($22, $47, $E9, $64), ($29, $49, $E0, $69), ($34, $5B, $FB, $7E), ($3F, $55, $F2, $73), + ($0E, $7F, $CD, $50), ($05, $71, $C4, $5D), ($18, $63, $DF, $4A), ($13, $6D, $D6, $47), ($CA, $D7, $31, $DC), ($C1, $D9, $38, $D1), ($DC, $CB, $23, $C6), ($D7, $C5, $2A, $CB), ($E6, $EF, $15, $E8), ($ED, $E1, $1C, $E5), ($F0, $F3, $07, $F2), ($FB, $FD, $0E, $FF), ($92, $A7, $79, $B4), ($99, $A9, $70, $B9), + ($84, $BB, $6B, $AE), ($8F, $B5, $62, $A3), ($BE, $9F, $5D, $80), ($B5, $91, $54, $8D), ($A8, $83, $4F, $9A), ($A3, $8D, $46, $97)); + + U3: array [0 .. 255, 0 .. 3] of Byte = (($00, $00, $00, $00), ($0D, $0B, $0E, $09), ($1A, $16, $1C, $12), ($17, $1D, $12, $1B), ($34, $2C, $38, $24), ($39, $27, $36, $2D), ($2E, $3A, $24, $36), ($23, $31, $2A, $3F), ($68, $58, $70, $48), ($65, $53, $7E, $41), ($72, $4E, $6C, $5A), ($7F, $45, $62, $53), + ($5C, $74, $48, $6C), ($51, $7F, $46, $65), ($46, $62, $54, $7E), ($4B, $69, $5A, $77), ($D0, $B0, $E0, $90), ($DD, $BB, $EE, $99), ($CA, $A6, $FC, $82), ($C7, $AD, $F2, $8B), ($E4, $9C, $D8, $B4), ($E9, $97, $D6, $BD), ($FE, $8A, $C4, $A6), ($F3, $81, $CA, $AF), ($B8, $E8, $90, $D8), ($B5, $E3, $9E, $D1), + ($A2, $FE, $8C, $CA), ($AF, $F5, $82, $C3), ($8C, $C4, $A8, $FC), ($81, $CF, $A6, $F5), ($96, $D2, $B4, $EE), ($9B, $D9, $BA, $E7), ($BB, $7B, $DB, $3B), ($B6, $70, $D5, $32), ($A1, $6D, $C7, $29), ($AC, $66, $C9, $20), ($8F, $57, $E3, $1F), ($82, $5C, $ED, $16), ($95, $41, $FF, $0D), ($98, $4A, $F1, $04), + ($D3, $23, $AB, $73), ($DE, $28, $A5, $7A), ($C9, $35, $B7, $61), ($C4, $3E, $B9, $68), ($E7, $0F, $93, $57), ($EA, $04, $9D, $5E), ($FD, $19, $8F, $45), ($F0, $12, $81, $4C), ($6B, $CB, $3B, $AB), ($66, $C0, $35, $A2), ($71, $DD, $27, $B9), ($7C, $D6, $29, $B0), ($5F, $E7, $03, $8F), ($52, $EC, $0D, $86), + ($45, $F1, $1F, $9D), ($48, $FA, $11, $94), ($03, $93, $4B, $E3), ($0E, $98, $45, $EA), ($19, $85, $57, $F1), ($14, $8E, $59, $F8), ($37, $BF, $73, $C7), ($3A, $B4, $7D, $CE), ($2D, $A9, $6F, $D5), ($20, $A2, $61, $DC), ($6D, $F6, $AD, $76), ($60, $FD, $A3, $7F), ($77, $E0, $B1, $64), ($7A, $EB, $BF, $6D), + ($59, $DA, $95, $52), ($54, $D1, $9B, $5B), ($43, $CC, $89, $40), ($4E, $C7, $87, $49), ($05, $AE, $DD, $3E), ($08, $A5, $D3, $37), ($1F, $B8, $C1, $2C), ($12, $B3, $CF, $25), ($31, $82, $E5, $1A), ($3C, $89, $EB, $13), ($2B, $94, $F9, $08), ($26, $9F, $F7, $01), ($BD, $46, $4D, $E6), ($B0, $4D, $43, $EF), + ($A7, $50, $51, $F4), ($AA, $5B, $5F, $FD), ($89, $6A, $75, $C2), ($84, $61, $7B, $CB), ($93, $7C, $69, $D0), ($9E, $77, $67, $D9), ($D5, $1E, $3D, $AE), ($D8, $15, $33, $A7), ($CF, $08, $21, $BC), ($C2, $03, $2F, $B5), ($E1, $32, $05, $8A), ($EC, $39, $0B, $83), ($FB, $24, $19, $98), ($F6, $2F, $17, $91), + ($D6, $8D, $76, $4D), ($DB, $86, $78, $44), ($CC, $9B, $6A, $5F), ($C1, $90, $64, $56), ($E2, $A1, $4E, $69), ($EF, $AA, $40, $60), ($F8, $B7, $52, $7B), ($F5, $BC, $5C, $72), ($BE, $D5, $06, $05), ($B3, $DE, $08, $0C), ($A4, $C3, $1A, $17), ($A9, $C8, $14, $1E), ($8A, $F9, $3E, $21), ($87, $F2, $30, $28), + ($90, $EF, $22, $33), ($9D, $E4, $2C, $3A), ($06, $3D, $96, $DD), ($0B, $36, $98, $D4), ($1C, $2B, $8A, $CF), ($11, $20, $84, $C6), ($32, $11, $AE, $F9), ($3F, $1A, $A0, $F0), ($28, $07, $B2, $EB), ($25, $0C, $BC, $E2), ($6E, $65, $E6, $95), ($63, $6E, $E8, $9C), ($74, $73, $FA, $87), ($79, $78, $F4, $8E), + ($5A, $49, $DE, $B1), ($57, $42, $D0, $B8), ($40, $5F, $C2, $A3), ($4D, $54, $CC, $AA), ($DA, $F7, $41, $EC), ($D7, $FC, $4F, $E5), ($C0, $E1, $5D, $FE), ($CD, $EA, $53, $F7), ($EE, $DB, $79, $C8), ($E3, $D0, $77, $C1), ($F4, $CD, $65, $DA), ($F9, $C6, $6B, $D3), ($B2, $AF, $31, $A4), ($BF, $A4, $3F, $AD), + ($A8, $B9, $2D, $B6), ($A5, $B2, $23, $BF), ($86, $83, $09, $80), ($8B, $88, $07, $89), ($9C, $95, $15, $92), ($91, $9E, $1B, $9B), ($0A, $47, $A1, $7C), ($07, $4C, $AF, $75), ($10, $51, $BD, $6E), ($1D, $5A, $B3, $67), ($3E, $6B, $99, $58), ($33, $60, $97, $51), ($24, $7D, $85, $4A), ($29, $76, $8B, $43), + ($62, $1F, $D1, $34), ($6F, $14, $DF, $3D), ($78, $09, $CD, $26), ($75, $02, $C3, $2F), ($56, $33, $E9, $10), ($5B, $38, $E7, $19), ($4C, $25, $F5, $02), ($41, $2E, $FB, $0B), ($61, $8C, $9A, $D7), ($6C, $87, $94, $DE), ($7B, $9A, $86, $C5), ($76, $91, $88, $CC), ($55, $A0, $A2, $F3), ($58, $AB, $AC, $FA), + ($4F, $B6, $BE, $E1), ($42, $BD, $B0, $E8), ($09, $D4, $EA, $9F), ($04, $DF, $E4, $96), ($13, $C2, $F6, $8D), ($1E, $C9, $F8, $84), ($3D, $F8, $D2, $BB), ($30, $F3, $DC, $B2), ($27, $EE, $CE, $A9), ($2A, $E5, $C0, $A0), ($B1, $3C, $7A, $47), ($BC, $37, $74, $4E), ($AB, $2A, $66, $55), ($A6, $21, $68, $5C), + ($85, $10, $42, $63), ($88, $1B, $4C, $6A), ($9F, $06, $5E, $71), ($92, $0D, $50, $78), ($D9, $64, $0A, $0F), ($D4, $6F, $04, $06), ($C3, $72, $16, $1D), ($CE, $79, $18, $14), ($ED, $48, $32, $2B), ($E0, $43, $3C, $22), ($F7, $5E, $2E, $39), ($FA, $55, $20, $30), ($B7, $01, $EC, $9A), ($BA, $0A, $E2, $93), + ($AD, $17, $F0, $88), ($A0, $1C, $FE, $81), ($83, $2D, $D4, $BE), ($8E, $26, $DA, $B7), ($99, $3B, $C8, $AC), ($94, $30, $C6, $A5), ($DF, $59, $9C, $D2), ($D2, $52, $92, $DB), ($C5, $4F, $80, $C0), ($C8, $44, $8E, $C9), ($EB, $75, $A4, $F6), ($E6, $7E, $AA, $FF), ($F1, $63, $B8, $E4), ($FC, $68, $B6, $ED), + ($67, $B1, $0C, $0A), ($6A, $BA, $02, $03), ($7D, $A7, $10, $18), ($70, $AC, $1E, $11), ($53, $9D, $34, $2E), ($5E, $96, $3A, $27), ($49, $8B, $28, $3C), ($44, $80, $26, $35), ($0F, $E9, $7C, $42), ($02, $E2, $72, $4B), ($15, $FF, $60, $50), ($18, $F4, $6E, $59), ($3B, $C5, $44, $66), ($36, $CE, $4A, $6F), + ($21, $D3, $58, $74), ($2C, $D8, $56, $7D), ($0C, $7A, $37, $A1), ($01, $71, $39, $A8), ($16, $6C, $2B, $B3), ($1B, $67, $25, $BA), ($38, $56, $0F, $85), ($35, $5D, $01, $8C), ($22, $40, $13, $97), ($2F, $4B, $1D, $9E), ($64, $22, $47, $E9), ($69, $29, $49, $E0), ($7E, $34, $5B, $FB), ($73, $3F, $55, $F2), + ($50, $0E, $7F, $CD), ($5D, $05, $71, $C4), ($4A, $18, $63, $DF), ($47, $13, $6D, $D6), ($DC, $CA, $D7, $31), ($D1, $C1, $D9, $38), ($C6, $DC, $CB, $23), ($CB, $D7, $C5, $2A), ($E8, $E6, $EF, $15), ($E5, $ED, $E1, $1C), ($F2, $F0, $F3, $07), ($FF, $FB, $FD, $0E), ($B4, $92, $A7, $79), ($B9, $99, $A9, $70), + ($AE, $84, $BB, $6B), ($A3, $8F, $B5, $62), ($80, $BE, $9F, $5D), ($8D, $B5, $91, $54), ($9A, $A8, $83, $4F), ($97, $A3, $8D, $46)); + + U4: array [0 .. 255, 0 .. 3] of Byte = (($00, $00, $00, $00), ($09, $0D, $0B, $0E), ($12, $1A, $16, $1C), ($1B, $17, $1D, $12), ($24, $34, $2C, $38), ($2D, $39, $27, $36), ($36, $2E, $3A, $24), ($3F, $23, $31, $2A), ($48, $68, $58, $70), ($41, $65, $53, $7E), ($5A, $72, $4E, $6C), ($53, $7F, $45, $62), + ($6C, $5C, $74, $48), ($65, $51, $7F, $46), ($7E, $46, $62, $54), ($77, $4B, $69, $5A), ($90, $D0, $B0, $E0), ($99, $DD, $BB, $EE), ($82, $CA, $A6, $FC), ($8B, $C7, $AD, $F2), ($B4, $E4, $9C, $D8), ($BD, $E9, $97, $D6), ($A6, $FE, $8A, $C4), ($AF, $F3, $81, $CA), ($D8, $B8, $E8, $90), ($D1, $B5, $E3, $9E), + ($CA, $A2, $FE, $8C), ($C3, $AF, $F5, $82), ($FC, $8C, $C4, $A8), ($F5, $81, $CF, $A6), ($EE, $96, $D2, $B4), ($E7, $9B, $D9, $BA), ($3B, $BB, $7B, $DB), ($32, $B6, $70, $D5), ($29, $A1, $6D, $C7), ($20, $AC, $66, $C9), ($1F, $8F, $57, $E3), ($16, $82, $5C, $ED), ($0D, $95, $41, $FF), ($04, $98, $4A, $F1), + ($73, $D3, $23, $AB), ($7A, $DE, $28, $A5), ($61, $C9, $35, $B7), ($68, $C4, $3E, $B9), ($57, $E7, $0F, $93), ($5E, $EA, $04, $9D), ($45, $FD, $19, $8F), ($4C, $F0, $12, $81), ($AB, $6B, $CB, $3B), ($A2, $66, $C0, $35), ($B9, $71, $DD, $27), ($B0, $7C, $D6, $29), ($8F, $5F, $E7, $03), ($86, $52, $EC, $0D), + ($9D, $45, $F1, $1F), ($94, $48, $FA, $11), ($E3, $03, $93, $4B), ($EA, $0E, $98, $45), ($F1, $19, $85, $57), ($F8, $14, $8E, $59), ($C7, $37, $BF, $73), ($CE, $3A, $B4, $7D), ($D5, $2D, $A9, $6F), ($DC, $20, $A2, $61), ($76, $6D, $F6, $AD), ($7F, $60, $FD, $A3), ($64, $77, $E0, $B1), ($6D, $7A, $EB, $BF), + ($52, $59, $DA, $95), ($5B, $54, $D1, $9B), ($40, $43, $CC, $89), ($49, $4E, $C7, $87), ($3E, $05, $AE, $DD), ($37, $08, $A5, $D3), ($2C, $1F, $B8, $C1), ($25, $12, $B3, $CF), ($1A, $31, $82, $E5), ($13, $3C, $89, $EB), ($08, $2B, $94, $F9), ($01, $26, $9F, $F7), ($E6, $BD, $46, $4D), ($EF, $B0, $4D, $43), + ($F4, $A7, $50, $51), ($FD, $AA, $5B, $5F), ($C2, $89, $6A, $75), ($CB, $84, $61, $7B), ($D0, $93, $7C, $69), ($D9, $9E, $77, $67), ($AE, $D5, $1E, $3D), ($A7, $D8, $15, $33), ($BC, $CF, $08, $21), ($B5, $C2, $03, $2F), ($8A, $E1, $32, $05), ($83, $EC, $39, $0B), ($98, $FB, $24, $19), ($91, $F6, $2F, $17), + ($4D, $D6, $8D, $76), ($44, $DB, $86, $78), ($5F, $CC, $9B, $6A), ($56, $C1, $90, $64), ($69, $E2, $A1, $4E), ($60, $EF, $AA, $40), ($7B, $F8, $B7, $52), ($72, $F5, $BC, $5C), ($05, $BE, $D5, $06), ($0C, $B3, $DE, $08), ($17, $A4, $C3, $1A), ($1E, $A9, $C8, $14), ($21, $8A, $F9, $3E), ($28, $87, $F2, $30), + ($33, $90, $EF, $22), ($3A, $9D, $E4, $2C), ($DD, $06, $3D, $96), ($D4, $0B, $36, $98), ($CF, $1C, $2B, $8A), ($C6, $11, $20, $84), ($F9, $32, $11, $AE), ($F0, $3F, $1A, $A0), ($EB, $28, $07, $B2), ($E2, $25, $0C, $BC), ($95, $6E, $65, $E6), ($9C, $63, $6E, $E8), ($87, $74, $73, $FA), ($8E, $79, $78, $F4), + ($B1, $5A, $49, $DE), ($B8, $57, $42, $D0), ($A3, $40, $5F, $C2), ($AA, $4D, $54, $CC), ($EC, $DA, $F7, $41), ($E5, $D7, $FC, $4F), ($FE, $C0, $E1, $5D), ($F7, $CD, $EA, $53), ($C8, $EE, $DB, $79), ($C1, $E3, $D0, $77), ($DA, $F4, $CD, $65), ($D3, $F9, $C6, $6B), ($A4, $B2, $AF, $31), ($AD, $BF, $A4, $3F), + ($B6, $A8, $B9, $2D), ($BF, $A5, $B2, $23), ($80, $86, $83, $09), ($89, $8B, $88, $07), ($92, $9C, $95, $15), ($9B, $91, $9E, $1B), ($7C, $0A, $47, $A1), ($75, $07, $4C, $AF), ($6E, $10, $51, $BD), ($67, $1D, $5A, $B3), ($58, $3E, $6B, $99), ($51, $33, $60, $97), ($4A, $24, $7D, $85), ($43, $29, $76, $8B), + ($34, $62, $1F, $D1), ($3D, $6F, $14, $DF), ($26, $78, $09, $CD), ($2F, $75, $02, $C3), ($10, $56, $33, $E9), ($19, $5B, $38, $E7), ($02, $4C, $25, $F5), ($0B, $41, $2E, $FB), ($D7, $61, $8C, $9A), ($DE, $6C, $87, $94), ($C5, $7B, $9A, $86), ($CC, $76, $91, $88), ($F3, $55, $A0, $A2), ($FA, $58, $AB, $AC), + ($E1, $4F, $B6, $BE), ($E8, $42, $BD, $B0), ($9F, $09, $D4, $EA), ($96, $04, $DF, $E4), ($8D, $13, $C2, $F6), ($84, $1E, $C9, $F8), ($BB, $3D, $F8, $D2), ($B2, $30, $F3, $DC), ($A9, $27, $EE, $CE), ($A0, $2A, $E5, $C0), ($47, $B1, $3C, $7A), ($4E, $BC, $37, $74), ($55, $AB, $2A, $66), ($5C, $A6, $21, $68), + ($63, $85, $10, $42), ($6A, $88, $1B, $4C), ($71, $9F, $06, $5E), ($78, $92, $0D, $50), ($0F, $D9, $64, $0A), ($06, $D4, $6F, $04), ($1D, $C3, $72, $16), ($14, $CE, $79, $18), ($2B, $ED, $48, $32), ($22, $E0, $43, $3C), ($39, $F7, $5E, $2E), ($30, $FA, $55, $20), ($9A, $B7, $01, $EC), ($93, $BA, $0A, $E2), + ($88, $AD, $17, $F0), ($81, $A0, $1C, $FE), ($BE, $83, $2D, $D4), ($B7, $8E, $26, $DA), ($AC, $99, $3B, $C8), ($A5, $94, $30, $C6), ($D2, $DF, $59, $9C), ($DB, $D2, $52, $92), ($C0, $C5, $4F, $80), ($C9, $C8, $44, $8E), ($F6, $EB, $75, $A4), ($FF, $E6, $7E, $AA), ($E4, $F1, $63, $B8), ($ED, $FC, $68, $B6), + ($0A, $67, $B1, $0C), ($03, $6A, $BA, $02), ($18, $7D, $A7, $10), ($11, $70, $AC, $1E), ($2E, $53, $9D, $34), ($27, $5E, $96, $3A), ($3C, $49, $8B, $28), ($35, $44, $80, $26), ($42, $0F, $E9, $7C), ($4B, $02, $E2, $72), ($50, $15, $FF, $60), ($59, $18, $F4, $6E), ($66, $3B, $C5, $44), ($6F, $36, $CE, $4A), + ($74, $21, $D3, $58), ($7D, $2C, $D8, $56), ($A1, $0C, $7A, $37), ($A8, $01, $71, $39), ($B3, $16, $6C, $2B), ($BA, $1B, $67, $25), ($85, $38, $56, $0F), ($8C, $35, $5D, $01), ($97, $22, $40, $13), ($9E, $2F, $4B, $1D), ($E9, $64, $22, $47), ($E0, $69, $29, $49), ($FB, $7E, $34, $5B), ($F2, $73, $3F, $55), + ($CD, $50, $0E, $7F), ($C4, $5D, $05, $71), ($DF, $4A, $18, $63), ($D6, $47, $13, $6D), ($31, $DC, $CA, $D7), ($38, $D1, $C1, $D9), ($23, $C6, $DC, $CB), ($2A, $CB, $D7, $C5), ($15, $E8, $E6, $EF), ($1C, $E5, $ED, $E1), ($07, $F2, $F0, $F3), ($0E, $FF, $FB, $FD), ($79, $B4, $92, $A7), ($70, $B9, $99, $A9), + ($6B, $AE, $84, $BB), ($62, $A3, $8F, $B5), ($5D, $80, $BE, $9F), ($54, $8D, $B5, $91), ($4F, $9A, $A8, $83), ($46, $97, $A3, $8D)); + + rcon: array [0 .. 29] of cardinal = ($01, $02, $04, $08, $10, $20, $40, $80, $1B, $36, $6C, $D8, $AB, $4D, $9A, $2F, $5E, $BC, $63, $C6, $97, $35, $6A, $D4, $B3, $7D, $FA, $EF, $C5, $91); + +class function TncEnc_rijndael.GetMaxKeySize: Integer; +begin + Result := 256; +end; + +class function TncEnc_rijndael.GetAlgorithm: string; +begin + Result := 'Rijndael'; +end; + +class function TncEnc_rijndael.SelfTest: Boolean; +const + Key1: array [0 .. 15] of Byte = ($00, $01, $02, $03, $05, $06, $07, $08, $0A, $0B, $0C, $0D, $0F, $10, $11, $12); + InData1: array [0 .. 15] of Byte = ($50, $68, $12, $A4, $5F, $08, $C8, $89, $B9, $7F, $59, $80, $03, $8B, $83, $59); + OutData1: array [0 .. 15] of Byte = ($D8, $F5, $32, $53, $82, $89, $EF, $7D, $06, $B5, $06, $A4, $FD, $5B, $E9, $C9); + Key2: array [0 .. 23] of Byte = ($A0, $A1, $A2, $A3, $A5, $A6, $A7, $A8, $AA, $AB, $AC, $AD, $AF, $B0, $B1, $B2, $B4, $B5, $B6, $B7, $B9, $BA, $BB, $BC); + InData2: array [0 .. 15] of Byte = ($4F, $1C, $76, $9D, $1E, $5B, $05, $52, $C7, $EC, $A8, $4D, $EA, $26, $A5, $49); + OutData2: array [0 .. 15] of Byte = ($F3, $84, $72, $10, $D5, $39, $1E, $23, $60, $60, $8E, $5A, $CB, $56, $05, $81); + Key3: array [0 .. 31] of Byte = ($00, $01, $02, $03, $05, $06, $07, $08, $0A, $0B, $0C, $0D, $0F, $10, $11, $12, $14, $15, $16, $17, $19, $1A, $1B, $1C, $1E, $1F, $20, $21, $23, $24, $25, $26); + InData3: array [0 .. 15] of Byte = ($5E, $25, $CA, $78, $F0, $DE, $55, $80, $25, $24, $D3, $8D, $A3, $FE, $44, $56); + OutData3: array [0 .. 15] of Byte = ($E8, $B7, $2B, $4E, $8B, $E2, $43, $43, $8C, $9F, $FF, $1F, $0E, $20, $58, $72); +var + Block: array [0 .. 15] of Byte; + Cipher: TncEnc_rijndael; +begin + Cipher := TncEnc_rijndael.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Block); + Result := Boolean(CompareMem(@Block, @OutData1, 16)); + Cipher.DecryptECB(Block, Block); + Cipher.Burn; + Result := Result and Boolean(CompareMem(@Block, @InData1, 16)); + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(InData2, Block); + Result := Result and Boolean(CompareMem(@Block, @OutData2, 16)); + Cipher.DecryptECB(Block, Block); + Cipher.Burn; + Result := Result and Boolean(CompareMem(@Block, @InData2, 16)); + Cipher.Init(Key3, Sizeof(Key3) * 8, nil); + Cipher.EncryptECB(InData3, Block); + Result := Result and Boolean(CompareMem(@Block, @OutData3, 16)); + Cipher.DecryptECB(Block, Block); + Cipher.Burn; + Result := Result and Boolean(CompareMem(@Block, @InData3, 16)); + Cipher.Free; +end; + +procedure InvMixColumn(a: PByteArray; BC: Byte); +var + j: longword; +begin + for j := 0 to (BC - 1) do + PUInt32(@(a^[j * 4]))^ := PUInt32(@U1[a^[j * 4 + 0]])^ xor PUInt32(@U2[a^[j * 4 + 1]])^ xor PUInt32(@U3[a^[j * 4 + 2]])^ xor PUInt32(@U4[a^[j * 4 + 3]])^; +end; + +procedure TncEnc_rijndael.InitKey(const Key; Size: longword); +var + KC, ROUNDS, j, r, t, rconpointer: longword; + tk: array [0 .. MAXKC - 1, 0 .. 3] of Byte; +begin + Size := Size div 8; + + FillChar(tk, Sizeof(tk), 0); + Move(Key, tk, Size); + if Size <= 16 then + begin + KC := 4; + ROUNDS := 10; + end + else if Size <= 24 then + begin + KC := 6; + ROUNDS := 12; + end + else + begin + KC := 8; + ROUNDS := 14; + end; + numrounds := ROUNDS; + r := 0; + t := 0; + j := 0; + while (j < KC) and (r < (ROUNDS + 1)) do + begin + while (j < KC) and (t < BC) do + begin + rk[r, t] := PUInt32(@tk[j])^; + Inc(j); + Inc(t); + end; + if t = BC then + begin + t := 0; + Inc(r); + end; + end; + rconpointer := 0; + while (r < (ROUNDS + 1)) do + begin + tk[0, 0] := tk[0, 0] xor S[tk[KC - 1, 1]]; + tk[0, 1] := tk[0, 1] xor S[tk[KC - 1, 2]]; + tk[0, 2] := tk[0, 2] xor S[tk[KC - 1, 3]]; + tk[0, 3] := tk[0, 3] xor S[tk[KC - 1, 0]]; + tk[0, 0] := tk[0, 0] xor rcon[rconpointer]; + Inc(rconpointer); + if KC <> 8 then + begin + for j := 1 to (KC - 1) do + PUInt32(@tk[j])^ := PUInt32(@tk[j])^ xor PUInt32(@tk[j - 1])^; + end + else + begin + for j := 1 to ((KC div 2) - 1) do + PUInt32(@tk[j])^ := PUInt32(@tk[j])^ xor PUInt32(@tk[j - 1])^; + tk[KC div 2, 0] := tk[KC div 2, 0] xor S[tk[KC div 2 - 1, 0]]; + tk[KC div 2, 1] := tk[KC div 2, 1] xor S[tk[KC div 2 - 1, 1]]; + tk[KC div 2, 2] := tk[KC div 2, 2] xor S[tk[KC div 2 - 1, 2]]; + tk[KC div 2, 3] := tk[KC div 2, 3] xor S[tk[KC div 2 - 1, 3]]; + for j := ((KC div 2) + 1) to (KC - 1) do + PUInt32(@tk[j])^ := PUInt32(@tk[j])^ xor PUInt32(@tk[j - 1])^; + end; + j := 0; + while (j < KC) and (r < (ROUNDS + 1)) do + begin + while (j < KC) and (t < BC) do + begin + rk[r, t] := PUInt32(@tk[j])^; + Inc(j); + Inc(t); + end; + if t = BC then + begin + Inc(r); + t := 0; + end; + end; + end; + Move(rk, drk, Sizeof(rk)); + for r := 1 to (numrounds - 1) do + InvMixColumn(@drk[r], BC); +end; + +procedure TncEnc_rijndael.Burn; +begin + numrounds := 0; + FillChar(rk, Sizeof(rk), 0); + FillChar(drk, Sizeof(drk), 0); + inherited Burn; +end; + +procedure TncEnc_rijndael.EncryptECB(const InData; var OutData); +var + r: longword; + tempb: array [0 .. MAXBC - 1, 0 .. 3] of Byte; + a: array [0 .. MAXBC, 0 .. 3] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + PUInt32(@a[0, 0])^ := PUInt32(@InData)^; + PUInt32(@a[1, 0])^ := PUInt32(NativeUInt(@InData) + 4)^; + PUInt32(@a[2, 0])^ := PUInt32(NativeUInt(@InData) + 8)^; + PUInt32(@a[3, 0])^ := PUInt32(NativeUInt(@InData) + 12)^; + for r := 0 to (numrounds - 2) do + begin + PUInt32(@tempb[0])^ := PUInt32(@a[0])^ xor rk[r, 0]; + PUInt32(@tempb[1])^ := PUInt32(@a[1])^ xor rk[r, 1]; + PUInt32(@tempb[2])^ := PUInt32(@a[2])^ xor rk[r, 2]; + PUInt32(@tempb[3])^ := PUInt32(@a[3])^ xor rk[r, 3]; + PUInt32(@a[0])^ := PUInt32(@T1[tempb[0, 0]])^ xor PUInt32(@T2[tempb[1, 1]])^ xor PUInt32(@T3[tempb[2, 2]])^ xor PUInt32(@T4[tempb[3, 3]])^; + PUInt32(@a[1])^ := PUInt32(@T1[tempb[1, 0]])^ xor PUInt32(@T2[tempb[2, 1]])^ xor PUInt32(@T3[tempb[3, 2]])^ xor PUInt32(@T4[tempb[0, 3]])^; + PUInt32(@a[2])^ := PUInt32(@T1[tempb[2, 0]])^ xor PUInt32(@T2[tempb[3, 1]])^ xor PUInt32(@T3[tempb[0, 2]])^ xor PUInt32(@T4[tempb[1, 3]])^; + PUInt32(@a[3])^ := PUInt32(@T1[tempb[3, 0]])^ xor PUInt32(@T2[tempb[0, 1]])^ xor PUInt32(@T3[tempb[1, 2]])^ xor PUInt32(@T4[tempb[2, 3]])^; + end; + PUInt32(@tempb[0])^ := PUInt32(@a[0])^ xor rk[numrounds - 1, 0]; + PUInt32(@tempb[1])^ := PUInt32(@a[1])^ xor rk[numrounds - 1, 1]; + PUInt32(@tempb[2])^ := PUInt32(@a[2])^ xor rk[numrounds - 1, 2]; + PUInt32(@tempb[3])^ := PUInt32(@a[3])^ xor rk[numrounds - 1, 3]; + a[0, 0] := T1[tempb[0, 0], 1]; + a[0, 1] := T1[tempb[1, 1], 1]; + a[0, 2] := T1[tempb[2, 2], 1]; + a[0, 3] := T1[tempb[3, 3], 1]; + a[1, 0] := T1[tempb[1, 0], 1]; + a[1, 1] := T1[tempb[2, 1], 1]; + a[1, 2] := T1[tempb[3, 2], 1]; + a[1, 3] := T1[tempb[0, 3], 1]; + a[2, 0] := T1[tempb[2, 0], 1]; + a[2, 1] := T1[tempb[3, 1], 1]; + a[2, 2] := T1[tempb[0, 2], 1]; + a[2, 3] := T1[tempb[1, 3], 1]; + a[3, 0] := T1[tempb[3, 0], 1]; + a[3, 1] := T1[tempb[0, 1], 1]; + a[3, 2] := T1[tempb[1, 2], 1]; + a[3, 3] := T1[tempb[2, 3], 1]; + PUInt32(@a[0])^ := PUInt32(@a[0])^ xor rk[numrounds, 0]; + PUInt32(@a[1])^ := PUInt32(@a[1])^ xor rk[numrounds, 1]; + PUInt32(@a[2])^ := PUInt32(@a[2])^ xor rk[numrounds, 2]; + PUInt32(@a[3])^ := PUInt32(@a[3])^ xor rk[numrounds, 3]; + + PUInt32(@OutData)^ := PUInt32(@a[0, 0])^; + PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@a[1, 0])^; + PUInt32(NativeUInt(@OutData) + 8)^ := PUInt32(@a[2, 0])^; + PUInt32(NativeUInt(@OutData) + 12)^ := PUInt32(@a[3, 0])^; +end; + +procedure TncEnc_rijndael.DecryptECB(const InData; var OutData); +var + r: longword; + tempb: array [0 .. MAXBC - 1, 0 .. 3] of Byte; + a: array [0 .. MAXBC, 0 .. 3] of Byte; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + PUInt32(@a[0, 0])^ := PUInt32(@InData)^; + PUInt32(@a[1, 0])^ := PUInt32(NativeUInt(@InData) + 4)^; + PUInt32(@a[2, 0])^ := PUInt32(NativeUInt(@InData) + 8)^; + PUInt32(@a[3, 0])^ := PUInt32(NativeUInt(@InData) + 12)^; + for r := numrounds downto 2 do + begin + PUInt32(@tempb[0])^ := PUInt32(@a[0])^ xor drk[r, 0]; + PUInt32(@tempb[1])^ := PUInt32(@a[1])^ xor drk[r, 1]; + PUInt32(@tempb[2])^ := PUInt32(@a[2])^ xor drk[r, 2]; + PUInt32(@tempb[3])^ := PUInt32(@a[3])^ xor drk[r, 3]; + PUInt32(@a[0])^ := PUInt32(@T5[tempb[0, 0]])^ xor PUInt32(@T6[tempb[3, 1]])^ xor PUInt32(@T7[tempb[2, 2]])^ xor PUInt32(@T8[tempb[1, 3]])^; + PUInt32(@a[1])^ := PUInt32(@T5[tempb[1, 0]])^ xor PUInt32(@T6[tempb[0, 1]])^ xor PUInt32(@T7[tempb[3, 2]])^ xor PUInt32(@T8[tempb[2, 3]])^; + PUInt32(@a[2])^ := PUInt32(@T5[tempb[2, 0]])^ xor PUInt32(@T6[tempb[1, 1]])^ xor PUInt32(@T7[tempb[0, 2]])^ xor PUInt32(@T8[tempb[3, 3]])^; + PUInt32(@a[3])^ := PUInt32(@T5[tempb[3, 0]])^ xor PUInt32(@T6[tempb[2, 1]])^ xor PUInt32(@T7[tempb[1, 2]])^ xor PUInt32(@T8[tempb[0, 3]])^; + end; + PUInt32(@tempb[0])^ := PUInt32(@a[0])^ xor drk[1, 0]; + PUInt32(@tempb[1])^ := PUInt32(@a[1])^ xor drk[1, 1]; + PUInt32(@tempb[2])^ := PUInt32(@a[2])^ xor drk[1, 2]; + PUInt32(@tempb[3])^ := PUInt32(@a[3])^ xor drk[1, 3]; + a[0, 0] := S5[tempb[0, 0]]; + a[0, 1] := S5[tempb[3, 1]]; + a[0, 2] := S5[tempb[2, 2]]; + a[0, 3] := S5[tempb[1, 3]]; + a[1, 0] := S5[tempb[1, 0]]; + a[1, 1] := S5[tempb[0, 1]]; + a[1, 2] := S5[tempb[3, 2]]; + a[1, 3] := S5[tempb[2, 3]]; + a[2, 0] := S5[tempb[2, 0]]; + a[2, 1] := S5[tempb[1, 1]]; + a[2, 2] := S5[tempb[0, 2]]; + a[2, 3] := S5[tempb[3, 3]]; + a[3, 0] := S5[tempb[3, 0]]; + a[3, 1] := S5[tempb[2, 1]]; + a[3, 2] := S5[tempb[1, 2]]; + a[3, 3] := S5[tempb[0, 3]]; + PUInt32(@a[0])^ := PUInt32(@a[0])^ xor drk[0, 0]; + PUInt32(@a[1])^ := PUInt32(@a[1])^ xor drk[0, 1]; + PUInt32(@a[2])^ := PUInt32(@a[2])^ xor drk[0, 2]; + PUInt32(@a[3])^ := PUInt32(@a[3])^ xor drk[0, 3]; + PUInt32(@OutData)^ := PUInt32(@a[0, 0])^; + PUInt32(NativeUInt(@OutData) + 4)^ := PUInt32(@a[1, 0])^; + PUInt32(NativeUInt(@OutData) + 8)^ := PUInt32(@a[2, 0])^; + PUInt32(NativeUInt(@OutData) + 12)^ := PUInt32(@a[3, 0])^; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncRipemd128.pas b/Source_using_TMonitor/Encryption/ncEncRipemd128.pas new file mode 100644 index 0000000..7aed635 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncRipemd128.pas @@ -0,0 +1,482 @@ +{$R-} +{$Q-} +unit ncEncRipemd128; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_ripemd128 = class(TncEncHash) + protected + LenHi, LenLo: UInt32; + Index: UInt32; + CurrentHash: array [0 .. 3] of UInt32; + HashBuffer: array [0 .. 63] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const aBuffer; aSize: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +procedure TncEnc_ripemd128.Compress; +var + X: array [0 .. 15] of UInt32; + a, aa, b, bb, c, cc, d, dd, t: UInt32; +begin + Move(HashBuffer, X, Sizeof(X)); + a := CurrentHash[0]; + aa := a; + b := CurrentHash[1]; + bb := b; + c := CurrentHash[2]; + cc := c; + d := CurrentHash[3]; + dd := d; + + t := a + (b xor c xor d) + X[0]; + a := (t shl 11) or (t shr (32 - 11)); + t := d + (a xor b xor c) + X[1]; + d := (t shl 14) or (t shr (32 - 14)); + t := c + (d xor a xor b) + X[2]; + c := (t shl 15) or (t shr (32 - 15)); + t := b + (c xor d xor a) + X[3]; + b := (t shl 12) or (t shr (32 - 12)); + t := a + (b xor c xor d) + X[4]; + a := (t shl 5) or (t shr (32 - 5)); + t := d + (a xor b xor c) + X[5]; + d := (t shl 8) or (t shr (32 - 8)); + t := c + (d xor a xor b) + X[6]; + c := (t shl 7) or (t shr (32 - 7)); + t := b + (c xor d xor a) + X[7]; + b := (t shl 9) or (t shr (32 - 9)); + t := a + (b xor c xor d) + X[8]; + a := (t shl 11) or (t shr (32 - 11)); + t := d + (a xor b xor c) + X[9]; + d := (t shl 13) or (t shr (32 - 13)); + t := c + (d xor a xor b) + X[10]; + c := (t shl 14) or (t shr (32 - 14)); + t := b + (c xor d xor a) + X[11]; + b := (t shl 15) or (t shr (32 - 15)); + t := a + (b xor c xor d) + X[12]; + a := (t shl 6) or (t shr (32 - 6)); + t := d + (a xor b xor c) + X[13]; + d := (t shl 7) or (t shr (32 - 7)); + t := c + (d xor a xor b) + X[14]; + c := (t shl 9) or (t shr (32 - 9)); + t := b + (c xor d xor a) + X[15]; + b := (t shl 8) or (t shr (32 - 8)); + + t := a + ((b and c) or (not b and d)) + X[7] + $5A827999; + a := (t shl 7) or (t shr (32 - 7)); + t := d + ((a and b) or (not a and c)) + X[4] + $5A827999; + d := (t shl 6) or (t shr (32 - 6)); + t := c + ((d and a) or (not d and b)) + X[13] + $5A827999; + c := (t shl 8) or (t shr (32 - 8)); + t := b + ((c and d) or (not c and a)) + X[1] + $5A827999; + b := (t shl 13) or (t shr (32 - 13)); + t := a + ((b and c) or (not b and d)) + X[10] + $5A827999; + a := (t shl 11) or (t shr (32 - 11)); + t := d + ((a and b) or (not a and c)) + X[6] + $5A827999; + d := (t shl 9) or (t shr (32 - 9)); + t := c + ((d and a) or (not d and b)) + X[15] + $5A827999; + c := (t shl 7) or (t shr (32 - 7)); + t := b + ((c and d) or (not c and a)) + X[3] + $5A827999; + b := (t shl 15) or (t shr (32 - 15)); + t := a + ((b and c) or (not b and d)) + X[12] + $5A827999; + a := (t shl 7) or (t shr (32 - 7)); + t := d + ((a and b) or (not a and c)) + X[0] + $5A827999; + d := (t shl 12) or (t shr (32 - 12)); + t := c + ((d and a) or (not d and b)) + X[9] + $5A827999; + c := (t shl 15) or (t shr (32 - 15)); + t := b + ((c and d) or (not c and a)) + X[5] + $5A827999; + b := (t shl 9) or (t shr (32 - 9)); + t := a + ((b and c) or (not b and d)) + X[2] + $5A827999; + a := (t shl 11) or (t shr (32 - 11)); + t := d + ((a and b) or (not a and c)) + X[14] + $5A827999; + d := (t shl 7) or (t shr (32 - 7)); + t := c + ((d and a) or (not d and b)) + X[11] + $5A827999; + c := (t shl 13) or (t shr (32 - 13)); + t := b + ((c and d) or (not c and a)) + X[8] + $5A827999; + b := (t shl 12) or (t shr (32 - 12)); + + t := a + ((b or not c) xor d) + X[3] + $6ED9EBA1; + a := (t shl 11) or (t shr (32 - 11)); + t := d + ((a or not b) xor c) + X[10] + $6ED9EBA1; + d := (t shl 13) or (t shr (32 - 13)); + t := c + ((d or not a) xor b) + X[14] + $6ED9EBA1; + c := (t shl 6) or (t shr (32 - 6)); + t := b + ((c or not d) xor a) + X[4] + $6ED9EBA1; + b := (t shl 7) or (t shr (32 - 7)); + t := a + ((b or not c) xor d) + X[9] + $6ED9EBA1; + a := (t shl 14) or (t shr (32 - 14)); + t := d + ((a or not b) xor c) + X[15] + $6ED9EBA1; + d := (t shl 9) or (t shr (32 - 9)); + t := c + ((d or not a) xor b) + X[8] + $6ED9EBA1; + c := (t shl 13) or (t shr (32 - 13)); + t := b + ((c or not d) xor a) + X[1] + $6ED9EBA1; + b := (t shl 15) or (t shr (32 - 15)); + t := a + ((b or not c) xor d) + X[2] + $6ED9EBA1; + a := (t shl 14) or (t shr (32 - 14)); + t := d + ((a or not b) xor c) + X[7] + $6ED9EBA1; + d := (t shl 8) or (t shr (32 - 8)); + t := c + ((d or not a) xor b) + X[0] + $6ED9EBA1; + c := (t shl 13) or (t shr (32 - 13)); + t := b + ((c or not d) xor a) + X[6] + $6ED9EBA1; + b := (t shl 6) or (t shr (32 - 6)); + t := a + ((b or not c) xor d) + X[13] + $6ED9EBA1; + a := (t shl 5) or (t shr (32 - 5)); + t := d + ((a or not b) xor c) + X[11] + $6ED9EBA1; + d := (t shl 12) or (t shr (32 - 12)); + t := c + ((d or not a) xor b) + X[5] + $6ED9EBA1; + c := (t shl 7) or (t shr (32 - 7)); + t := b + ((c or not d) xor a) + X[12] + $6ED9EBA1; + b := (t shl 5) or (t shr (32 - 5)); + + t := a + ((b and d) or (c and not d)) + X[1] + $8F1BBCDC; + a := (t shl 11) or (t shr (32 - 11)); + t := d + ((a and c) or (b and not c)) + X[9] + $8F1BBCDC; + d := (t shl 12) or (t shr (32 - 12)); + t := c + ((d and b) or (a and not b)) + X[11] + $8F1BBCDC; + c := (t shl 14) or (t shr (32 - 14)); + t := b + ((c and a) or (d and not a)) + X[10] + $8F1BBCDC; + b := (t shl 15) or (t shr (32 - 15)); + t := a + ((b and d) or (c and not d)) + X[0] + $8F1BBCDC; + a := (t shl 14) or (t shr (32 - 14)); + t := d + ((a and c) or (b and not c)) + X[8] + $8F1BBCDC; + d := (t shl 15) or (t shr (32 - 15)); + t := c + ((d and b) or (a and not b)) + X[12] + $8F1BBCDC; + c := (t shl 9) or (t shr (32 - 9)); + t := b + ((c and a) or (d and not a)) + X[4] + $8F1BBCDC; + b := (t shl 8) or (t shr (32 - 8)); + t := a + ((b and d) or (c and not d)) + X[13] + $8F1BBCDC; + a := (t shl 9) or (t shr (32 - 9)); + t := d + ((a and c) or (b and not c)) + X[3] + $8F1BBCDC; + d := (t shl 14) or (t shr (32 - 14)); + t := c + ((d and b) or (a and not b)) + X[7] + $8F1BBCDC; + c := (t shl 5) or (t shr (32 - 5)); + t := b + ((c and a) or (d and not a)) + X[15] + $8F1BBCDC; + b := (t shl 6) or (t shr (32 - 6)); + t := a + ((b and d) or (c and not d)) + X[14] + $8F1BBCDC; + a := (t shl 8) or (t shr (32 - 8)); + t := d + ((a and c) or (b and not c)) + X[5] + $8F1BBCDC; + d := (t shl 6) or (t shr (32 - 6)); + t := c + ((d and b) or (a and not b)) + X[6] + $8F1BBCDC; + c := (t shl 5) or (t shr (32 - 5)); + t := b + ((c and a) or (d and not a)) + X[2] + $8F1BBCDC; + b := (t shl 12) or (t shr (32 - 12)); + + t := aa + ((bb and dd) or (cc and not dd)) + X[5] + $50A28BE6; + aa := (t shl 8) or (t shr (32 - 8)); + t := dd + ((aa and cc) or (bb and not cc)) + X[14] + $50A28BE6; + dd := (t shl 9) or (t shr (32 - 9)); + t := cc + ((dd and bb) or (aa and not bb)) + X[7] + $50A28BE6; + cc := (t shl 9) or (t shr (32 - 9)); + t := bb + ((cc and aa) or (dd and not aa)) + X[0] + $50A28BE6; + bb := (t shl 11) or (t shr (32 - 11)); + t := aa + ((bb and dd) or (cc and not dd)) + X[9] + $50A28BE6; + aa := (t shl 13) or (t shr (32 - 13)); + t := dd + ((aa and cc) or (bb and not cc)) + X[2] + $50A28BE6; + dd := (t shl 15) or (t shr (32 - 15)); + t := cc + ((dd and bb) or (aa and not bb)) + X[11] + $50A28BE6; + cc := (t shl 15) or (t shr (32 - 15)); + t := bb + ((cc and aa) or (dd and not aa)) + X[4] + $50A28BE6; + bb := (t shl 5) or (t shr (32 - 5)); + t := aa + ((bb and dd) or (cc and not dd)) + X[13] + $50A28BE6; + aa := (t shl 7) or (t shr (32 - 7)); + t := dd + ((aa and cc) or (bb and not cc)) + X[6] + $50A28BE6; + dd := (t shl 7) or (t shr (32 - 7)); + t := cc + ((dd and bb) or (aa and not bb)) + X[15] + $50A28BE6; + cc := (t shl 8) or (t shr (32 - 8)); + t := bb + ((cc and aa) or (dd and not aa)) + X[8] + $50A28BE6; + bb := (t shl 11) or (t shr (32 - 11)); + t := aa + ((bb and dd) or (cc and not dd)) + X[1] + $50A28BE6; + aa := (t shl 14) or (t shr (32 - 14)); + t := dd + ((aa and cc) or (bb and not cc)) + X[10] + $50A28BE6; + dd := (t shl 14) or (t shr (32 - 14)); + t := cc + ((dd and bb) or (aa and not bb)) + X[3] + $50A28BE6; + cc := (t shl 12) or (t shr (32 - 12)); + t := bb + ((cc and aa) or (dd and not aa)) + X[12] + $50A28BE6; + bb := (t shl 6) or (t shr (32 - 6)); + + t := aa + ((bb or not cc) xor dd) + X[6] + $5C4DD124; + aa := (t shl 9) or (t shr (32 - 9)); + t := dd + ((aa or not bb) xor cc) + X[11] + $5C4DD124; + dd := (t shl 13) or (t shr (32 - 13)); + t := cc + ((dd or not aa) xor bb) + X[3] + $5C4DD124; + cc := (t shl 15) or (t shr (32 - 15)); + t := bb + ((cc or not dd) xor aa) + X[7] + $5C4DD124; + bb := (t shl 7) or (t shr (32 - 7)); + t := aa + ((bb or not cc) xor dd) + X[0] + $5C4DD124; + aa := (t shl 12) or (t shr (32 - 12)); + t := dd + ((aa or not bb) xor cc) + X[13] + $5C4DD124; + dd := (t shl 8) or (t shr (32 - 8)); + t := cc + ((dd or not aa) xor bb) + X[5] + $5C4DD124; + cc := (t shl 9) or (t shr (32 - 9)); + t := bb + ((cc or not dd) xor aa) + X[10] + $5C4DD124; + bb := (t shl 11) or (t shr (32 - 11)); + t := aa + ((bb or not cc) xor dd) + X[14] + $5C4DD124; + aa := (t shl 7) or (t shr (32 - 7)); + t := dd + ((aa or not bb) xor cc) + X[15] + $5C4DD124; + dd := (t shl 7) or (t shr (32 - 7)); + t := cc + ((dd or not aa) xor bb) + X[8] + $5C4DD124; + cc := (t shl 12) or (t shr (32 - 12)); + t := bb + ((cc or not dd) xor aa) + X[12] + $5C4DD124; + bb := (t shl 7) or (t shr (32 - 7)); + t := aa + ((bb or not cc) xor dd) + X[4] + $5C4DD124; + aa := (t shl 6) or (t shr (32 - 6)); + t := dd + ((aa or not bb) xor cc) + X[9] + $5C4DD124; + dd := (t shl 15) or (t shr (32 - 15)); + t := cc + ((dd or not aa) xor bb) + X[1] + $5C4DD124; + cc := (t shl 13) or (t shr (32 - 13)); + t := bb + ((cc or not dd) xor aa) + X[2] + $5C4DD124; + bb := (t shl 11) or (t shr (32 - 11)); + + t := aa + ((bb and cc) or (not bb and dd)) + X[15] + $6D703EF3; + aa := (t shl 9) or (t shr (32 - 9)); + t := dd + ((aa and bb) or (not aa and cc)) + X[5] + $6D703EF3; + dd := (t shl 7) or (t shr (32 - 7)); + t := cc + ((dd and aa) or (not dd and bb)) + X[1] + $6D703EF3; + cc := (t shl 15) or (t shr (32 - 15)); + t := bb + ((cc and dd) or (not cc and aa)) + X[3] + $6D703EF3; + bb := (t shl 11) or (t shr (32 - 11)); + t := aa + ((bb and cc) or (not bb and dd)) + X[7] + $6D703EF3; + aa := (t shl 8) or (t shr (32 - 8)); + t := dd + ((aa and bb) or (not aa and cc)) + X[14] + $6D703EF3; + dd := (t shl 6) or (t shr (32 - 6)); + t := cc + ((dd and aa) or (not dd and bb)) + X[6] + $6D703EF3; + cc := (t shl 6) or (t shr (32 - 6)); + t := bb + ((cc and dd) or (not cc and aa)) + X[9] + $6D703EF3; + bb := (t shl 14) or (t shr (32 - 14)); + t := aa + ((bb and cc) or (not bb and dd)) + X[11] + $6D703EF3; + aa := (t shl 12) or (t shr (32 - 12)); + t := dd + ((aa and bb) or (not aa and cc)) + X[8] + $6D703EF3; + dd := (t shl 13) or (t shr (32 - 13)); + t := cc + ((dd and aa) or (not dd and bb)) + X[12] + $6D703EF3; + cc := (t shl 5) or (t shr (32 - 5)); + t := bb + ((cc and dd) or (not cc and aa)) + X[2] + $6D703EF3; + bb := (t shl 14) or (t shr (32 - 14)); + t := aa + ((bb and cc) or (not bb and dd)) + X[10] + $6D703EF3; + aa := (t shl 13) or (t shr (32 - 13)); + t := dd + ((aa and bb) or (not aa and cc)) + X[0] + $6D703EF3; + dd := (t shl 13) or (t shr (32 - 13)); + t := cc + ((dd and aa) or (not dd and bb)) + X[4] + $6D703EF3; + cc := (t shl 7) or (t shr (32 - 7)); + t := bb + ((cc and dd) or (not cc and aa)) + X[13] + $6D703EF3; + bb := (t shl 5) or (t shr (32 - 5)); + + t := aa + (bb xor cc xor dd) + X[8]; + aa := (t shl 15) or (t shr (32 - 15)); + t := dd + (aa xor bb xor cc) + X[6]; + dd := (t shl 5) or (t shr (32 - 5)); + t := cc + (dd xor aa xor bb) + X[4]; + cc := (t shl 8) or (t shr (32 - 8)); + t := bb + (cc xor dd xor aa) + X[1]; + bb := (t shl 11) or (t shr (32 - 11)); + t := aa + (bb xor cc xor dd) + X[3]; + aa := (t shl 14) or (t shr (32 - 14)); + t := dd + (aa xor bb xor cc) + X[11]; + dd := (t shl 14) or (t shr (32 - 14)); + t := cc + (dd xor aa xor bb) + X[15]; + cc := (t shl 6) or (t shr (32 - 6)); + t := bb + (cc xor dd xor aa) + X[0]; + bb := (t shl 14) or (t shr (32 - 14)); + t := aa + (bb xor cc xor dd) + X[5]; + aa := (t shl 6) or (t shr (32 - 6)); + t := dd + (aa xor bb xor cc) + X[12]; + dd := (t shl 9) or (t shr (32 - 9)); + t := cc + (dd xor aa xor bb) + X[2]; + cc := (t shl 12) or (t shr (32 - 12)); + t := bb + (cc xor dd xor aa) + X[13]; + bb := (t shl 9) or (t shr (32 - 9)); + t := aa + (bb xor cc xor dd) + X[9]; + aa := (t shl 12) or (t shr (32 - 12)); + t := dd + (aa xor bb xor cc) + X[7]; + dd := (t shl 5) or (t shr (32 - 5)); + t := cc + (dd xor aa xor bb) + X[10]; + cc := (t shl 15) or (t shr (32 - 15)); + t := bb + (cc xor dd xor aa) + X[14]; + bb := (t shl 8) or (t shr (32 - 8)); + + Inc(dd, c + CurrentHash[1]); + CurrentHash[1] := CurrentHash[2] + d + aa; + CurrentHash[2] := CurrentHash[3] + a + bb; + CurrentHash[3] := CurrentHash[0] + b + cc; + CurrentHash[0] := dd; + + FillChar(X, Sizeof(X), 0); + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_ripemd128.GetHashSize: Integer; +begin + Result := 128; +end; + +class function TncEnc_ripemd128.GetAlgorithm: string; +begin + Result := 'RipeMD-128'; +end; + +class function TncEnc_ripemd128.SelfTest: Boolean; +const + Test1Out: array [0 .. 15] of Byte = ($86, $BE, $7A, $FA, $33, $9D, $0F, $C7, $CF, $C7, $85, $E7, $2F, $57, $8D, $33); + Test2Out: array [0 .. 15] of Byte = ($FD, $2A, $A6, $07, $F7, $1D, $C8, $F5, $10, $71, $49, $22, $B3, $71, $83, $4E); +var + TestHash: TncEnc_ripemd128; + TestOut: array [0 .. 15] of Byte; +begin + TestHash := TncEnc_ripemd128.Create(nil); + TestHash.Init; + TestHash.UpdateStr('a'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Init; + TestHash.UpdateStr('abcdefghijklmnopqrstuvwxyz'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out)) and Result; + TestHash.Free; +end; + +procedure TncEnc_ripemd128.Init; +begin + Burn; + CurrentHash[0] := $67452301; + CurrentHash[1] := $EFCDAB89; + CurrentHash[2] := $98BADCFE; + CurrentHash[3] := $10325476; + FInitialized := true; +end; + +procedure TncEnc_ripemd128.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_ripemd128.Update(const aBuffer; aSize: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenHi, aSize shr 29); + Inc(LenLo, aSize * 8); + if LenLo < (aSize * 8) then + Inc(LenHi); + + PBuf := @aBuffer; + while aSize > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= aSize then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(aSize, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], aSize); + Inc(Index, aSize); + aSize := 0; + end; + end; +end; + +procedure TncEnc_ripemd128.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 56 then + Compress; + PUInt32(@HashBuffer[56])^ := LenLo; + PUInt32(@HashBuffer[60])^ := LenHi; + Compress; + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncRipemd160.pas b/Source_using_TMonitor/Encryption/ncEncRipemd160.pas new file mode 100644 index 0000000..a9972b6 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncRipemd160.pas @@ -0,0 +1,711 @@ +{$R-} +{$Q-} +unit ncEncRipemd160; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_ripemd160 = class(TncEncHash) + protected + LenHi, LenLo: UInt32; + Index: UInt32; + CurrentHash: array [0 .. 4] of UInt32; + HashBuffer: array [0 .. 63] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const Buffer; Size: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +procedure TncEnc_ripemd160.Compress; +var + aa, bb, cc, dd, ee, aaa, bbb, ccc, ddd, eee: UInt32; + X: array [0 .. 15] of UInt32; +begin + Move(HashBuffer, X, Sizeof(X)); + aa := CurrentHash[0]; + aaa := CurrentHash[0]; + bb := CurrentHash[1]; + bbb := CurrentHash[1]; + cc := CurrentHash[2]; + ccc := CurrentHash[2]; + dd := CurrentHash[3]; + ddd := CurrentHash[3]; + ee := CurrentHash[4]; + eee := CurrentHash[4]; + + aa := aa + (bb xor cc xor dd) + X[0]; + aa := ((aa shl 11) or (aa shr (32 - 11))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + (aa xor bb xor cc) + X[1]; + ee := ((ee shl 14) or (ee shr (32 - 14))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + (ee xor aa xor bb) + X[2]; + dd := ((dd shl 15) or (dd shr (32 - 15))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + (dd xor ee xor aa) + X[3]; + cc := ((cc shl 12) or (cc shr (32 - 12))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + (cc xor dd xor ee) + X[4]; + bb := ((bb shl 5) or (bb shr (32 - 5))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + (bb xor cc xor dd) + X[5]; + aa := ((aa shl 8) or (aa shr (32 - 8))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + (aa xor bb xor cc) + X[6]; + ee := ((ee shl 7) or (ee shr (32 - 7))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + (ee xor aa xor bb) + X[7]; + dd := ((dd shl 9) or (dd shr (32 - 9))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + (dd xor ee xor aa) + X[8]; + cc := ((cc shl 11) or (cc shr (32 - 11))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + (cc xor dd xor ee) + X[9]; + bb := ((bb shl 13) or (bb shr (32 - 13))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + (bb xor cc xor dd) + X[10]; + aa := ((aa shl 14) or (aa shr (32 - 14))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + (aa xor bb xor cc) + X[11]; + ee := ((ee shl 15) or (ee shr (32 - 15))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + (ee xor aa xor bb) + X[12]; + dd := ((dd shl 6) or (dd shr (32 - 6))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + (dd xor ee xor aa) + X[13]; + cc := ((cc shl 7) or (cc shr (32 - 7))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + (cc xor dd xor ee) + X[14]; + bb := ((bb shl 9) or (bb shr (32 - 9))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + (bb xor cc xor dd) + X[15]; + aa := ((aa shl 8) or (aa shr (32 - 8))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + + ee := ee + ((aa and bb) or ((not aa) and cc)) + X[7] + $5A827999; + ee := ((ee shl 7) or (ee shr (32 - 7))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee and aa) or ((not ee) and bb)) + X[4] + $5A827999; + dd := ((dd shl 6) or (dd shr (32 - 6))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd and ee) or ((not dd) and aa)) + X[13] + $5A827999; + cc := ((cc shl 8) or (cc shr (32 - 8))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc and dd) or ((not cc) and ee)) + X[1] + $5A827999; + bb := ((bb shl 13) or (bb shr (32 - 13))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb and cc) or ((not bb) and dd)) + X[10] + $5A827999; + aa := ((aa shl 11) or (aa shr (32 - 11))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa and bb) or ((not aa) and cc)) + X[6] + $5A827999; + ee := ((ee shl 9) or (ee shr (32 - 9))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee and aa) or ((not ee) and bb)) + X[15] + $5A827999; + dd := ((dd shl 7) or (dd shr (32 - 7))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd and ee) or ((not dd) and aa)) + X[3] + $5A827999; + cc := ((cc shl 15) or (cc shr (32 - 15))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc and dd) or ((not cc) and ee)) + X[12] + $5A827999; + bb := ((bb shl 7) or (bb shr (32 - 7))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb and cc) or ((not bb) and dd)) + X[0] + $5A827999; + aa := ((aa shl 12) or (aa shr (32 - 12))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa and bb) or ((not aa) and cc)) + X[9] + $5A827999; + ee := ((ee shl 15) or (ee shr (32 - 15))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee and aa) or ((not ee) and bb)) + X[5] + $5A827999; + dd := ((dd shl 9) or (dd shr (32 - 9))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd and ee) or ((not dd) and aa)) + X[2] + $5A827999; + cc := ((cc shl 11) or (cc shr (32 - 11))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc and dd) or ((not cc) and ee)) + X[14] + $5A827999; + bb := ((bb shl 7) or (bb shr (32 - 7))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb and cc) or ((not bb) and dd)) + X[11] + $5A827999; + aa := ((aa shl 13) or (aa shr (32 - 13))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa and bb) or ((not aa) and cc)) + X[8] + $5A827999; + ee := ((ee shl 12) or (ee shr (32 - 12))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + + dd := dd + ((ee or (not aa)) xor bb) + X[3] + $6ED9EBA1; + dd := ((dd shl 11) or (dd shr (32 - 11))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd or (not ee)) xor aa) + X[10] + $6ED9EBA1; + cc := ((cc shl 13) or (cc shr (32 - 13))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc or (not dd)) xor ee) + X[14] + $6ED9EBA1; + bb := ((bb shl 6) or (bb shr (32 - 6))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb or (not cc)) xor dd) + X[4] + $6ED9EBA1; + aa := ((aa shl 7) or (aa shr (32 - 7))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa or (not bb)) xor cc) + X[9] + $6ED9EBA1; + ee := ((ee shl 14) or (ee shr (32 - 14))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee or (not aa)) xor bb) + X[15] + $6ED9EBA1; + dd := ((dd shl 9) or (dd shr (32 - 9))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd or (not ee)) xor aa) + X[8] + $6ED9EBA1; + cc := ((cc shl 13) or (cc shr (32 - 13))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc or (not dd)) xor ee) + X[1] + $6ED9EBA1; + bb := ((bb shl 15) or (bb shr (32 - 15))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb or (not cc)) xor dd) + X[2] + $6ED9EBA1; + aa := ((aa shl 14) or (aa shr (32 - 14))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa or (not bb)) xor cc) + X[7] + $6ED9EBA1; + ee := ((ee shl 8) or (ee shr (32 - 8))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee or (not aa)) xor bb) + X[0] + $6ED9EBA1; + dd := ((dd shl 13) or (dd shr (32 - 13))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd or (not ee)) xor aa) + X[6] + $6ED9EBA1; + cc := ((cc shl 6) or (cc shr (32 - 6))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc or (not dd)) xor ee) + X[13] + $6ED9EBA1; + bb := ((bb shl 5) or (bb shr (32 - 5))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb or (not cc)) xor dd) + X[11] + $6ED9EBA1; + aa := ((aa shl 12) or (aa shr (32 - 12))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa or (not bb)) xor cc) + X[5] + $6ED9EBA1; + ee := ((ee shl 7) or (ee shr (32 - 7))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee or (not aa)) xor bb) + X[12] + $6ED9EBA1; + dd := ((dd shl 5) or (dd shr (32 - 5))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + + cc := cc + ((dd and aa) or (ee and (not aa))) + X[1] + $8F1BBCDC; + cc := ((cc shl 11) or (cc shr (32 - 11))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc and ee) or (dd and (not ee))) + X[9] + $8F1BBCDC; + bb := ((bb shl 12) or (bb shr (32 - 12))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb and dd) or (cc and (not dd))) + X[11] + $8F1BBCDC; + aa := ((aa shl 14) or (aa shr (32 - 14))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa and cc) or (bb and (not cc))) + X[10] + $8F1BBCDC; + ee := ((ee shl 15) or (ee shr (32 - 15))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee and bb) or (aa and (not bb))) + X[0] + $8F1BBCDC; + dd := ((dd shl 14) or (dd shr (32 - 14))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd and aa) or (ee and (not aa))) + X[8] + $8F1BBCDC; + cc := ((cc shl 15) or (cc shr (32 - 15))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc and ee) or (dd and (not ee))) + X[12] + $8F1BBCDC; + bb := ((bb shl 9) or (bb shr (32 - 9))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb and dd) or (cc and (not dd))) + X[4] + $8F1BBCDC; + aa := ((aa shl 8) or (aa shr (32 - 8))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa and cc) or (bb and (not cc))) + X[13] + $8F1BBCDC; + ee := ((ee shl 9) or (ee shr (32 - 9))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee and bb) or (aa and (not bb))) + X[3] + $8F1BBCDC; + dd := ((dd shl 14) or (dd shr (32 - 14))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd and aa) or (ee and (not aa))) + X[7] + $8F1BBCDC; + cc := ((cc shl 5) or (cc shr (32 - 5))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + ((cc and ee) or (dd and (not ee))) + X[15] + $8F1BBCDC; + bb := ((bb shl 6) or (bb shr (32 - 6))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + ((bb and dd) or (cc and (not dd))) + X[14] + $8F1BBCDC; + aa := ((aa shl 8) or (aa shr (32 - 8))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + ((aa and cc) or (bb and (not cc))) + X[5] + $8F1BBCDC; + ee := ((ee shl 6) or (ee shr (32 - 6))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + ((ee and bb) or (aa and (not bb))) + X[6] + $8F1BBCDC; + dd := ((dd shl 5) or (dd shr (32 - 5))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + ((dd and aa) or (ee and (not aa))) + X[2] + $8F1BBCDC; + cc := ((cc shl 12) or (cc shr (32 - 12))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + + bb := bb + (cc xor (dd or (not ee))) + X[4] + $A953FD4E; + bb := ((bb shl 9) or (bb shr (32 - 9))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + (bb xor (cc or (not dd))) + X[0] + $A953FD4E; + aa := ((aa shl 15) or (aa shr (32 - 15))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + (aa xor (bb or (not cc))) + X[5] + $A953FD4E; + ee := ((ee shl 5) or (ee shr (32 - 5))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + (ee xor (aa or (not bb))) + X[9] + $A953FD4E; + dd := ((dd shl 11) or (dd shr (32 - 11))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + (dd xor (ee or (not aa))) + X[7] + $A953FD4E; + cc := ((cc shl 6) or (cc shr (32 - 6))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + (cc xor (dd or (not ee))) + X[12] + $A953FD4E; + bb := ((bb shl 8) or (bb shr (32 - 8))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + (bb xor (cc or (not dd))) + X[2] + $A953FD4E; + aa := ((aa shl 13) or (aa shr (32 - 13))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + (aa xor (bb or (not cc))) + X[10] + $A953FD4E; + ee := ((ee shl 12) or (ee shr (32 - 12))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + (ee xor (aa or (not bb))) + X[14] + $A953FD4E; + dd := ((dd shl 5) or (dd shr (32 - 5))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + (dd xor (ee or (not aa))) + X[1] + $A953FD4E; + cc := ((cc shl 12) or (cc shr (32 - 12))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + (cc xor (dd or (not ee))) + X[3] + $A953FD4E; + bb := ((bb shl 13) or (bb shr (32 - 13))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + aa := aa + (bb xor (cc or (not dd))) + X[8] + $A953FD4E; + aa := ((aa shl 14) or (aa shr (32 - 14))) + ee; + cc := ((cc shl 10) or (cc shr (32 - 10))); + ee := ee + (aa xor (bb or (not cc))) + X[11] + $A953FD4E; + ee := ((ee shl 11) or (ee shr (32 - 11))) + dd; + bb := ((bb shl 10) or (bb shr (32 - 10))); + dd := dd + (ee xor (aa or (not bb))) + X[6] + $A953FD4E; + dd := ((dd shl 8) or (dd shr (32 - 8))) + cc; + aa := ((aa shl 10) or (aa shr (32 - 10))); + cc := cc + (dd xor (ee or (not aa))) + X[15] + $A953FD4E; + cc := ((cc shl 5) or (cc shr (32 - 5))) + bb; + ee := ((ee shl 10) or (ee shr (32 - 10))); + bb := bb + (cc xor (dd or (not ee))) + X[13] + $A953FD4E; + bb := ((bb shl 6) or (bb shr (32 - 6))) + aa; + dd := ((dd shl 10) or (dd shr (32 - 10))); + + aaa := aaa + (bbb xor (ccc or (not ddd))) + X[5] + $50A28BE6; + aaa := ((aaa shl 8) or (aaa shr (32 - 8))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + (aaa xor (bbb or (not ccc))) + X[14] + $50A28BE6; + eee := ((eee shl 9) or (eee shr (32 - 9))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + (eee xor (aaa or (not bbb))) + X[7] + $50A28BE6; + ddd := ((ddd shl 9) or (ddd shr (32 - 9))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + (ddd xor (eee or (not aaa))) + X[0] + $50A28BE6; + ccc := ((ccc shl 11) or (ccc shr (32 - 11))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + (ccc xor (ddd or (not eee))) + X[9] + $50A28BE6; + bbb := ((bbb shl 13) or (bbb shr (32 - 13))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + (bbb xor (ccc or (not ddd))) + X[2] + $50A28BE6; + aaa := ((aaa shl 15) or (aaa shr (32 - 15))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + (aaa xor (bbb or (not ccc))) + X[11] + $50A28BE6; + eee := ((eee shl 15) or (eee shr (32 - 15))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + (eee xor (aaa or (not bbb))) + X[4] + $50A28BE6; + ddd := ((ddd shl 5) or (ddd shr (32 - 5))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + (ddd xor (eee or (not aaa))) + X[13] + $50A28BE6; + ccc := ((ccc shl 7) or (ccc shr (32 - 7))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + (ccc xor (ddd or (not eee))) + X[6] + $50A28BE6; + bbb := ((bbb shl 7) or (bbb shr (32 - 7))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + (bbb xor (ccc or (not ddd))) + X[15] + $50A28BE6; + aaa := ((aaa shl 8) or (aaa shr (32 - 8))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + (aaa xor (bbb or (not ccc))) + X[8] + $50A28BE6; + eee := ((eee shl 11) or (eee shr (32 - 11))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + (eee xor (aaa or (not bbb))) + X[1] + $50A28BE6; + ddd := ((ddd shl 14) or (ddd shr (32 - 14))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + (ddd xor (eee or (not aaa))) + X[10] + $50A28BE6; + ccc := ((ccc shl 14) or (ccc shr (32 - 14))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + (ccc xor (ddd or (not eee))) + X[3] + $50A28BE6; + bbb := ((bbb shl 12) or (bbb shr (32 - 12))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + (bbb xor (ccc or (not ddd))) + X[12] + $50A28BE6; + aaa := ((aaa shl 6) or (aaa shr (32 - 6))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + + eee := eee + ((aaa and ccc) or (bbb and (not ccc))) + X[6] + $5C4DD124; + eee := ((eee shl 9) or (eee shr (32 - 9))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee and bbb) or (aaa and (not bbb))) + X[11] + $5C4DD124; + ddd := ((ddd shl 13) or (ddd shr (32 - 13))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd and aaa) or (eee and (not aaa))) + X[3] + $5C4DD124; + ccc := ((ccc shl 15) or (ccc shr (32 - 15))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc and eee) or (ddd and (not eee))) + X[7] + $5C4DD124; + bbb := ((bbb shl 7) or (bbb shr (32 - 7))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb and ddd) or (ccc and (not ddd))) + X[0] + $5C4DD124; + aaa := ((aaa shl 12) or (aaa shr (32 - 12))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa and ccc) or (bbb and (not ccc))) + X[13] + $5C4DD124; + eee := ((eee shl 8) or (eee shr (32 - 8))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee and bbb) or (aaa and (not bbb))) + X[5] + $5C4DD124; + ddd := ((ddd shl 9) or (ddd shr (32 - 9))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd and aaa) or (eee and (not aaa))) + X[10] + $5C4DD124; + ccc := ((ccc shl 11) or (ccc shr (32 - 11))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc and eee) or (ddd and (not eee))) + X[14] + $5C4DD124; + bbb := ((bbb shl 7) or (bbb shr (32 - 7))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb and ddd) or (ccc and (not ddd))) + X[15] + $5C4DD124; + aaa := ((aaa shl 7) or (aaa shr (32 - 7))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa and ccc) or (bbb and (not ccc))) + X[8] + $5C4DD124; + eee := ((eee shl 12) or (eee shr (32 - 12))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee and bbb) or (aaa and (not bbb))) + X[12] + $5C4DD124; + ddd := ((ddd shl 7) or (ddd shr (32 - 7))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd and aaa) or (eee and (not aaa))) + X[4] + $5C4DD124; + ccc := ((ccc shl 6) or (ccc shr (32 - 6))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc and eee) or (ddd and (not eee))) + X[9] + $5C4DD124; + bbb := ((bbb shl 15) or (bbb shr (32 - 15))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb and ddd) or (ccc and (not ddd))) + X[1] + $5C4DD124; + aaa := ((aaa shl 13) or (aaa shr (32 - 13))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa and ccc) or (bbb and (not ccc))) + X[2] + $5C4DD124; + eee := ((eee shl 11) or (eee shr (32 - 11))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + + ddd := ddd + ((eee or (not aaa)) xor bbb) + X[15] + $6D703EF3; + ddd := ((ddd shl 9) or (ddd shr (32 - 9))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd or (not eee)) xor aaa) + X[5] + $6D703EF3; + ccc := ((ccc shl 7) or (ccc shr (32 - 7))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc or (not ddd)) xor eee) + X[1] + $6D703EF3; + bbb := ((bbb shl 15) or (bbb shr (32 - 15))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb or (not ccc)) xor ddd) + X[3] + $6D703EF3; + aaa := ((aaa shl 11) or (aaa shr (32 - 11))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa or (not bbb)) xor ccc) + X[7] + $6D703EF3; + eee := ((eee shl 8) or (eee shr (32 - 8))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee or (not aaa)) xor bbb) + X[14] + $6D703EF3; + ddd := ((ddd shl 6) or (ddd shr (32 - 6))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd or (not eee)) xor aaa) + X[6] + $6D703EF3; + ccc := ((ccc shl 6) or (ccc shr (32 - 6))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc or (not ddd)) xor eee) + X[9] + $6D703EF3; + bbb := ((bbb shl 14) or (bbb shr (32 - 14))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb or (not ccc)) xor ddd) + X[11] + $6D703EF3; + aaa := ((aaa shl 12) or (aaa shr (32 - 12))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa or (not bbb)) xor ccc) + X[8] + $6D703EF3; + eee := ((eee shl 13) or (eee shr (32 - 13))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee or (not aaa)) xor bbb) + X[12] + $6D703EF3; + ddd := ((ddd shl 5) or (ddd shr (32 - 5))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd or (not eee)) xor aaa) + X[2] + $6D703EF3; + ccc := ((ccc shl 14) or (ccc shr (32 - 14))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc or (not ddd)) xor eee) + X[10] + $6D703EF3; + bbb := ((bbb shl 13) or (bbb shr (32 - 13))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb or (not ccc)) xor ddd) + X[0] + $6D703EF3; + aaa := ((aaa shl 13) or (aaa shr (32 - 13))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa or (not bbb)) xor ccc) + X[4] + $6D703EF3; + eee := ((eee shl 7) or (eee shr (32 - 7))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee or (not aaa)) xor bbb) + X[13] + $6D703EF3; + ddd := ((ddd shl 5) or (ddd shr (32 - 5))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + + ccc := ccc + ((ddd and eee) or ((not ddd) and aaa)) + X[8] + $7A6D76E9; + ccc := ((ccc shl 15) or (ccc shr (32 - 15))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc and ddd) or ((not ccc) and eee)) + X[6] + $7A6D76E9; + bbb := ((bbb shl 5) or (bbb shr (32 - 5))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb and ccc) or ((not bbb) and ddd)) + X[4] + $7A6D76E9; + aaa := ((aaa shl 8) or (aaa shr (32 - 8))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa and bbb) or ((not aaa) and ccc)) + X[1] + $7A6D76E9; + eee := ((eee shl 11) or (eee shr (32 - 11))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee and aaa) or ((not eee) and bbb)) + X[3] + $7A6D76E9; + ddd := ((ddd shl 14) or (ddd shr (32 - 14))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd and eee) or ((not ddd) and aaa)) + X[11] + $7A6D76E9; + ccc := ((ccc shl 14) or (ccc shr (32 - 14))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc and ddd) or ((not ccc) and eee)) + X[15] + $7A6D76E9; + bbb := ((bbb shl 6) or (bbb shr (32 - 6))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb and ccc) or ((not bbb) and ddd)) + X[0] + $7A6D76E9; + aaa := ((aaa shl 14) or (aaa shr (32 - 14))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa and bbb) or ((not aaa) and ccc)) + X[5] + $7A6D76E9; + eee := ((eee shl 6) or (eee shr (32 - 6))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee and aaa) or ((not eee) and bbb)) + X[12] + $7A6D76E9; + ddd := ((ddd shl 9) or (ddd shr (32 - 9))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd and eee) or ((not ddd) and aaa)) + X[2] + $7A6D76E9; + ccc := ((ccc shl 12) or (ccc shr (32 - 12))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + ((ccc and ddd) or ((not ccc) and eee)) + X[13] + $7A6D76E9; + bbb := ((bbb shl 9) or (bbb shr (32 - 9))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + ((bbb and ccc) or ((not bbb) and ddd)) + X[9] + $7A6D76E9; + aaa := ((aaa shl 12) or (aaa shr (32 - 12))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + ((aaa and bbb) or ((not aaa) and ccc)) + X[7] + $7A6D76E9; + eee := ((eee shl 5) or (eee shr (32 - 5))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + ((eee and aaa) or ((not eee) and bbb)) + X[10] + $7A6D76E9; + ddd := ((ddd shl 15) or (ddd shr (32 - 15))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + ((ddd and eee) or ((not ddd) and aaa)) + X[14] + $7A6D76E9; + ccc := ((ccc shl 8) or (ccc shr (32 - 8))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + + bbb := bbb + (ccc xor ddd xor eee) + X[12]; + bbb := ((bbb shl 8) or (bbb shr (32 - 8))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + (bbb xor ccc xor ddd) + X[15]; + aaa := ((aaa shl 5) or (aaa shr (32 - 5))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + (aaa xor bbb xor ccc) + X[10]; + eee := ((eee shl 12) or (eee shr (32 - 12))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + (eee xor aaa xor bbb) + X[4]; + ddd := ((ddd shl 9) or (ddd shr (32 - 9))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + (ddd xor eee xor aaa) + X[1]; + ccc := ((ccc shl 12) or (ccc shr (32 - 12))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + (ccc xor ddd xor eee) + X[5]; + bbb := ((bbb shl 5) or (bbb shr (32 - 5))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + (bbb xor ccc xor ddd) + X[8]; + aaa := ((aaa shl 14) or (aaa shr (32 - 14))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + (aaa xor bbb xor ccc) + X[7]; + eee := ((eee shl 6) or (eee shr (32 - 6))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + (eee xor aaa xor bbb) + X[6]; + ddd := ((ddd shl 8) or (ddd shr (32 - 8))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + (ddd xor eee xor aaa) + X[2]; + ccc := ((ccc shl 13) or (ccc shr (32 - 13))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + (ccc xor ddd xor eee) + X[13]; + bbb := ((bbb shl 6) or (bbb shr (32 - 6))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + aaa := aaa + (bbb xor ccc xor ddd) + X[14]; + aaa := ((aaa shl 5) or (aaa shr (32 - 5))) + eee; + ccc := ((ccc shl 10) or (ccc shr (32 - 10))); + eee := eee + (aaa xor bbb xor ccc) + X[0]; + eee := ((eee shl 15) or (eee shr (32 - 15))) + ddd; + bbb := ((bbb shl 10) or (bbb shr (32 - 10))); + ddd := ddd + (eee xor aaa xor bbb) + X[3]; + ddd := ((ddd shl 13) or (ddd shr (32 - 13))) + ccc; + aaa := ((aaa shl 10) or (aaa shr (32 - 10))); + ccc := ccc + (ddd xor eee xor aaa) + X[9]; + ccc := ((ccc shl 11) or (ccc shr (32 - 11))) + bbb; + eee := ((eee shl 10) or (eee shr (32 - 10))); + bbb := bbb + (ccc xor ddd xor eee) + X[11]; + bbb := ((bbb shl 11) or (bbb shr (32 - 11))) + aaa; + ddd := ((ddd shl 10) or (ddd shr (32 - 10))); + + ddd := ddd + cc + CurrentHash[1]; + CurrentHash[1] := CurrentHash[2] + dd + eee; + CurrentHash[2] := CurrentHash[3] + ee + aaa; + CurrentHash[3] := CurrentHash[4] + aa + bbb; + CurrentHash[4] := CurrentHash[0] + bb + ccc; + CurrentHash[0] := ddd; + FillChar(X, Sizeof(X), 0); + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_ripemd160.GetHashSize: Integer; +begin + Result := 160; +end; + +class function TncEnc_ripemd160.GetAlgorithm: string; +begin + Result := 'RipeMD-160'; +end; + +class function TncEnc_ripemd160.SelfTest: Boolean; +const + Test1Out: array [0 .. 19] of Byte = ($0B, $DC, $9D, $2D, $25, $6B, $3E, $E9, $DA, $AE, $34, $7B, $E6, $F4, $DC, $83, $5A, $46, $7F, $FE); + Test2Out: array [0 .. 19] of Byte = ($F7, $1C, $27, $10, $9C, $69, $2C, $1B, $56, $BB, $DC, $EB, $5B, $9D, $28, $65, $B3, $70, $8D, $BC); +var + TestHash: TncEnc_ripemd160; + TestOut: array [0 .. 19] of Byte; +begin + TestHash := TncEnc_ripemd160.Create(nil); + TestHash.Init; + TestHash.UpdateStr('a'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Init; + TestHash.UpdateStr('abcdefghijklmnopqrstuvwxyz'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out)) and Result; + TestHash.Free; +end; + +procedure TncEnc_ripemd160.Init; +begin + Burn; + CurrentHash[0] := $67452301; + CurrentHash[1] := $EFCDAB89; + CurrentHash[2] := $98BADCFE; + CurrentHash[3] := $10325476; + CurrentHash[4] := $C3D2E1F0; + FInitialized := true; +end; + +procedure TncEnc_ripemd160.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_ripemd160.Update(const Buffer; Size: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenHi, Size shr 29); + Inc(LenLo, Size * 8); + if LenLo < (Size * 8) then + Inc(LenHi); + + PBuf := @Buffer; + while Size > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= Size then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(Size, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], Size); + Inc(Index, Size); + Size := 0; + end; + end; +end; + +procedure TncEnc_ripemd160.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 56 then + Compress; + PUInt32(@HashBuffer[56])^ := LenLo; + PUInt32(@HashBuffer[60])^ := LenHi; + Compress; + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncSerpent.pas b/Source_using_TMonitor/Encryption/ncEncSerpent.pas new file mode 100644 index 0000000..fb8b808 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncSerpent.pas @@ -0,0 +1,927 @@ +{$R-} +{$Q-} +unit ncEncSerpent; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_serpent = class(TncEnc_blockcipher128) + protected + l_key: array [0 .. 131] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +class function TncEnc_serpent.GetAlgorithm: string; +begin + Result := 'Serpent'; +end; + +class function TncEnc_serpent.GetMaxKeySize: Integer; +begin + Result := 256; +end; + +class function TncEnc_serpent.SelfTest: Boolean; +const + Key1: array [0 .. 15] of byte = ($FF, $EE, $DD, $CC, $BB, $AA, $99, $88, $77, $66, $55, $44, $33, $22, $11, $00); + InData1: array [0 .. 15] of byte = ($10, $32, $54, $76, $98, $BA, $DC, $FE, $EF, $CD, $AB, $89, $67, $45, $23, $01); + OutData1: array [0 .. 15] of byte = ($D5, $BA, $A0, $0A, $4B, $B9, $D8, $A7, $C9, $81, $C8, $DC, $90, $D8, $9D, $92); + Key2: array [0 .. 23] of byte = ($88, $99, $AA, $BB, $CC, $DD, $EE, $FF, $FF, $EE, $DD, $CC, $BB, $AA, $99, $88, $77, $66, $55, $44, $33, $22, $11, $00); + InData2: array [0 .. 15] of byte = ($10, $32, $54, $76, $98, $BA, $DC, $FE, $EF, $CD, $AB, $89, $67, $45, $23, $01); + OutData2: array [0 .. 15] of byte = ($DA, $86, $08, $42, $B7, $20, $80, $2B, $F4, $04, $A4, $C7, $10, $34, $87, $9A); + Key3: array [0 .. 31] of byte = ($00, $11, $22, $33, $44, $55, $66, $77, $88, $99, $AA, $BB, $CC, $DD, $EE, $FF, $FF, $EE, $DD, $CC, $BB, $AA, $99, $88, $77, $66, $55, $44, $33, $22, $11, $00); + InData3: array [0 .. 15] of byte = ($10, $32, $54, $76, $98, $BA, $DC, $FE, $EF, $CD, $AB, $89, $67, $45, $23, $01); + OutData3: array [0 .. 15] of byte = ($93, $DF, $9A, $3C, $AF, $E3, $87, $BD, $99, $9E, $EB, $E3, $93, $A1, $7F, $CA); +var + Block: array [0 .. 15] of byte; + Cipher: TncEnc_serpent; +begin + Cipher := TncEnc_serpent.Create(nil); + Cipher.Init(Key1, Sizeof(Key1) * 8, nil); + Cipher.EncryptECB(InData1, Block); + Result := Boolean(CompareMem(@Block, @OutData1, 16)); + Cipher.DecryptECB(Block, Block); + Cipher.Burn; + Result := Result and Boolean(CompareMem(@Block, @InData1, 16)); + Cipher.Init(Key2, Sizeof(Key2) * 8, nil); + Cipher.EncryptECB(InData2, Block); + Result := Result and Boolean(CompareMem(@Block, @OutData2, 16)); + Cipher.DecryptECB(Block, Block); + Cipher.Burn; + Result := Result and Boolean(CompareMem(@Block, @InData2, 16)); + Cipher.Init(Key3, Sizeof(Key3) * 8, nil); + Cipher.EncryptECB(InData3, Block); + Result := Result and Boolean(CompareMem(@Block, @OutData3, 16)); + Cipher.DecryptECB(Block, Block); + Cipher.Burn; + Result := Result and Boolean(CompareMem(@Block, @InData3, 16)); + Cipher.Free; +end; + +procedure TncEnc_serpent.InitKey(const Key; Size: longword); +var + kp: array [0 .. 139] of UInt32; + i, n: Integer; + t, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17: UInt32; + a, b, c, d: UInt32; +begin + FillChar(kp, 256 div 8, 0); + Move(Key, kp, Size div 8); + if Size < 256 then + begin + i := Size div 32; + t := 1 shl (Size mod 32); + kp[i] := (kp[i] and (t - 1)) or t; + end; + for i := 8 to 139 do + begin + t := kp[i - 8] xor kp[i - 5] xor kp[i - 3] xor kp[i - 1] xor $9E3779B9 xor longword(i - 8); + kp[i] := (t shl 11) or (t shr 21); + end; + for i := 0 to 3 do + begin + n := i * 32; + a := kp[n + 4 * 0 + 8]; + b := kp[n + 4 * 0 + 9]; + c := kp[n + 4 * 0 + 10]; + d := kp[n + 4 * 0 + 11]; + t1 := a xor c; + t2 := a or d; + t3 := a and b; + t4 := a and d; + t5 := b or t4; + t6 := t1 and t2; + kp[9 + n] := t5 xor t6; + t8 := b xor d; + t9 := c or t3; + t10 := t6 xor t8; + kp[11 + n] := t9 xor t10; + t12 := c xor t3; + t13 := t2 and kp[11 + n]; + kp[10 + n] := t12 xor t13; + t15 := not kp[10 + n]; + t16 := t2 xor t3; + t17 := kp[9 + n] and t15; + kp[8 + n] := t16 xor t17; + a := kp[n + 4 * 1 + 8]; + b := kp[n + 4 * 1 + 9]; + c := kp[n + 4 * 1 + 10]; + d := kp[n + 4 * 1 + 11]; + t1 := not a; + t2 := b xor d; + t3 := c and t1; + kp[12 + n] := t2 xor t3; + t5 := c xor t1; + t6 := c xor kp[12 + n]; + t7 := b and t6; + kp[15 + n] := t5 xor t7; + t9 := d or t7; + t10 := kp[12 + n] or t5; + t11 := t9 and t10; + kp[14 + n] := a xor t11; + t13 := d or t1; + t14 := t2 xor kp[15 + n]; + t15 := kp[14 + n] xor t13; + kp[13 + n] := t14 xor t15; + a := kp[n + 4 * 2 + 8]; + b := kp[n + 4 * 2 + 9]; + c := kp[n + 4 * 2 + 10]; + d := kp[n + 4 * 2 + 11]; + t1 := a xor d; + t2 := b xor d; + t3 := a and b; + t4 := not c; + t5 := t2 xor t3; + kp[18 + n] := t4 xor t5; + t7 := a xor t2; + t8 := b or t4; + t9 := d or kp[18 + n]; + t10 := t7 and t9; + kp[17 + n] := t8 xor t10; + t12 := c xor d; + t13 := t1 or t2; + t14 := kp[17 + n] xor t12; + kp[19 + n] := t13 xor t14; + t16 := t1 or kp[18 + n]; + t17 := t8 xor t14; + kp[16 + n] := t16 xor t17; + a := kp[n + 4 * 3 + 8]; + b := kp[n + 4 * 3 + 9]; + c := kp[n + 4 * 3 + 10]; + d := kp[n + 4 * 3 + 11]; + t1 := b xor d; + t2 := not t1; + t3 := a or d; + t4 := b xor c; + kp[23 + n] := t3 xor t4; + t6 := a xor b; + t7 := a or t4; + t8 := c and t6; + t9 := t2 or t8; + kp[20 + n] := t7 xor t9; + t11 := a xor kp[23 + n]; + t12 := t1 and t6; + t13 := kp[20 + n] xor t11; + kp[21 + n] := t12 xor t13; + t15 := kp[20 + n] or kp[21 + n]; + t16 := t3 and t15; + kp[22 + n] := b xor t16; + a := kp[n + 4 * 4 + 8]; + b := kp[n + 4 * 4 + 9]; + c := kp[n + 4 * 4 + 10]; + d := kp[n + 4 * 4 + 11]; + t1 := not c; + t2 := b xor c; + t3 := b or t1; + t4 := d xor t3; + t5 := a and t4; + kp[27 + n] := t2 xor t5; + t7 := a xor d; + t8 := b xor t5; + t9 := t2 or t8; + kp[25 + n] := t7 xor t9; + t11 := d and t3; + t12 := t5 xor kp[25 + n]; + t13 := kp[27 + n] and t12; + kp[26 + n] := t11 xor t13; + t15 := t1 or t4; + t16 := t12 xor kp[26 + n]; + kp[24 + n] := t15 xor t16; + a := kp[n + 4 * 5 + 8]; + b := kp[n + 4 * 5 + 9]; + c := kp[n + 4 * 5 + 10]; + d := kp[n + 4 * 5 + 11]; + t1 := a xor c; + t2 := b or d; + t3 := b xor c; + t4 := not t3; + t5 := a and d; + kp[29 + n] := t4 xor t5; + t7 := b or c; + t8 := d xor t1; + t9 := t7 and t8; + kp[31 + n] := t2 xor t9; + t11 := t1 and t7; + t12 := t4 xor t8; + t13 := kp[31 + n] and t11; + kp[28 + n] := t12 xor t13; + t15 := t3 xor t11; + t16 := kp[31 + n] or t15; + kp[30 + n] := t12 xor t16; + a := kp[n + 4 * 6 + 8]; + b := kp[n + 4 * 6 + 9]; + c := kp[n + 4 * 6 + 10]; + d := kp[n + 4 * 6 + 11]; + t1 := not a; + t2 := a xor b; + t3 := a xor d; + t4 := c xor t1; + t5 := t2 or t3; + kp[32 + n] := t4 xor t5; + t7 := not d; + t8 := kp[32 + n] and t7; + kp[33 + n] := t2 xor t8; + t10 := b or kp[33 + n]; + t11 := c or kp[32 + n]; + t12 := t7 xor t10; + kp[35 + n] := t11 xor t12; + t14 := d or kp[33 + n]; + t15 := t1 xor t14; + t16 := kp[32 + n] or kp[35 + n]; + kp[34 + n] := t15 xor t16; + a := kp[n + 4 * 7 + 8]; + b := kp[n + 4 * 7 + 9]; + c := kp[n + 4 * 7 + 10]; + d := kp[n + 4 * 7 + 11]; + t1 := not a; + t2 := a xor d; + t3 := a xor b; + t4 := c xor t1; + t5 := t2 or t3; + kp[36 + n] := t4 xor t5; + t7 := not kp[36 + n]; + t8 := b or t7; + kp[39 + n] := t2 xor t8; + t10 := a and kp[36 + n]; + t11 := b xor kp[39 + n]; + t12 := t8 and t11; + kp[38 + n] := t10 xor t12; + t14 := a or t7; + t15 := t3 xor t14; + t16 := kp[39 + n] and kp[38 + n]; + kp[37 + n] := t15 xor t16; + end; + a := kp[136]; + b := kp[137]; + c := kp[138]; + d := kp[139]; + t1 := a xor c; + t2 := a or d; + t3 := a and b; + t4 := a and d; + t5 := b or t4; + t6 := t1 and t2; + kp[137] := t5 xor t6; + t8 := b xor d; + t9 := c or t3; + t10 := t6 xor t8; + kp[139] := t9 xor t10; + t12 := c xor t3; + t13 := t2 and kp[139]; + kp[138] := t12 xor t13; + t15 := not kp[138]; + t16 := t2 xor t3; + t17 := kp[137] and t15; + kp[136] := t16 xor t17; + Move(kp[8], l_key, Sizeof(l_key)); + FillChar(kp, Sizeof(kp), 0); +end; + +procedure TncEnc_serpent.Burn; +begin + FillChar(l_key, Sizeof(l_key), 0); + inherited Burn; +end; + +procedure TncEnc_serpent.EncryptECB(const InData; var OutData); +var + i: Integer; + a, b, c, d, e, f, g, h: UInt32; + t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + + a := PUInt32(@InData)^; + b := PUInt32(NativeUInt(@InData) + 4)^; + c := PUInt32(NativeUInt(@InData) + 8)^; + d := PUInt32(NativeUInt(@InData) + 12)^; + + i := 0; + while i < 32 do + begin + a := a xor l_key[4 * (i)]; + b := b xor l_key[4 * (i) + 1]; + c := c xor l_key[4 * (i) + 2]; + d := d xor l_key[4 * (i) + 3]; + t1 := b xor d; + t2 := not t1; + t3 := a or d; + t4 := b xor c; + h := t3 xor t4; + t6 := a xor b; + t7 := a or t4; + t8 := c and t6; + t9 := t2 or t8; + e := t7 xor t9; + t11 := a xor h; + t12 := t1 and t6; + t13 := e xor t11; + f := t12 xor t13; + t15 := e or f; + t16 := t3 and t15; + g := b xor t16; + e := (e shl 13) or (e shr 19); + g := (g shl 3) or (g shr 29); + f := f xor e xor g; + h := h xor g xor (e shl 3); + f := (f shl 1) or (f shr 31); + h := (h shl 7) or (h shr 25); + e := e xor f xor h; + g := g xor h xor (f shl 7); + e := (e shl 5) or (e shr 27); + g := (g shl 22) or (g shr 10); + e := e xor l_key[4 * (i + 1)]; + f := f xor l_key[4 * (i + 1) + 1]; + g := g xor l_key[4 * (i + 1) + 2]; + h := h xor l_key[4 * (i + 1) + 3]; + t1 := e xor h; + t2 := f xor h; + t3 := e and f; + t4 := not g; + t5 := t2 xor t3; + c := t4 xor t5; + t7 := e xor t2; + t8 := f or t4; + t9 := h or c; + t10 := t7 and t9; + b := t8 xor t10; + t12 := g xor h; + t13 := t1 or t2; + t14 := b xor t12; + d := t13 xor t14; + t16 := t1 or c; + t17 := t8 xor t14; + a := t16 xor t17; + a := (a shl 13) or (a shr 19); + c := (c shl 3) or (c shr 29); + b := b xor a xor c; + d := d xor c xor (a shl 3); + b := (b shl 1) or (b shr 31); + d := (d shl 7) or (d shr 25); + a := a xor b xor d; + c := c xor d xor (b shl 7); + a := (a shl 5) or (a shr 27); + c := (c shl 22) or (c shr 10); + a := a xor l_key[4 * (i + 2)]; + b := b xor l_key[4 * (i + 2) + 1]; + c := c xor l_key[4 * (i + 2) + 2]; + d := d xor l_key[4 * (i + 2) + 3]; + t1 := not a; + t2 := b xor d; + t3 := c and t1; + e := t2 xor t3; + t5 := c xor t1; + t6 := c xor e; + t7 := b and t6; + h := t5 xor t7; + t9 := d or t7; + t10 := e or t5; + t11 := t9 and t10; + g := a xor t11; + t13 := d or t1; + t14 := t2 xor h; + t15 := g xor t13; + f := t14 xor t15; + e := (e shl 13) or (e shr 19); + g := (g shl 3) or (g shr 29); + f := f xor e xor g; + h := h xor g xor (e shl 3); + f := (f shl 1) or (f shr 31); + h := (h shl 7) or (h shr 25); + e := e xor f xor h; + g := g xor h xor (f shl 7); + e := (e shl 5) or (e shr 27); + g := (g shl 22) or (g shr 10); + e := e xor l_key[4 * (i + 3)]; + f := f xor l_key[4 * (i + 3) + 1]; + g := g xor l_key[4 * (i + 3) + 2]; + h := h xor l_key[4 * (i + 3) + 3]; + t1 := e xor g; + t2 := e or h; + t3 := e and f; + t4 := e and h; + t5 := f or t4; + t6 := t1 and t2; + b := t5 xor t6; + t8 := f xor h; + t9 := g or t3; + t10 := t6 xor t8; + d := t9 xor t10; + t12 := g xor t3; + t13 := t2 and d; + c := t12 xor t13; + t15 := not c; + t16 := t2 xor t3; + t17 := b and t15; + a := t16 xor t17; + a := (a shl 13) or (a shr 19); + c := (c shl 3) or (c shr 29); + b := b xor a xor c; + d := d xor c xor (a shl 3); + b := (b shl 1) or (b shr 31); + d := (d shl 7) or (d shr 25); + a := a xor b xor d; + c := c xor d xor (b shl 7); + a := (a shl 5) or (a shr 27); + c := (c shl 22) or (c shr 10); + a := a xor l_key[4 * (i + 4)]; + b := b xor l_key[4 * (i + 4) + 1]; + c := c xor l_key[4 * (i + 4) + 2]; + d := d xor l_key[4 * (i + 4) + 3]; + t1 := not a; + t2 := a xor d; + t3 := a xor b; + t4 := c xor t1; + t5 := t2 or t3; + e := t4 xor t5; + t7 := not e; + t8 := b or t7; + h := t2 xor t8; + t10 := a and e; + t11 := b xor h; + t12 := t8 and t11; + g := t10 xor t12; + t14 := a or t7; + t15 := t3 xor t14; + t16 := h and g; + f := t15 xor t16; + e := (e shl 13) or (e shr 19); + g := (g shl 3) or (g shr 29); + f := f xor e xor g; + h := h xor g xor (e shl 3); + f := (f shl 1) or (f shr 31); + h := (h shl 7) or (h shr 25); + e := e xor f xor h; + g := g xor h xor (f shl 7); + e := (e shl 5) or (e shr 27); + g := (g shl 22) or (g shr 10); + e := e xor l_key[4 * (i + 5)]; + f := f xor l_key[4 * (i + 5) + 1]; + g := g xor l_key[4 * (i + 5) + 2]; + h := h xor l_key[4 * (i + 5) + 3]; + t1 := not e; + t2 := e xor f; + t3 := e xor h; + t4 := g xor t1; + t5 := t2 or t3; + a := t4 xor t5; + t7 := not h; + t8 := a and t7; + b := t2 xor t8; + t10 := f or b; + t11 := g or a; + t12 := t7 xor t10; + d := t11 xor t12; + t14 := h or b; + t15 := t1 xor t14; + t16 := a or d; + c := t15 xor t16; + a := (a shl 13) or (a shr 19); + c := (c shl 3) or (c shr 29); + b := b xor a xor c; + d := d xor c xor (a shl 3); + b := (b shl 1) or (b shr 31); + d := (d shl 7) or (d shr 25); + a := a xor b xor d; + c := c xor d xor (b shl 7); + a := (a shl 5) or (a shr 27); + c := (c shl 22) or (c shr 10); + a := a xor l_key[4 * (i + 6)]; + b := b xor l_key[4 * (i + 6) + 1]; + c := c xor l_key[4 * (i + 6) + 2]; + d := d xor l_key[4 * (i + 6) + 3]; + t1 := a xor c; + t2 := b or d; + t3 := b xor c; + t4 := not t3; + t5 := a and d; + f := t4 xor t5; + t7 := b or c; + t8 := d xor t1; + t9 := t7 and t8; + h := t2 xor t9; + t11 := t1 and t7; + t12 := t4 xor t8; + t13 := h and t11; + e := t12 xor t13; + t15 := t3 xor t11; + t16 := h or t15; + g := t12 xor t16; + e := (e shl 13) or (e shr 19); + g := (g shl 3) or (g shr 29); + f := f xor e xor g; + h := h xor g xor (e shl 3); + f := (f shl 1) or (f shr 31); + h := (h shl 7) or (h shr 25); + e := e xor f xor h; + g := g xor h xor (f shl 7); + e := (e shl 5) or (e shr 27); + g := (g shl 22) or (g shr 10); + e := e xor l_key[4 * (i + 7)]; + f := f xor l_key[4 * (i + 7) + 1]; + g := g xor l_key[4 * (i + 7) + 2]; + h := h xor l_key[4 * (i + 7) + 3]; + t1 := not g; + t2 := f xor g; + t3 := f or t1; + t4 := h xor t3; + t5 := e and t4; + d := t2 xor t5; + t7 := e xor h; + t8 := f xor t5; + t9 := t2 or t8; + b := t7 xor t9; + t11 := h and t3; + t12 := t5 xor b; + t13 := d and t12; + c := t11 xor t13; + t15 := t1 or t4; + t16 := t12 xor c; + a := t15 xor t16; + + Inc(i, 8); + if i < 32 then + begin + a := (a shl 13) or (a shr 19); + c := (c shl 3) or (c shr 29); + b := b xor a xor c; + d := d xor c xor (a shl 3); + b := (b shl 1) or (b shr 31); + d := (d shl 7) or (d shr 25); + a := a xor b xor d; + c := c xor d xor (b shl 7); + a := (a shl 5) or (a shr 27); + c := (c shl 22) or (c shr 10); + end; + end; + a := a xor l_key[128]; + b := b xor l_key[128 + 1]; + c := c xor l_key[128 + 2]; + d := d xor l_key[128 + 3]; + + PUInt32(NativeUInt(@OutData) + 0)^ := a; + PUInt32(NativeUInt(@OutData) + 4)^ := b; + PUInt32(NativeUInt(@OutData) + 8)^ := c; + PUInt32(NativeUInt(@OutData) + 12)^ := d; +end; + +procedure TncEnc_serpent.DecryptECB(const InData; var OutData); +var + i: Integer; + a, b, c, d, e, f, g, h: UInt32; + t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + + a := PUInt32(@InData)^; + b := PUInt32(NativeUInt(@InData) + 4)^; + c := PUInt32(NativeUInt(@InData) + 8)^; + d := PUInt32(NativeUInt(@InData) + 12)^; + + i := 32; + a := a xor l_key[4 * 32]; + b := b xor l_key[4 * 32 + 1]; + c := c xor l_key[4 * 32 + 2]; + d := d xor l_key[4 * 32 + 3]; + while i > 0 do + begin + if i < 32 then + begin + c := (c shr 22) or (c shl 10); + a := (a shr 5) or (a shl 27); + c := c xor d xor (b shl 7); + a := a xor b xor d; + d := (d shr 7) or (d shl 25); + b := (b shr 1) or (b shl 31); + d := d xor c xor (a shl 3); + b := b xor a xor c; + c := (c shr 3) or (c shl 29); + a := (a shr 13) or (a shl 19); + end; + + t1 := a and b; + t2 := a or b; + t3 := c or t1; + t4 := d and t2; + h := t3 xor t4; + t6 := not d; + t7 := b xor t4; + t8 := h xor t6; + t9 := t7 or t8; + f := a xor t9; + t11 := c xor t7; + t12 := d or f; + e := t11 xor t12; + t14 := a and h; + t15 := t3 xor f; + t16 := e xor t14; + g := t15 xor t16; + e := e xor l_key[4 * (i - 1)]; + f := f xor l_key[4 * (i - 1) + 1]; + g := g xor l_key[4 * (i - 1) + 2]; + h := h xor l_key[4 * (i - 1) + 3]; + g := (g shr 22) or (g shl 10); + e := (e shr 5) or (e shl 27); + g := g xor h xor (f shl 7); + e := e xor f xor h; + h := (h shr 7) or (h shl 25); + f := (f shr 1) or (f shl 31); + h := h xor g xor (e shl 3); + f := f xor e xor g; + g := (g shr 3) or (g shl 29); + e := (e shr 13) or (e shl 19); + t1 := not g; + t2 := e xor g; + t3 := f xor h; + t4 := e or t1; + b := t3 xor t4; + t6 := e or f; + t7 := f and t2; + t8 := b xor t6; + t9 := t7 or t8; + a := g xor t9; + t11 := not b; + t12 := h or t2; + t13 := t9 xor t11; + d := t12 xor t13; + t15 := f xor t11; + t16 := a and d; + c := t15 xor t16; + a := a xor l_key[4 * (i - 2)]; + b := b xor l_key[4 * (i - 2) + 1]; + c := c xor l_key[4 * (i - 2) + 2]; + d := d xor l_key[4 * (i - 2) + 3]; + c := (c shr 22) or (c shl 10); + a := (a shr 5) or (a shl 27); + c := c xor d xor (b shl 7); + a := a xor b xor d; + d := (d shr 7) or (d shl 25); + b := (b shr 1) or (b shl 31); + d := d xor c xor (a shl 3); + b := b xor a xor c; + c := (c shr 3) or (c shl 29); + a := (a shr 13) or (a shl 19); + t1 := not c; + t2 := b and t1; + t3 := d xor t2; + t4 := a and t3; + t5 := b xor t1; + h := t4 xor t5; + t7 := b or h; + t8 := a and t7; + f := t3 xor t8; + t10 := a or d; + t11 := t1 xor t7; + e := t10 xor t11; + t13 := a xor c; + t14 := b and t10; + t15 := t4 or t13; + g := t14 xor t15; + e := e xor l_key[4 * (i - 3)]; + f := f xor l_key[4 * (i - 3) + 1]; + g := g xor l_key[4 * (i - 3) + 2]; + h := h xor l_key[4 * (i - 3) + 3]; + g := (g shr 22) or (g shl 10); + e := (e shr 5) or (e shl 27); + g := g xor h xor (f shl 7); + e := e xor f xor h; + h := (h shr 7) or (h shl 25); + f := (f shr 1) or (f shl 31); + h := h xor g xor (e shl 3); + f := f xor e xor g; + g := (g shr 3) or (g shl 29); + e := (e shr 13) or (e shl 19); + t1 := g xor h; + t2 := g or h; + t3 := f xor t2; + t4 := e and t3; + b := t1 xor t4; + t6 := e xor h; + t7 := f or h; + t8 := t6 and t7; + d := t3 xor t8; + t10 := not e; + t11 := g xor d; + t12 := t10 or t11; + a := t3 xor t12; + t14 := g or t4; + t15 := t7 xor t14; + t16 := d or t10; + c := t15 xor t16; + a := a xor l_key[4 * (i - 4)]; + b := b xor l_key[4 * (i - 4) + 1]; + c := c xor l_key[4 * (i - 4) + 2]; + d := d xor l_key[4 * (i - 4) + 3]; + c := (c shr 22) or (c shl 10); + a := (a shr 5) or (a shl 27); + c := c xor d xor (b shl 7); + a := a xor b xor d; + d := (d shr 7) or (d shl 25); + b := (b shr 1) or (b shl 31); + d := d xor c xor (a shl 3); + b := b xor a xor c; + c := (c shr 3) or (c shl 29); + a := (a shr 13) or (a shl 19); + t1 := b xor c; + t2 := b or c; + t3 := a xor c; + t4 := t2 xor t3; + t5 := d or t4; + e := t1 xor t5; + t7 := a xor d; + t8 := t1 or t5; + t9 := t2 xor t7; + g := t8 xor t9; + t11 := a and t4; + t12 := e or t9; + f := t11 xor t12; + t14 := a and g; + t15 := t2 xor t14; + t16 := e and t15; + h := t4 xor t16; + e := e xor l_key[4 * (i - 5)]; + f := f xor l_key[4 * (i - 5) + 1]; + g := g xor l_key[4 * (i - 5) + 2]; + h := h xor l_key[4 * (i - 5) + 3]; + g := (g shr 22) or (g shl 10); + e := (e shr 5) or (e shl 27); + g := g xor h xor (f shl 7); + e := e xor f xor h; + h := (h shr 7) or (h shl 25); + f := (f shr 1) or (f shl 31); + h := h xor g xor (e shl 3); + f := f xor e xor g; + g := (g shr 3) or (g shl 29); + e := (e shr 13) or (e shl 19); + t1 := f xor h; + t2 := not t1; + t3 := e xor g; + t4 := g xor t1; + t5 := f and t4; + a := t3 xor t5; + t7 := e or t2; + t8 := h xor t7; + t9 := t3 or t8; + d := t1 xor t9; + t11 := not t4; + t12 := a or d; + b := t11 xor t12; + t14 := h and t11; + t15 := t3 xor t12; + c := t14 xor t15; + a := a xor l_key[4 * (i - 6)]; + b := b xor l_key[4 * (i - 6) + 1]; + c := c xor l_key[4 * (i - 6) + 2]; + d := d xor l_key[4 * (i - 6) + 3]; + c := (c shr 22) or (c shl 10); + a := (a shr 5) or (a shl 27); + c := c xor d xor (b shl 7); + a := a xor b xor d; + d := (d shr 7) or (d shl 25); + b := (b shr 1) or (b shl 31); + d := d xor c xor (a shl 3); + b := b xor a xor c; + c := (c shr 3) or (c shl 29); + a := (a shr 13) or (a shl 19); + t1 := a xor d; + t2 := a and b; + t3 := b xor c; + t4 := a xor t3; + t5 := b or d; + h := t4 xor t5; + t7 := c or t1; + t8 := b xor t7; + t9 := t4 and t8; + f := t1 xor t9; + t11 := not t2; + t12 := h and f; + t13 := t9 xor t11; + g := t12 xor t13; + t15 := a and d; + t16 := c xor t13; + e := t15 xor t16; + e := e xor l_key[4 * (i - 7)]; + f := f xor l_key[4 * (i - 7) + 1]; + g := g xor l_key[4 * (i - 7) + 2]; + h := h xor l_key[4 * (i - 7) + 3]; + g := (g shr 22) or (g shl 10); + e := (e shr 5) or (e shl 27); + g := g xor h xor (f shl 7); + e := e xor f xor h; + h := (h shr 7) or (h shl 25); + f := (f shr 1) or (f shl 31); + h := h xor g xor (e shl 3); + f := f xor e xor g; + g := (g shr 3) or (g shl 29); + e := (e shr 13) or (e shl 19); + t1 := e xor h; + t2 := g xor h; + t3 := not t2; + t4 := e or f; + c := t3 xor t4; + t6 := f xor t1; + t7 := g or t6; + t8 := e xor t7; + t9 := t2 and t8; + b := t6 xor t9; + t11 := not t8; + t12 := f and h; + t13 := b or t12; + d := t11 xor t13; + t15 := t2 xor t12; + t16 := b or d; + a := t15 xor t16; + a := a xor l_key[4 * (i - 8)]; + b := b xor l_key[4 * (i - 8) + 1]; + c := c xor l_key[4 * (i - 8) + 2]; + d := d xor l_key[4 * (i - 8) + 3]; + Dec(i, 8); + end; + + PUInt32(NativeUInt(@OutData) + 0)^ := a; + PUInt32(NativeUInt(@OutData) + 4)^ := b; + PUInt32(NativeUInt(@OutData) + 8)^ := c; + PUInt32(NativeUInt(@OutData) + 12)^ := d; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncSha1.pas b/Source_using_TMonitor/Encryption/ncEncSha1.pas new file mode 100644 index 0000000..02a92d8 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncSha1.pas @@ -0,0 +1,394 @@ +{$R-} +{$Q-} +unit ncEncSha1; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_sha1 = class(TncEncHash) + protected + LenHi, LenLo: UInt32; + Index: UInt32; + CurrentHash: array [0 .. 4] of UInt32; + HashBuffer: array [0 .. 63] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const aBuffer; aSize: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +function SwapUInt32(const a: UInt32): UInt32; inline; +begin + Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); +end; + +procedure TncEnc_sha1.Compress; +var + a, B, C, D, E: UInt32; + W: array [0 .. 79] of UInt32; + i: longword; +begin + Index := 0; + Move(HashBuffer, W, Sizeof(HashBuffer)); + for i := 0 to 15 do + W[i] := SwapUInt32(W[i]); + for i := 16 to 79 do + W[i] := ((W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16]) shl 1) or ((W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16]) shr 31); + a := CurrentHash[0]; + B := CurrentHash[1]; + C := CurrentHash[2]; + D := CurrentHash[3]; + E := CurrentHash[4]; + + Inc(E, ((a shl 5) or (a shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[0]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (C xor (a and (B xor C))) + $5A827999 + W[1]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (B xor (E and (a xor B))) + $5A827999 + W[2]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (a xor (D and (E xor a))) + $5A827999 + W[3]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[4]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[5]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (C xor (a and (B xor C))) + $5A827999 + W[6]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (B xor (E and (a xor B))) + $5A827999 + W[7]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (a xor (D and (E xor a))) + $5A827999 + W[8]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[9]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[10]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (C xor (a and (B xor C))) + $5A827999 + W[11]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (B xor (E and (a xor B))) + $5A827999 + W[12]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (a xor (D and (E xor a))) + $5A827999 + W[13]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[14]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[15]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (C xor (a and (B xor C))) + $5A827999 + W[16]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (B xor (E and (a xor B))) + $5A827999 + W[17]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (a xor (D and (E xor a))) + $5A827999 + W[18]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[19]); + C := (C shl 30) or (C shr 2); + + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[20]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $6ED9EBA1 + W[21]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $6ED9EBA1 + W[22]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $6ED9EBA1 + W[23]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[24]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[25]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $6ED9EBA1 + W[26]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $6ED9EBA1 + W[27]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $6ED9EBA1 + W[28]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[29]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[30]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $6ED9EBA1 + W[31]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $6ED9EBA1 + W[32]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $6ED9EBA1 + W[33]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[34]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[35]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $6ED9EBA1 + W[36]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $6ED9EBA1 + W[37]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $6ED9EBA1 + W[38]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[39]); + C := (C shl 30) or (C shr 2); + + Inc(E, ((a shl 5) or (a shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[40]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + ((a and B) or (C and (a or B))) + $8F1BBCDC + W[41]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + ((E and a) or (B and (E or a))) + $8F1BBCDC + W[42]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + ((D and E) or (a and (D or E))) + $8F1BBCDC + W[43]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[44]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[45]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + ((a and B) or (C and (a or B))) + $8F1BBCDC + W[46]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + ((E and a) or (B and (E or a))) + $8F1BBCDC + W[47]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + ((D and E) or (a and (D or E))) + $8F1BBCDC + W[48]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[49]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[50]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + ((a and B) or (C and (a or B))) + $8F1BBCDC + W[51]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + ((E and a) or (B and (E or a))) + $8F1BBCDC + W[52]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + ((D and E) or (a and (D or E))) + $8F1BBCDC + W[53]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[54]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[55]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + ((a and B) or (C and (a or B))) + $8F1BBCDC + W[56]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + ((E and a) or (B and (E or a))) + $8F1BBCDC + W[57]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + ((D and E) or (a and (D or E))) + $8F1BBCDC + W[58]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[59]); + C := (C shl 30) or (C shr 2); + + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $CA62C1D6 + W[60]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $CA62C1D6 + W[61]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $CA62C1D6 + W[62]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $CA62C1D6 + W[63]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[64]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $CA62C1D6 + W[65]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $CA62C1D6 + W[66]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $CA62C1D6 + W[67]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $CA62C1D6 + W[68]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[69]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $CA62C1D6 + W[70]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $CA62C1D6 + W[71]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $CA62C1D6 + W[72]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $CA62C1D6 + W[73]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[74]); + C := (C shl 30) or (C shr 2); + Inc(E, ((a shl 5) or (a shr 27)) + (B xor C xor D) + $CA62C1D6 + W[75]); + B := (B shl 30) or (B shr 2); + Inc(D, ((E shl 5) or (E shr 27)) + (a xor B xor C) + $CA62C1D6 + W[76]); + a := (a shl 30) or (a shr 2); + Inc(C, ((D shl 5) or (D shr 27)) + (E xor a xor B) + $CA62C1D6 + W[77]); + E := (E shl 30) or (E shr 2); + Inc(B, ((C shl 5) or (C shr 27)) + (D xor E xor a) + $CA62C1D6 + W[78]); + D := (D shl 30) or (D shr 2); + Inc(a, ((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[79]); + C := (C shl 30) or (C shr 2); + + CurrentHash[0] := CurrentHash[0] + a; + CurrentHash[1] := CurrentHash[1] + B; + CurrentHash[2] := CurrentHash[2] + C; + CurrentHash[3] := CurrentHash[3] + D; + CurrentHash[4] := CurrentHash[4] + E; + FillChar(W, Sizeof(W), 0); + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_sha1.GetAlgorithm: string; +begin + Result := 'SHA1'; +end; + +class function TncEnc_sha1.GetHashSize: Integer; +begin + Result := 160; +end; + +class function TncEnc_sha1.SelfTest: Boolean; +const + Test1Out: array [0 .. 19] of Byte = ($A9, $99, $3E, $36, $47, $06, $81, $6A, $BA, $3E, $25, $71, $78, $50, $C2, $6C, $9C, $D0, $D8, $9D); + Test2Out: array [0 .. 19] of Byte = ($84, $98, $3E, $44, $1C, $3B, $D2, $6E, $BA, $AE, $4A, $A1, $F9, $51, $29, $E5, $E5, $46, $70, $F1); +var + TestHash: TncEnc_sha1; + TestOut: array [0 .. 19] of Byte; +begin + TestHash := TncEnc_sha1.Create(nil); + TestHash.Init; + TestHash.UpdateStr('abc'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out))); + TestHash.Init; + TestHash.UpdateStr('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out))) and Result; + TestHash.Free; +end; + +procedure TncEnc_sha1.Init; +begin + Burn; + CurrentHash[0] := $67452301; + CurrentHash[1] := $EFCDAB89; + CurrentHash[2] := $98BADCFE; + CurrentHash[3] := $10325476; + CurrentHash[4] := $C3D2E1F0; + FInitialized := true; +end; + +procedure TncEnc_sha1.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_sha1.Update(const aBuffer; aSize: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenHi, aSize shr 29); + Inc(LenLo, aSize * 8); + if LenLo < (aSize * 8) then + Inc(LenHi); + + PBuf := @aBuffer; + while aSize > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= aSize then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(aSize, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], aSize); + Inc(Index, aSize); + aSize := 0; + end; + end; +end; + +procedure TncEnc_sha1.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 56 then + Compress; + PUInt32(@HashBuffer[56])^ := SwapUInt32(LenHi); + PUInt32(@HashBuffer[60])^ := SwapUInt32(LenLo); + Compress; + CurrentHash[0] := SwapUInt32(CurrentHash[0]); + CurrentHash[1] := SwapUInt32(CurrentHash[1]); + CurrentHash[2] := SwapUInt32(CurrentHash[2]); + CurrentHash[3] := SwapUInt32(CurrentHash[3]); + CurrentHash[4] := SwapUInt32(CurrentHash[4]); + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncSha256.pas b/Source_using_TMonitor/Encryption/ncEncSha256.pas new file mode 100644 index 0000000..956c757 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncSha256.pas @@ -0,0 +1,510 @@ +{$R-} +{$Q-} +unit ncEncSha256; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_sha256 = class(TncEncHash) + protected + LenHi, LenLo: UInt32; + Index: UInt32; + CurrentHash: array [0 .. 7] of UInt32; + HashBuffer: array [0 .. 63] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const aBuffer; aSize: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +function SwapUInt32(const a: UInt32): UInt32; inline; +begin + Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); +end; + +procedure TncEnc_sha256.Compress; +var + a, b, c, d, e, f, g, h, t1, t2: UInt32; + W: array [0 .. 63] of UInt32; + i: Integer; +begin + Index := 0; + a := CurrentHash[0]; + b := CurrentHash[1]; + c := CurrentHash[2]; + d := CurrentHash[3]; + e := CurrentHash[4]; + f := CurrentHash[5]; + g := CurrentHash[6]; + h := CurrentHash[7]; + Move(HashBuffer, W, Sizeof(HashBuffer)); + for i := 0 to 15 do + W[i] := SwapUInt32(W[i]); + for i := 16 to 63 do + W[i] := (((W[i - 2] shr 17) or (W[i - 2] shl 15)) xor ((W[i - 2] shr 19) or (W[i - 2] shl 13)) xor (W[i - 2] shr 10)) + W[i - 7] + (((W[i - 15] shr 7) or (W[i - 15] shl 25)) xor ((W[i - 15] shr 18) or (W[i - 15] shl 14)) xor (W[i - 15] shr 3)) + W[i - 16]; + { + Non-optimised version + for i:= 0 to 63 do + begin + t1:= h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + + ((e and f) xor (not e and g)) + K[i] + W[i]; + t2:= (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + + ((a and b) xor (a and c) xor (b and c)); + h:= g; g:= f; f:= e; e:= d + t1; d:= c; c:= b; b:= a; a:= t1 + t2; + end; + } + + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $428A2F98 + W[0]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $71374491 + W[1]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $B5C0FBCF + W[2]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $E9B5DBA5 + W[3]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $3956C25B + W[4]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $59F111F1 + W[5]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $923F82A4 + W[6]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $AB1C5ED5 + W[7]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $D807AA98 + W[8]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $12835B01 + W[9]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $243185BE + W[10]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $550C7DC3 + W[11]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $72BE5D74 + W[12]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $80DEB1FE + W[13]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $9BDC06A7 + W[14]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $C19BF174 + W[15]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $E49B69C1 + W[16]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $EFBE4786 + W[17]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $0FC19DC6 + W[18]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $240CA1CC + W[19]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $2DE92C6F + W[20]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $4A7484AA + W[21]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $5CB0A9DC + W[22]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $76F988DA + W[23]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $983E5152 + W[24]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $A831C66D + W[25]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $B00327C8 + W[26]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $BF597FC7 + W[27]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $C6E00BF3 + W[28]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $D5A79147 + W[29]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $06CA6351 + W[30]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $14292967 + W[31]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $27B70A85 + W[32]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $2E1B2138 + W[33]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $4D2C6DFC + W[34]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $53380D13 + W[35]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $650A7354 + W[36]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $766A0ABB + W[37]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $81C2C92E + W[38]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $92722C85 + W[39]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $A2BFE8A1 + W[40]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $A81A664B + W[41]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $C24B8B70 + W[42]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $C76C51A3 + W[43]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $D192E819 + W[44]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $D6990624 + W[45]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $F40E3585 + W[46]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $106AA070 + W[47]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $19A4C116 + W[48]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $1E376C08 + W[49]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $2748774C + W[50]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $34B0BCB5 + W[51]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $391C0CB3 + W[52]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $4ED8AA4A + W[53]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $5B9CCA4F + W[54]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $682E6FF3 + W[55]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + t1 := h + (((e shr 6) or (e shl 26)) xor ((e shr 11) or (e shl 21)) xor ((e shr 25) or (e shl 7))) + ((e and f) xor (not e and g)) + $748F82EE + W[56]; + t2 := (((a shr 2) or (a shl 30)) xor ((a shr 13) or (a shl 19)) xor ((a shr 22) xor (a shl 10))) + ((a and b) xor (a and c) xor (b and c)); + h := t1 + t2; + d := d + t1; + t1 := g + (((d shr 6) or (d shl 26)) xor ((d shr 11) or (d shl 21)) xor ((d shr 25) or (d shl 7))) + ((d and e) xor (not d and f)) + $78A5636F + W[57]; + t2 := (((h shr 2) or (h shl 30)) xor ((h shr 13) or (h shl 19)) xor ((h shr 22) xor (h shl 10))) + ((h and a) xor (h and b) xor (a and b)); + g := t1 + t2; + c := c + t1; + t1 := f + (((c shr 6) or (c shl 26)) xor ((c shr 11) or (c shl 21)) xor ((c shr 25) or (c shl 7))) + ((c and d) xor (not c and e)) + $84C87814 + W[58]; + t2 := (((g shr 2) or (g shl 30)) xor ((g shr 13) or (g shl 19)) xor ((g shr 22) xor (g shl 10))) + ((g and h) xor (g and a) xor (h and a)); + f := t1 + t2; + b := b + t1; + t1 := e + (((b shr 6) or (b shl 26)) xor ((b shr 11) or (b shl 21)) xor ((b shr 25) or (b shl 7))) + ((b and c) xor (not b and d)) + $8CC70208 + W[59]; + t2 := (((f shr 2) or (f shl 30)) xor ((f shr 13) or (f shl 19)) xor ((f shr 22) xor (f shl 10))) + ((f and g) xor (f and h) xor (g and h)); + e := t1 + t2; + a := a + t1; + t1 := d + (((a shr 6) or (a shl 26)) xor ((a shr 11) or (a shl 21)) xor ((a shr 25) or (a shl 7))) + ((a and b) xor (not a and c)) + $90BEFFFA + W[60]; + t2 := (((e shr 2) or (e shl 30)) xor ((e shr 13) or (e shl 19)) xor ((e shr 22) xor (e shl 10))) + ((e and f) xor (e and g) xor (f and g)); + d := t1 + t2; + h := h + t1; + t1 := c + (((h shr 6) or (h shl 26)) xor ((h shr 11) or (h shl 21)) xor ((h shr 25) or (h shl 7))) + ((h and a) xor (not h and b)) + $A4506CEB + W[61]; + t2 := (((d shr 2) or (d shl 30)) xor ((d shr 13) or (d shl 19)) xor ((d shr 22) xor (d shl 10))) + ((d and e) xor (d and f) xor (e and f)); + c := t1 + t2; + g := g + t1; + t1 := b + (((g shr 6) or (g shl 26)) xor ((g shr 11) or (g shl 21)) xor ((g shr 25) or (g shl 7))) + ((g and h) xor (not g and a)) + $BEF9A3F7 + W[62]; + t2 := (((c shr 2) or (c shl 30)) xor ((c shr 13) or (c shl 19)) xor ((c shr 22) xor (c shl 10))) + ((c and d) xor (c and e) xor (d and e)); + b := t1 + t2; + f := f + t1; + t1 := a + (((f shr 6) or (f shl 26)) xor ((f shr 11) or (f shl 21)) xor ((f shr 25) or (f shl 7))) + ((f and g) xor (not f and h)) + $C67178F2 + W[63]; + t2 := (((b shr 2) or (b shl 30)) xor ((b shr 13) or (b shl 19)) xor ((b shr 22) xor (b shl 10))) + ((b and c) xor (b and d) xor (c and d)); + a := t1 + t2; + e := e + t1; + + CurrentHash[0] := CurrentHash[0] + a; + CurrentHash[1] := CurrentHash[1] + b; + CurrentHash[2] := CurrentHash[2] + c; + CurrentHash[3] := CurrentHash[3] + d; + CurrentHash[4] := CurrentHash[4] + e; + CurrentHash[5] := CurrentHash[5] + f; + CurrentHash[6] := CurrentHash[6] + g; + CurrentHash[7] := CurrentHash[7] + h; + FillChar(W, Sizeof(W), 0); + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_sha256.GetAlgorithm: string; +begin + Result := 'SHA256'; +end; + +class function TncEnc_sha256.GetHashSize: Integer; +begin + Result := 256; +end; + +class function TncEnc_sha256.SelfTest: Boolean; +const + Test1Out: array [0 .. 31] of Byte = ($BA, $78, $16, $BF, $8F, $01, $CF, $EA, $41, $41, $40, $DE, $5D, $AE, $22, $23, $B0, $03, $61, $A3, $96, $17, $7A, $9C, $B4, $10, $FF, $61, $F2, $00, $15, $AD); + Test2Out: array [0 .. 31] of Byte = ($24, $8D, $6A, $61, $D2, $06, $38, $B8, $E5, $C0, $26, $93, $0C, $3E, $60, $39, $A3, $3C, $E4, $59, $64, $FF, $21, $67, $F6, $EC, $ED, $D4, $19, $DB, $06, $C1); +var + TestHash: TncEnc_sha256; + TestOut: array [0 .. 31] of Byte; +begin + TestHash := TncEnc_sha256.Create(nil); + TestHash.Init; + TestHash.UpdateStr('abc'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out))); + TestHash.Init; + TestHash.UpdateStr('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out))) and Result; + TestHash.Free; +end; + +procedure TncEnc_sha256.Init; +begin + Burn; + CurrentHash[0] := $6A09E667; + CurrentHash[1] := $BB67AE85; + CurrentHash[2] := $3C6EF372; + CurrentHash[3] := $A54FF53A; + CurrentHash[4] := $510E527F; + CurrentHash[5] := $9B05688C; + CurrentHash[6] := $1F83D9AB; + CurrentHash[7] := $5BE0CD19; + FInitialized := True; +end; + +procedure TncEnc_sha256.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := False; +end; + +procedure TncEnc_sha256.Update(const aBuffer; aSize: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenHi, aSize shr 29); + Inc(LenLo, aSize * 8); + if LenLo < (aSize * 8) then + Inc(LenHi); + + PBuf := @aBuffer; + while aSize > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= aSize then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(aSize, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], aSize); + Inc(Index, aSize); + aSize := 0; + end; + end; +end; + +procedure TncEnc_sha256.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 56 then + Compress; + PUInt32(@HashBuffer[56])^ := SwapUInt32(LenHi); + PUInt32(@HashBuffer[60])^ := SwapUInt32(LenLo); + Compress; + CurrentHash[0] := SwapUInt32(CurrentHash[0]); + CurrentHash[1] := SwapUInt32(CurrentHash[1]); + CurrentHash[2] := SwapUInt32(CurrentHash[2]); + CurrentHash[3] := SwapUInt32(CurrentHash[3]); + CurrentHash[4] := SwapUInt32(CurrentHash[4]); + CurrentHash[5] := SwapUInt32(CurrentHash[5]); + CurrentHash[6] := SwapUInt32(CurrentHash[6]); + CurrentHash[7] := SwapUInt32(CurrentHash[7]); + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncSha512.pas b/Source_using_TMonitor/Encryption/ncEncSha512.pas new file mode 100644 index 0000000..2579007 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncSha512.pas @@ -0,0 +1,657 @@ +{$R-} +{$Q-} +{$WARN BOUNDS_ERROR OFF} +unit ncEncSha512; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_sha512base = class(TncEncHash) + protected + LenHi, LenLo: UInt64; + Index: UInt64; + CurrentHash: array [0 .. 7] of UInt64; + HashBuffer: array [0 .. 127] of byte; + procedure Compress; + public + procedure Update(const aBuffer; aSize: NativeUInt); override; + procedure Burn; override; + end; + + TncEnc_sha384 = class(TncEnc_sha512base) + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Final(var Digest); override; + end; + + TncEnc_sha512 = class(TncEnc_sha512base) + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Final(var Digest); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +function SwapUInt64(const a: UInt64): UInt64; inline; +begin + Result := ((a and $FF) shl 56) or ((a and $FF00) shl 40) or ((a and $FF0000) shl 24) or ((a and $FF000000) shl 8) or ((a and $FF00000000) shr 8) or ((a and $FF0000000000) shr 24) or ((a and $FF000000000000) shr 40) or ((a and $FF00000000000000) shr 56); +end; + +procedure TncEnc_sha512base.Compress; +var + a, b, c, d, e, f, g, h, t1, t2: UInt64; + W: array [0 .. 79] of UInt64; + i: Integer; +begin + Index := 0; + a := CurrentHash[0]; + b := CurrentHash[1]; + c := CurrentHash[2]; + d := CurrentHash[3]; + e := CurrentHash[4]; + f := CurrentHash[5]; + g := CurrentHash[6]; + h := CurrentHash[7]; + Move(HashBuffer, W, Sizeof(HashBuffer)); + for i := 0 to 15 do + W[i] := SwapUInt64(W[i]); + for i := 16 to 79 do + W[i] := (((W[i - 2] shr 19) or (W[i - 2] shl 45)) xor ((W[i - 2] shr 61) or (W[i - 2] shl 3)) xor (W[i - 2] shr 6)) + W[i - 7] + (((W[i - 15] shr 1) or (W[i - 15] shl 63)) xor ((W[i - 15] shr 8) or (W[i - 15] shl 56)) xor (W[i - 15] shr 7)) + W[i - 16]; + + { + Non-optimised version + for i:= 0 to 79 do + begin + t1:= h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + + ((e and f) xor (not e and g)) + K[i] + W[i]; + t2:= (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + + ((a and b) xor (a and c) xor (b and c)); + h:= g; g:= f; f:= e; e:= d + t1; d:= c; c:= b; b:= a; a:= t1 + t2; + end; + } + + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($428A2F98D728AE22) + W[0]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($7137449123EF65CD) + W[1]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($B5C0FBCFEC4D3B2F) + W[2]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($E9B5DBA58189DBBC) + W[3]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($3956C25BF348B538) + W[4]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($59F111F1B605D019) + W[5]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($923F82A4AF194F9B) + W[6]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($AB1C5ED5DA6D8118) + W[7]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($D807AA98A3030242) + W[8]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($12835B0145706FBE) + W[9]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($243185BE4EE4B28C) + W[10]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($550C7DC3D5FFB4E2) + W[11]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($72BE5D74F27B896F) + W[12]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($80DEB1FE3B1696B1) + W[13]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($9BDC06A725C71235) + W[14]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($C19BF174CF692694) + W[15]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($E49B69C19EF14AD2) + W[16]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($EFBE4786384F25E3) + W[17]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($0FC19DC68B8CD5B5) + W[18]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($240CA1CC77AC9C65) + W[19]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($2DE92C6F592B0275) + W[20]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($4A7484AA6EA6E483) + W[21]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($5CB0A9DCBD41FBD4) + W[22]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($76F988DA831153B5) + W[23]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($983E5152EE66DFAB) + W[24]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($A831C66D2DB43210) + W[25]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($B00327C898FB213F) + W[26]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($BF597FC7BEEF0EE4) + W[27]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($C6E00BF33DA88FC2) + W[28]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($D5A79147930AA725) + W[29]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($06CA6351E003826F) + W[30]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($142929670A0E6E70) + W[31]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($27B70A8546D22FFC) + W[32]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($2E1B21385C26C926) + W[33]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($4D2C6DFC5AC42AED) + W[34]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($53380D139D95B3DF) + W[35]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($650A73548BAF63DE) + W[36]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($766A0ABB3C77B2A8) + W[37]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($81C2C92E47EDAEE6) + W[38]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($92722C851482353B) + W[39]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($A2BFE8A14CF10364) + W[40]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($A81A664BBC423001) + W[41]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($C24B8B70D0F89791) + W[42]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($C76C51A30654BE30) + W[43]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($D192E819D6EF5218) + W[44]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($D69906245565A910) + W[45]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($F40E35855771202A) + W[46]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($106AA07032BBD1B8) + W[47]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($19A4C116B8D2D0C8) + W[48]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($1E376C085141AB53) + W[49]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($2748774CDF8EEB99) + W[50]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($34B0BCB5E19B48A8) + W[51]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($391C0CB3C5C95A63) + W[52]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($4ED8AA4AE3418ACB) + W[53]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($5B9CCA4F7763E373) + W[54]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($682E6FF3D6B2B8A3) + W[55]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($748F82EE5DEFB2FC) + W[56]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($78A5636F43172F60) + W[57]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($84C87814A1F0AB72) + W[58]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($8CC702081A6439EC) + W[59]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($90BEFFFA23631E28) + W[60]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($A4506CEBDE82BDE9) + W[61]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($BEF9A3F7B2C67915) + W[62]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($C67178F2E372532B) + W[63]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($CA273ECEEA26619C) + W[64]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($D186B8C721C0C207) + W[65]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($EADA7DD6CDE0EB1E) + W[66]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($F57D4F7FEE6ED178) + W[67]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($06F067AA72176FBA) + W[68]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($0A637DC5A2C898A6) + W[69]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($113F9804BEF90DAE) + W[70]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($1B710B35131C471B) + W[71]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + t1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor ((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + UInt64($28DB77F523047D84) + W[72]; + t2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor ((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c)); + d := d + t1; + h := t1 + t2; + t1 := g + (((d shr 14) or (d shl 50)) xor ((d shr 18) or (d shl 46)) xor ((d shr 41) or (d shl 23))) + ((d and e) xor (not d and f)) + UInt64($32CAAB7B40C72493) + W[73]; + t2 := (((h shr 28) or (h shl 36)) xor ((h shr 34) or (h shl 30)) xor ((h shr 39) or (h shl 25))) + ((h and a) xor (h and b) xor (a and b)); + c := c + t1; + g := t1 + t2; + t1 := f + (((c shr 14) or (c shl 50)) xor ((c shr 18) or (c shl 46)) xor ((c shr 41) or (c shl 23))) + ((c and d) xor (not c and e)) + UInt64($3C9EBE0A15C9BEBC) + W[74]; + t2 := (((g shr 28) or (g shl 36)) xor ((g shr 34) or (g shl 30)) xor ((g shr 39) or (g shl 25))) + ((g and h) xor (g and a) xor (h and a)); + b := b + t1; + f := t1 + t2; + t1 := e + (((b shr 14) or (b shl 50)) xor ((b shr 18) or (b shl 46)) xor ((b shr 41) or (b shl 23))) + ((b and c) xor (not b and d)) + UInt64($431D67C49C100D4C) + W[75]; + t2 := (((f shr 28) or (f shl 36)) xor ((f shr 34) or (f shl 30)) xor ((f shr 39) or (f shl 25))) + ((f and g) xor (f and h) xor (g and h)); + a := a + t1; + e := t1 + t2; + t1 := d + (((a shr 14) or (a shl 50)) xor ((a shr 18) or (a shl 46)) xor ((a shr 41) or (a shl 23))) + ((a and b) xor (not a and c)) + UInt64($4CC5D4BECB3E42B6) + W[76]; + t2 := (((e shr 28) or (e shl 36)) xor ((e shr 34) or (e shl 30)) xor ((e shr 39) or (e shl 25))) + ((e and f) xor (e and g) xor (f and g)); + h := h + t1; + d := t1 + t2; + t1 := c + (((h shr 14) or (h shl 50)) xor ((h shr 18) or (h shl 46)) xor ((h shr 41) or (h shl 23))) + ((h and a) xor (not h and b)) + UInt64($597F299CFC657E2A) + W[77]; + t2 := (((d shr 28) or (d shl 36)) xor ((d shr 34) or (d shl 30)) xor ((d shr 39) or (d shl 25))) + ((d and e) xor (d and f) xor (e and f)); + g := g + t1; + c := t1 + t2; + t1 := b + (((g shr 14) or (g shl 50)) xor ((g shr 18) or (g shl 46)) xor ((g shr 41) or (g shl 23))) + ((g and h) xor (not g and a)) + UInt64($5FCB6FAB3AD6FAEC) + W[78]; + t2 := (((c shr 28) or (c shl 36)) xor ((c shr 34) or (c shl 30)) xor ((c shr 39) or (c shl 25))) + ((c and d) xor (c and e) xor (d and e)); + f := f + t1; + b := t1 + t2; + t1 := a + (((f shr 14) or (f shl 50)) xor ((f shr 18) or (f shl 46)) xor ((f shr 41) or (f shl 23))) + ((f and g) xor (not f and h)) + UInt64($6C44198C4A475817) + W[79]; + t2 := (((b shr 28) or (b shl 36)) xor ((b shr 34) or (b shl 30)) xor ((b shr 39) or (b shl 25))) + ((b and c) xor (b and d) xor (c and d)); + e := e + t1; + a := t1 + t2; + + CurrentHash[0] := CurrentHash[0] + a; + CurrentHash[1] := CurrentHash[1] + b; + CurrentHash[2] := CurrentHash[2] + c; + CurrentHash[3] := CurrentHash[3] + d; + CurrentHash[4] := CurrentHash[4] + e; + CurrentHash[5] := CurrentHash[5] + f; + CurrentHash[6] := CurrentHash[6] + g; + CurrentHash[7] := CurrentHash[7] + h; + FillChar(W, Sizeof(W), 0); + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +procedure TncEnc_sha512base.Burn; +begin + LenHi := 0; + LenLo := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_sha512base.Update(const aBuffer; aSize: NativeUInt); +var + PBuf: ^byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(LenLo, aSize * 8); + if LenLo < (aSize * 8) then + Inc(LenHi); + + PBuf := @aBuffer; + while aSize > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= aSize then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(aSize, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], aSize); + Inc(Index, aSize); + aSize := 0; + end; + end; +end; + +{ ****************************************************************************** } +class function TncEnc_sha384.GetAlgorithm: string; +begin + Result := 'SHA384'; +end; + +class function TncEnc_sha384.GetHashSize: Integer; +begin + Result := 384; +end; + +class function TncEnc_sha384.SelfTest: Boolean; +const + Test1Out: array [0 .. 47] of byte = ($CB, $00, $75, $3F, $45, $A3, $5E, $8B, $B5, $A0, $3D, $69, $9A, $C6, $50, $07, $27, $2C, $32, $AB, $0E, $DE, $D1, $63, $1A, $8B, $60, $5A, $43, $FF, $5B, $ED, $80, $86, $07, $2B, $A1, $E7, $CC, $23, $58, $BA, $EC, $A1, $34, $C8, $25, $A7); + Test2Out: array [0 .. 47] of byte = ($09, $33, $0C, $33, $F7, $11, $47, $E8, $3D, $19, $2F, $C7, $82, $CD, $1B, $47, $53, $11, $1B, $17, $3B, $3B, $05, $D2, $2F, $A0, $80, $86, $E3, $B0, $F7, $12, $FC, $C7, $C7, $1A, $55, $7E, $2D, $B9, $66, $C3, $E9, $FA, $91, $74, $60, $39); +var + TestHash: TncEnc_sha384; + TestOut: array [0 .. 47] of byte; +begin + TestHash := TncEnc_sha384.Create(nil); + TestHash.Init; + TestHash.UpdateStr('abc'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out))); + TestHash.Init; + TestHash.UpdateStr('abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out))) and Result; + TestHash.Free; +end; + +procedure TncEnc_sha384.Init; +begin + Burn; + CurrentHash[0] := $CBBB9D5DC1059ED8; + CurrentHash[1] := $629A292A367CD507; + CurrentHash[2] := $9159015A3070DD17; + CurrentHash[3] := $152FECD8F70E5939; + CurrentHash[4] := $67332667FFC00B31; + CurrentHash[5] := $8EB44A8768581511; + CurrentHash[6] := $DB0C2E0D64F98FA7; + CurrentHash[7] := $47B5481DBEFA4FA4; + FInitialized := true; +end; + +procedure TncEnc_sha384.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 112 then + Compress; + PUInt64(@HashBuffer[112])^ := SwapUInt64(LenHi); + PUInt64(@HashBuffer[120])^ := SwapUInt64(LenLo); + Compress; + CurrentHash[0] := SwapUInt64(CurrentHash[0]); + CurrentHash[1] := SwapUInt64(CurrentHash[1]); + CurrentHash[2] := SwapUInt64(CurrentHash[2]); + CurrentHash[3] := SwapUInt64(CurrentHash[3]); + CurrentHash[4] := SwapUInt64(CurrentHash[4]); + CurrentHash[5] := SwapUInt64(CurrentHash[5]); + Move(CurrentHash, Digest, 384 div 8); + Burn; +end; + +{ ****************************************************************************** } +class function TncEnc_sha512.GetAlgorithm: string; +begin + Result := 'SHA512'; +end; + +class function TncEnc_sha512.GetHashSize: Integer; +begin + Result := 512; +end; + +class function TncEnc_sha512.SelfTest: Boolean; +const + Test1Out: array [0 .. 63] of byte = ($DD, $AF, $35, $A1, $93, $61, $7A, $BA, $CC, $41, $73, $49, $AE, $20, $41, $31, $12, $E6, $FA, $4E, $89, $A9, $7E, $A2, $0A, $9E, $EE, $E6, $4B, $55, $D3, $9A, $21, $92, $99, $2A, $27, $4F, $C1, $A8, $36, $BA, $3C, $23, $A3, $FE, $EB, $BD, $45, $4D, $44, $23, $64, $3C, $E8, $0E, + $2A, $9A, $C9, $4F, $A5, $4C, $A4, $9F); + Test2Out: array [0 .. 63] of byte = ($8E, $95, $9B, $75, $DA, $E3, $13, $DA, $8C, $F4, $F7, $28, $14, $FC, $14, $3F, $8F, $77, $79, $C6, $EB, $9F, $7F, $A1, $72, $99, $AE, $AD, $B6, $88, $90, $18, $50, $1D, $28, $9E, $49, $00, $F7, $E4, $33, $1B, $99, $DE, $C4, $B5, $43, $3A, $C7, $D3, $29, $EE, $B6, $DD, $26, $54, + $5E, $96, $E5, $5B, $87, $4B, $E9, $09); +var + TestHash: TncEnc_sha512; + TestOut: array [0 .. 63] of byte; +begin + TestHash := TncEnc_sha512.Create(nil); + TestHash.Init; + TestHash.UpdateStr('abc'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out))); + TestHash.Init; + TestHash.UpdateStr('abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu'); + TestHash.Final(TestOut); + Result := Boolean(CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out))) and Result; + TestHash.Free; +end; + +procedure TncEnc_sha512.Init; +begin + Burn; + CurrentHash[0] := $6A09E667F3BCC908; + CurrentHash[1] := $BB67AE8584CAA73B; + CurrentHash[2] := $3C6EF372FE94F82B; + CurrentHash[3] := $A54FF53A5F1D36F1; + CurrentHash[4] := $510E527FADE682D1; + CurrentHash[5] := $9B05688C2B3E6C1F; + CurrentHash[6] := $1F83D9ABFB41BD6B; + CurrentHash[7] := $5BE0CD19137E2179; + FInitialized := true; +end; + +procedure TncEnc_sha512.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + HashBuffer[Index] := $80; + if Index >= 112 then + Compress; + PUInt64(@HashBuffer[112])^ := SwapUInt64(LenHi); + PUInt64(@HashBuffer[120])^ := SwapUInt64(LenLo); + Compress; + CurrentHash[0] := SwapUInt64(CurrentHash[0]); + CurrentHash[1] := SwapUInt64(CurrentHash[1]); + CurrentHash[2] := SwapUInt64(CurrentHash[2]); + CurrentHash[3] := SwapUInt64(CurrentHash[3]); + CurrentHash[4] := SwapUInt64(CurrentHash[4]); + CurrentHash[5] := SwapUInt64(CurrentHash[5]); + CurrentHash[6] := SwapUInt64(CurrentHash[6]); + CurrentHash[7] := SwapUInt64(CurrentHash[7]); + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncTea.pas b/Source_using_TMonitor/Encryption/ncEncTea.pas new file mode 100644 index 0000000..0270979 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncTea.pas @@ -0,0 +1,193 @@ +{$R-} +{$Q-} +unit ncEncTea; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +type + TncEnc_tea = class(TncEnc_blockcipher64) + protected + KeyData: array [0 .. 3] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: Integer; override; + class function SelfTest: Boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + Delta = $9E3779B9; + Rounds = 32; + +function SwapDword(const a: UInt32): UInt32; inline; +begin + Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); +end; + +class function TncEnc_tea.GetAlgorithm: string; +begin + Result := 'Tea'; +end; + +class function TncEnc_tea.GetMaxKeySize: Integer; +begin + Result := 128; +end; + +class function TncEnc_tea.SelfTest: Boolean; +const + Key: array [0 .. 3] of UInt32 = ($12345678, $9ABCDEF0, $0FEDCBA9, $87654321); + PT: array [0 .. 1] of UInt32 = ($12345678, $9ABCDEF0); +var + Data: array [0 .. 1] of UInt32; + Cipher: TncEnc_tea; +begin + Cipher := TncEnc_tea.Create(nil); + Cipher.Init(Key, Sizeof(Key) * 8, nil); + Cipher.EncryptECB(PT, Data); + Result := not CompareMem(@Data, @PT, Sizeof(PT)); + Cipher.DecryptECB(Data, Data); + Result := Result and CompareMem(@Data, @PT, Sizeof(PT)); + Cipher.Burn; + Cipher.Free; +end; + +procedure TncEnc_tea.InitKey(const Key; Size: longword); +begin + FillChar(KeyData, Sizeof(KeyData), 0); + Move(Key, KeyData, Size div 8); + KeyData[0] := SwapDword(KeyData[0]); + KeyData[1] := SwapDword(KeyData[1]); + KeyData[2] := SwapDword(KeyData[2]); + KeyData[3] := SwapDword(KeyData[3]); +end; + +procedure TncEnc_tea.Burn; +begin + FillChar(KeyData, Sizeof(KeyData), 0); + inherited Burn; +end; + +procedure TncEnc_tea.EncryptECB(const InData; var OutData); +var + a, b, c, d, x, y, n, sum: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + + x := SwapDword(PUInt32(@InData)^); + y := SwapDword(PUInt32(NativeUInt(@InData) + 4)^); + sum := 0; + a := KeyData[0]; + b := KeyData[1]; + c := KeyData[2]; + d := KeyData[3]; + for n := 1 to Rounds do + begin + Inc(sum, Delta); + Inc(x, (y shl 4) + (a xor y) + (sum xor (y shr 5)) + b); + Inc(y, (x shl 4) + (c xor x) + (sum xor (x shr 5)) + d); + end; + PUInt32(@OutData)^ := SwapDword(x); + PUInt32(NativeUInt(@OutData) + 4)^ := SwapDword(y); +end; + +procedure TncEnc_tea.DecryptECB(const InData; var OutData); +var + a, b, c, d, x, y, n, sum: UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + + x := SwapDword(PUInt32(@InData)^); + y := SwapDword(PUInt32(NativeUInt(@InData) + 4)^); + sum := Delta shl 5; + a := KeyData[0]; + b := KeyData[1]; + c := KeyData[2]; + d := KeyData[3]; + for n := 1 to Rounds do + begin + Dec(y, (x shl 4) + (c xor x) + (sum xor (x shr 5)) + d); + Dec(x, (y shl 4) + (a xor y) + (sum xor (y shr 5)) + b); + Dec(sum, Delta); + end; + PUInt32(@OutData)^ := SwapDword(x); + PUInt32(NativeUInt(@OutData) + 4)^ := SwapDword(y); +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncTiger.pas b/Source_using_TMonitor/Encryption/ncEncTiger.pas new file mode 100644 index 0000000..bc23c85 --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncTiger.pas @@ -0,0 +1,409 @@ +{$R-} +{$Q-} +{$WARN BOUNDS_ERROR OFF} +unit ncEncTiger; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2; + +type + TncEnc_tiger = class(TncEncHash) + protected + Len: UInt64; + Index: UInt64; + CurrentHash: array [0 .. 2] of UInt64; + HashBuffer: array [0 .. 63] of Byte; + procedure Compress; + public + class function GetAlgorithm: string; override; + class function GetHashSize: Integer; override; + class function SelfTest: Boolean; override; + procedure Init; override; + procedure Update(const Buffer; Size: NativeUInt); override; + procedure Final(var Digest); override; + procedure Burn; override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + t1: array [0 .. 255] of UInt64 = ($02AAB17CF7E90C5E, $AC424B03E243A8EC, $72CD5BE30DD5FCD3, $6D019B93F6F97F3A, $CD9978FFD21F9193, $7573A1C9708029E2, $B164326B922A83C3, $46883EEE04915870, $EAACE3057103ECE6, $C54169B808A3535C, $4CE754918DDEC47C, $0AA2F4DFDC0DF40C, $10B76F18A74DBEFA, $C6CCB6235AD1AB6A, $13726121572FE2FF, + $1A488C6F199D921E, $4BC9F9F4DA0007CA, $26F5E6F6E85241C7, $859079DBEA5947B6, $4F1885C5C99E8C92, $D78E761EA96F864B, $8E36428C52B5C17D, $69CF6827373063C1, $B607C93D9BB4C56E, $7D820E760E76B5EA, $645C9CC6F07FDC42, $BF38A078243342E0, $5F6B343C9D2E7D04, $F2C28AEB600B0EC6, $6C0ED85F7254BCAC, $71592281A4DB4FE5, + $1967FA69CE0FED9F, $FD5293F8B96545DB, $C879E9D7F2A7600B, $860248920193194E, $A4F9533B2D9CC0B3, $9053836C15957613, $DB6DCF8AFC357BF1, $18BEEA7A7A370F57, $037117CA50B99066, $6AB30A9774424A35, $F4E92F02E325249B, $7739DB07061CCAE1, $D8F3B49CECA42A05, $BD56BE3F51382F73, $45FAED5843B0BB28, $1C813D5C11BF1F83, + $8AF0E4B6D75FA169, $33EE18A487AD9999, $3C26E8EAB1C94410, $B510102BC0A822F9, $141EEF310CE6123B, $FC65B90059DDB154, $E0158640C5E0E607, $884E079826C3A3CF, $930D0D9523C535FD, $35638D754E9A2B00, $4085FCCF40469DD5, $C4B17AD28BE23A4C, $CAB2F0FC6A3E6A2E, $2860971A6B943FCD, $3DDE6EE212E30446, $6222F32AE01765AE, + $5D550BB5478308FE, $A9EFA98DA0EDA22A, $C351A71686C40DA7, $1105586D9C867C84, $DCFFEE85FDA22853, $CCFBD0262C5EEF76, $BAF294CB8990D201, $E69464F52AFAD975, $94B013AFDF133E14, $06A7D1A32823C958, $6F95FE5130F61119, $D92AB34E462C06C0, $ED7BDE33887C71D2, $79746D6E6518393E, $5BA419385D713329, $7C1BA6B948A97564, + $31987C197BFDAC67, $DE6C23C44B053D02, $581C49FED002D64D, $DD474D6338261571, $AA4546C3E473D062, $928FCE349455F860, $48161BBACAAB94D9, $63912430770E6F68, $6EC8A5E602C6641C, $87282515337DDD2B, $2CDA6B42034B701B, $B03D37C181CB096D, $E108438266C71C6F, $2B3180C7EB51B255, $DF92B82F96C08BBC, $5C68C8C0A632F3BA, + $5504CC861C3D0556, $ABBFA4E55FB26B8F, $41848B0AB3BACEB4, $B334A273AA445D32, $BCA696F0A85AD881, $24F6EC65B528D56C, $0CE1512E90F4524A, $4E9DD79D5506D35A, $258905FAC6CE9779, $2019295B3E109B33, $F8A9478B73A054CC, $2924F2F934417EB0, $3993357D536D1BC4, $38A81AC21DB6FF8B, $47C4FBF17D6016BF, $1E0FAADD7667E3F5, + $7ABCFF62938BEB96, $A78DAD948FC179C9, $8F1F98B72911E50D, $61E48EAE27121A91, $4D62F7AD31859808, $ECEBA345EF5CEAEB, $F5CEB25EBC9684CE, $F633E20CB7F76221, $A32CDF06AB8293E4, $985A202CA5EE2CA4, $CF0B8447CC8A8FB1, $9F765244979859A3, $A8D516B1A1240017, $0BD7BA3EBB5DC726, $E54BCA55B86ADB39, $1D7A3AFD6C478063, + $519EC608E7669EDD, $0E5715A2D149AA23, $177D4571848FF194, $EEB55F3241014C22, $0F5E5CA13A6E2EC2, $8029927B75F5C361, $AD139FABC3D6E436, $0D5DF1A94CCF402F, $3E8BD948BEA5DFC8, $A5A0D357BD3FF77E, $A2D12E251F74F645, $66FD9E525E81A082, $2E0C90CE7F687A49, $C2E8BCBEBA973BC5, $000001BCE509745F, $423777BBE6DAB3D6, + $D1661C7EAEF06EB5, $A1781F354DAACFD8, $2D11284A2B16AFFC, $F1FC4F67FA891D1F, $73ECC25DCB920ADA, $AE610C22C2A12651, $96E0A810D356B78A, $5A9A381F2FE7870F, $D5AD62EDE94E5530, $D225E5E8368D1427, $65977B70C7AF4631, $99F889B2DE39D74F, $233F30BF54E1D143, $9A9675D3D9A63C97, $5470554FF334F9A8, $166ACB744A4F5688, + $70C74CAAB2E4AEAD, $F0D091646F294D12, $57B82A89684031D1, $EFD95A5A61BE0B6B, $2FBD12E969F2F29A, $9BD37013FEFF9FE8, $3F9B0404D6085A06, $4940C1F3166CFE15, $09542C4DCDF3DEFB, $B4C5218385CD5CE3, $C935B7DC4462A641, $3417F8A68ED3B63F, $B80959295B215B40, $F99CDAEF3B8C8572, $018C0614F8FCB95D, $1B14ACCD1A3ACDF3, + $84D471F200BB732D, $C1A3110E95E8DA16, $430A7220BF1A82B8, $B77E090D39DF210E, $5EF4BD9F3CD05E9D, $9D4FF6DA7E57A444, $DA1D60E183D4A5F8, $B287C38417998E47, $FE3EDC121BB31886, $C7FE3CCC980CCBEF, $E46FB590189BFD03, $3732FD469A4C57DC, $7EF700A07CF1AD65, $59C64468A31D8859, $762FB0B4D45B61F6, $155BAED099047718, + $68755E4C3D50BAA6, $E9214E7F22D8B4DF, $2ADDBF532EAC95F4, $32AE3909B4BD0109, $834DF537B08E3450, $FA209DA84220728D, $9E691D9B9EFE23F7, $0446D288C4AE8D7F, $7B4CC524E169785B, $21D87F0135CA1385, $CEBB400F137B8AA5, $272E2B66580796BE, $3612264125C2B0DE, $057702BDAD1EFBB2, $D4BABB8EACF84BE9, $91583139641BC67B, + $8BDC2DE08036E024, $603C8156F49F68ED, $F7D236F7DBEF5111, $9727C4598AD21E80, $A08A0896670A5FD7, $CB4A8F4309EBA9CB, $81AF564B0F7036A1, $C0B99AA778199ABD, $959F1EC83FC8E952, $8C505077794A81B9, $3ACAAF8F056338F0, $07B43F50627A6778, $4A44AB49F5ECCC77, $3BC3D6E4B679EE98, $9CC0D4D1CF14108C, $4406C00B206BC8A0, + $82A18854C8D72D89, $67E366B35C3C432C, $B923DD61102B37F2, $56AB2779D884271D, $BE83E1B0FF1525AF, $FB7C65D4217E49A9, $6BDBE0E76D48E7D4, $08DF828745D9179E, $22EA6A9ADD53BD34, $E36E141C5622200A, $7F805D1B8CB750EE, $AFE5C7A59F58E837, $E27F996A4FB1C23C, $D3867DFB0775F0D0, $D0E673DE6E88891A, $123AEB9EAFB86C25, + $30F1D5D5C145B895, $BB434A2DEE7269E7, $78CB67ECF931FA38, $F33B0372323BBF9C, $52D66336FB279C74, $505F33AC0AFB4EAA, $E8A5CD99A2CCE187, $534974801E2D30BB, $8D2D5711D5876D90, $1F1A412891BC038E, $D6E2E71D82E56648, $74036C3A497732B7, $89B67ED96361F5AB, $FFED95D8F1EA02A2, $E72B3BD61464D43D, $A6300F170BDC4820, + $EBC18760ED78A77A); + + t2: array [0 .. 255] of UInt64 = ($E6A6BE5A05A12138, $B5A122A5B4F87C98, $563C6089140B6990, $4C46CB2E391F5DD5, $D932ADDBC9B79434, $08EA70E42015AFF5, $D765A6673E478CF1, $C4FB757EAB278D99, $DF11C6862D6E0692, $DDEB84F10D7F3B16, $6F2EF604A665EA04, $4A8E0F0FF0E0DFB3, $A5EDEEF83DBCBA51, $FC4F0A2A0EA4371E, $E83E1DA85CB38429, + $DC8FF882BA1B1CE2, $CD45505E8353E80D, $18D19A00D4DB0717, $34A0CFEDA5F38101, $0BE77E518887CAF2, $1E341438B3C45136, $E05797F49089CCF9, $FFD23F9DF2591D14, $543DDA228595C5CD, $661F81FD99052A33, $8736E641DB0F7B76, $15227725418E5307, $E25F7F46162EB2FA, $48A8B2126C13D9FE, $AFDC541792E76EEA, $03D912BFC6D1898F, + $31B1AAFA1B83F51B, $F1AC2796E42AB7D9, $40A3A7D7FCD2EBAC, $1056136D0AFBBCC5, $7889E1DD9A6D0C85, $D33525782A7974AA, $A7E25D09078AC09B, $BD4138B3EAC6EDD0, $920ABFBE71EB9E70, $A2A5D0F54FC2625C, $C054E36B0B1290A3, $F6DD59FF62FE932B, $3537354511A8AC7D, $CA845E9172FADCD4, $84F82B60329D20DC, $79C62CE1CD672F18, + $8B09A2ADD124642C, $D0C1E96A19D9E726, $5A786A9B4BA9500C, $0E020336634C43F3, $C17B474AEB66D822, $6A731AE3EC9BAAC2, $8226667AE0840258, $67D4567691CAECA5, $1D94155C4875ADB5, $6D00FD985B813FDF, $51286EFCB774CD06, $5E8834471FA744AF, $F72CA0AEE761AE2E, $BE40E4CDAEE8E09A, $E9970BBB5118F665, $726E4BEB33DF1964, + $703B000729199762, $4631D816F5EF30A7, $B880B5B51504A6BE, $641793C37ED84B6C, $7B21ED77F6E97D96, $776306312EF96B73, $AE528948E86FF3F4, $53DBD7F286A3F8F8, $16CADCE74CFC1063, $005C19BDFA52C6DD, $68868F5D64D46AD3, $3A9D512CCF1E186A, $367E62C2385660AE, $E359E7EA77DCB1D7, $526C0773749ABE6E, $735AE5F9D09F734B, + $493FC7CC8A558BA8, $B0B9C1533041AB45, $321958BA470A59BD, $852DB00B5F46C393, $91209B2BD336B0E5, $6E604F7D659EF19F, $B99A8AE2782CCB24, $CCF52AB6C814C4C7, $4727D9AFBE11727B, $7E950D0C0121B34D, $756F435670AD471F, $F5ADD442615A6849, $4E87E09980B9957A, $2ACFA1DF50AEE355, $D898263AFD2FD556, $C8F4924DD80C8FD6, + $CF99CA3D754A173A, $FE477BACAF91BF3C, $ED5371F6D690C12D, $831A5C285E687094, $C5D3C90A3708A0A4, $0F7F903717D06580, $19F9BB13B8FDF27F, $B1BD6F1B4D502843, $1C761BA38FFF4012, $0D1530C4E2E21F3B, $8943CE69A7372C8A, $E5184E11FEB5CE66, $618BDB80BD736621, $7D29BAD68B574D0B, $81BB613E25E6FE5B, $071C9C10BC07913F, + $C7BEEB7909AC2D97, $C3E58D353BC5D757, $EB017892F38F61E8, $D4EFFB9C9B1CC21A, $99727D26F494F7AB, $A3E063A2956B3E03, $9D4A8B9A4AA09C30, $3F6AB7D500090FB4, $9CC0F2A057268AC0, $3DEE9D2DEDBF42D1, $330F49C87960A972, $C6B2720287421B41, $0AC59EC07C00369C, $EF4EAC49CB353425, $F450244EEF0129D8, $8ACC46E5CAF4DEB6, + $2FFEAB63989263F7, $8F7CB9FE5D7A4578, $5BD8F7644E634635, $427A7315BF2DC900, $17D0C4AA2125261C, $3992486C93518E50, $B4CBFEE0A2D7D4C3, $7C75D6202C5DDD8D, $DBC295D8E35B6C61, $60B369D302032B19, $CE42685FDCE44132, $06F3DDB9DDF65610, $8EA4D21DB5E148F0, $20B0FCE62FCD496F, $2C1B912358B0EE31, $B28317B818F5A308, + $A89C1E189CA6D2CF, $0C6B18576AAADBC8, $B65DEAA91299FAE3, $FB2B794B7F1027E7, $04E4317F443B5BEB, $4B852D325939D0A6, $D5AE6BEEFB207FFC, $309682B281C7D374, $BAE309A194C3B475, $8CC3F97B13B49F05, $98A9422FF8293967, $244B16B01076FF7C, $F8BF571C663D67EE, $1F0D6758EEE30DA1, $C9B611D97ADEB9B7, $B7AFD5887B6C57A2, + $6290AE846B984FE1, $94DF4CDEACC1A5FD, $058A5BD1C5483AFF, $63166CC142BA3C37, $8DB8526EB2F76F40, $E10880036F0D6D4E, $9E0523C9971D311D, $45EC2824CC7CD691, $575B8359E62382C9, $FA9E400DC4889995, $D1823ECB45721568, $DAFD983B8206082F, $AA7D29082386A8CB, $269FCD4403B87588, $1B91F5F728BDD1E0, $E4669F39040201F6, + $7A1D7C218CF04ADE, $65623C29D79CE5CE, $2368449096C00BB1, $AB9BF1879DA503BA, $BC23ECB1A458058E, $9A58DF01BB401ECC, $A070E868A85F143D, $4FF188307DF2239E, $14D565B41A641183, $EE13337452701602, $950E3DCF3F285E09, $59930254B9C80953, $3BF299408930DA6D, $A955943F53691387, $A15EDECAA9CB8784, $29142127352BE9A0, + $76F0371FFF4E7AFB, $0239F450274F2228, $BB073AF01D5E868B, $BFC80571C10E96C1, $D267088568222E23, $9671A3D48E80B5B0, $55B5D38AE193BB81, $693AE2D0A18B04B8, $5C48B4ECADD5335F, $FD743B194916A1CA, $2577018134BE98C4, $E77987E83C54A4AD, $28E11014DA33E1B9, $270CC59E226AA213, $71495F756D1A5F60, $9BE853FB60AFEF77, + $ADC786A7F7443DBF, $0904456173B29A82, $58BC7A66C232BD5E, $F306558C673AC8B2, $41F639C6B6C9772A, $216DEFE99FDA35DA, $11640CC71C7BE615, $93C43694565C5527, $EA038E6246777839, $F9ABF3CE5A3E2469, $741E768D0FD312D2, $0144B883CED652C6, $C20B5A5BA33F8552, $1AE69633C3435A9D, $97A28CA4088CFDEC, $8824A43C1E96F420, + $37612FA66EEEA746, $6B4CB165F9CF0E5A, $43AA1C06A0ABFB4A, $7F4DC26FF162796B, $6CBACC8E54ED9B0F, $A6B7FFEFD2BB253E, $2E25BC95B0A29D4F, $86D6A58BDEF1388C, $DED74AC576B6F054, $8030BDBC2B45805D, $3C81AF70E94D9289, $3EFF6DDA9E3100DB, $B38DC39FDFCC8847, $123885528D17B87E, $F2DA0ED240B1B642, $44CEFADCD54BF9A9, + $1312200E433C7EE6, $9FFCC84F3A78C748, $F0CD1F72248576BB, $EC6974053638CFE4, $2BA7B67C0CEC4E4C, $AC2F4DF3E5CE32ED, $CB33D14326EA4C11, $A4E9044CC77E58BC, $5F513293D934FCEF, $5DC9645506E55444, $50DE418F317DE40A, $388CB31A69DDE259, $2DB4A83455820A86, $9010A91E84711AE9, $4DF7F0B7B1498371, $D62A2EABC0977179, + $22FAC097AA8D5C0E); + + t3: array [0 .. 255] of UInt64 = ($F49FCC2FF1DAF39B, $487FD5C66FF29281, $E8A30667FCDCA83F, $2C9B4BE3D2FCCE63, $DA3FF74B93FBBBC2, $2FA165D2FE70BA66, $A103E279970E93D4, $BECDEC77B0E45E71, $CFB41E723985E497, $B70AAA025EF75017, $D42309F03840B8E0, $8EFC1AD035898579, $96C6920BE2B2ABC5, $66AF4163375A9172, $2174ABDCCA7127FB, + $B33CCEA64A72FF41, $F04A4933083066A5, $8D970ACDD7289AF5, $8F96E8E031C8C25E, $F3FEC02276875D47, $EC7BF310056190DD, $F5ADB0AEBB0F1491, $9B50F8850FD58892, $4975488358B74DE8, $A3354FF691531C61, $0702BBE481D2C6EE, $89FB24057DEDED98, $AC3075138596E902, $1D2D3580172772ED, $EB738FC28E6BC30D, $5854EF8F63044326, + $9E5C52325ADD3BBE, $90AA53CF325C4623, $C1D24D51349DD067, $2051CFEEA69EA624, $13220F0A862E7E4F, $CE39399404E04864, $D9C42CA47086FCB7, $685AD2238A03E7CC, $066484B2AB2FF1DB, $FE9D5D70EFBF79EC, $5B13B9DD9C481854, $15F0D475ED1509AD, $0BEBCD060EC79851, $D58C6791183AB7F8, $D1187C5052F3EEE4, $C95D1192E54E82FF, + $86EEA14CB9AC6CA2, $3485BEB153677D5D, $DD191D781F8C492A, $F60866BAA784EBF9, $518F643BA2D08C74, $8852E956E1087C22, $A768CB8DC410AE8D, $38047726BFEC8E1A, $A67738B4CD3B45AA, $AD16691CEC0DDE19, $C6D4319380462E07, $C5A5876D0BA61938, $16B9FA1FA58FD840, $188AB1173CA74F18, $ABDA2F98C99C021F, $3E0580AB134AE816, + $5F3B05B773645ABB, $2501A2BE5575F2F6, $1B2F74004E7E8BA9, $1CD7580371E8D953, $7F6ED89562764E30, $B15926FF596F003D, $9F65293DA8C5D6B9, $6ECEF04DD690F84C, $4782275FFF33AF88, $E41433083F820801, $FD0DFE409A1AF9B5, $4325A3342CDB396B, $8AE77E62B301B252, $C36F9E9F6655615A, $85455A2D92D32C09, $F2C7DEA949477485, + $63CFB4C133A39EBA, $83B040CC6EBC5462, $3B9454C8FDB326B0, $56F56A9E87FFD78C, $2DC2940D99F42BC6, $98F7DF096B096E2D, $19A6E01E3AD852BF, $42A99CCBDBD4B40B, $A59998AF45E9C559, $366295E807D93186, $6B48181BFAA1F773, $1FEC57E2157A0A1D, $4667446AF6201AD5, $E615EBCACFB0F075, $B8F31F4F68290778, $22713ED6CE22D11E, + $3057C1A72EC3C93B, $CB46ACC37C3F1F2F, $DBB893FD02AAF50E, $331FD92E600B9FCF, $A498F96148EA3AD6, $A8D8426E8B6A83EA, $A089B274B7735CDC, $87F6B3731E524A11, $118808E5CBC96749, $9906E4C7B19BD394, $AFED7F7E9B24A20C, $6509EADEEB3644A7, $6C1EF1D3E8EF0EDE, $B9C97D43E9798FB4, $A2F2D784740C28A3, $7B8496476197566F, + $7A5BE3E6B65F069D, $F96330ED78BE6F10, $EEE60DE77A076A15, $2B4BEE4AA08B9BD0, $6A56A63EC7B8894E, $02121359BA34FEF4, $4CBF99F8283703FC, $398071350CAF30C8, $D0A77A89F017687A, $F1C1A9EB9E423569, $8C7976282DEE8199, $5D1737A5DD1F7ABD, $4F53433C09A9FA80, $FA8B0C53DF7CA1D9, $3FD9DCBC886CCB77, $C040917CA91B4720, + $7DD00142F9D1DCDF, $8476FC1D4F387B58, $23F8E7C5F3316503, $032A2244E7E37339, $5C87A5D750F5A74B, $082B4CC43698992E, $DF917BECB858F63C, $3270B8FC5BF86DDA, $10AE72BB29B5DD76, $576AC94E7700362B, $1AD112DAC61EFB8F, $691BC30EC5FAA427, $FF246311CC327143, $3142368E30E53206, $71380E31E02CA396, $958D5C960AAD76F1, + $F8D6F430C16DA536, $C8FFD13F1BE7E1D2, $7578AE66004DDBE1, $05833F01067BE646, $BB34B5AD3BFE586D, $095F34C9A12B97F0, $247AB64525D60CA8, $DCDBC6F3017477D1, $4A2E14D4DECAD24D, $BDB5E6D9BE0A1EEB, $2A7E70F7794301AB, $DEF42D8A270540FD, $01078EC0A34C22C1, $E5DE511AF4C16387, $7EBB3A52BD9A330A, $77697857AA7D6435, + $004E831603AE4C32, $E7A21020AD78E312, $9D41A70C6AB420F2, $28E06C18EA1141E6, $D2B28CBD984F6B28, $26B75F6C446E9D83, $BA47568C4D418D7F, $D80BADBFE6183D8E, $0E206D7F5F166044, $E258A43911CBCA3E, $723A1746B21DC0BC, $C7CAA854F5D7CDD3, $7CAC32883D261D9C, $7690C26423BA942C, $17E55524478042B8, $E0BE477656A2389F, + $4D289B5E67AB2DA0, $44862B9C8FBBFD31, $B47CC8049D141365, $822C1B362B91C793, $4EB14655FB13DFD8, $1ECBBA0714E2A97B, $6143459D5CDE5F14, $53A8FBF1D5F0AC89, $97EA04D81C5E5B00, $622181A8D4FDB3F3, $E9BCD341572A1208, $1411258643CCE58A, $9144C5FEA4C6E0A4, $0D33D06565CF620F, $54A48D489F219CA1, $C43E5EAC6D63C821, + $A9728B3A72770DAF, $D7934E7B20DF87EF, $E35503B61A3E86E5, $CAE321FBC819D504, $129A50B3AC60BFA6, $CD5E68EA7E9FB6C3, $B01C90199483B1C7, $3DE93CD5C295376C, $AED52EDF2AB9AD13, $2E60F512C0A07884, $BC3D86A3E36210C9, $35269D9B163951CE, $0C7D6E2AD0CDB5FA, $59E86297D87F5733, $298EF221898DB0E7, $55000029D1A5AA7E, + $8BC08AE1B5061B45, $C2C31C2B6C92703A, $94CC596BAF25EF42, $0A1D73DB22540456, $04B6A0F9D9C4179A, $EFFDAFA2AE3D3C60, $F7C8075BB49496C4, $9CC5C7141D1CD4E3, $78BD1638218E5534, $B2F11568F850246A, $EDFABCFA9502BC29, $796CE5F2DA23051B, $AAE128B0DC93537C, $3A493DA0EE4B29AE, $B5DF6B2C416895D7, $FCABBD25122D7F37, + $70810B58105DC4B1, $E10FDD37F7882A90, $524DCAB5518A3F5C, $3C9E85878451255B, $4029828119BD34E2, $74A05B6F5D3CECCB, $B610021542E13ECA, $0FF979D12F59E2AC, $6037DA27E4F9CC50, $5E92975A0DF1847D, $D66DE190D3E623FE, $5032D6B87B568048, $9A36B7CE8235216E, $80272A7A24F64B4A, $93EFED8B8C6916F7, $37DDBFF44CCE1555, + $4B95DB5D4B99BD25, $92D3FDA169812FC0, $FB1A4A9A90660BB6, $730C196946A4B9B2, $81E289AA7F49DA68, $64669A0F83B1A05F, $27B3FF7D9644F48B, $CC6B615C8DB675B3, $674F20B9BCEBBE95, $6F31238275655982, $5AE488713E45CF05, $BF619F9954C21157, $EABAC46040A8EAE9, $454C6FE9F2C0C1CD, $419CF6496412691C, $D3DC3BEF265B0F70, + $6D0E60F5C3578A9E); + + t4: array [0 .. 255] of UInt64 = ($5B0E608526323C55, $1A46C1A9FA1B59F5, $A9E245A17C4C8FFA, $65CA5159DB2955D7, $05DB0A76CE35AFC2, $81EAC77EA9113D45, $528EF88AB6AC0A0D, $A09EA253597BE3FF, $430DDFB3AC48CD56, $C4B3A67AF45CE46F, $4ECECFD8FBE2D05E, $3EF56F10B39935F0, $0B22D6829CD619C6, $17FD460A74DF2069, $6CF8CC8E8510ED40, + $D6C824BF3A6ECAA7, $61243D581A817049, $048BACB6BBC163A2, $D9A38AC27D44CC32, $7FDDFF5BAAF410AB, $AD6D495AA804824B, $E1A6A74F2D8C9F94, $D4F7851235DEE8E3, $FD4B7F886540D893, $247C20042AA4BFDA, $096EA1C517D1327C, $D56966B4361A6685, $277DA5C31221057D, $94D59893A43ACFF7, $64F0C51CCDC02281, $3D33BCC4FF6189DB, + $E005CB184CE66AF1, $FF5CCD1D1DB99BEA, $B0B854A7FE42980F, $7BD46A6A718D4B9F, $D10FA8CC22A5FD8C, $D31484952BE4BD31, $C7FA975FCB243847, $4886ED1E5846C407, $28CDDB791EB70B04, $C2B00BE2F573417F, $5C9590452180F877, $7A6BDDFFF370EB00, $CE509E38D6D9D6A4, $EBEB0F00647FA702, $1DCC06CF76606F06, $E4D9F28BA286FF0A, + $D85A305DC918C262, $475B1D8732225F54, $2D4FB51668CCB5FE, $A679B9D9D72BBA20, $53841C0D912D43A5, $3B7EAA48BF12A4E8, $781E0E47F22F1DDF, $EFF20CE60AB50973, $20D261D19DFFB742, $16A12B03062A2E39, $1960EB2239650495, $251C16FED50EB8B8, $9AC0C330F826016E, $ED152665953E7671, $02D63194A6369570, $5074F08394B1C987, + $70BA598C90B25CE1, $794A15810B9742F6, $0D5925E9FCAF8C6C, $3067716CD868744E, $910AB077E8D7731B, $6A61BBDB5AC42F61, $93513EFBF0851567, $F494724B9E83E9D5, $E887E1985C09648D, $34B1D3C675370CFD, $DC35E433BC0D255D, $D0AAB84234131BE0, $08042A50B48B7EAF, $9997C4EE44A3AB35, $829A7B49201799D0, $263B8307B7C54441, + $752F95F4FD6A6CA6, $927217402C08C6E5, $2A8AB754A795D9EE, $A442F7552F72943D, $2C31334E19781208, $4FA98D7CEAEE6291, $55C3862F665DB309, $BD0610175D53B1F3, $46FE6CB840413F27, $3FE03792DF0CFA59, $CFE700372EB85E8F, $A7BE29E7ADBCE118, $E544EE5CDE8431DD, $8A781B1B41F1873E, $A5C94C78A0D2F0E7, $39412E2877B60728, + $A1265EF3AFC9A62C, $BCC2770C6A2506C5, $3AB66DD5DCE1CE12, $E65499D04A675B37, $7D8F523481BFD216, $0F6F64FCEC15F389, $74EFBE618B5B13C8, $ACDC82B714273E1D, $DD40BFE003199D17, $37E99257E7E061F8, $FA52626904775AAA, $8BBBF63A463D56F9, $F0013F1543A26E64, $A8307E9F879EC898, $CC4C27A4150177CC, $1B432F2CCA1D3348, + $DE1D1F8F9F6FA013, $606602A047A7DDD6, $D237AB64CC1CB2C7, $9B938E7225FCD1D3, $EC4E03708E0FF476, $FEB2FBDA3D03C12D, $AE0BCED2EE43889A, $22CB8923EBFB4F43, $69360D013CF7396D, $855E3602D2D4E022, $073805BAD01F784C, $33E17A133852F546, $DF4874058AC7B638, $BA92B29C678AA14A, $0CE89FC76CFAADCD, $5F9D4E0908339E34, + $F1AFE9291F5923B9, $6E3480F60F4A265F, $EEBF3A2AB29B841C, $E21938A88F91B4AD, $57DFEFF845C6D3C3, $2F006B0BF62CAAF2, $62F479EF6F75EE78, $11A55AD41C8916A9, $F229D29084FED453, $42F1C27B16B000E6, $2B1F76749823C074, $4B76ECA3C2745360, $8C98F463B91691BD, $14BCC93CF1ADE66A, $8885213E6D458397, $8E177DF0274D4711, + $B49B73B5503F2951, $10168168C3F96B6B, $0E3D963B63CAB0AE, $8DFC4B5655A1DB14, $F789F1356E14DE5C, $683E68AF4E51DAC1, $C9A84F9D8D4B0FD9, $3691E03F52A0F9D1, $5ED86E46E1878E80, $3C711A0E99D07150, $5A0865B20C4E9310, $56FBFC1FE4F0682E, $EA8D5DE3105EDF9B, $71ABFDB12379187A, $2EB99DE1BEE77B9C, $21ECC0EA33CF4523, + $59A4D7521805C7A1, $3896F5EB56AE7C72, $AA638F3DB18F75DC, $9F39358DABE9808E, $B7DEFA91C00B72AC, $6B5541FD62492D92, $6DC6DEE8F92E4D5B, $353F57ABC4BEEA7E, $735769D6DA5690CE, $0A234AA642391484, $F6F9508028F80D9D, $B8E319A27AB3F215, $31AD9C1151341A4D, $773C22A57BEF5805, $45C7561A07968633, $F913DA9E249DBE36, + $DA652D9B78A64C68, $4C27A97F3BC334EF, $76621220E66B17F4, $967743899ACD7D0B, $F3EE5BCAE0ED6782, $409F753600C879FC, $06D09A39B5926DB6, $6F83AEB0317AC588, $01E6CA4A86381F21, $66FF3462D19F3025, $72207C24DDFD3BFB, $4AF6B6D3E2ECE2EB, $9C994DBEC7EA08DE, $49ACE597B09A8BC4, $B38C4766CF0797BA, $131B9373C57C2A75, + $B1822CCE61931E58, $9D7555B909BA1C0C, $127FAFDD937D11D2, $29DA3BADC66D92E4, $A2C1D57154C2ECBC, $58C5134D82F6FE24, $1C3AE3515B62274F, $E907C82E01CB8126, $F8ED091913E37FCB, $3249D8F9C80046C9, $80CF9BEDE388FB63, $1881539A116CF19E, $5103F3F76BD52457, $15B7E6F5AE47F7A8, $DBD7C6DED47E9CCF, $44E55C410228BB1A, + $B647D4255EDB4E99, $5D11882BB8AAFC30, $F5098BBB29D3212A, $8FB5EA14E90296B3, $677B942157DD025A, $FB58E7C0A390ACB5, $89D3674C83BD4A01, $9E2DA4DF4BF3B93B, $FCC41E328CAB4829, $03F38C96BA582C52, $CAD1BDBD7FD85DB2, $BBB442C16082AE83, $B95FE86BA5DA9AB0, $B22E04673771A93F, $845358C9493152D8, $BE2A488697B4541E, + $95A2DC2DD38E6966, $C02C11AC923C852B, $2388B1990DF2A87B, $7C8008FA1B4F37BE, $1F70D0C84D54E503, $5490ADEC7ECE57D4, $002B3C27D9063A3A, $7EAEA3848030A2BF, $C602326DED2003C0, $83A7287D69A94086, $C57A5FCB30F57A8A, $B56844E479EBE779, $A373B40F05DCBCE9, $D71A786E88570EE2, $879CBACDBDE8F6A0, $976AD1BCC164A32F, + $AB21E25E9666D78B, $901063AAE5E5C33C, $9818B34448698D90, $E36487AE3E1E8ABB, $AFBDF931893BDCB4, $6345A0DC5FBBD519, $8628FE269B9465CA, $1E5D01603F9C51EC, $4DE44006A15049B7, $BF6C70E5F776CBB1, $411218F2EF552BED, $CB0C0708705A36A3, $E74D14754F986044, $CD56D9430EA8280E, $C12591D7535F5065, $C83223F1720AEF96, + $C3A0396F7363A51F); + +procedure TncEnc_tiger.Compress; +var + a, b, c, aa, bb, cc: UInt64; + x: array [0 .. 7] of UInt64; +begin + a := CurrentHash[0]; + aa := a; + b := CurrentHash[1]; + bb := b; + c := CurrentHash[2]; + cc := c; + + Move(HashBuffer, x, Sizeof(x)); + + c := c xor x[0]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 5; + a := a xor x[1]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 5; + b := b xor x[2]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 5; + c := c xor x[3]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 5; + a := a xor x[4]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 5; + b := b xor x[5]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 5; + c := c xor x[6]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 5; + a := a xor x[7]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 5; + x[0] := x[0] - (x[7] xor $A5A5A5A5A5A5A5A5); + x[1] := x[1] xor x[0]; + x[2] := x[2] + x[1]; + x[3] := x[3] - (x[2] xor ((not x[1]) shl 19)); + x[4] := x[4] xor x[3]; + x[5] := x[5] + x[4]; + x[6] := x[6] - (x[5] xor ((not x[4]) shr 23)); + x[7] := x[7] xor x[6]; + x[0] := x[0] + x[7]; + x[1] := x[1] - (x[0] xor ((not x[7]) shl 19)); + x[2] := x[2] xor x[1]; + x[3] := x[3] + x[2]; + x[4] := x[4] - (x[3] xor ((not x[2]) shr 23)); + x[5] := x[5] xor x[4]; + x[6] := x[6] + x[5]; + x[7] := x[7] - (x[6] xor $0123456789ABCDEF); + b := b xor x[0]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 7; + c := c xor x[1]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 7; + a := a xor x[2]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 7; + b := b xor x[3]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 7; + c := c xor x[4]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 7; + a := a xor x[5]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 7; + b := b xor x[6]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 7; + c := c xor x[7]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 7; + x[0] := x[0] - (x[7] xor $A5A5A5A5A5A5A5A5); + x[1] := x[1] xor x[0]; + x[2] := x[2] + x[1]; + x[3] := x[3] - (x[2] xor ((not x[1]) shl 19)); + x[4] := x[4] xor x[3]; + x[5] := x[5] + x[4]; + x[6] := x[6] - (x[5] xor ((not x[4]) shr 23)); + x[7] := x[7] xor x[6]; + x[0] := x[0] + x[7]; + x[1] := x[1] - (x[0] xor ((not x[7]) shl 19)); + x[2] := x[2] xor x[1]; + x[3] := x[3] + x[2]; + x[4] := x[4] - (x[3] xor ((not x[2]) shr 23)); + x[5] := x[5] xor x[4]; + x[6] := x[6] + x[5]; + x[7] := x[7] - (x[6] xor $0123456789ABCDEF); + a := a xor x[0]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 9; + b := b xor x[1]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 9; + c := c xor x[2]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 9; + a := a xor x[3]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 9; + b := b xor x[4]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 9; + c := c xor x[5]; + a := a - (t1[c and $FF] xor t2[(c shr 16) and $FF] xor t3[(c shr 32) and $FF] xor t4[(c shr 48) and $FF]); + b := b + (t4[(c shr 8) and $FF] xor t3[(c shr 24) and $FF] xor t2[(c shr 40) and $FF] xor t1[(c shr 56) and $FF]); + b := b * 9; + a := a xor x[6]; + b := b - (t1[a and $FF] xor t2[(a shr 16) and $FF] xor t3[(a shr 32) and $FF] xor t4[(a shr 48) and $FF]); + c := c + (t4[(a shr 8) and $FF] xor t3[(a shr 24) and $FF] xor t2[(a shr 40) and $FF] xor t1[(a shr 56) and $FF]); + c := c * 9; + b := b xor x[7]; + c := c - (t1[b and $FF] xor t2[(b shr 16) and $FF] xor t3[(b shr 32) and $FF] xor t4[(b shr 48) and $FF]); + a := a + (t4[(b shr 8) and $FF] xor t3[(b shr 24) and $FF] xor t2[(b shr 40) and $FF] xor t1[(b shr 56) and $FF]); + a := a * 9; + + CurrentHash[0] := a xor aa; + CurrentHash[1] := b - bb; + CurrentHash[2] := c + cc; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); +end; + +class function TncEnc_tiger.GetHashSize: Integer; +begin + Result := 192; +end; + +class function TncEnc_tiger.GetAlgorithm: string; +begin + Result := 'Tiger'; +end; + +class function TncEnc_tiger.SelfTest: Boolean; +const + Test1Out: array [0 .. 2] of UInt64 = ($87FB2A9083851CF7, $470D2CF810E6DF9E, $B586445034A5A386); + Test2Out: array [0 .. 2] of UInt64 = ($0C410A042968868A, $1671DA5A3FD29A72, $5EC1E457D3CDB303); +var + TestHash: TncEnc_tiger; + TestOut: array [0 .. 2] of UInt64; +begin + TestHash := TncEnc_tiger.Create(nil); + TestHash.Init; + TestHash.UpdateStr('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test1Out, Sizeof(Test1Out)); + TestHash.Init; + TestHash.UpdateStr('Tiger - A Fast New Hash Function, by Ross Anderson and Eli Biham'); + TestHash.Final(TestOut); + Result := CompareMem(@TestOut, @Test2Out, Sizeof(Test2Out)) and Result; + TestHash.Free; +end; + +procedure TncEnc_tiger.Init; +begin + Burn; + FInitialized := true; + CurrentHash[0] := $0123456789ABCDEF; + CurrentHash[1] := $FEDCBA9876543210; + CurrentHash[2] := $F096A5B4C3B2E187; +end; + +procedure TncEnc_tiger.Burn; +begin + Len := 0; + Index := 0; + FillChar(HashBuffer, Sizeof(HashBuffer), 0); + FillChar(CurrentHash, Sizeof(CurrentHash), 0); + FInitialized := false; +end; + +procedure TncEnc_tiger.Update(const Buffer; Size: NativeUInt); +var + PBuf: ^Byte; +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + + Inc(Len, Size * 8); + + PBuf := @Buffer; + while Size > 0 do + begin + if (Sizeof(HashBuffer) - Index) <= Size then + begin + Move(PBuf^, HashBuffer[Index], Sizeof(HashBuffer) - Index); + Dec(Size, Sizeof(HashBuffer) - Index); + Inc(PBuf, Sizeof(HashBuffer) - Index); + Compress; + end + else + begin + Move(PBuf^, HashBuffer[Index], Size); + Inc(Index, Size); + Size := 0; + end; + end; +end; + +procedure TncEnc_tiger.Final(var Digest); +begin + if not FInitialized then + raise EEncHashException.Create(rsHashNotInitialised); + HashBuffer[Index] := $01; + if Index >= 56 then + Compress; + PUInt64(@HashBuffer[56])^ := Len; + Compress; + Move(CurrentHash, Digest, Sizeof(CurrentHash)); + Burn; +end; + +end. diff --git a/Source_using_TMonitor/Encryption/ncEncTwofish.pas b/Source_using_TMonitor/Encryption/ncEncTwofish.pas new file mode 100644 index 0000000..790249d --- /dev/null +++ b/Source_using_TMonitor/Encryption/ncEncTwofish.pas @@ -0,0 +1,600 @@ +{$R-} +{$Q-} +unit ncEncTwofish; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; + +const + INPUTWHITEN = 0; + OUTPUTWHITEN = 4; + NUMROUNDS = 16; + ROUNDSUBKEYS = (OUTPUTWHITEN + 4); + TOTALSUBKEYS = (ROUNDSUBKEYS + NUMROUNDS * 2); + RS_GF_FDBK = $14D; + MDS_GF_FDBK = $169; + SK_STEP = $02020202; + SK_BUMP = $01010101; + SK_ROTL = 9; + +type + TncEnc_twofish = class(TncEnc_blockcipher128) + protected + SubKeys: array [0 .. TOTALSUBKEYS - 1] of UInt32; + sbox: array [0 .. 3, 0 .. 255] of UInt32; + procedure InitKey(const Key; Size: longword); override; + public + class function GetAlgorithm: string; override; + class function GetMaxKeySize: integer; override; + class function SelfTest: boolean; override; + procedure Burn; override; + procedure EncryptECB(const InData; var OutData); override; + procedure DecryptECB(const InData; var OutData); override; + constructor Create(AOwner: TComponent); override; + end; + + { ****************************************************************************** } + { ****************************************************************************** } +implementation + +uses ncEncryption; + +const + p8x8: array [0 .. 1, 0 .. 255] of byte = (($A9, $67, $B3, $E8, $04, $FD, $A3, $76, $9A, $92, $80, $78, $E4, $DD, $D1, $38, $0D, $C6, $35, $98, $18, $F7, $EC, $6C, $43, $75, $37, $26, $FA, $13, $94, $48, $F2, $D0, $8B, $30, $84, $54, $DF, $23, $19, $5B, $3D, $59, $F3, $AE, $A2, $82, $63, $01, $83, $2E, $D9, $51, $9B, + $7C, $A6, $EB, $A5, $BE, $16, $0C, $E3, $61, $C0, $8C, $3A, $F5, $73, $2C, $25, $0B, $BB, $4E, $89, $6B, $53, $6A, $B4, $F1, $E1, $E6, $BD, $45, $E2, $F4, $B6, $66, $CC, $95, $03, $56, $D4, $1C, $1E, $D7, $FB, $C3, $8E, $B5, $E9, $CF, $BF, $BA, $EA, $77, $39, $AF, $33, $C9, $62, $71, $81, $79, $09, $AD, $24, $CD, + $F9, $D8, $E5, $C5, $B9, $4D, $44, $08, $86, $E7, $A1, $1D, $AA, $ED, $06, $70, $B2, $D2, $41, $7B, $A0, $11, $31, $C2, $27, $90, $20, $F6, $60, $FF, $96, $5C, $B1, $AB, $9E, $9C, $52, $1B, $5F, $93, $0A, $EF, $91, $85, $49, $EE, $2D, $4F, $8F, $3B, $47, $87, $6D, $46, $D6, $3E, $69, $64, $2A, $CE, $CB, $2F, $FC, + $97, $05, $7A, $AC, $7F, $D5, $1A, $4B, $0E, $A7, $5A, $28, $14, $3F, $29, $88, $3C, $4C, $02, $B8, $DA, $B0, $17, $55, $1F, $8A, $7D, $57, $C7, $8D, $74, $B7, $C4, $9F, $72, $7E, $15, $22, $12, $58, $07, $99, $34, $6E, $50, $DE, $68, $65, $BC, $DB, $F8, $C8, $A8, $2B, $40, $DC, $FE, $32, $A4, $CA, $10, $21, $F0, + $D3, $5D, $0F, $00, $6F, $9D, $36, $42, $4A, $5E, $C1, $E0), ($75, $F3, $C6, $F4, $DB, $7B, $FB, $C8, $4A, $D3, $E6, $6B, $45, $7D, $E8, $4B, $D6, $32, $D8, $FD, $37, $71, $F1, $E1, $30, $0F, $F8, $1B, $87, $FA, $06, $3F, $5E, $BA, $AE, $5B, $8A, $00, $BC, $9D, $6D, $C1, $B1, $0E, $80, $5D, $D2, $D5, $A0, $84, $07, + $14, $B5, $90, $2C, $A3, $B2, $73, $4C, $54, $92, $74, $36, $51, $38, $B0, $BD, $5A, $FC, $60, $62, $96, $6C, $42, $F7, $10, $7C, $28, $27, $8C, $13, $95, $9C, $C7, $24, $46, $3B, $70, $CA, $E3, $85, $CB, $11, $D0, $93, $B8, $A6, $83, $20, $FF, $9F, $77, $C3, $CC, $03, $6F, $08, $BF, $40, $E7, $2B, $E2, $79, $0C, + $AA, $82, $41, $3A, $EA, $B9, $E4, $9A, $A4, $97, $7E, $DA, $7A, $17, $66, $94, $A1, $1D, $3D, $F0, $DE, $B3, $0B, $72, $A7, $1C, $EF, $D1, $53, $3E, $8F, $33, $26, $5F, $EC, $76, $2A, $49, $81, $88, $EE, $21, $C4, $1A, $EB, $D9, $C5, $39, $99, $CD, $AD, $31, $8B, $01, $18, $23, $DD, $1F, $4E, $2D, $F9, $48, $4F, + $F2, $65, $8E, $78, $5C, $58, $19, $8D, $E5, $98, $57, $67, $7F, $05, $64, $AF, $63, $B6, $FE, $F5, $B7, $3C, $A5, $CE, $E9, $68, $44, $E0, $4D, $43, $69, $29, $2E, $AC, $15, $59, $A8, $0A, $9E, $6E, $47, $DF, $34, $35, $6A, $CF, $DC, $22, $C9, $C0, $9B, $89, $D4, $ED, $AB, $12, $A2, $0D, $52, $BB, $02, $2F, $A9, + $D7, $61, $1E, $B4, $50, $04, $F6, $C2, $16, $25, $86, $56, $55, $09, $BE, $91)); + +var + MDS: array [0 .. 3, 0 .. 255] of UInt32; + MDSDone: boolean; + +class function TncEnc_twofish.GetAlgorithm: string; +begin + Result := 'Twofish'; +end; + +class function TncEnc_twofish.GetMaxKeySize: integer; +begin + Result := 256; +end; + +class function TncEnc_twofish.SelfTest: boolean; +const + Out128: array [0 .. 15] of byte = ($5D, $9D, $4E, $EF, $FA, $91, $51, $57, $55, $24, $F1, $15, $81, $5A, $12, $E0); + Out192: array [0 .. 15] of byte = ($E7, $54, $49, $21, $2B, $EE, $F9, $F4, $A3, $90, $BD, $86, $0A, $64, $09, $41); + Out256: array [0 .. 15] of byte = ($37, $FE, $26, $FF, $1C, $F6, $61, $75, $F5, $DD, $F4, $C3, $3B, $97, $A2, $05); +var + i: integer; + Key: array [0 .. 31] of byte; + Block: array [0 .. 15] of byte; + Cipher: TncEnc_twofish; +begin + Cipher := TncEnc_twofish.Create(nil); + FillChar(Key, Sizeof(Key), 0); + FillChar(Block, Sizeof(Block), 0); + for i := 1 to 49 do + begin + Cipher.Init(Key, 128, nil); + Move(Block, Key, 16); + Cipher.EncryptECB(Block, Block); + Cipher.Burn; + end; + Result := boolean(CompareMem(@Block, @Out128, 16)); + FillChar(Key, Sizeof(Key), 0); + FillChar(Block, Sizeof(Block), 0); + for i := 1 to 49 do + begin + Cipher.Init(Key, 192, nil); + Move(Key[0], Key[16], 8); + Move(Block, Key, 16); + Cipher.EncryptECB(Block, Block); + Cipher.Burn; + end; + Result := Result and boolean(CompareMem(@Block, @Out192, 16)); + FillChar(Key, Sizeof(Key), 0); + FillChar(Block, Sizeof(Block), 0); + for i := 1 to 49 do + begin + Cipher.Init(Key, 256, nil); + Move(Key[0], Key[16], 16); + Move(Block, Key, 16); + Cipher.EncryptECB(Block, Block); + Cipher.Burn; + end; + Result := Result and boolean(CompareMem(@Block, @Out256, 16)); + Cipher.Burn; + Cipher.Free; +end; + +function LFSR1(x: UInt32): UInt32; inline; +begin + if (x and 1) <> 0 then + Result := (x shr 1) xor (MDS_GF_FDBK div 2) + else + Result := (x shr 1); +end; + +function LFSR2(x: UInt32): UInt32; inline; +begin + if (x and 2) <> 0 then + if (x and 1) <> 0 then + Result := (x shr 2) xor (MDS_GF_FDBK div 2) xor (MDS_GF_FDBK div 4) + else + Result := (x shr 2) xor (MDS_GF_FDBK div 2) + else if (x and 1) <> 0 then + Result := (x shr 2) xor (MDS_GF_FDBK div 4) + else + Result := (x shr 2); +end; + +function Mul_X(x: UInt32): UInt32; inline; +begin + Result := x xor LFSR2(x); +end; + +function Mul_Y(x: UInt32): UInt32; inline; +begin + Result := x xor LFSR1(x) xor LFSR2(x); +end; + +function RS_MDS_Encode(lK0, lK1: UInt32): UInt32; +var + lR, nJ, lG2, lG3: UInt32; + bB: byte; +begin + lR := lK1; + for nJ := 0 to 3 do + begin + bB := lR shr 24; + if (bB and $80) <> 0 then + lG2 := ((bB shl 1) xor RS_GF_FDBK) and $FF + else + lG2 := (bB shl 1) and $FF; + if (bB and 1) <> 0 then + lG3 := ((bB shr 1) and $7F) xor (RS_GF_FDBK shr 1) xor lG2 + else + lG3 := ((bB shr 1) and $7F) xor lG2; + lR := (lR shl 8) xor (lG3 shl 24) xor (lG2 shl 16) xor (lG3 shl 8) xor bB; + end; + lR := lR xor lK0; + for nJ := 0 to 3 do + begin + bB := lR shr 24; + if (bB and $80) <> 0 then + lG2 := ((bB shl 1) xor RS_GF_FDBK) and $FF + else + lG2 := (bB shl 1) and $FF; + if (bB and 1) <> 0 then + lG3 := ((bB shr 1) and $7F) xor (RS_GF_FDBK shr 1) xor lG2 + else + lG3 := ((bB shr 1) and $7F) xor lG2; + lR := (lR shl 8) xor (lG3 shl 24) xor (lG2 shl 16) xor (lG3 shl 8) xor bB; + end; + Result := lR; +end; + +function f32(x: UInt32; K32: PUInt32Array; Len: UInt32): UInt32; +var + t0, t1, t2, t3: UInt32; +begin + t0 := x and $FF; + t1 := (x shr 8) and $FF; + t2 := (x shr 16) and $FF; + t3 := x shr 24; + if Len = 256 then + begin + t0 := p8x8[1, t0] xor ((K32^[3]) and $FF); + t1 := p8x8[0, t1] xor ((K32^[3] shr 8) and $FF); + t2 := p8x8[0, t2] xor ((K32^[3] shr 16) and $FF); + t3 := p8x8[1, t3] xor ((K32^[3] shr 24)); + end; + if Len >= 192 then + begin + t0 := p8x8[1, t0] xor ((K32^[2]) and $FF); + t1 := p8x8[1, t1] xor ((K32^[2] shr 8) and $FF); + t2 := p8x8[0, t2] xor ((K32^[2] shr 16) and $FF); + t3 := p8x8[0, t3] xor ((K32^[2] shr 24)); + end; + Result := MDS[0, p8x8[0, p8x8[0, t0] xor ((K32^[1]) and $FF)] xor ((K32^[0]) and $FF)] xor MDS[1, p8x8[0, p8x8[1, t1] xor ((K32^[1] shr 8) and $FF)] xor ((K32^[0] shr 8) and $FF)] xor MDS[2, p8x8[1, p8x8[0, t2] xor ((K32^[1] shr 16) and $FF)] xor ((K32^[0] shr 16) and $FF) + ] xor MDS[3, p8x8[1, p8x8[1, t3] xor ((K32^[1] shr 24))] xor ((K32^[0] shr 24))]; +end; + +procedure Xor256(Dst, Src: PUInt32Array; v: byte); +var + i, j: UInt32; +begin + i := 0; + j := v * $01010101; + while i < 64 do + begin + Dst^[i] := Src^[i] xor j; + Dst^[i + 1] := Src^[i + 1] xor j; + Dst^[i + 2] := Src^[i + 2] xor j; + Dst^[i + 3] := Src^[i + 3] xor j; + Inc(i, 4); + end; +end; + +procedure TncEnc_twofish.InitKey(const Key; Size: longword); +const + subkeyCnt = ROUNDSUBKEYS + 2 * NUMROUNDS; +var + key32: array [0 .. 7] of UInt32; + k32e, k32o, sboxkeys: array [0 .. 3] of UInt32; + k64Cnt, i, j, A, B, q: UInt32; + L0, L1: array [0 .. 255] of byte; +begin + FillChar(key32, Sizeof(key32), 0); + Move(Key, key32, Size div 8); + if Size <= 128 then { pad the key to either 128bit, 192bit or 256bit } + Size := 128 + else if Size <= 192 then + Size := 192 + else + Size := 256; + k64Cnt := Size div 64; + j := k64Cnt - 1; + for i := 0 to j do + begin + k32e[i] := key32[2 * i]; + k32o[i] := key32[2 * i + 1]; + sboxkeys[j] := RS_MDS_Encode(k32e[i], k32o[i]); + Dec(j); + end; + q := 0; + for i := 0 to ((subkeyCnt div 2) - 1) do + begin + A := f32(q, @k32e, Size); + B := f32(q + SK_BUMP, @k32o, Size); + B := (B shl 8) or (B shr 24); + SubKeys[2 * i] := A + B; + B := A + 2 * B; + SubKeys[2 * i + 1] := (B shl SK_ROTL) or (B shr (32 - SK_ROTL)); + Inc(q, SK_STEP); + end; + case Size of + 128: + begin + Xor256(@L0, @p8x8[0], (sboxkeys[1] and $FF)); + A := (sboxkeys[0] and $FF); + i := 0; + while i < 256 do + begin + sbox[0 and 2, 2 * i + (0 and 1)] := MDS[0, p8x8[0, L0[i]] xor A]; + sbox[0 and 2, 2 * i + (0 and 1) + 2] := MDS[0, p8x8[0, L0[i + 1]] xor A]; + Inc(i, 2); + end; + Xor256(@L0, @p8x8[1], (sboxkeys[1] shr 8) and $FF); + A := (sboxkeys[0] shr 8) and $FF; + i := 0; + while i < 256 do + begin + sbox[1 and 2, 2 * i + (1 and 1)] := MDS[1, p8x8[0, L0[i]] xor A]; + sbox[1 and 2, 2 * i + (1 and 1) + 2] := MDS[1, p8x8[0, L0[i + 1]] xor A]; + Inc(i, 2); + end; + Xor256(@L0, @p8x8[0], (sboxkeys[1] shr 16) and $FF); + A := (sboxkeys[0] shr 16) and $FF; + i := 0; + while i < 256 do + begin + sbox[2 and 2, 2 * i + (2 and 1)] := MDS[2, p8x8[1, L0[i]] xor A]; + sbox[2 and 2, 2 * i + (2 and 1) + 2] := MDS[2, p8x8[1, L0[i + 1]] xor A]; + Inc(i, 2); + end; + Xor256(@L0, @p8x8[1], (sboxkeys[1] shr 24)); + A := (sboxkeys[0] shr 24); + i := 0; + while i < 256 do + begin + sbox[3 and 2, 2 * i + (3 and 1)] := MDS[3, p8x8[1, L0[i]] xor A]; + sbox[3 and 2, 2 * i + (3 and 1) + 2] := MDS[3, p8x8[1, L0[i + 1]] xor A]; + Inc(i, 2); + end; + end; + 192: + begin + Xor256(@L0, @p8x8[1], sboxkeys[2] and $FF); + A := sboxkeys[0] and $FF; + B := sboxkeys[1] and $FF; + i := 0; + while i < 256 do + begin + sbox[0 and 2, 2 * i + (0 and 1)] := MDS[0, p8x8[0, p8x8[0, L0[i]] xor B] xor A]; + sbox[0 and 2, 2 * i + (0 and 1) + 2] := MDS[0, p8x8[0, p8x8[0, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + Xor256(@L0, @p8x8[1], (sboxkeys[2] shr 8) and $FF); + A := (sboxkeys[0] shr 8) and $FF; + B := (sboxkeys[1] shr 8) and $FF; + i := 0; + while i < 256 do + begin + sbox[1 and 2, 2 * i + (1 and 1)] := MDS[1, p8x8[0, p8x8[1, L0[i]] xor B] xor A]; + sbox[1 and 2, 2 * i + (1 and 1) + 2] := MDS[1, p8x8[0, p8x8[1, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + Xor256(@L0, @p8x8[0], (sboxkeys[2] shr 16) and $FF); + A := (sboxkeys[0] shr 16) and $FF; + B := (sboxkeys[1] shr 16) and $FF; + i := 0; + while i < 256 do + begin + sbox[2 and 2, 2 * i + (2 and 1)] := MDS[2, p8x8[1, p8x8[0, L0[i]] xor B] xor A]; + sbox[2 and 2, 2 * i + (2 and 1) + 2] := MDS[2, p8x8[1, p8x8[0, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + Xor256(@L0, @p8x8[0], (sboxkeys[2] shr 24)); + A := (sboxkeys[0] shr 24); + B := (sboxkeys[1] shr 24); + i := 0; + while i < 256 do + begin + sbox[3 and 2, 2 * i + (3 and 1)] := MDS[3, p8x8[1, p8x8[1, L0[i]] xor B] xor A]; + sbox[3 and 2, 2 * i + (3 and 1) + 2] := MDS[3, p8x8[1, p8x8[1, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + end; + 256: + begin + Xor256(@L1, @p8x8[1], (sboxkeys[3]) and $FF); + i := 0; + while i < 256 do + begin + L0[i] := p8x8[1, L1[i]]; + L0[i + 1] := p8x8[1, L1[i + 1]]; + Inc(i, 2); + end; + Xor256(@L0, @L0, (sboxkeys[2]) and $FF); + A := (sboxkeys[0]) and $FF; + B := (sboxkeys[1]) and $FF; + i := 0; + while i < 256 do + begin + sbox[0 and 2, 2 * i + (0 and 1)] := MDS[0, p8x8[0, p8x8[0, L0[i]] xor B] xor A]; + sbox[0 and 2, 2 * i + (0 and 1) + 2] := MDS[0, p8x8[0, p8x8[0, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + Xor256(@L1, @p8x8[0], (sboxkeys[3] shr 8) and $FF); + i := 0; + while i < 256 do + begin + L0[i] := p8x8[1, L1[i]]; + L0[i + 1] := p8x8[1, L1[i + 1]]; + Inc(i, 2); + end; + Xor256(@L0, @L0, (sboxkeys[2] shr 8) and $FF); + A := (sboxkeys[0] shr 8) and $FF; + B := (sboxkeys[1] shr 8) and $FF; + i := 0; + while i < 256 do + begin + sbox[1 and 2, 2 * i + (1 and 1)] := MDS[1, p8x8[0, p8x8[1, L0[i]] xor B] xor A]; + sbox[1 and 2, 2 * i + (1 and 1) + 2] := MDS[1, p8x8[0, p8x8[1, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + + Xor256(@L1, @p8x8[0], (sboxkeys[3] shr 16) and $FF); + i := 0; + while i < 256 do + begin + L0[i] := p8x8[0, L1[i]]; + L0[i + 1] := p8x8[0, L1[i + 1]]; + Inc(i, 2); + end; + Xor256(@L0, @L0, (sboxkeys[2] shr 16) and $FF); + A := (sboxkeys[0] shr 16) and $FF; + B := (sboxkeys[1] shr 16) and $FF; + i := 0; + while i < 256 do + begin + sbox[2 and 2, 2 * i + (2 and 1)] := MDS[2, p8x8[1, p8x8[0, L0[i]] xor B] xor A]; + sbox[2 and 2, 2 * i + (2 and 1) + 2] := MDS[2, p8x8[1, p8x8[0, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + Xor256(@L1, @p8x8[1], (sboxkeys[3] shr 24)); + i := 0; + while i < 256 do + begin + L0[i] := p8x8[0, L1[i]]; + L0[i + 1] := p8x8[0, L1[i + 1]]; + Inc(i, 2); + end; + Xor256(@L0, @L0, (sboxkeys[2] shr 24)); + A := (sboxkeys[0] shr 24); + B := (sboxkeys[1] shr 24); + i := 0; + while i < 256 do + begin + sbox[3 and 2, 2 * i + (3 and 1)] := MDS[3, p8x8[1, p8x8[1, L0[i]] xor B] xor A]; + sbox[3 and 2, 2 * i + (3 and 1) + 2] := MDS[3, p8x8[1, p8x8[1, L0[i + 1]] xor B] xor A]; + Inc(i, 2); + end; + end; + end; +end; + +procedure TncEnc_twofish.Burn; +begin + FillChar(sbox, Sizeof(sbox), $FF); + FillChar(SubKeys, Sizeof(SubKeys), $FF); + inherited Burn; +end; + +procedure TncEnc_twofish.EncryptECB(const InData; var OutData); +var + i: longword; + t0, t1: UInt32; + x: array [0 .. 3] of UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + x[0] := PUInt32(@InData)^ xor SubKeys[INPUTWHITEN]; + x[1] := PUInt32(NativeUInt(@InData) + 4)^ xor SubKeys[INPUTWHITEN + 1]; + x[2] := PUInt32(NativeUInt(@InData) + 8)^ xor SubKeys[INPUTWHITEN + 2]; + x[3] := PUInt32(NativeUInt(@InData) + 12)^ xor SubKeys[INPUTWHITEN + 3]; + i := 0; + while i <= NUMROUNDS - 2 do + begin + t0 := sbox[0, (x[0] shl 1) and $1FE] xor sbox[0, ((x[0] shr 7) and $1FE) + 1] xor sbox[2, (x[0] shr 15) and $1FE] xor sbox[2, ((x[0] shr 23) and $1FE) + 1]; + t1 := sbox[0, ((x[1] shr 23) and $1FE)] xor sbox[0, ((x[1] shl 1) and $1FE) + 1] xor sbox[2, ((x[1] shr 7) and $1FE)] xor sbox[2, ((x[1] shr 15) and $1FE) + 1]; + x[3] := (x[3] shl 1) or (x[3] shr 31); + x[2] := x[2] xor (t0 + t1 + SubKeys[ROUNDSUBKEYS + 2 * i]); + x[3] := x[3] xor (t0 + 2 * t1 + SubKeys[ROUNDSUBKEYS + 2 * i + 1]); + x[2] := (x[2] shr 1) or (x[2] shl 31); + + t0 := sbox[0, (x[2] shl 1) and $1FE] xor sbox[0, ((x[2] shr 7) and $1FE) + 1] xor sbox[2, ((x[2] shr 15) and $1FE)] xor sbox[2, ((x[2] shr 23) and $1FE) + 1]; + t1 := sbox[0, ((x[3] shr 23) and $1FE)] xor sbox[0, ((x[3] shl 1) and $1FE) + 1] xor sbox[2, ((x[3] shr 7) and $1FE)] xor sbox[2, ((x[3] shr 15) and $1FE) + 1]; + x[1] := (x[1] shl 1) or (x[1] shr 31); + x[0] := x[0] xor (t0 + t1 + SubKeys[ROUNDSUBKEYS + 2 * (i + 1)]); + x[1] := x[1] xor (t0 + 2 * t1 + SubKeys[ROUNDSUBKEYS + 2 * (i + 1) + 1]); + x[0] := (x[0] shr 1) or (x[0] shl 31); + Inc(i, 2); + end; + PUInt32(NativeUInt(@OutData) + 0)^ := x[2] xor SubKeys[OUTPUTWHITEN]; + PUInt32(NativeUInt(@OutData) + 4)^ := x[3] xor SubKeys[OUTPUTWHITEN + 1]; + PUInt32(NativeUInt(@OutData) + 8)^ := x[0] xor SubKeys[OUTPUTWHITEN + 2]; + PUInt32(NativeUInt(@OutData) + 12)^ := x[1] xor SubKeys[OUTPUTWHITEN + 3]; +end; + +procedure TncEnc_twofish.DecryptECB(const InData; var OutData); +var + i: integer; + t0, t1: UInt32; + x: array [0 .. 3] of UInt32; +begin + if not FInitialized then + raise EEncBlockcipherException.Create(rsCipherNotInitialised); + x[2] := PUInt32(@InData)^ xor SubKeys[OUTPUTWHITEN]; + x[3] := PUInt32(NativeUInt(@InData) + 4)^ xor SubKeys[OUTPUTWHITEN + 1]; + x[0] := PUInt32(NativeUInt(@InData) + 8)^ xor SubKeys[OUTPUTWHITEN + 2]; + x[1] := PUInt32(NativeUInt(@InData) + 12)^ xor SubKeys[OUTPUTWHITEN + 3]; + i := NUMROUNDS - 2; + while i >= 0 do + begin + t0 := sbox[0, (x[2] shl 1) and $1FE] xor sbox[0, ((x[2] shr 7) and $1FE) + 1] xor sbox[2, ((x[2] shr 15) and $1FE)] xor sbox[2, ((x[2] shr 23) and $1FE) + 1]; + t1 := sbox[0, ((x[3] shr 23) and $1FE)] xor sbox[0, ((x[3] shl 1) and $1FE) + 1] xor sbox[2, ((x[3] shr 7) and $1FE)] xor sbox[2, ((x[3] shr 15) and $1FE) + 1]; + x[0] := (x[0] shl 1) or (x[0] shr 31); + x[0] := x[0] xor (t0 + t1 + SubKeys[ROUNDSUBKEYS + 2 * (i + 1)]); + x[1] := x[1] xor (t0 + 2 * t1 + SubKeys[ROUNDSUBKEYS + 2 * (i + 1) + 1]); + x[1] := (x[1] shr 1) or (x[1] shl 31); + + t0 := sbox[0, (x[0] shl 1) and $1FE] xor sbox[0, ((x[0] shr 7) and $1FE) + 1] xor sbox[2, (x[0] shr 15) and $1FE] xor sbox[2, ((x[0] shr 23) and $1FE) + 1]; + t1 := sbox[0, ((x[1] shr 23) and $1FE)] xor sbox[0, ((x[1] shl 1) and $1FE) + 1] xor sbox[2, ((x[1] shr 7) and $1FE)] xor sbox[2, ((x[1] shr 15) and $1FE) + 1]; + x[2] := (x[2] shl 1) or (x[2] shr 31); + x[2] := x[2] xor (t0 + t1 + SubKeys[ROUNDSUBKEYS + 2 * i]); + x[3] := x[3] xor (t0 + 2 * t1 + SubKeys[ROUNDSUBKEYS + 2 * i + 1]); + x[3] := (x[3] shr 1) or (x[3] shl 31); + Dec(i, 2); + end; + PUInt32(NativeUInt(@OutData) + 0)^ := x[0] xor SubKeys[INPUTWHITEN]; + PUInt32(NativeUInt(@OutData) + 4)^ := x[1] xor SubKeys[INPUTWHITEN + 1]; + PUInt32(NativeUInt(@OutData) + 8)^ := x[2] xor SubKeys[INPUTWHITEN + 2]; + PUInt32(NativeUInt(@OutData) + 12)^ := x[3] xor SubKeys[INPUTWHITEN + 3]; +end; + +procedure PreCompMDS; +var + m1, mx, my: array [0 .. 1] of UInt32; + nI: longword; +begin + for nI := 0 to 255 do + begin + m1[0] := p8x8[0, nI]; + mx[0] := Mul_X(m1[0]); + my[0] := Mul_Y(m1[0]); + m1[1] := p8x8[1, nI]; + mx[1] := Mul_X(m1[1]); + my[1] := Mul_Y(m1[1]); + MDS[0, nI] := (m1[1] shl 0) or (mx[1] shl 8) or (my[1] shl 16) or (my[1] shl 24); + MDS[1, nI] := (my[0] shl 0) or (my[0] shl 8) or (mx[0] shl 16) or (m1[0] shl 24); + MDS[2, nI] := (mx[1] shl 0) or (my[1] shl 8) or (m1[1] shl 16) or (my[1] shl 24); + MDS[3, nI] := (mx[0] shl 0) or (m1[0] shl 8) or (my[0] shl 16) or (mx[0] shl 24); + end; +end; + +constructor TncEnc_twofish.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + if not MDSDone then + begin + PreCompMDS; + MDSDone := true; + end; +end; + +initialization + +MDSDone := false; + +end. diff --git a/Source_using_TMonitor/NetComRegister.dcr b/Source_using_TMonitor/NetComRegister.dcr new file mode 100644 index 0000000..da53b4b Binary files /dev/null and b/Source_using_TMonitor/NetComRegister.dcr differ diff --git a/Source_using_TMonitor/NetComRegister.pas b/Source_using_TMonitor/NetComRegister.pas new file mode 100644 index 0000000..12fa95a --- /dev/null +++ b/Source_using_TMonitor/NetComRegister.pas @@ -0,0 +1,240 @@ +unit NetComRegister; + +interface + +uses + WinApi.Windows, System.Classes, System.SysUtils, ToolsAPI, DesignIntf, DesignEditors, + ncSockets, ncSocketsDual, ncSources, ncSocketsThd, ncCommandHandlers, ncDBSrv, ncDBCnt, + ncUDPSockets, ncUDPSocketsLCP, ncUDPSocketsDual; + +type + TncTCPSocketDefaultEditor = class(TDefaultEditor) + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncUDPSocketDefaultEditor = class(TDefaultEditor) // Added UDP editor + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncUDPSocketLCPDefaultEditor = class(TDefaultEditor) // Added UDP LCP editor + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncUDPSocketDualDefaultEditor = class(TDefaultEditor) // Added UDP Dual editor + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + + TncSourceDefaultEditor = class(TDefaultEditor) + public + procedure EditProperty(const Prop: IProperty; var Continue: Boolean); override; + end; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('NetCom7', [ + TncTCPServer, + TncTCPClient, + TncTCPServerDual, // Dual enhanced socket components + TncTCPClientDual, + TncTCPServerThd, // Threaded socket components + TncTCPClientThd, + TncUDPServer, // Raw UDP components + TncUDPClient, + TncUDPServerLCP, // LCP-only UDP components + TncUDPClientLCP, + TncUDPServerDual, // Dual-mode UDP components + TncUDPClientDual, + TncServerSource, + TncClientSource, + TncCommandHandler, + TncDBServer, + TncDBDataset + ]); + + RegisterComponentEditor(TncTCPServer, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncTCPClient, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncTCPServerDual, TncTCPSocketDefaultEditor); // Dual enhanced socket editors + RegisterComponentEditor(TncTCPClientDual, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncTCPServerThd, TncTCPSocketDefaultEditor); // Threaded socket editors + RegisterComponentEditor(TncTCPClientThd, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncUDPServer, TncUDPSocketDefaultEditor); // Raw UDP editors + RegisterComponentEditor(TncUDPClient, TncUDPSocketDefaultEditor); + RegisterComponentEditor(TncUDPServerLCP, TncUDPSocketLCPDefaultEditor); // LCP UDP editors + RegisterComponentEditor(TncUDPClientLCP, TncUDPSocketLCPDefaultEditor); + RegisterComponentEditor(TncUDPServerDual, TncUDPSocketDualDefaultEditor); // Dual UDP editors + RegisterComponentEditor(TncUDPClientDual, TncUDPSocketDualDefaultEditor); + RegisterComponentEditor(TncServerSource, TncSourceDefaultEditor); + RegisterComponentEditor(TncClientSource, TncSourceDefaultEditor); + + UnlistPublishedProperty(TncDBDataset, 'Connection'); + UnlistPublishedProperty(TncDBDataset, 'ConnectionString'); + RegisterPropertyEditor(TypeInfo(string), TncDBDataset, 'ConnectionString', nil); + + ForceDemandLoadState(dlDisable); +end; + +function GetVersion(aMinor: Boolean = True; aRelease: Boolean = True; aBuild: Boolean = True): string; +var + VerInfoSize: DWORD; + VerInfo: Pointer; + VerValueSize: DWORD; + VerValue: PVSFixedFileInfo; + Dummy: DWORD; + strBuffer: array [0 .. MAX_PATH] of Char; +begin + GetModuleFileName(hInstance, strBuffer, MAX_PATH); + VerInfoSize := GetFileVersionInfoSize(strBuffer, Dummy); + if VerInfoSize <> 0 then + begin + GetMem(VerInfo, VerInfoSize); + try + GetFileVersionInfo(strBuffer, 0, VerInfoSize, VerInfo); + VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); + with VerValue^ do + begin + Result := IntToStr(dwFileVersionMS shr 16); // Major always there + if aMinor then + Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF); + if aRelease then + Result := Result + '.' + IntToStr(dwFileVersionLS shr 16); + if aBuild then + Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF); + end; + finally + FreeMem(VerInfo, VerInfoSize); + end; + end + else + Result := '1.0.0.0'; +end; + +const + ICON_SPLASH = 'TNCICON'; + ICON_ABOUT = 'TNCICON'; + +var + AboutBoxServices: IOTAAboutBoxServices = nil; + AboutBoxIndex: Integer = 0; + +resourcestring + resPackageName = 'NetCom7 Network Communications Framework'; + resLicence = 'Full Edition for RAD Studio'; + resAboutCopyright = 'Copyright @ 2020 Bill Demos (VasDemos@yahoo.co.uk)'; + resAboutDescription = + 'Netcom7 Communicatios Framework enables you to use communication components with the ease of use of the Delphi programming language. Create and handle client/server sockets, sources and DB elements with no single line of API calls.'; + +procedure RegisterSplashScreen; +var + SplashScreenHandle: HBitmap; +begin + SplashScreenHandle := LoadBitmap(hInstance, ICON_SPLASH); + try + SplashScreenServices.AddPluginBitmap(resPackageName + ' ' + GetVersion, SplashScreenHandle, False, resLicence); + finally + DeleteObject(SplashScreenHandle); + end; +end; + +procedure RegisterAboutBox; +var + ProductImage: HBitmap; +begin + Supports(BorlandIDEServices, IOTAAboutBoxServices, AboutBoxServices); + ProductImage := LoadBitmap(FindResourceHInstance(hInstance), ICON_ABOUT); + AboutBoxIndex := AboutBoxServices.AddPluginInfo(resPackageName + GetVersion, + resAboutCopyright + #13#10 + resAboutDescription, ProductImage, False, resLicence); +end; + +procedure UnregisterAboutBox; +begin + if (AboutBoxIndex <> 0) and Assigned(AboutBoxServices) then + begin + AboutBoxServices.RemovePluginInfo(AboutBoxIndex); + AboutBoxIndex := 0; + AboutBoxServices := nil; + end; +end; + +{ TncTCPSocketDefaultEditor } + +procedure TncTCPSocketDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONREADDATA') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncUDPSocketDefaultEditor } // Added UDP editor implementation + +procedure TncUDPSocketDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONREADDATAGRAM') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncUDPSocketLCPDefaultEditor } // Added UDP LCP editor implementation + +procedure TncUDPSocketLCPDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONCOMMAND') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncUDPSocketDualDefaultEditor } // Added UDP Dual editor implementation + +procedure TncUDPSocketDualDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if (CompareText(Prop.GetName, 'ONREADDATAGRAM') = 0) or + (CompareText(Prop.GetName, 'ONCOMMAND') = 0) then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +{ TncSourceDefaultEditor } + +procedure TncSourceDefaultEditor.EditProperty(const Prop: IProperty; var Continue: Boolean); +begin + if CompareText(Prop.GetName, 'ONHANDLECOMMAND') = 0 then + begin + Prop.Edit; + Continue := False; + end + else + inherited; +end; + +initialization + RegisterSplashScreen; + RegisterAboutBox; + +finalization + UnregisterAboutBox; + +end. + diff --git a/Source_using_TMonitor/ncCommandHandlers.pas b/Source_using_TMonitor/ncCommandHandlers.pas new file mode 100644 index 0000000..508bc3d --- /dev/null +++ b/Source_using_TMonitor/ncCommandHandlers.pas @@ -0,0 +1,183 @@ +unit ncCommandHandlers; + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.SysUtils, System.SyncObjs, System.Rtti, ncSources; + +type + TncCustomCommandHandler = class(TComponent, IncCommandHandler) + private + FSource: TncSourceBase; + FPeerCommandHandler: string; + FOnConnected: TncOnSourceConnectDisconnect; + FOnDisconnected: TncOnSourceConnectDisconnect; + FOnHandleCommand: TncOnSourceHandleCommand; + FOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; + procedure SetSource(const Value: TncSourceBase); + function GetPeerCommandHandler: string; + procedure SetPeerCommandHandler(const Value: string); + function GetOnConnected: TncOnSourceConnectDisconnect; + procedure SetOnConnected(const Value: TncOnSourceConnectDisconnect); + function GetOnDisconnected: TncOnSourceConnectDisconnect; + procedure SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); + function GetOnHandleCommand: TncOnSourceHandleCommand; + procedure SetOnHandleCommand(const Value: TncOnSourceHandleCommand); + function GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; + procedure SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + function GetComponentName: string; + + property Source: TncSourceBase read FSource write SetSource; + property PeerCommandHandler: string read GetPeerCommandHandler write SetPeerCommandHandler; + property OnConnected: TncOnSourceConnectDisconnect read GetOnConnected write SetOnConnected; + property OnDisconnected: TncOnSourceConnectDisconnect read GetOnDisconnected write SetOnDisconnected; + property OnHandleCommand: TncOnSourceHandleCommand read GetOnHandleCommand write SetOnHandleCommand; + property OnAsyncExecCommandResult: TncOnAsyncExecCommandResult read GetOnAsyncExecCommandResult write SetOnAsyncExecCommandResult; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function ExecCommand(aLine: TncSourceLine; const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; + aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''): TBytes; + published + end; + + TncCommandHandler = class(TncCustomCommandHandler) + published + property Source; + property PeerCommandHandler; + + property OnConnected; + property OnDisconnected; + property OnHandleCommand; + end; + +implementation + +{ TncCustomCommandHandler } + +constructor TncCustomCommandHandler.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FSource := nil; + FOnConnected := nil; + FOnDisconnected := nil; + FOnHandleCommand := nil; + FOnAsyncExecCommandResult := nil; +end; + +destructor TncCustomCommandHandler.Destroy; +begin + Source := nil; + inherited Destroy; +end; + +procedure TncCustomCommandHandler.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + + if Operation = opRemove then + if AComponent = FSource then + SetSource(nil); + + if not(csLoading in ComponentState) then + begin + if Operation = opInsert then + if not Assigned(FSource) then + if AComponent is TncSourceBase then + SetSource(TncSourceBase(AComponent)); + end; +end; + +function TncCustomCommandHandler.ExecCommand(aLine: TncSourceLine; const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; + aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''): TBytes; +begin + if not Assigned(Source) then + raise Exception.Create('Cannot execute with no source object'); + + // If no override, we use the component's command handler (the property) + if aPeerComponentHandler = '' then + Result := Source.ExecCommand(aLine, aCmd, aData, aRequiresResult, aAsyncExecute, PeerCommandHandler) + else + Result := Source.ExecCommand(aLine, aCmd, aData, aRequiresResult, aAsyncExecute, aPeerComponentHandler); +end; + +procedure TncCustomCommandHandler.SetSource(const Value: TncSourceBase); +begin + if FSource <> Value then + begin + if Assigned(FSource) then + FSource.RemoveCommandHandler(Self); + + FSource := Value; + + if Assigned(FSource) then + FSource.AddCommandHandler(Self); + end; +end; + +function TncCustomCommandHandler.GetPeerCommandHandler: string; +begin + Result := FPeerCommandHandler; +end; + +procedure TncCustomCommandHandler.SetPeerCommandHandler(const Value: string); +begin + FPeerCommandHandler := Value; +end; + +function TncCustomCommandHandler.GetComponentName: string; +begin + Result := Name; +end; + +function TncCustomCommandHandler.GetOnConnected: TncOnSourceConnectDisconnect; +begin + Result := FOnConnected; +end; + +procedure TncCustomCommandHandler.SetOnConnected(const Value: TncOnSourceConnectDisconnect); +begin + FOnConnected := Value; +end; + +function TncCustomCommandHandler.GetOnDisconnected: TncOnSourceConnectDisconnect; +begin + Result := FOnDisconnected; +end; + +procedure TncCustomCommandHandler.SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); +begin + FOnDisconnected := Value; +end; + +function TncCustomCommandHandler.GetOnHandleCommand: TncOnSourceHandleCommand; +begin + Result := FOnHandleCommand; +end; + +procedure TncCustomCommandHandler.SetOnHandleCommand(const Value: TncOnSourceHandleCommand); +begin + FOnHandleCommand := Value; +end; + +function TncCustomCommandHandler.GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; +begin + Result := FOnAsyncExecCommandResult; +end; + +procedure TncCustomCommandHandler.SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); +begin + FOnAsyncExecCommandResult := Value; +end; + +end. diff --git a/Source_using_TMonitor/ncCommandPacking.pas b/Source_using_TMonitor/ncCommandPacking.pas new file mode 100644 index 0000000..747f2e1 --- /dev/null +++ b/Source_using_TMonitor/ncCommandPacking.pas @@ -0,0 +1,262 @@ +unit ncCommandPacking; + +/// //////////////////////////////////////////////////////////////////////////// +// +// TSocketList +// +// This unit declares a TncCommand which is used by ncSources to pass +// information from peer to peer. +// The TncCommand can be packed and unnpacked into and from a TBytes array +// +// This unit has been optimised to perform at maximum speed by checking the +// assembly the compiler generates. +// +// Written by Demos Bill +// 7/8/2020 +// - Optimised code by checking assembly. The performance of executing 100000 +// times a command with data: 'Hello from Client', and compression on, was +// before optimisation: 57532 msec +// after optimisation: 19383 msec +// performance gain: 2,97 times faster. +// With compression off we can execute 100000 command executions +// in 5438 msec +// This performance testing was made before ncSources were re-engineered. +// Please check ncSources to see what the new performance is after +// latest re-engineering. +// - Initial Creation: Ported code from ncSources +// +/// //////////////////////////////////////////////////////////////////////////// + +interface + +uses SysUtils; + +type + ENetComImproperMessageEncoding = class(Exception); + + TncCommandType = (ctInitiator, ctResponse); + PncCommandType = ^TncCommandType; + + TncCommandUniqueID = UInt32; + PncCommandUniqueID = ^TncCommandUniqueID; + + TncCommandCmd = UInt32; + PncCommandCmd = ^TncCommandCmd; + + TncCommand = record + public + CommandType: TncCommandType; + UniqueID: TncCommandUniqueID; + Cmd: TncCommandCmd; + Data: TBytes; + RequiresResult: Boolean; + AsyncExecute: Boolean; + ResultIsErrorString: Boolean; + SourceComponentHandler: string; + PeerComponentHandler: string; + + procedure FromBytes(const aBytes: TBytes); + function ToBytes: TBytes; + end; + +resourcestring + ENetComImproperMessageEncodingMessage = 'Improper message encoding'; + +implementation + +// ///////////////////////////////////////////////////////////////////////////// +{ TncCommand } +// ///////////////////////////////////////////////////////////////////////////// + +procedure TncCommand.FromBytes(const aBytes: TBytes); +type + PBool = ^Boolean; + PInt32 = ^Int32; + PUInt64 = ^UInt64; + +const + SigLen = SizeOf(Byte); + BytesLen = SizeOf(UInt64); + + CommandTypeLen = SizeOf(TncCommandType); + UniqueIDLen = SizeOf(TncCommandUniqueID); + CmdLen = SizeOf(TncCommandCmd); + AsyncExecuteLen = SizeOf(Boolean); + RequiresResultLen = SizeOf(Boolean); + ResultIsErrorStringLen = SizeOf(Boolean); + +var + AddrPtr: PByte; + DataBytesLen, SourceComponentBytesLen, PeerComponentBytesLen: UInt64; + StrBytes: TBytes; + +begin + // Point to beginning of aBytes + AddrPtr := @aBytes[0]; + + // Read command type + CommandType := PncCommandType(AddrPtr)^; + inc(AddrPtr, CommandTypeLen); + // Read UniqueID + UniqueID := PncCommandUniqueID(AddrPtr)^; + inc(AddrPtr, UniqueIDLen); + // Read Cmd + Cmd := PncCommandCmd(AddrPtr)^; + inc(AddrPtr, CmdLen); + // Read AsyncExecute + AsyncExecute := PBool(AddrPtr)^; + inc(AddrPtr, AsyncExecuteLen); + // Read RequiresResult + RequiresResult := PBool(AddrPtr)^; + inc(AddrPtr, RequiresResultLen); + // Read ResultIsErrorString + ResultIsErrorString := PBool(AddrPtr)^; + inc(AddrPtr, ResultIsErrorStringLen); + + // Read Signature + if PByte(AddrPtr)^ <> $AA then // 10101010 bin + raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); + inc(AddrPtr, SigLen); + // Read DataLen + DataBytesLen := PUInt64(AddrPtr)^; + inc(AddrPtr, BytesLen); + + // Read Signature + if PByte(AddrPtr)^ <> $AA then // 10101010 bin + raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); + inc(AddrPtr, SigLen); + // Read SourceComponentHandlerBytesLen + SourceComponentBytesLen := PUInt64(AddrPtr)^; + inc(AddrPtr, BytesLen); + + // Read Signature + if PByte(AddrPtr)^ <> $AA then // 10101010 bin + raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); + inc(AddrPtr, SigLen); + // Read PeerComponentHandlerBytesLen + PeerComponentBytesLen := PUInt64(AddrPtr)^; + inc(AddrPtr, BytesLen); + + // Read Data + if DataBytesLen > 0 then + begin + SetLength(Data, DataBytesLen); + move(AddrPtr^, Data[0], DataBytesLen); + inc(AddrPtr, DataBytesLen); + end; + // Read SourceComponentHandlerBytes + if SourceComponentBytesLen > 0 then + begin + SetLength(StrBytes, SourceComponentBytesLen); + move(AddrPtr^, StrBytes[0], SourceComponentBytesLen); + SourceComponentHandler := StringOf(StrBytes); + inc(AddrPtr, SourceComponentBytesLen); + end; + // Read PeerComponentHandlerBytes + if PeerComponentBytesLen > 0 then + begin + SetLength(StrBytes, PeerComponentBytesLen); + move(AddrPtr^, StrBytes[0], PeerComponentBytesLen); + PeerComponentHandler := StringOf(StrBytes); + end; +end; + +function TncCommand.ToBytes: TBytes; +type + PBool = ^Boolean; + PInt32 = ^Int32; + PUInt64 = ^UInt64; + +const + SigLen = SizeOf(Byte); + BytesLen = SizeOf(UInt64); + + CommandTypeLen = SizeOf(TncCommandType); + UniqueIDLen = SizeOf(TncCommandUniqueID); + CmdLen = SizeOf(TncCommandCmd); + AsyncExecuteLen = SizeOf(Boolean); + RequiresResultLen = SizeOf(Boolean); + ResultIsErrorStringLen = SizeOf(Boolean); + + StaticBufferLen = + + UInt64(CommandTypeLen + UniqueIDLen + CmdLen + AsyncExecuteLen + RequiresResultLen + ResultIsErrorStringLen + + + SigLen + BytesLen + SigLen + BytesLen + SigLen + BytesLen); + +var + AddrPtr: PByte; + DataBytesLen, SourceComponentBytesLen, PeerComponentBytesLen: UInt64; + SourceComponentHandlerBytes, PeerComponentHandlerBytes: TBytes; + +begin + SourceComponentHandlerBytes := BytesOf(SourceComponentHandler); + PeerComponentHandlerBytes := BytesOf(PeerComponentHandler); + + DataBytesLen := Length(Data); + SourceComponentBytesLen := Length(SourceComponentHandlerBytes); + PeerComponentBytesLen := Length(PeerComponentHandlerBytes); + + SetLength(Result, StaticBufferLen + DataBytesLen + SourceComponentBytesLen + PeerComponentBytesLen); + + // Point to beginning of result buffer + AddrPtr := @Result[0]; + + // Write command type + PncCommandType(AddrPtr)^ := CommandType; + inc(AddrPtr, CommandTypeLen); + // Write UniqueID + PncCommandUniqueID(AddrPtr)^ := UniqueID; + inc(AddrPtr, UniqueIDLen); + // Write Cmd + PncCommandCmd(AddrPtr)^ := Cmd; + inc(AddrPtr, CmdLen); + // Write AnyncExecute + PBool(AddrPtr)^ := AsyncExecute; + inc(AddrPtr, AsyncExecuteLen); + // Write RequiresResult + PBool(AddrPtr)^ := RequiresResult; + inc(AddrPtr, RequiresResultLen); + // Write ResultIsErrorString + PBool(AddrPtr)^ := ResultIsErrorString; + inc(AddrPtr, ResultIsErrorStringLen); + + // Write Signature + PByte(AddrPtr)^ := $AA; // 10101010 bin + inc(AddrPtr, SigLen); + // Write DataLen + PUInt64(AddrPtr)^ := DataBytesLen; + inc(AddrPtr, BytesLen); + + // Write Signature + PByte(AddrPtr)^ := $AA; // 10101010 bin + inc(AddrPtr, SigLen); + // Write SourceComponentHandlerBytesLen + PUInt64(AddrPtr)^ := SourceComponentBytesLen; + inc(AddrPtr, BytesLen); + + // Write Signature + PByte(AddrPtr)^ := $AA; // 10101010 bin + inc(AddrPtr, SigLen); + // Write PeerComponentHandlerBytesLen + PUInt64(AddrPtr)^ := PeerComponentBytesLen; + inc(AddrPtr, BytesLen); + + // Write Data + if DataBytesLen > 0 then + begin + move(Data[0], AddrPtr^, DataBytesLen); + inc(AddrPtr, DataBytesLen); + end; + // Write SourceComponentHandlerBytes + if SourceComponentBytesLen > 0 then + begin + move(SourceComponentHandlerBytes[0], AddrPtr^, SourceComponentBytesLen); + inc(AddrPtr, SourceComponentBytesLen); + end; + // Write PeerComponentHandlerBytes + if PeerComponentBytesLen > 0 then + move(PeerComponentHandlerBytes[0], AddrPtr^, PeerComponentBytesLen); +end; + +end. diff --git a/Source_using_TMonitor/ncCompression.pas b/Source_using_TMonitor/ncCompression.pas new file mode 100644 index 0000000..4db0ca6 --- /dev/null +++ b/Source_using_TMonitor/ncCompression.pas @@ -0,0 +1,38 @@ +unit ncCompression; + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses System.ZLib, System.Classes, System.SysUtils; + +type + TncCompressionLevel = TZCompressionLevel; + +function CompressBytes(const aBytes: TBytes; aCompressionLevel: TncCompressionLevel = zcDefault): TBytes; +function DecompressBytes(const aBytes: TBytes): TBytes; + +implementation + +function CompressBytes(const aBytes: TBytes; aCompressionLevel: TncCompressionLevel = zcDefault): TBytes; +begin + if Length(aBytes) > 0 then + ZCompress(aBytes, Result, aCompressionLevel) + else + SetLength(Result, 0); +end; + +function DecompressBytes(const aBytes: TBytes): TBytes; +begin + if Length(aBytes) > 0 then + ZDecompress(aBytes, Result, Length(aBytes) * 128) + else + SetLength(Result, 0); +end; + +end. diff --git a/Source_using_TMonitor/ncDBCnt.pas b/Source_using_TMonitor/ncDBCnt.pas new file mode 100644 index 0000000..26304b7 --- /dev/null +++ b/Source_using_TMonitor/ncDBCnt.pas @@ -0,0 +1,550 @@ +unit ncDBCnt; + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + Windows, Classes, SysUtils, SyncObjs, + Variants, ncSources, ncCommandHandlers, DB, ADOInt, ADODB, ActiveX, ncSerializeADO, ncDBCommands; + +type + TncDBDataset = class(TCustomADODataSet, IncCommandHandler) + private + WasActivated: Boolean; + procedure UpdateSQLParams; + private + FSQL: TStrings; + FSource: TncClientSource; + FPeerCommandHandler: string; + + BeforeUpdatesRecordIndex: Integer; + + function GetSQL: TStrings; + procedure SetSQL(const Value: TStrings); + function GetPeerCommandHandler: string; + procedure SetPeerCommandHandler(const Value: string); + procedure SetSource(const Value: TncClientSource); + + function GetOnConnected: TncOnSourceConnectDisconnect; + procedure SetOnConnected(const Value: TncOnSourceConnectDisconnect); + function GetOnDisconnected: TncOnSourceConnectDisconnect; + procedure SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); + function GetOnHandleCommand: TncOnSourceHandleCommand; + procedure SetOnHandleCommand(const Value: TncOnSourceHandleCommand); + function GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; + procedure SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); + protected + WithinUpdates: Boolean; + + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure Loaded; override; + + procedure InitializeMasterFieldsNew; + procedure RefreshParams; + procedure MasterChanged(Sender: TObject); override; + procedure SQLChanged(Sender: TObject); + + procedure OpenCursor(InfoQuery: Boolean); override; + procedure InternalRefresh; override; + + procedure InternalApplyUpdates; + + procedure DoBeforeEdit; override; + procedure DoBeforeInsert; override; + procedure DoBeforeDelete; override; + procedure DoAfterPost; override; + procedure DoAfterDelete; override; + + function GetComponentName: string; + property OnHandleCommand: TncOnSourceHandleCommand read GetOnHandleCommand write SetOnHandleCommand; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure FetchRemoteDataset; + + procedure Requery; + function ExecSQL: Integer; + + procedure BeginUpdates; + procedure ApplyUpdates; + procedure CancelUpdates; + + published + property Active; // : Boolean read GetActive write SetActive default False; + property Source: TncClientSource read FSource write SetSource; + property PeerCommandHandler: string read GetPeerCommandHandler write SetPeerCommandHandler; + property SQL: TStrings read GetSQL write SetSQL; + property DataSource; + property IndexFieldNames; + property Parameters; + end; + +implementation + +{ TncDBDataset } + +constructor TncDBDataset.Create(AOwner: TComponent); +begin + inherited; + + WasActivated := False; + + FSQL := TStringList.Create; + TStringList(FSQL).OnChange := SQLChanged; + + CursorLocation := clUseClient; + LockType := ltBatchOptimistic; + // This is the type also returned from BytesToRecordset used in this component + // to stream back the contents from server + CommandType := cmdFile; + + WithinUpdates := False; +end; + +destructor TncDBDataset.Destroy; +begin + Active := False; + Source := nil; + FSQL.Free; + + inherited; +end; + +procedure TncDBDataset.SQLChanged(Sender: TObject); +begin + if not(csLoading in ComponentState) then + Active := False; + UpdateSQLParams; +end; + +procedure TncDBDataset.UpdateSQLParams; +begin + Parameters.ParseSQL(FSQL.Text, True); +end; + +function TncDBDataset.GetComponentName: string; +begin + Result := Name; +end; + +function TncDBDataset.GetOnConnected: TncOnSourceConnectDisconnect; +begin + // Does nothing + Result := nil; +end; + +procedure TncDBDataset.SetOnConnected(const Value: TncOnSourceConnectDisconnect); +begin + // Does nothing +end; + +function TncDBDataset.GetOnDisconnected: TncOnSourceConnectDisconnect; +begin + // Does nothing + Result := nil; +end; + +procedure TncDBDataset.SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); +begin + // Does nothing +end; + +function TncDBDataset.GetOnHandleCommand: TncOnSourceHandleCommand; +begin + // Does nothing + Result := nil; +end; + +procedure TncDBDataset.SetOnHandleCommand(const Value: TncOnSourceHandleCommand); +begin + // Does nothing +end; + +function TncDBDataset.GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; +begin + // Does nothing + Result := nil; +end; + +procedure TncDBDataset.SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); +begin + // Does nothing +end; + +procedure TncDBDataset.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + + if Operation = opRemove then + if AComponent = FSource then + SetSource(nil); + + if not(csLoading in ComponentState) then + begin + if Operation = opInsert then + if not Assigned(FSource) then + if AComponent is TncClientSource then + SetSource(TncClientSource(AComponent)); + end; +end; + +procedure TncDBDataset.Loaded; +begin + inherited; + + if WasActivated then + Active := True; +end; + +procedure TncDBDataset.MasterChanged(Sender: TObject); +begin + if not Active then + Exit; + if Parameters.Count = 0 then + begin + CheckBrowseMode; + if SetDetailFilter then + First; + end + else + RefreshParams; +end; + +procedure TncDBDataset.InitializeMasterFieldsNew; +var + I: Integer; + MasterFieldList: string; +begin + { Assign MasterFields from parameters as needed by the MasterDataLink } + if (Parameters.Count > 0) and Assigned(MasterDataLink.DataSource) and Assigned(MasterDataLink.DataSource.DataSet) then + begin + for I := 0 to Parameters.Count - 1 do + if (Parameters[I].Direction in [pdInput, pdInputOutput]) and (MasterDataLink.DataSource.DataSet.FindField(Parameters[I].Name) <> nil) then + MasterFieldList := MasterFieldList + Parameters[I].Name + ';'; + MasterFields := Copy(MasterFieldList, 1, Length(MasterFieldList) - 1); + SetParamsFromCursor; + end; +end; + +procedure TncDBDataset.RefreshParams; +var + DataSet: TDataSet; + + function FieldValueChanged(const V1, V2: Variant): Boolean; + begin + // RTL doesn't support comparison of VT_DECIMAL variants, so convert those to strings first. + // Fixes QC# 50327. + if (VarType(V1) = VT_DECIMAL) or (VarType(V2) = VT_DECIMAL) then + Result := not SameStr(VarToStr(V1), VarToStr(V2)) + else + Result := V1 <> V2; + end; + + function MasterFieldsChanged: Boolean; + var + I: Integer; + MasterField: TField; + begin + Result := False; + if MasterDataLink.DataSource <> nil then + for I := 0 to MasterDataLink.Fields.Count - 1 do + begin + MasterField := TField(MasterDataLink.Fields[I]); + if FieldValueChanged(Parameters.ParamByName(MasterField.FieldName).Value, MasterField.Value) then + begin + Result := True; + break; + end; + end; + end; + +begin + DisableControls; + try + if MasterDataLink.DataSource <> nil then + begin + DataSet := MasterDataLink.DataSource.DataSet; + if DataSet <> nil then + if DataSet.Active and (DataSet.State <> dsSetKey) and MasterFieldsChanged then + begin + SetParamsFromCursor; + Requery; + end; + end; + finally + EnableControls; + end; +end; + +procedure TncDBDataset.DoBeforeEdit; +begin + BeforeUpdatesRecordIndex := RecNo; + inherited; +end; + +procedure TncDBDataset.DoBeforeInsert; +begin + BeforeUpdatesRecordIndex := RecNo; + inherited; +end; + +procedure TncDBDataset.DoBeforeDelete; +begin + BeforeUpdatesRecordIndex := RecNo; + inherited; +end; + +procedure TncDBDataset.DoAfterPost; +begin + // If we are not within a transaction, apply commits on the fly + if not WithinUpdates then + try + InternalApplyUpdates; + except + CancelUpdates; + raise; + end; + + inherited; +end; + +procedure TncDBDataset.DoAfterDelete; +begin + // If we are not within a transaction, delete commits on the fly + if not WithinUpdates then + try + InternalApplyUpdates; + except + CancelUpdates; + raise; + end; + + inherited; +end; + +procedure TncDBDataset.FetchRemoteDataset; +var + CommandData: TDBDatasetData; + Data: TBytes; + // PrevBk: TBytes; + // CurrRec: Integer; +begin + // Make sure we establish the comms + if not Assigned(Source) then + raise Exception.Create('Source component not specified'); + if Trim(Name) = '' then + raise Exception.Create('TncDBDataset cannot activate without component name'); + + CommandData := TDBDatasetData.Create; + try + // Set the MasterFields property and also get the data for the parameter + // from the DataSource's equivalent + InitializeMasterFieldsNew; + + // Send the SQL and Parameters and retrieve the table back + CommandData.SQL := SQL.Text; + CommandData.Parameters := ParametersToBytes(Parameters); + + Data := Source.ExecCommand(ncDBOpenDataset, CommandData.ToBytes, True, False, PeerCommandHandler, Name); + + finally + CommandData.Free; + end; + Recordset := BytesToRecordset(Data); +end; + +procedure TncDBDataset.OpenCursor(InfoQuery: Boolean); +begin + if not Assigned(Recordset) then + FetchRemoteDataset + else + inherited OpenCursor(InfoQuery); +end; + +// For close cursor we could have: +// if Source.Active then +// try +// Source.ExecCommand(ncDBCloseDataset, nil, True, PeerCommandHandler, Name); +// except +// end; + +procedure TncDBDataset.InternalRefresh; +begin + Requery; + DestroyLookupCursor; +end; + +procedure TncDBDataset.Requery; +var + PrevRecNo: Integer; +begin + PrevRecNo := RecNo; + DisableControls; + try + FetchRemoteDataset; + if (PrevRecNo > 0) and (PrevRecNo <= RecordCount) then + RecNo := PrevRecNo; + finally + EnableControls; + end; +end; + +procedure TncDBDataset.BeginUpdates; +begin + WithinUpdates := True; + BeforeUpdatesRecordIndex := RecNo; +end; + +procedure TncDBDataset.CancelUpdates; +begin + // TODO: DisableControls + Recordset.CancelBatch(adAffectAll); + Resync([]); + RecNo := BeforeUpdatesRecordIndex; + + WithinUpdates := False; +end; + +procedure TncDBDataset.ApplyUpdates; +begin + InternalApplyUpdates; + + WithinUpdates := False; +end; + +procedure TncDBDataset.InternalApplyUpdates; +var + UpdateData: TDBUpdateDatasetData; + AppliedUpdatesRS: _Recordset; + I: Integer; + CannotUpdate: Boolean; +begin + CheckBrowseMode; + CannotUpdate := False; + + DisableControls; + try + Recordset.MarshalOptions := adMarshalModifiedOnly; + Recordset.Filter := adFilterPendingRecords; + try + if Recordset.RecordCount > 0 then // there exist updates + begin + UpdateData := TDBUpdateDatasetData.Create; + try + UpdateData.SQL := SQL.Text; + UpdateData.Parameters := ParametersToBytes(Parameters); + UpdateData.RecordUpdates := Recordset; + + // Send the updates and get back the updated updates + + AppliedUpdatesRS := BytesToRecordset(Source.ExecCommand(ncDBUpdateDataset, UpdateData.ToBytes, True, False, PeerCommandHandler, Name), nil); + finally + UpdateData.Free; + end; + + // Flatten local updates one by one, copying refreshed values from AppliedUpdates + Recordset.MoveFirst; + while not Recordset.EOF do + try + if Recordset.Status in [adRecNew, adRecModified] then + begin + // Copy field by field + CannotUpdate := False; + for I := 0 to Recordset.Fields.Count - 1 do + try + Recordset.Fields.Item[I].Value := AppliedUpdatesRS.Fields.Item[I].Value; + except + // We have tried to assign to a readonly field + // Silence off exception. This means a field could not be updated (SQL AutoInc) + // If Field is SQLServer & IDENTITY/AutoInc then should delete the field add it again as Integer. + // When this is fixed the CannotUpdate must be removed... + + if Recordset.Fields.Item[I].Value <> AppliedUpdatesRS.Fields.Item[I].Value then + CannotUpdate := True; + end; + AppliedUpdatesRS.MoveNext; + end; + + // Flatten local record with updated updates + Recordset.UpdateBatch(adAffectCurrent); + finally + Recordset.MoveNext; + end; + end; + finally + Recordset.Filter := adFilterNone; + end; + + // Refresh the displaying data + UpdateCursorPos; + DestroyLookupCursor; + Resync([]); + finally + EnableControls; + end; + + // Temporary (see ToDo comment on the middle of the function.) Just make sure that even if something fails, the data are correct/refresh from server + if CannotUpdate then + Refresh; +end; + +function TncDBDataset.ExecSQL: Integer; +var + CommandData: TDBDatasetData; +begin + CommandData := TDBDatasetData.Create; + try + // Set the MasterFields property and also get the data for the parameter + // from the DataSource's equivalent + InitializeMasterFieldsNew; + + CommandData.SQL := SQL.Text; + CommandData.Parameters := ParametersToBytes(Parameters); + Result := StrToInt(StringOf(Source.ExecCommand(ncDBExecDataset, CommandData.ToBytes, True, False, PeerCommandHandler, Name))); + finally + CommandData.Free; + end; +end; + +function TncDBDataset.GetSQL: TStrings; +begin + Result := FSQL; +end; + +procedure TncDBDataset.SetSQL(const Value: TStrings); +begin + FSQL.Assign(Value); +end; + +procedure TncDBDataset.SetSource(const Value: TncClientSource); +begin + if FSource <> Value then + begin + if Assigned(FSource) then + FSource.RemoveCommandHandler(Self); + + FSource := Value; + + if Assigned(FSource) then + FSource.AddCommandHandler(Self); + end; +end; + +function TncDBDataset.GetPeerCommandHandler: string; +begin + Result := FPeerCommandHandler; +end; + +procedure TncDBDataset.SetPeerCommandHandler(const Value: string); +begin + FPeerCommandHandler := Value; +end; + +end. diff --git a/Source_using_TMonitor/ncDBCommands.pas b/Source_using_TMonitor/ncDBCommands.pas new file mode 100644 index 0000000..34f0403 --- /dev/null +++ b/Source_using_TMonitor/ncDBCommands.pas @@ -0,0 +1,105 @@ +unit ncDBCommands; + +interface + +uses Classes, SysUtils, DB, ADODB, ADOInt, ncCommandPacking, ncSources, ncSerializeADO; + +const + ncDBOpenDataset = 0; // uses TDBDatasetData as param + ncDBCloseDataset = 1; // uses no params + ncDBUpdateDataset = 2; // uses TDBUpdateDatasetData as param + ncDBExecDataset = 3; // uses TDBDatasetData as param + +type + TDBDatasetData = class + public + SQL: string; + Parameters: TBytes; + + constructor Create; + destructor Destroy; override; + + function FromBytes(aBytes: TBytes): Integer; virtual; + function ToBytes: TBytes; virtual; + end; + + TDBUpdateDatasetData = class(TDBDatasetData) + public + RecordUpdates: _Recordset; + + constructor Create; + destructor Destroy; override; + + function FromBytes(aBytes: TBytes): Integer; override; + function ToBytes: TBytes; override; + end; + +implementation + +{ TDBOpenDatasetData } + +constructor TDBDatasetData.Create; +begin + inherited Create; + SetLength(Parameters, 0); +end; + +destructor TDBDatasetData.Destroy; +begin + inherited; +end; + +function TDBDatasetData.FromBytes(aBytes: TBytes): Integer; +begin + Result := 0; + + SQL := ReadString(aBytes, Result); + Parameters := ReadBytes(aBytes, Result); +end; + +function TDBDatasetData.ToBytes: TBytes; +var + BufLen: Integer; +begin + // This is intended for the use of WriteMessageEmbeddedBufferLen + SetLength(Result, 0); + BufLen := 0; + + WriteString(SQL, Result, BufLen); + WriteBytes(Parameters, Result, BufLen); +end; + +{ TDBUpdateDatasetData } + +constructor TDBUpdateDatasetData.Create; +begin + inherited Create; + RecordUpdates := nil; +end; + +destructor TDBUpdateDatasetData.Destroy; +begin + if Assigned(RecordUpdates) then + RecordUpdates := nil; + + inherited; +end; + +function TDBUpdateDatasetData.FromBytes(aBytes: TBytes): Integer; +begin + Result := inherited FromBytes(aBytes); + + RecordUpdates := BytesToRecordset(ReadBytes(aBytes, Result)); +end; + +function TDBUpdateDatasetData.ToBytes: TBytes; +var + BufLen: Integer; +begin + Result := inherited ToBytes; + BufLen := Length(Result); + + WriteBytes(RecordsetToBytes(RecordUpdates, pfADTG), Result, BufLen); +end; + +end. diff --git a/Source_using_TMonitor/ncDBSrv.pas b/Source_using_TMonitor/ncDBSrv.pas new file mode 100644 index 0000000..eae5ea9 --- /dev/null +++ b/Source_using_TMonitor/ncDBSrv.pas @@ -0,0 +1,500 @@ +// This is the DB server part of netcom7 +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// Written by Demos Bill +// +// Date completed: 2011 / 5 / 5 +// +// The TncDBServer is an object which serves recordsets to ncClientDatasets + +// It holds every recordset open for its issued SQL. It maintains the recordset +// open for performance when requering. +// This is more performant even from stored procedures. +// +// It also cashes all responses depending on sql and params. The cache uses +// binary searching of issued sql to get the response, so this is extremely fast. +// Updating a recordset clears cache for the current updated recordset and all +// recordsets active in the list which contain a cached result and draw data +// from the same tables that were updated. + +unit ncDBSrv; + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, System.SysUtils, System.SyncObjs, System.Variants, Data.Win.ADODB, Winapi.ADOInt, + ncSources, ncCommandHandlers, ncDBCommands, ncSerializeADO; + +type + // Add an array of tables and if one of them is altered then void all the ReadyResults. + TReadyQueryItem = class + private + FSerialiser: TObject; // TMonitor synchronization object + // Ready results holds a string list of Parameters, and the Objects are TBytes + ReadyResults: TStringList; + protected + Tables: TStringList; + procedure GetTablesForSQL; + public + ADOQuery: TADOQuery; + + constructor Create(const aConnectionString, aSQL: string; aSerialiser: TObject); + destructor Destroy; override; + function GetResult(aParams: TBytes; aUseCache: Boolean): TBytes; + function Update(aUpdates: _recordset): TBytes; + procedure ClearCachedResults; + end; + + TReadyQueryList = class + private + Serialiser: TObject; // TMonitor synchronization object + // A Sorted String List of SQL statements + // The Data contains a TReadyQueryItem + ReadyQueries: TStringList; + FConnectionString: string; + public + // Returns the corresponding TReadyQueryItem (creates it if it does not exist). + constructor Create; + destructor Destroy; override; + function GetQuery(const aSQL: string): TReadyQueryItem; + + procedure SetConnectionString(const aConnectionString: string); + end; + + TncDBServer = class(TncCustomCommandHandler) + private + PropertyLock: TObject; // TMonitor synchronization object + ReadyQueryList: TReadyQueryList; + FCacheResponses: Boolean; + + procedure DBServerConnected(Sender: TObject; aLine: TncLine); + procedure DBServerDisconnected(Sender: TObject; aLine: TncLine); + function DBServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TBytes; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TBytes; + private + FADOConnection: TADOConnection; + PrevADOConnectionString: string; + procedure SetADOConnection(const Value: TADOConnection); + function GetADOConnection: TADOConnection; + function GetCacheResponses: Boolean; + procedure SetCacheResponses(const Value: Boolean); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property ADOConnection: TADOConnection read GetADOConnection write SetADOConnection; + property CacheResponses: Boolean read GetCacheResponses write SetCacheResponses default True; + property Source; + end; + +implementation + +{ TncDBServer } + +constructor TncDBServer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + PropertyLock := TObject.Create; + ReadyQueryList := TReadyQueryList.Create; + + FCacheResponses := True; + PrevADOConnectionString := ''; + + FADOConnection := nil; + OnHandleCommand := DBServerHandleCommand; + OnConnected := DBServerConnected; + OnDisconnected := DBServerDisconnected; +end; + +destructor TncDBServer.Destroy; +begin + ReadyQueryList.Free; + PropertyLock.Free; + inherited; +end; + +procedure TncDBServer.DBServerConnected(Sender: TObject; aLine: TncLine); +begin + ReadyQueryList.SetConnectionString(ADOConnection.ConnectionString); +end; + +procedure TncDBServer.DBServerDisconnected(Sender: TObject; aLine: TncLine); +begin + // Remove all items for the line that disconnected + // RecordsetList.RemoveRecordsetItems(aLine); +end; + +function TncDBServer.DBServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TBytes; aRequiresResult: Boolean; + const aSenderComponent, aReceiverComponent: string): TBytes; +var + DatasetData: TDBDatasetData; // Command + UpdateDatasetData: TDBUpdateDatasetData; // Command + ReadyQry: TReadyQueryItem; + ExecQry: TADOQuery; + + UpdatedTables: TStringList; + rq: Integer; + ListRQ: TReadyQueryItem; + i: Integer; +begin + SetLength(Result, 0); + + TMonitor.Enter(PropertyLock); + try + if Assigned(FADOConnection) then + begin + if FADOConnection.ConnectionString <> PrevADOConnectionString then + begin + PrevADOConnectionString := FADOConnection.ConnectionString; + // Purge all cache + for rq := 0 to ReadyQueryList.ReadyQueries.Count - 1 do + begin + ListRQ := TReadyQueryItem(ReadyQueryList.ReadyQueries.Objects[rq]); + ListRQ.ClearCachedResults; + end; + end; + end; + finally + TMonitor.Exit(PropertyLock); + end; + + case aCmd of + ncDBOpenDataset: + begin + DatasetData := TDBDatasetData.Create; + try + // Deserialise aData to DatasetData + DatasetData.FromBytes(aData); + + ReadyQry := ReadyQueryList.GetQuery(DatasetData.SQL); + Result := ReadyQry.GetResult(DatasetData.Parameters, CacheResponses); + finally + DatasetData.Free; + end; + end; + + ncDBCloseDataset: + begin + end; + + ncDBUpdateDataset: + begin + UpdateDatasetData := TDBUpdateDatasetData.Create; + try + UpdateDatasetData.FromBytes(aData); + + ReadyQry := ReadyQueryList.GetQuery(UpdateDatasetData.SQL); + Result := ReadyQry.Update(UpdateDatasetData.RecordUpdates); + + UpdatedTables := ReadyQry.Tables; + // For each updated Table + for i := 0 to UpdatedTables.Count - 1 do + // Search all open queries + for rq := 0 to ReadyQueryList.ReadyQueries.Count - 1 do + begin + ListRQ := TReadyQueryItem(ReadyQueryList.ReadyQueries.Objects[rq]); + + // If table exists on target + if ListRQ.Tables.IndexOf(UpdatedTables.Strings[i]) > -1 then + ListRQ.ClearCachedResults; + end; + + // This would be to send back the complete table, but we don't do that + // instead, we send back the updated updates (updates that were posted, + // and returned back with the new autoinc fields for example. + // Result := ReadyQry.GetResult(UpdateDatasetData.Parameters, CacheResponses); + finally + UpdateDatasetData.Free; + end; + end; + ncDBExecDataset: + begin + DatasetData := TDBDatasetData.Create; + try + // Deserialise aData to DatasetData + DatasetData.FromBytes(aData); + + ExecQry := TADOQuery.Create(nil); + try + ExecQry.SQL.Text := DatasetData.SQL; + BytesToParameters(DatasetData.Parameters, ExecQry.Parameters); + Result := BytesOf(IntToStr(ExecQry.ExecSQL)); + + // Since a exec query can virtually do anything, + // We are going to purge all cached responses + for rq := 0 to ReadyQueryList.ReadyQueries.Count - 1 do + begin + ListRQ := TReadyQueryItem(ReadyQueryList.ReadyQueries.Objects[rq]); + ListRQ.ClearCachedResults; + end; + finally + ExecQry.Free; + end; + finally + DatasetData.Free; + end; + end; + end; +end; + +procedure TncDBServer.Notification(AComponent: TComponent; Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + + if Operation = opRemove then + if AComponent = FADOConnection then + SetADOConnection(nil); + + if not(csLoading in ComponentState) then + begin + if Operation = opInsert then + if not Assigned(FADOConnection) then + if AComponent is TADOConnection then + SetADOConnection(TADOConnection(AComponent)); + end; +end; + +function TncDBServer.GetADOConnection: TADOConnection; +begin + TMonitor.Enter(PropertyLock); + try + Result := FADOConnection; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncDBServer.SetADOConnection(const Value: TADOConnection); +begin + TMonitor.Enter(PropertyLock); + try + FADOConnection := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncDBServer.GetCacheResponses: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCacheResponses; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncDBServer.SetCacheResponses(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FCacheResponses := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +{ TReadyQueryItem } + +constructor TReadyQueryItem.Create(const aConnectionString, aSQL: string; aSerialiser: TObject); +begin + FSerialiser := aSerialiser; + + // Get the new query created + ADOQuery := TADOQuery.Create(nil); + // Setting ConnectionString reports to server as different session: + // i.e: sees everything updated + // Also ensures multithreading works (multithreaded queries are not allowed + // to share a Connection. + // ConnectionString must be specified + ADOQuery.Connection := TADOConnection.Create(nil); + ADOQuery.Connection.ConnectionString := aConnectionString; + ADOQuery.SQL.Text := aSQL; + // ADOQuery.LockType := ltBatchOptimistic; + // ADOQuery.MarshalOptions := moMarshalModifiedOnly; + + // ADOQuery.CursorLocation := clUseClient; + // ADOQuery.CursorType := ctOpenForwardOnly; + + // Get the cashed results list ready + ReadyResults := TStringList.Create; + ReadyResults.CaseSensitive := False; + ReadyResults.Sorted := True; + ReadyResults.Duplicates := dupIgnore; + + // Get the tables references list created + Tables := TStringList.Create; + Tables.CaseSensitive := False; + Tables.Sorted := True; + Tables.Duplicates := dupIgnore; +end; + +destructor TReadyQueryItem.Destroy; +begin + ClearCachedResults; + + Tables.Free; + ReadyResults.Free; + + ADOQuery.Connection.Free; + ADOQuery.Free; + + inherited; +end; + +type + TResObj = class + Content: TBytes; + end; + +function TReadyQueryItem.GetResult(aParams: TBytes; aUseCache: Boolean): TBytes; +var + strParams: string; + Ndx: Integer; + ResObj: TResObj; +begin + TMonitor.Enter(FSerialiser); + try + strParams := StringOf(aParams); + + if aUseCache then + Ndx := ReadyResults.IndexOf(strParams) + else + Ndx := -1; + + if (Ndx < 0) then // Result not found + begin + BytesToParameters(aParams, ADOQuery.Parameters); + + if not ADOQuery.Active then + begin + ADOQuery.Active := True; + GetTablesForSQL; + end + else + ADOQuery.Requery; + + Result := RecordsetToBytes(ADOQuery.Recordset, pfADTG); + + if aUseCache and (Length(Result) > 0) then + begin + ResObj := TResObj.Create; + ResObj.Content := Result; + ReadyResults.AddObject(strParams, ResObj); + end; + end + else + Result := TResObj(ReadyResults.Objects[Ndx]).Content; + + finally + TMonitor.Exit(FSerialiser); + end; +end; + +procedure TReadyQueryItem.GetTablesForSQL; +var + i: Integer; +begin + Tables.Clear; + // Get for every field the table it comes from + for i := 0 to ADOQuery.Recordset.Fields.Count - 1 do + if VarIsStr(ADOQuery.Recordset.Fields.Item[i].Properties.Item['BASETABLENAME'].Value) then + Tables.Add(ADOQuery.Recordset.Fields.Item[i].Properties.Item['BASETABLENAME'].Value); +end; + +function TReadyQueryItem.Update(aUpdates: _recordset): TBytes; +var + tmpDS: TADODataSet; +begin + TMonitor.Enter(FSerialiser); + try + tmpDS := TADODataSet.Create(nil); + try + tmpDS.Recordset := aUpdates; + tmpDS.Recordset.Set_ActiveConnection(ADOQuery.Connection.ConnectionObject); + tmpDS.Recordset.UpdateBatch(adAffectAll); + // tmpDS.Recordset.Filter := adFilterAffectedRecords; + Result := RecordsetToBytes(tmpDS.Recordset, pfADTG); + finally + tmpDS.Free; + end; + finally + TMonitor.Exit(FSerialiser); + end; +end; + +procedure TReadyQueryItem.ClearCachedResults; +var + i: Integer; +begin + for i := 0 to ReadyResults.Count - 1 do + ReadyResults.Objects[i].Free; + + ReadyResults.Clear; +end; + +{ TReadyQueryList } + +constructor TReadyQueryList.Create; +begin + Serialiser := TObject.Create; + ReadyQueries := TStringList.Create; + ReadyQueries.CaseSensitive := False; + ReadyQueries.Sorted := True; + ReadyQueries.Duplicates := dupIgnore; +end; + +destructor TReadyQueryList.Destroy; +var + i: Integer; +begin + for i := 0 to ReadyQueries.Count - 1 do + TReadyQueryItem(ReadyQueries.Objects[i]).Free; + + ReadyQueries.Free; + Serialiser.Free; + + inherited; +end; + +function TReadyQueryList.GetQuery(const aSQL: string): TReadyQueryItem; +var + Ndx: Integer; +begin + TMonitor.Enter(Serialiser); + try + Ndx := ReadyQueries.IndexOf(aSQL); + if (Ndx < 0) then // not found + begin + Result := TReadyQueryItem.Create(FConnectionString, aSQL, Serialiser); + ReadyQueries.AddObject(aSQL, Result); + end + else + Result := TReadyQueryItem(ReadyQueries.Objects[Ndx]); + finally + TMonitor.Exit(Serialiser); + end; +end; + +procedure TReadyQueryList.SetConnectionString(const aConnectionString: string); +begin + TMonitor.Enter(Serialiser); + try + FConnectionString := aConnectionString; + finally + TMonitor.Exit(Serialiser); + end; +end; + +end. diff --git a/Source_using_TMonitor/ncEncryption.pas b/Source_using_TMonitor/ncEncryption.pas new file mode 100644 index 0000000..f23b520 --- /dev/null +++ b/Source_using_TMonitor/ncEncryption.pas @@ -0,0 +1,418 @@ +{$R-} +{$O-} +unit ncEncryption; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// 13 Dec 2010, 23/3/2024 +// +// Written by Demos Bill +// VasDemos@yahoo.co.uk +// +// This portion of NetCom adapts DCPCrypt into the library, +// so that is does not depend on any DCP package the programmer may have installed. +// The reason is because if there is an error in any encryption/decryption class, +// That error should be maintained the same for any compilation of this library, +// that is for any client using it. +// To adapt DCPCrypt, a few changes had to be made: +// 1. cosmetic changes (underscores were removed) +// 2. performance changes +// - const parameters when applicable +// - inlined functions when necessary +// 3. bug fixes: +// - all ciphers do pointer walking arithmetic under only win32 +// For example, in DCPblowfish.pas, line 209, 210, you would find: +// xL:= Pdword(@InData)^; +// xR:= Pdword(longword(@InData)+4)^; +// That would treat, wrongly, the address of @InData as a 32 bit unsigned int, +// so all this type of pointer arithmetic has been replaced with the proper: +// xL:= Pdword(@InData)^; +// xR:= Pdword(NativeUInt(@InData)+4)^; +// - All Pdword and dword references have been replaced with their appropriate +// intrinsic types. +// +// Bellow is tribute to David Barton for supplying such a gem to the software community: +// +{ ****************************************************************************** } +{ * Copyright (c) 1999-2002 David Barton * } +{ * Permission is hereby granted, free of charge, to any person obtaining a * } +{ * copy of this software and associated documentation files (the "Software"), * } +{ * to deal in the Software without restriction, including without limitation * } +{ * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } +{ * and/or sell copies of the Software, and to permit persons to whom the * } +{ * Software is furnished to do so, subject to the following conditions: * } +{ * * } +{ * The above copyright notice and this permission notice shall be included in * } +{ * all copies or substantial portions of the Software. * } +{ * * } +{ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } +{ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } +{ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } +{ * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } +{ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } +{ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } +{ * DEALINGS IN THE SOFTWARE. * } +{ ****************************************************************************** } +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.Classes, + System.SysUtils, + System.Math, + ncEncCrypt2, + // Ciphers: + ncEncBlockciphers, + ncEncRc2, ncEncRc4, ncEncRc5, ncEncRc6, + ncEncBlowfish, ncEncTwofish, + ncEncCast128, ncEncCast256, + ncEncRijndael, ncEncMisty1, ncEncIdea, ncEncMars, + ncEncIce, ncEncDes, ncEncTea, ncEncSerpent, + // Hashers + ncEncSha1, ncEncSha256, ncEncSha512, + ncEncRipeMd128, ncEncRipeMd160, + ncEncHaval, ncEncMd4, ncEncMd5, ncEncTiger; + +type + TEncryptorType = (etNoEncryption, etRc2, etRc4, etRc5, etRc6, etBlowfish, etTwoFish, etCast128, etCast256, etRijndael, etMisty1, etIdea, etMars, etIce, etThinIce, etIce2, etDES, et3DES, etTea, etSerpent); + + THasherType = (htNoDigesting, htSha1, htSha256, htSha384, htSha512, htRipeMd128, htRipeMd160, htHaval, htMd4, htMd5, htTiger); + + // Encode a AnsiString into Base64 format + // (output is (4/3) times bigger than input) +function Base64EncodeBytes(const aBytes: TBytes): TBytes; +// Decode a Base64 format AnsiString +function Base64DecodeBytes(const aBytes: TBytes): TBytes; + +// Hashing +function GetHash(const aBytes: TBytes; aHasherType: THasherType = htSha256; aBase64Encode: Boolean = True): TBytes; +function GetHashFromFile(const aFileName: string; aHasherType: THasherType = htSha256; aBase64Encode: Boolean = True): TBytes; + +// Encryption +function EncryptBytes(const aBytes: TBytes; const aEncryptionKey: AnsiString = 'TheEncryptionKey'; aEncryptorType: TEncryptorType = etBlowfish; aEncryptOnHashedKey: Boolean = True; aBase64Encode: Boolean = True): TBytes; +function DecryptBytes(aBytes: TBytes; const aDecryptionKey: AnsiString = 'TheEncryptionKey'; aDecryptorType: TEncryptorType = etBlowfish; aDecryptOnHashedKey: Boolean = True; aBase64Encoded: Boolean = True): TBytes; + +implementation + +const + B64: array [0 .. 63] of Byte = (65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 43, 47); + +function Base64Encode(pInput: Pointer; pOutput: Pointer; Size: longint): longint; +var + i, iptr, optr: Integer; + Input, Output: PByteArray; +begin + Input := PByteArray(pInput); + Output := PByteArray(pOutput); + iptr := 0; + optr := 0; + for i := 1 to (Size div 3) do + begin + Output^[optr + 0] := B64[Input^[iptr] shr 2]; + Output^[optr + 1] := B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr + 1] shr 4)]; + Output^[optr + 2] := B64[((Input^[iptr + 1] and 15) shl 2) + (Input^[iptr + 2] shr 6)]; + Output^[optr + 3] := B64[Input^[iptr + 2] and 63]; + Inc(optr, 4); + Inc(iptr, 3); + end; + case (Size mod 3) of + 1: + begin + Output^[optr + 0] := B64[Input^[iptr] shr 2]; + Output^[optr + 1] := B64[(Input^[iptr] and 3) shl 4]; + Output^[optr + 2] := Byte('='); + Output^[optr + 3] := Byte('='); + end; + 2: + begin + Output^[optr + 0] := B64[Input^[iptr] shr 2]; + Output^[optr + 1] := B64[((Input^[iptr] and 3) shl 4) + (Input^[iptr + 1] shr 4)]; + Output^[optr + 2] := B64[(Input^[iptr + 1] and 15) shl 2]; + Output^[optr + 3] := Byte('='); + end; + end; + Result := ((Size + 2) div 3) * 4; +end; + +function Base64EncodeBytes(const aBytes: TBytes): TBytes; +begin + SetLength(Result, 0); + + SetLength(Result, ((Length(aBytes) + 2) div 3) * 4); + Base64Encode(@aBytes[0], @Result[0], Length(aBytes)); +end; + +function Base64Decode(pInput: Pointer; pOutput: Pointer; Size: longint): longint; +var + i, j, iptr, optr: Integer; + Temp: array [0 .. 3] of Byte; + Input, Output: PByteArray; +begin + Input := PByteArray(pInput); + Output := PByteArray(pOutput); + iptr := 0; + optr := 0; + Result := 0; + for i := 1 to (Size div 4) do + begin + for j := 0 to 3 do + begin + case Input^[iptr] of + 65 .. 90: + Temp[j] := Input^[iptr] - Ord('A'); + 97 .. 122: + Temp[j] := Input^[iptr] - Ord('a') + 26; + 48 .. 57: + Temp[j] := Input^[iptr] - Ord('0') + 52; + 43: + Temp[j] := 62; + 47: + Temp[j] := 63; + 61: + Temp[j] := $FF; + end; + Inc(iptr); + end; + Output^[optr] := (Temp[0] shl 2) or (Temp[1] shr 4); + Result := optr + 1; + if (Temp[2] <> $FF) and (Temp[3] = $FF) then + begin + Output^[optr + 1] := (Temp[1] shl 4) or (Temp[2] shr 2); + Result := optr + 2; + Inc(optr); + end + else if (Temp[2] <> $FF) then + begin + Output^[optr + 1] := (Temp[1] shl 4) or (Temp[2] shr 2); + Output^[optr + 2] := (Temp[2] shl 6) or Temp[3]; + Result := optr + 3; + Inc(optr, 2); + end; + Inc(optr); + end; +end; + +function Base64DecodeBytes(const aBytes: TBytes): TBytes; +begin + SetLength(Result, 0); + + SetLength(Result, (Length(aBytes) div 4) * 3); + SetLength(Result, Base64Decode(@aBytes[0], @Result[0], Length(aBytes))); +end; + +function GetHash(const aBytes: TBytes; aHasherType: THasherType = htSha256; aBase64Encode: Boolean = True): TBytes; +var + Hash: TncEncHash; + Digest: PByte; +begin + // Create unique hash + case aHasherType of + htSha1: + Hash := TncEnc_sha1.Create(nil); + htSha256: + Hash := TncEnc_sha256.Create(nil); + htSha384: + Hash := TncEnc_sha384.Create(nil); + htSha512: + Hash := TncEnc_sha512.Create(nil); + htRipeMd128: + Hash := TncEnc_RipeMd128.Create(nil); + htRipeMd160: + Hash := TncEnc_RipeMd160.Create(nil); + htHaval: + Hash := TncEnc_Haval.Create(nil); + htMd4: + Hash := TncEnc_Md4.Create(nil); + htMd5: + Hash := TncEnc_Md5.Create(nil); + htTiger: + Hash := TncEnc_Tiger.Create(nil); + else + Hash := nil; + end; + + if Hash = nil then + Result := aBytes + else + try + Hash.Init; + Hash.Update(aBytes[0], Length(aBytes)); + GetMem(Digest, Hash.HashSize div 8); + try + Hash.Final(Digest^); + SetLength(Result, (Hash.HashSize div 8)); + move(Digest^, Result[0], Length(Result)); + + if aBase64Encode then + Result := Base64EncodeBytes(Result); + finally + FreeMem(Digest, Hash.HashSize div 8); + end; + finally + Hash.Free; + end; +end; + +function GetHashFromFile(const aFileName: string; aHasherType: THasherType = htSha256; aBase64Encode: Boolean = True): TBytes; +var + fs: TFileStream; + FileBytes: TBytes; +begin + fs := TFileStream.Create(aFileName, fmOpenRead or fmShareDenyWrite); + try + SetLength(FileBytes, fs.Size); + fs.Read(FileBytes[0], fs.Size); + finally + fs.Free; + end; + + Result := GetHash(FileBytes, aHasherType, aBase64Encode); +end; + +function EncryptBytes(const aBytes: TBytes; const aEncryptionKey: AnsiString = 'TheEncryptionKey'; aEncryptorType: TEncryptorType = etBlowfish; aEncryptOnHashedKey: Boolean = True; aBase64Encode: Boolean = True): TBytes; +var + Encryptor: TncEncCipher; +begin + case aEncryptorType of + etRc2: + Encryptor := TncEnc_Rc2.Create(nil); + etRc4: + Encryptor := TncEnc_Rc4.Create(nil); + etRc5: + Encryptor := TncEnc_Rc5.Create(nil); + etRc6: + Encryptor := TncEnc_Rc6.Create(nil); + etBlowfish: + Encryptor := TncEnc_blowfish.Create(nil); + etTwoFish: + Encryptor := TncEnc_TwoFish.Create(nil); + etCast128: + Encryptor := TncEnc_cast128.Create(nil); + etCast256: + Encryptor := TncEnc_cast256.Create(nil); + etRijndael: + Encryptor := TncEnc_Rijndael.Create(nil); + etMisty1: + Encryptor := TncEnc_Misty1.Create(nil); + etIdea: + Encryptor := TncEnc_Idea.Create(nil); + etMars: + Encryptor := TncEnc_Mars.Create(nil); + etIce: + Encryptor := TncEnc_Ice.Create(nil); + etThinIce: + Encryptor := TncEnc_ThinIce.Create(nil); + etIce2: + Encryptor := TncEnc_Ice2.Create(nil); + etDES: + Encryptor := TncEnc_DES.Create(nil); + et3DES: + Encryptor := TncEnc_3DES.Create(nil); + etTea: + Encryptor := TncEnc_Tea.Create(nil); + etSerpent: + Encryptor := TncEnc_Serpent.Create(nil); + else + Encryptor := nil; + end; + + if Encryptor = nil then + Result := aBytes + else + try + if aEncryptOnHashedKey then + Encryptor.InitStr(aEncryptionKey, TncEnc_sha256) + else + Encryptor.Init(aEncryptionKey[1], min(Length(aEncryptionKey) * 8, Encryptor.MaxKeySize), nil); + + SetLength(Result, Length(aBytes)); + Encryptor.Encrypt(aBytes[0], Result[0], Length(aBytes)); + + if aBase64Encode then + Result := Base64EncodeBytes(Result); + + Encryptor.Burn; // clear keying information + finally + Encryptor.Free; + end; +end; + +function DecryptBytes(aBytes: TBytes; const aDecryptionKey: AnsiString = 'TheEncryptionKey'; aDecryptorType: TEncryptorType = etBlowfish; aDecryptOnHashedKey: Boolean = True; aBase64Encoded: Boolean = True): TBytes; +var + Decryptor: TncEncCipher; +begin + case aDecryptorType of + etRc2: + Decryptor := TncEnc_Rc2.Create(nil); + etRc4: + Decryptor := TncEnc_Rc4.Create(nil); + etRc5: + Decryptor := TncEnc_Rc5.Create(nil); + etRc6: + Decryptor := TncEnc_Rc6.Create(nil); + etBlowfish: + Decryptor := TncEnc_blowfish.Create(nil); + etTwoFish: + Decryptor := TncEnc_TwoFish.Create(nil); + etCast128: + Decryptor := TncEnc_cast128.Create(nil); + etCast256: + Decryptor := TncEnc_cast256.Create(nil); + etRijndael: + Decryptor := TncEnc_Rijndael.Create(nil); + etMisty1: + Decryptor := TncEnc_Misty1.Create(nil); + etIdea: + Decryptor := TncEnc_Idea.Create(nil); + etMars: + Decryptor := TncEnc_Mars.Create(nil); + etIce: + Decryptor := TncEnc_Ice.Create(nil); + etThinIce: + Decryptor := TncEnc_ThinIce.Create(nil); + etIce2: + Decryptor := TncEnc_Ice2.Create(nil); + etDES: + Decryptor := TncEnc_DES.Create(nil); + et3DES: + Decryptor := TncEnc_3DES.Create(nil); + etTea: + Decryptor := TncEnc_Tea.Create(nil); + etSerpent: + Decryptor := TncEnc_Serpent.Create(nil); + else + Decryptor := nil; + end; + + if Decryptor = nil then + Result := aBytes + else + try + if aDecryptOnHashedKey then + Decryptor.InitStr(aDecryptionKey, TncEnc_sha256) + else + Decryptor.Init(aDecryptionKey[1], min(Length(aDecryptionKey) * 8, Decryptor.MaxKeySize), nil); + + if aBase64Encoded then + aBytes := Base64DecodeBytes(aBytes); + + SetLength(Result, Length(aBytes)); + Decryptor.Decrypt(aBytes[0], Result[0], Length(aBytes)); + + Decryptor.Burn; // clear keying information + finally + Decryptor.Free; + end; +end; + +end. diff --git a/Source_using_TMonitor/ncIPUtils.pas b/Source_using_TMonitor/ncIPUtils.pas new file mode 100644 index 0000000..08d3802 --- /dev/null +++ b/Source_using_TMonitor/ncIPUtils.pas @@ -0,0 +1,284 @@ +unit ncIPUtils; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - IP Address utils +// +// +// +// 21/01/2025 +// - Initial creation +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +interface + +uses + {$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, + {$ELSE} + Posix.SysSocket, Posix.NetDB, Posix.NetIf, Posix.ArpaInet, + {$ENDIF} + System.SysUtils, System.Classes; + +const + IPV6_ADDR_LEN = 16; // IPv6 address length in bytes + IPV6_STR_MAX_LEN = 46; // Maximum string length for IPv6 address including null terminator + SOCKADDR_STORAGE_SIZE = 128; // Size of sockaddr_storage structure + + {$IFDEF MSWINDOWS} + AF_INET6 = 23; + {$ENDIF} + +type + TIn6Addr = record + case Integer of + 0: (s6_bytes: array[0..15] of Byte); + 1: (s6_words: array[0..7] of Word); + end; + PIn6Addr = ^TIn6Addr; + + TSockAddrIn6 = record + sin6_family: Word; // AF_INET6 + sin6_port: Word; // Transport layer port # + sin6_flowinfo: Cardinal; // IPv6 flow information + sin6_addr: TIn6Addr; // IPv6 address + sin6_scope_id: Cardinal; // Set of interfaces for scope + end; + PSockAddrIn6 = ^TSockAddrIn6; + + // Socket storage structure - used for both IPv4 and IPv6 + TSockAddrStorage = record + ss_family: Word; // Address family + __ss_pad1: array [0..5] of Byte; // 6 bytes of padding + __ss_align: Int64; // Force alignment + __ss_pad2: array [0..111] of Byte; // 112 bytes of padding + end; + PSockAddrStorage = ^TSockAddrStorage; + + EIPError = class(Exception); + + // Function types for dynamic loading + {$IFDEF MSWINDOWS} + TInetPton = function(Family: Integer; const pszAddrString: PAnsiChar; + pAddrBuf: Pointer): Integer; stdcall; + TInetNtop = function(Family: Integer; pAddr: Pointer; + pStringBuf: PAnsiChar; StringBufSize: size_t): PAnsiChar; stdcall; + {$ENDIF} + + TncIPUtils = class + private + {$IFDEF MSWINDOWS} + class var + InetPton: TInetPton; + InetNtop: TInetNtop; + class function LoadIPv6Functions: Boolean; + {$ENDIF} + public + class constructor Create; + + // SockAddrStorage methods + class function StorageToString(const Storage: TSockAddrStorage): string; + class function IsIPv6Storage(const Storage: TSockAddrStorage): Boolean; + class function GetStorageFamily(const Storage: TSockAddrStorage): Word; + class function StorageToIPv6Address(const Storage: TSockAddrStorage; + out Addr: TSockAddrIn6): Boolean; + class function GetIPFromStorage(const Storage: TSockAddrStorage): string; + class function GetPortFromStorage(const Storage: TSockAddrStorage): Word; + + // Existing IPv6 methods + class function IsIPv6ValidAddress(const AddrStr: string): Boolean; + class function AddressToString(const Addr: TIn6Addr): string; + class function StringToAddress(const AddrStr: string; out Addr: TIn6Addr): Boolean; + class function IsLinkLocal(const AddrStr: string): Boolean; + class function NormalizeAddress(const AddrStr: string): string; + class function AddressToPresentation(const Addr: TIn6Addr): string; + class function PresentationToAddress(const Present: string; var Addr: TIn6Addr): Boolean; + end; + +implementation + +{$IFDEF MSWINDOWS} +var + Ws2_32DllHandle: THandle; + + +class function TncIPUtils.LoadIPv6Functions: Boolean; +begin + Result := False; + + if Ws2_32DllHandle = 0 then + Ws2_32DllHandle := LoadLibrary('ws2_32.dll'); + + if Ws2_32DllHandle <> 0 then + begin + InetPton := GetProcAddress(Ws2_32DllHandle, 'inet_pton'); + InetNtop := GetProcAddress(Ws2_32DllHandle, 'inet_ntop'); + Result := Assigned(InetPton) and Assigned(InetNtop); + end; +end; +{$ENDIF} + +class constructor TncIPUtils.Create; +begin + {$IFDEF MSWINDOWS} + if not LoadIPv6Functions then + raise EIPError.Create('Failed to load IPv6 functions from ws2_32.dll'); + {$ENDIF} +end; + +class function TncIPUtils.StorageToString(const Storage: TSockAddrStorage): string; +begin + case Storage.ss_family of + AF_INET: + begin + var addr_in := PSockAddrIn(@Storage)^; + with addr_in.sin_addr.S_un_b do + Result := Format('%d.%d.%d.%d', [s_b1, s_b2, s_b3, s_b4]); + end; + + AF_INET6: + begin + var addr_in6 := PSockAddrIn6(@Storage)^; + Result := AddressToString(addr_in6.sin6_addr); + if IsLinkLocal(Result) then + Result := Format('%s%%%d', [Result, addr_in6.sin6_scope_id]); + end; + else + Result := ''; + end; +end; + +class function TncIPUtils.IsIPv6Storage(const Storage: TSockAddrStorage): Boolean; +begin + Result := Storage.ss_family = AF_INET6; +end; + +class function TncIPUtils.GetStorageFamily(const Storage: TSockAddrStorage): Word; +begin + Result := Storage.ss_family; +end; + +class function TncIPUtils.StorageToIPv6Address(const Storage: TSockAddrStorage; + out Addr: TSockAddrIn6): Boolean; +begin + Result := Storage.ss_family = AF_INET6; + if Result then + Addr := PSockAddrIn6(@Storage)^; +end; + +class function TncIPUtils.GetIPFromStorage(const Storage: TSockAddrStorage): string; +begin + Result := StorageToString(Storage); +end; + +class function TncIPUtils.GetPortFromStorage(const Storage: TSockAddrStorage): Word; +begin + case Storage.ss_family of + AF_INET: Result := ntohs(PSockAddrIn(@Storage)^.sin_port); + AF_INET6: Result := ntohs(PSockAddrIn6(@Storage)^.sin6_port); + else + Result := 0; + end; +end; + +class function TncIPUtils.IsIPv6ValidAddress(const AddrStr: string): Boolean; +var + Addr: TIn6Addr; +begin + Result := StringToAddress(AddrStr, Addr); +end; + +class function TncIPUtils.AddressToString(const Addr: TIn6Addr): string; +var + StringBuffer: array[0..IPV6_STR_MAX_LEN-1] of AnsiChar; +begin + {$IFDEF MSWINDOWS} + if InetNtop(AF_INET6, @Addr, StringBuffer, IPV6_STR_MAX_LEN) = nil then + raise EIPError.Create('Failed to convert IPv6 address to string: ' + + SysErrorMessage(WSAGetLastError)); + {$ELSE} + if Posix.ArpaInet.inet_ntop(AF_INET6, @Addr, StringBuffer, IPV6_STR_MAX_LEN) = nil then + raise EIPv6Error.Create('Failed to convert IPv6 address to string: ' + + SysErrorMessage(GetLastError)); + {$ENDIF} + + Result := string(AnsiString(StringBuffer)); +end; + +class function TncIPUtils.StringToAddress(const AddrStr: string; out Addr: TIn6Addr): Boolean; +var + AnsiAddr: AnsiString; +begin + AnsiAddr := AnsiString(AddrStr); + {$IFDEF MSWINDOWS} + Result := InetPton(AF_INET6, PAnsiChar(AnsiAddr), @Addr) = 1; + {$ELSE} + Result := Posix.ArpaInet.inet_pton(AF_INET6, PAnsiChar(AnsiAddr), @Addr) = 1; + {$ENDIF} +end; + +class function TncIPUtils.IsLinkLocal(const AddrStr: string): Boolean; +begin + // Link-local addresses start with fe80::/10 + Result := (Length(AddrStr) >= 4) and + (LowerCase(Copy(AddrStr, 1, 4)) = 'fe80'); +end; + +class function TncIPUtils.NormalizeAddress(const AddrStr: string): string; +var + Addr: TIn6Addr; +begin + if StringToAddress(AddrStr, Addr) then + Result := AddressToString(Addr) + else + raise EIPError.CreateFmt('Invalid IPv6 address: %s', [AddrStr]); +end; + +class function TncIPUtils.AddressToPresentation(const Addr: TIn6Addr): string; +var + i: Integer; + NonZeroFound: Boolean; +begin + Result := ''; + NonZeroFound := False; + + // Convert words to hex representation + for i := 0 to 7 do + begin + if (Addr.s6_words[i] <> 0) or NonZeroFound then + begin + if Result <> '' then + Result := Result + ':'; + Result := Result + IntToHex(Addr.s6_words[i], 1); + NonZeroFound := True; + end; + end; + + // Handle all-zero case + if Result = '' then + Result := '::' + else if not NonZeroFound then + Result := Result + ':'; +end; + +class function TncIPUtils.PresentationToAddress(const Present: string; + var Addr: TIn6Addr): Boolean; +begin + FillChar(Addr, SizeOf(Addr), 0); + Result := StringToAddress(Present, Addr); +end; + +initialization + {$IFDEF MSWINDOWS} + Ws2_32DllHandle := 0; + {$ENDIF} + +finalization + {$IFDEF MSWINDOWS} + if Ws2_32DllHandle <> 0 then + FreeLibrary(Ws2_32DllHandle); + {$ENDIF} + +end. + diff --git a/Source_using_TMonitor/ncLines.pas b/Source_using_TMonitor/ncLines.pas new file mode 100644 index 0000000..84b92f9 --- /dev/null +++ b/Source_using_TMonitor/ncLines.pas @@ -0,0 +1,1115 @@ +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// +// This unit implements a TncLine, which is all the WinSock API commands for a +// socket, organised in an object which contains the handle of the socket, +// and also makes sure it checks every API command for errors +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// 13/07/2025 - by J.Pauwels +// - Added TLS handshake callback integration through OnBeforeConnected architecture +// - Integrated TLS support into line-level socket operations +// - Added secure communication layer for both server and client connections +// +// 14/01/2025 - by J.Pauwels +// - Fix Linux compilation +// - Added UDP support +// - Added IPV6 support +// - Removed problematic threading approach from CreateClientHandle +// - Implemented socket-level timeout control for more reliable connection handling +// +// 9/8/2020 +// - Completed multiplatform support, now NetCom can be compiled in all +// platforms +// - Made custom fdset manipulation so that our sockets can handle more than +// 1024 concurrent connections in Linux/Mac/Android! +// See Readable function for implementation +// +// 8/8/2020 +// - Created this unit by breaking the code from ncSockets where it was +// initially situated +// - Increased number of concurrent conections from 65536 to infinite +// (to as much memory as the computer has) +// - Added Win64 support +// +// Written by Demos Bill +// +// ///////////////////////////////////////////////////////////////////////////// + +unit ncLines; + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysTypes, Posix.SysSelect, Posix.SysSocket, Posix.NetDB, Posix.SysTime, + Posix.Unistd, Posix.Errno, +{$ENDIF} + System.SyncObjs, + System.Math, + System.SysUtils, + System.Diagnostics, + System.IOUtils, + System.Classes, + ncIPUtils; + +const + // Flag that indicates that the socket is intended for bind() + listen() when constructing it + AI_PASSIVE = 1; + IPV6_V6ONLY = 27; + AI_ADDRCONFIG = $0020; // Return only if local system configured + AI_NUMERICHOST = $0004; // Don't use name resolution + INET6_ADDRSTRLEN = 46; + // Maximum length of IPv6 address string including null terminator +{$IFDEF MSWINDOWS} + InvalidSocket = Winapi.Winsock2.INVALID_SOCKET; + SocketError = SOCKET_ERROR; + WSAETIMEDOUT = 10060; +{$ELSE} + InvalidSocket = -1; + SocketError = -1; + IPPROTO_TCP = 6; + TCP_NODELAY = $0001; + ETIMEDOUT = 110; + ECONNREFUSED = 111; +{$ENDIF} + +type + TSocketType = (stUDP, stTCP); + +const + CSocketTypeNames: array [TSocketType] of string = ('UDP', 'TCP'); + + CRawSocketTypes: array [TSocketType] of Integer = (SOCK_DGRAM, // UDP datagram + SOCK_STREAM // TCP stream + ); + + CRawProtocolTypes: array [TSocketType] of Integer = (IPPROTO_UDP, + IPPROTO_TCP); + +type + TAddressType = (afIPv4, afIPv6); + +const + CAddressTypeNames: array [TAddressType] of string = ('IPv4', 'IPv6'); + +type +{$IFDEF MSWINDOWS} + TSocketHandle = Winapi.Winsock2.TSocket; + + PAddrInfoW = ^TAddrInfoW; + PPAddrInfoW = ^PAddrInfoW; + + TAddrInfoW = record + ai_flags: Integer; + ai_family: Integer; + ai_socktype: Integer; + ai_protocol: Integer; + ai_addrlen: ULONG; // is NativeUInt + ai_canonname: PWideChar; + ai_addr: PSOCKADDR; + ai_next: PAddrInfoW; + end; + + TGetAddrInfoW = function(NodeName: PWideChar; ServiceName: PWideChar; + Hints: PAddrInfoW; ppResult: PPAddrInfoW): Integer; stdcall; + TFreeAddrInfoW = procedure(ai: PAddrInfoW); stdcall; +{$ELSE} + TSocketHandle = Integer; +{$ENDIF} + TSocketHandleArray = array of TSocketHandle; + + EncLineException = class(Exception); + + TncLine = class; // Forward declaration + + TncLineOnConnectDisconnect = procedure(aLine: TncLine) of object; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncLine + // Bring in all functionality from WinSock API, with appropriate exception raising on errors + + TncLine = class(TObject) + private const + DefaultConnectTimeout = 100; // msec + private + FKind: TSocketType; + FFamily: TAddressType; + FMaxPort: Integer; + FActive: Boolean; + FLastSent: Int64; + FLastReceived: Int64; + FPeerIP: string; + FDataObject: TObject; + FOnConnected: TncLineOnConnectDisconnect; + FOnDisconnected: TncLineOnConnectDisconnect; + FOnBeforeConnected: TncLineOnConnectDisconnect; // Called before OnConnected for TLS setup + FOnBeforeDisconnected: TncLineOnConnectDisconnect; // Called before OnDisconnected for TLS cleanup + private + PropertyLock: TObject; // TMonitor synchronization object + FHandle: TSocketHandle; + FConnectTimeout: Integer; + +{$IFDEF MSWINDOWS} + AddrResult: PAddrInfoW; +{$ELSE} + AddrResult: Paddrinfo; +{$ENDIF} + function IsConnectionBased: Boolean; + procedure SetConnected; + procedure SetDisconnected; + function GetReceiveTimeout: Integer; + procedure SetReceiveTimeout(const Value: Integer); + function GetSendTimeout: Integer; + procedure SetSendTimeout(const Value: Integer); + function GetLastReceived: Int64; + procedure SetLastReceived(const Value: Int64); + function GetLastSent: Int64; + procedure SetLastSent(const Value: Int64); + protected const + DefaultKind = stTCP; + + const + DefaultFamily = afIPv4; + protected + procedure SetKind(const AKind: TSocketType); + procedure SetFamily(const Value: TAddressType); + function CreateLineObject: TncLine; virtual; + procedure Check(aCmdRes: Integer); inline; + + // API functions + procedure CreateClientHandle(const aHost: string; const aPort: Integer; + const aBroadcast: Boolean = False); + procedure CreateServerHandle(const aPort: Integer); + procedure DestroyHandle; + + function AcceptLine: TncLine; inline; + + function SendBuffer(const aBuf; aLen: Integer): Integer; inline; + function RecvBuffer(var aBuf; aLen: Integer): Integer; inline; + + procedure EnableNoDelay; inline; + procedure EnableKeepAlive; inline; + procedure EnableBroadcast; inline; + procedure EnableIPv6Only; inline; + + procedure EnableReuseAddress; inline; + procedure SetReceiveSize(const aBufferSize: Integer); + procedure SetWriteSize(const aBufferSize: Integer); + + property OnConnected: TncLineOnConnectDisconnect read FOnConnected + write FOnConnected; + property OnDisconnected: TncLineOnConnectDisconnect read FOnDisconnected + write FOnDisconnected; + property OnBeforeConnected: TncLineOnConnectDisconnect read FOnBeforeConnected + write FOnBeforeConnected; + property OnBeforeDisconnected: TncLineOnConnectDisconnect read FOnBeforeDisconnected + write FOnBeforeDisconnected; + public + constructor Create; overload; virtual; + destructor Destroy; override; + + property Kind: TSocketType read FKind; + property Family: TAddressType read FFamily; + property Handle: TSocketHandle read FHandle; + property Active: Boolean read FActive; + property LastSent: Int64 read GetLastSent write SetLastSent; + property LastReceived: Int64 read GetLastReceived write SetLastReceived; + property PeerIP: string read FPeerIP; + property DataObject: TObject read FDataObject write FDataObject; + property ConnectTimeout: Integer read FConnectTimeout write FConnectTimeout + default DefaultConnectTimeout; + property ReceiveTimeout: Integer read GetReceiveTimeout + write SetReceiveTimeout; + property SendTimeout: Integer read GetSendTimeout write SetSendTimeout; + end; + +function Readable(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): TSocketHandleArray; +function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): Boolean; inline; + +implementation + +// Readable checks to see if any socket handles have data +// and if so, overwrites aReadFDS with the data +function Readable(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): TSocketHandleArray; +{$IFDEF MSWINDOWS} +var + TimeoutValue: timeval; + FDSetPtr: PFdSet; + SocketArrayLength, SocketArrayBytes: Integer; +begin + TimeoutValue.tv_sec := aTimeout div 1000; + TimeoutValue.tv_usec := (aTimeout mod 1000) * 1000; + + SocketArrayLength := Length(aSocketHandleArray); + SocketArrayBytes := SocketArrayLength * SizeOf(TSocketHandle); + + // + 32 is there in case of compiler record field aligning + GetMem(FDSetPtr, SizeOf(FDSetPtr^.fd_count) + SocketArrayBytes + 32); + try + FDSetPtr^.fd_count := SocketArrayLength; + move(aSocketHandleArray[0], FDSetPtr^.fd_array[0], SocketArrayBytes); + + Select(0, FDSetPtr, nil, nil, @TimeoutValue); + + if FDSetPtr^.fd_count > 0 then + begin + SetLength(Result, FDSetPtr^.fd_count); + move(FDSetPtr^.fd_array[0], Result[0], FDSetPtr^.fd_count * + SizeOf(TSocketHandle)); + end + else + SetLength(Result, 0); // This is needed with newer compilers + finally + FreeMem(FDSetPtr); + end; +end; + +{$ELSE} + +var + TimeoutValue: timeval; + i: Integer; + SocketHandle: TSocketHandle; + FDSetPtr: Pfd_set; + FDArrayLen, FDNdx, ReadySockets, ResultNdx: Integer; +begin + TimeoutValue.tv_sec := aTimeout div 1000; + TimeoutValue.tv_usec := (aTimeout mod 1000) * 1000; + + // Find max socket handle + SocketHandle := 0; + for i := 0 to High(aSocketHandleArray) do + if SocketHandle < aSocketHandleArray[i] then + SocketHandle := aSocketHandleArray[i]; + + // NFDBITS is SizeOf(fd_mask) in bits (i.e. SizeOf(fd_mask) * 8)) + FDArrayLen := SocketHandle div NFDBITS + 1; + GetMem(FDSetPtr, FDArrayLen * SizeOf(fd_mask)); + try + FillChar(FDSetPtr^.fds_bits[0], FDArrayLen * SizeOf(fd_mask), 0); + for i := 0 to High(aSocketHandleArray) do + begin + SocketHandle := aSocketHandleArray[i]; + FDNdx := SocketHandle div NFDBITS; + FDSetPtr.fds_bits[FDNdx] := FDSetPtr.fds_bits[FDNdx] or + (1 shl (SocketHandle mod NFDBITS)); + end; + + ReadySockets := Select(FDArrayLen * NFDBITS, FDSetPtr, nil, nil, + @TimeoutValue); + + if ReadySockets > 0 then + begin + SetLength(Result, ReadySockets); + + ResultNdx := 0; + for i := 0 to High(aSocketHandleArray) do + begin + SocketHandle := aSocketHandleArray[i]; + FDNdx := SocketHandle div NFDBITS; + if FDSetPtr.fds_bits[FDNdx] and (1 shl (SocketHandle mod NFDBITS)) <> 0 + then + begin + Result[ResultNdx] := SocketHandle; + ResultNdx := ResultNdx + 1; + end; + end; + end + else + SetLength(Result, 0); + finally + FreeMem(FDSetPtr); + end; +end; +{$ENDIF} + +function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; + const aTimeout: Cardinal): Boolean; +begin + Result := Length(Readable(aSocketHandleArray, aTimeout)) > 0; +end; + +{$IFDEF MSWINDOWS} + +var + DllGetAddrInfo: TGetAddrInfoW = nil; + DllFreeAddrInfo: TFreeAddrInfoW = nil; + +procedure GetAddressInfo(NodeName: PWideChar; ServiceName: PWideChar; + Hints: PAddrInfoW; ppResult: PPAddrInfoW); +var + iRes: Integer; +begin + if LowerCase(string(NodeName)) = 'localhost' then + NodeName := '127.0.0.1'; + + iRes := DllGetAddrInfo(NodeName, ServiceName, Hints, ppResult); + if iRes <> 0 then + raise EncLineException.Create(SysErrorMessage(iRes)); +end; + +procedure FreeAddressInfo(ai: PAddrInfoW); +begin + DllFreeAddrInfo(ai); +end; + +function IsBroadcastAddress(const aHost: string): Boolean; +var + Octets: TArray; + LastOctet: Integer; +begin + // Split the IP into octets + Octets := aHost.Split(['.']); + + // Basic validation + if Length(Octets) <> 4 then + Exit(False); + + // Try to parse last octet + if not TryStrToInt(Octets[3], LastOctet) then + Exit(False); + + Result := + // Global broadcast + (aHost = '255.255.255.255') or + // Limited broadcast + (aHost = '0.0.0.0') or + // Subnet broadcast (last octet is 255) + (LastOctet = 255); +end; + +{$ENDIF} +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncLine } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncLine.Create; +begin + inherited Create; + + PropertyLock := TObject.Create; + FHandle := InvalidSocket; + FKind := DefaultKind; + FFamily := DefaultFamily; + + FConnectTimeout := DefaultConnectTimeout; + FActive := False; + FLastSent := TStopWatch.GetTimeStamp; + FLastReceived := FLastSent; + FPeerIP := '127.0.0.1'; + FDataObject := nil; + + FOnConnected := nil; + FOnDisconnected := nil; + FOnBeforeConnected := nil; + FOnBeforeDisconnected := nil; +end; + +destructor TncLine.Destroy; +begin + if FActive then + DestroyHandle; + + PropertyLock.Free; + inherited Destroy; +end; + +function TncLine.CreateLineObject: TncLine; +begin + Result := TncLine.Create; + Result.SetKind(Kind); + Result.SetFamily(Family); +end; + +/// ///////////////////////////////////////////////////////////////////////////// + +procedure TncLine.Check(aCmdRes: Integer); +begin + if aCmdRes = SocketError then +{$IFDEF MSWINDOWS} + raise EncLineException.Create(SysErrorMessage(WSAGetLastError)); +{$ELSE} + raise EncLineException.Create(SysErrorMessage(GetLastError)); +{$ENDIF} +end; + +procedure TncLine.CreateClientHandle(const aHost: string; const aPort: Integer; + const aBroadcast: Boolean = False); +var +{$IFDEF MSWINDOWS} + Hints: TAddrInfoW; + ErrorCode: Integer; +{$ELSE} + Hints: addrinfo; + AnsiHost, AnsiPort: RawByteString; +{$ENDIF} + ResolveHost: string; + ConnectResult: Integer; +begin + try + // Validate host for IPv6 if applicable + if (FFamily = afIPv6) and (aHost <> '') and (LowerCase(aHost) <> 'localhost') then + begin + // Validate IPv6 address format if it looks like an IPv6 address + if (Pos(':', aHost) > 0) and not TncIPUtils.IsIPv6ValidAddress(aHost) then + raise EIPError.CreateFmt('Invalid IPv6 address format: %s', [aHost]); + end; + + if IsBroadcastAddress(aHost) and not aBroadcast then + raise Exception.Create('Cannot use broadcast address when Broadcast is False'); + + FillChar(Hints, SizeOf(Hints), 0); + + // Set address family and related flags based on FFamily + case FFamily of + afIPv4: + begin + Hints.ai_family := AF_INET; + if LowerCase(aHost) = 'localhost' then + ResolveHost := '127.0.0.1' + else + ResolveHost := aHost; + end; + afIPv6: + begin + Hints.ai_family := AF_INET6; + Hints.ai_flags := AI_ADDRCONFIG; + // If it's a valid IPv6 address, normalize it + if (Pos(':', aHost) > 0) and TncIPUtils.IsIPv6ValidAddress(aHost) then + ResolveHost := TncIPUtils.NormalizeAddress(aHost) + else + ResolveHost := aHost; + + // Handle link-local addresses correctly + if TncIPUtils.IsLinkLocal(ResolveHost) then + begin + // Extract scope ID if present in the address + var ScopePos := Pos('%', ResolveHost); + if ScopePos > 0 then + ResolveHost := Copy(ResolveHost, 1, ScopePos - 1); + end; + end; + end; + + Hints.ai_socktype := CRawSocketTypes[FKind]; + Hints.ai_protocol := CRawProtocolTypes[FKind]; + + // Resolve the server address and port +{$IFDEF MSWINDOWS} + GetAddressInfo(PChar(ResolveHost), PChar(IntToStr(aPort)), @Hints, + @AddrResult); +{$ELSE} + AnsiHost := RawByteString(ResolveHost); + AnsiPort := RawByteString(IntToStr(aPort)); + GetAddrInfo(MarshaledAString(AnsiHost), MarshaledAString(AnsiPort), Hints, + AddrResult); +{$ENDIF} + try + // Create a SOCKET for connecting to server + FHandle := Socket(AddrResult^.ai_family, AddrResult^.ai_socktype, AddrResult^.ai_protocol); + Check(FHandle); + try +{$IFNDEF MSWINDOWS} + EnableReuseAddress; +{$ENDIF} + if IsConnectionBased then + begin + ConnectResult := Connect(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen); + if ConnectResult = -1 then + raise EncLineException.Create('Connect timeout'); + Check(ConnectResult); + + // For TLS connections, perform handshake BEFORE triggering OnConnected + if Assigned(FOnBeforeConnected) then + begin + try + FOnBeforeConnected(Self); // This will do TLS handshake + except + on E: Exception do + begin + DestroyHandle; + raise EncLineException.CreateFmt('TLS handshake failed: %s', [E.Message]); + end; + end; + end; + + SetConnected; // Only triggers OnConnected AFTER TLS is ready + end + else + begin + // For UDP, handle IPv4 and IPv6 differently + case FFamily of + afIPv4: + begin + // IPv4 UDP: connect if not broadcast mode + if not aBroadcast then + begin + ConnectResult := Connect(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen); + Check(ConnectResult); + end + else + begin + // Enable broadcast option for UDP broadcast + EnableBroadcast; + end; + SetConnected; + end; + afIPv6: + begin + // For IPv6 UDP with link-local addresses, ensure scope ID is set + if TncIPUtils.IsLinkLocal(ResolveHost) then + begin + var AddrIn6 := PSockAddrIn6(AddrResult^.ai_addr)^; + // Set appropriate scope ID if needed + // This could be enhanced with interface detection + end; + SetConnected; + end; + end; + end; + + except + DestroyHandle; + raise; + end; + finally +{$IFDEF MSWINDOWS} + FreeAddressInfo(AddrResult); +{$ELSE} + freeaddrinfo(AddrResult^); +{$ENDIF} + end; + except + FHandle := InvalidSocket; + raise; + end; +end; + +procedure TncLine.CreateServerHandle(const aPort: Integer); +var +{$IFDEF MSWINDOWS} + Hints: TAddrInfoW; +{$ELSE} + Hints: addrinfo; + AnsiPort: RawByteString; +{$ENDIF} +begin + FillChar(Hints, SizeOf(Hints), 0); + case FFamily of + afIPv4: + begin + Hints.ai_family := AF_INET; + end; + afIPv6: + begin + Hints.ai_family := AF_INET6; + end; + end; + Hints.ai_socktype := CRawSocketTypes[FKind]; + Hints.ai_protocol := CRawProtocolTypes[FKind]; + Hints.ai_flags := AI_PASSIVE; // Inform GetAddrInfo to return a server socket + + // Resolve the server address and port +{$IFDEF MSWINDOWS} + GetAddressInfo(nil, PChar(IntToStr(aPort)), @Hints, @AddrResult); +{$ELSE} + AnsiPort := RawByteString(IntToStr(aPort)); + GetAddrInfo(nil, MarshaledAString(AnsiPort), Hints, AddrResult); +{$ENDIF} + try + // Create a server listener socket + FHandle := Socket(AddrResult^.ai_family, AddrResult^.ai_socktype, + AddrResult^.ai_protocol); + Check(FHandle); + try + EnableIPv6Only; + +{$IFNDEF MSWINDOWS} + EnableReuseAddress; +{$ENDIF} + // Bind the socket + Check(bind(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen)); + + // For TCP, we need to listen for incoming connections + if IsConnectionBased then + Check(Listen(FHandle, SOMAXCONN)); + + SetConnected; + except + DestroyHandle; + raise; + end; + finally +{$IFDEF MSWINDOWS} + FreeAddressInfo(AddrResult); +{$ELSE} + freeaddrinfo(AddrResult^); +{$ENDIF} + end; +end; + +procedure TncLine.DestroyHandle; +begin + if FActive then + begin + // CRITICAL: Call TLS cleanup BEFORE destroying socket + if Assigned(FOnBeforeDisconnected) then + begin + try + FOnBeforeDisconnected(Self); // TLS cleanup while socket is still active + except + on E: Exception do + // Continue with socket cleanup even if TLS cleanup fails + end; + end; + + try +{$IFDEF MSWINDOWS} + Shutdown(FHandle, SD_BOTH); + CloseSocket(FHandle); +{$ELSE} + Shutdown(FHandle, SHUT_RDWR); + Posix.Unistd.__Close(FHandle); +{$ENDIF} + except + on E: Exception do + // + end; + try + SetDisconnected; + except + on E: Exception do + // + end; + FHandle := InvalidSocket; + end; +end; + +function TncLine.AcceptLine: TncLine; +var + NewHandle: TSocketHandle; +{$IFNDEF MSWINDOWS} + addr: sockaddr; + AddrLen: socklen_t; +{$ENDIF} +begin +{$IFDEF MSWINDOWS} + NewHandle := Accept(FHandle, nil, nil); +{$ELSE} + NewHandle := Accept(FHandle, addr, AddrLen); +{$ENDIF} + if NewHandle = InvalidSocket then + Abort; // raise silent exception + + Result := CreateLineObject; + + Result.FHandle := NewHandle; + Result.OnConnected := OnConnected; + Result.OnDisconnected := OnDisconnected; + Result.OnBeforeConnected := OnBeforeConnected; + Result.OnBeforeDisconnected := OnBeforeDisconnected; + + // For server-side TLS connections, perform handshake BEFORE triggering OnConnected + if Assigned(Result.OnBeforeConnected) then + begin + try + Result.OnBeforeConnected(Result); // This will do TLS handshake for server + except + on E: Exception do + begin + Result.DestroyHandle; + Result.Free; + raise EncLineException.CreateFmt('Server TLS handshake failed: %s', [E.Message]); + end; + end; + end; + + Result.SetConnected; +end; + +function TncLine.SendBuffer(const aBuf; aLen: Integer): Integer; +begin + Result := Send(FHandle, aBuf, aLen, 0); + + if Result = SocketError then + begin + if IsConnectionBased then + try + Abort; // TCP: raise silent exception + except + DestroyHandle; + raise; + end + else + Check(Result); // UDP: normal error check + end + else + LastSent := TStopWatch.GetTimeStamp; +end; + +function TncLine.RecvBuffer(var aBuf; aLen: Integer): Integer; +begin + Result := recv(FHandle, aBuf, aLen, 0); + + if (Result = SocketError) or + (IsConnectionBased and (Result = 0)) then // TCP: 0 means disconnected + begin + if IsConnectionBased then + try + Abort; // TCP: raise silent exception + except + DestroyHandle; + raise; + end + else + Check(Result); // UDP: normal error check + end + else + LastReceived := TStopWatch.GetTimeStamp; +end; + +procedure TncLine.EnableNoDelay; +var + optval: Integer; +begin + optval := 1; +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, IPPROTO_TCP, TCP_NODELAY, PAnsiChar(@optval), + SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, IPPROTO_TCP, TCP_NODELAY, optval, SizeOf(optval))); +{$ENDIF} +end; + +procedure TncLine.EnableKeepAlive; +var + optval: Integer; +begin + optval := 1; // any non zero indicates true +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_KEEPALIVE, PAnsiChar(@optval), + SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_KEEPALIVE, optval, SizeOf(optval))); +{$ENDIF} +end; + +procedure TncLine.EnableBroadcast; +var + optval: Integer; +begin + optval := 1; +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@optval), + SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, optval, SizeOf(optval))); +{$ENDIF} +end; + +procedure TncLine.EnableIPv6Only; +var + optval: Integer; +begin + if FFamily = afIPv6 then + begin + optval := 1; +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, IPPROTO_IPV6, IPV6_V6ONLY, PAnsiChar(@optval), + SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, IPPROTO_IPV6, IPV6_V6ONLY, optval, + SizeOf(optval))); +{$ENDIF} + end; +end; + +procedure TncLine.EnableReuseAddress; +var + optval: Integer; +begin + optval := 1; +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, PAnsiChar(@optval), + SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_REUSEADDR, optval, SizeOf(optval))); +{$ENDIF} +end; + +procedure TncLine.SetKind(const AKind: TSocketType); +begin + if FHandle = InvalidSocket then // TODO: Raise exception otherwise??? + begin + FKind := AKind; + end; +end; + +procedure TncLine.SetFamily(const Value: TAddressType); +begin + if FHandle = InvalidSocket then + // Only allow changing family when socket is not active + begin + FFamily := Value; + end + else + // Form1.Log('WARNING: Attempted to change Family while socket is active'); +end; + +function TncLine.IsConnectionBased: Boolean; +begin + Result := FKind = stTCP; +end; + +procedure TncLine.SetReceiveSize(const aBufferSize: Integer); +begin + // min is 512 bytes, max is 1048576 +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, PAnsiChar(@aBufferSize), + SizeOf(aBufferSize))); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, aBufferSize, + SizeOf(aBufferSize))); +{$ENDIF} +end; + +procedure TncLine.SetWriteSize(const aBufferSize: Integer); +begin +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_SNDBUF, PAnsiChar(@aBufferSize), + SizeOf(aBufferSize))); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVBUF, aBufferSize, + SizeOf(aBufferSize))); +{$ENDIF} +end; + +procedure TncLine.SetConnected; +var + addr: TSockAddrStorage; + AddrSize: {$IFDEF MSWINDOWS}Integer{$ELSE}socklen_t{$ENDIF}; +begin + if not FActive then + begin + FActive := True; + LastSent := TStopWatch.GetTimeStamp; + LastReceived := LastSent; + + if IsConnectionBased then + begin + // Get peer information + AddrSize := SizeOf(TSockAddrStorage); + + if GetPeerName(FHandle, PSOCKADDR(@addr)^, AddrSize) = 0 then + begin + try + FPeerIP := TncIPUtils.GetIPFromStorage(addr); + except + on E: EIPError do + FPeerIP := ''; + end; + + // If we got an empty string, set default values based on family + if FPeerIP = '' then + begin + case FFamily of + afIPv4: FPeerIP := '0.0.0.0'; + afIPv6: FPeerIP := '::'; + end; + end; + end + else + begin + var ErrorCode := {$IFDEF MSWINDOWS}WSAGetLastError(){$ELSE}GetLastError(){$ENDIF}; + FPeerIP := ''; + end; + end + else + begin + // For UDP, we're always "connected" but might not have peer info yet + case FFamily of + afIPv4: FPeerIP := '0.0.0.0'; + afIPv6: FPeerIP := '::'; + end; + end; + + if Assigned(OnConnected) then + try + OnConnected(Self); + except + end; + end; +end; + +procedure TncLine.SetDisconnected; +begin + if FActive then + begin + FActive := False; + + if Assigned(FOnDisconnected) then + try + OnDisconnected(Self); + except + end; + end; +end; + +function TncLine.GetReceiveTimeout: Integer; +var + Opt: Cardinal; + OptSize: {$IFDEF MSWINDOWS}Integer{$ELSE}socklen_t{$ENDIF}; +begin + OptSize := SizeOf(Opt); +{$IFDEF MSWINDOWS} + Check(GetSockOpt(FHandle, SOL_SOCKET, SO_RCVTIMEO, PAnsiChar(@Opt), OptSize)); +{$ELSE} + Check(GetSockOpt(FHandle, SOL_SOCKET, SO_RCVTIMEO, Opt, OptSize)); +{$ENDIF} + Result := Opt; +end; + +procedure TncLine.SetReceiveTimeout(const Value: Integer); +var + Opt: Cardinal; + OptSize: Integer; +begin + Opt := Value; + OptSize := SizeOf(Opt); +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVTIMEO, PAnsiChar(@Opt), OptSize)); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_RCVTIMEO, Opt, OptSize)); +{$ENDIF} +end; + +function TncLine.GetSendTimeout: Integer; +var + Opt: Cardinal; + OptSize: {$IFDEF MSWINDOWS}Integer{$ELSE}socklen_t{$ENDIF}; +begin + OptSize := SizeOf(Opt); +{$IFDEF MSWINDOWS} + Check(GetSockOpt(FHandle, SOL_SOCKET, SO_SNDTIMEO, PAnsiChar(@Opt), OptSize)); +{$ELSE} + Check(GetSockOpt(FHandle, SOL_SOCKET, SO_SNDTIMEO, Opt, OptSize)); +{$ENDIF} + Result := Opt; +end; + +procedure TncLine.SetSendTimeout(const Value: Integer); +var + Opt: Cardinal; + OptSize: Integer; +begin + Opt := Value; + OptSize := SizeOf(Opt); +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_SNDTIMEO, PAnsiChar(@Opt), OptSize)); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_SNDTIMEO, Opt, OptSize)); +{$ENDIF} +end; + +function TncLine.GetLastReceived: Int64; +begin + TMonitor.Enter(PropertyLock); + try + Result := FLastReceived; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncLine.SetLastReceived(const Value: Int64); +begin + TMonitor.Enter(PropertyLock); + try + FLastReceived := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncLine.GetLastSent: Int64; +begin + TMonitor.Enter(PropertyLock); + try + Result := FLastSent; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncLine.SetLastSent(const Value: Int64); +begin + TMonitor.Enter(PropertyLock); + try + FLastSent := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +{$IFDEF MSWINDOWS} + +// Windows-specific types and variables +var + ExtDllHandle: THandle = 0; + +procedure AttachAddrInfo; + procedure SafeLoadFrom(aDll: string); + begin + if not Assigned(DllGetAddrInfo) then + begin + ExtDllHandle := SafeLoadLibrary(aDll); + if ExtDllHandle <> 0 then + begin + DllGetAddrInfo := GetProcAddress(ExtDllHandle, 'GetAddrInfoW'); + DllFreeAddrInfo := GetProcAddress(ExtDllHandle, 'FreeAddrInfoW'); + if not Assigned(DllGetAddrInfo) then + begin + FreeLibrary(ExtDllHandle); + ExtDllHandle := 0; + end; + end; + end; + end; + +begin + SafeLoadFrom('ws2_32.dll'); + SafeLoadFrom('wship6.dll'); +end; +{$ENDIF} + +initialization + +{$IFDEF MSWINDOWS} + +var + WSAData: TWSAData; +begin + WSAStartup(MakeWord(2, 2), WSAData); + AttachAddrInfo; +end; +{$ENDIF} + +finalization + +{$IFDEF MSWINDOWS} +if ExtDllHandle <> 0 then + FreeLibrary(ExtDllHandle); +WSACleanup; +{$ENDIF} + +end. + diff --git a/Source_using_TMonitor/ncPendingCommandsList.pas b/Source_using_TMonitor/ncPendingCommandsList.pas new file mode 100644 index 0000000..a8b2be3 --- /dev/null +++ b/Source_using_TMonitor/ncPendingCommandsList.pas @@ -0,0 +1,204 @@ +unit ncPendingCommandsList; + +/// //////////////////////////////////////////////////////////////////////////// +// +// TPendingCommandsList +// Written by Demos Bill, Tue 11/08/2020 +// +// PendingCommandsList, the equivalent of TStringList +// but for the type of TncCommandUniqueID +// +/// //////////////////////////////////////////////////////////////////////////// + +interface + +uses System.Classes, System.SysUtils, System.RTLConsts, System.SyncObjs, ncCommandPacking; + +type + TPendingCommandItem = record + FUniqueID: TncCommandUniqueID; + FReceivedResultEvent: TLightweightEvent; + FResult: TncCommand; + end; + + PPendingCommandItem = ^TPendingCommandItem; + + TPendingCommandItemsList = array of TPendingCommandItem; + PPendingCommandItemsList = ^TPendingCommandItemsList; + + TPendingCommandsList = class(TPersistent) + private + FList: TPendingCommandItemsList; + FCount: Integer; + FCapacity: Integer; + function GetUniqueIDs(Index: Integer): TncCommandUniqueID; register; + function GetReceivedResultEvents(Index: Integer): TLightweightEvent; register; + procedure PutReceivedResultEvents(Index: Integer; aReceivedResultEvent: TLightweightEvent); + function GetResults(Index: Integer): TncCommand; + procedure PutResults(Index: Integer; const aResult: TncCommand); + procedure SetCapacity(aNewCapacity: Integer); + protected + procedure Insert(aIndex: Integer; const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent); + procedure Grow; + public + destructor Destroy; override; + + function Add(const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent): Integer; + procedure Clear; + procedure Delete(aIndex: Integer); register; + function Find(const aUniqueID: TncCommandUniqueID; var aIndex: Integer): Boolean; register; + function IndexOf(const aUniqueID: TncCommandUniqueID): Integer; register; + + property Count: Integer read FCount; + property UniqueIDs[index: Integer]: TncCommandUniqueID read GetUniqueIDs; default; + property ReceivedResultEvents[index: Integer]: TLightweightEvent read GetReceivedResultEvents write PutReceivedResultEvents; + property Results[index: Integer]: TncCommand read GetResults write PutResults; + end; + +implementation + +resourcestring + SDuplicateUniqueID = 'Command unique ID list does not allow duplicates'; + + { TPendingCommandList } + +destructor TPendingCommandsList.Destroy; +begin + inherited Destroy; + FCount := 0; + SetCapacity(0); +end; + +function TPendingCommandsList.Add(const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent): Integer; +begin + if Find(aUniqueID, Result) then + raise Exception.Create(SDuplicateUniqueID); + Insert(Result, aUniqueID, aReceivedResultEvent); +end; + +procedure TPendingCommandsList.Clear; +begin + if FCount <> 0 then + begin + FCount := 0; + SetCapacity(0); + end; +end; + +procedure TPendingCommandsList.Delete(aIndex: Integer); +begin + if (aIndex < 0) or (aIndex >= FCount) then + raise Exception.Create(Format(SListIndexError, [aIndex])); + + Dec(FCount); + if aIndex < FCount then + System.Move(FList[aIndex + 1], FList[aIndex], (FCount - aIndex) * SizeOf(TPendingCommandItem)); +end; + +// Binary Searching + +function TPendingCommandsList.Find(const aUniqueID: TncCommandUniqueID; var aIndex: Integer): Boolean; +var + Low, High, Mid: Integer; +begin + Result := False; + Low := 0; + High := FCount - 1; + while Low <= High do + begin + Mid := (Low + High) shr 1; + if aUniqueID > FList[Mid].FUniqueID then + Low := Mid + 1 + else + begin + High := Mid - 1; + if aUniqueID = FList[Mid].FUniqueID then + begin + Result := True; + Low := Mid; + end; + end; + end; + aIndex := Low; +end; + +procedure TPendingCommandsList.Grow; +var + Delta: Integer; +begin + if FCapacity > 64 then + Delta := FCapacity div 4 + else if FCapacity > 8 then + Delta := 16 + else + Delta := 4; + SetCapacity(FCapacity + Delta); +end; + +function TPendingCommandsList.IndexOf(const aUniqueID: TncCommandUniqueID): Integer; +begin + if not Find(aUniqueID, Result) then + Result := -1; +end; + +procedure TPendingCommandsList.Insert(aIndex: Integer; const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent); +begin + if FCount = FCapacity then + Grow; + if aIndex < FCount then + System.Move(FList[aIndex], FList[aIndex + 1], (FCount - aIndex) * SizeOf(TPendingCommandItem)); + with FList[aIndex] do + begin + FUniqueID := aUniqueID; + FReceivedResultEvent := aReceivedResultEvent; + end; + Inc(FCount); +end; + +function TPendingCommandsList.GetUniqueIDs(Index: Integer): TncCommandUniqueID; +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + Result := FList[index].FUniqueID; +end; + +function TPendingCommandsList.GetReceivedResultEvents(Index: Integer): TLightweightEvent; +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + Result := FList[index].FReceivedResultEvent; +end; + +procedure TPendingCommandsList.PutReceivedResultEvents(Index: Integer; aReceivedResultEvent: TLightweightEvent); +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + FList[index].FReceivedResultEvent := aReceivedResultEvent; +end; + +function TPendingCommandsList.GetResults(Index: Integer): TncCommand; +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + Result := FList[index].FResult; +end; + +procedure TPendingCommandsList.PutResults(Index: Integer; const aResult: TncCommand); +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + FList[index].FResult := aResult; +end; + +procedure TPendingCommandsList.SetCapacity(aNewCapacity: Integer); +begin + if aNewCapacity < FCount then + raise Exception.Create(Format(SListCapacityError, [aNewCapacity])); + if aNewCapacity <> FCapacity then + begin + SetLength(FList, aNewCapacity); + FCapacity := aNewCapacity; + end; +end; + +end. diff --git a/Source_using_TMonitor/ncSChannel.pas b/Source_using_TMonitor/ncSChannel.pas new file mode 100644 index 0000000..5f612e0 --- /dev/null +++ b/Source_using_TMonitor/ncSChannel.pas @@ -0,0 +1,1544 @@ +unit ncSChannel; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// +// This unit implements TLS/SSL support for NetCom7 through Windows SChannel +// (Secure Channel) API integration. Provides secure communication capabilities +// for both TCP servers and clients using native Windows cryptographic services. +// +// 13/07/2025 - by J.Pauwels +// - Initial creation +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +interface + +uses + SysUtils, + Classes, + Windows; + +//****************************************************************************** +// CryptoAPI +//****************************************************************************** +const + CERT_STORE_PROV_FILENAME = 8; + CERT_STORE_PROV_MEMORY = 2; + CERT_STORE_OPEN_EXISTING_FLAG = $00004000; + CERT_STORE_READONLY_FLAG = $00008000; + PKCS12_NO_PERSIST_KEY = $00008000; + PKCS12_INCLUDE_EXTENDED_PROPERTIES = $00000010; + + CERT_FIND_ANY = 0; + // no check is made to determine whether memory for contexts remains allocated + CERT_CLOSE_STORE_DEFAULT = 0; + // force freeing all contexts associated with the store + CERT_CLOSE_STORE_FORCE_FLAG = 1; + // checks for nonfreed certificate, CRL, and CTL context to report an error on leak + CERT_CLOSE_STORE_CHECK_FLAG = 2; + + CRYPT_ASN_ENCODING = $00000001; + CRYPT_NDR_ENCODING = $00000002; + X509_ASN_ENCODING = $00000001; + X509_NDR_ENCODING = $00000002; + PKCS_7_ASN_ENCODING = $00010000; + PKCS_7_NDR_ENCODING = $00020000; + // TCryptCertUsage mormot.crypt.secure + CERT_OFFLINE_CRL_SIGN_KEY_USAGE = $02; // cuCrlSign + CERT_KEY_CERT_SIGN_KEY_USAGE = $04; // cuKeyCertSign + CERT_KEY_AGREEMENT_KEY_USAGE = $08; // cuKeyAgreement + CERT_DATA_ENCIPHERMENT_KEY_USAGE = $10; // cuDataEncipherment + CERT_KEY_ENCIPHERMENT_KEY_USAGE = $20; // cuKeyEncipherment + CERT_NON_REPUDIATION_KEY_USAGE = $40; // cuNonRepudiation + CERT_DIGITAL_SIGNATURE_KEY_USAGE = $80; // cuDigitalSignature + + CERT_KEY_PROV_INFO_PROP_ID = 2; + CERT_HASH_PROP_ID = 3; + CERT_FRIENDLY_NAME_PROP_ID = 11; + + CERT_SIMPLE_NAME_STR = 1; + CERT_OID_NAME_STR = 2; + CERT_X500_NAME_STR = 3; + + CRYPT_OID_INFO_OID_KEY = 1; + +type + HCRYPTPROV = pointer; + HCRYPTKEY = pointer; + HCRYPTHASH = pointer; + HCERTSTORE = pointer; + + CRYPTOAPI_BLOB = record + cbData: DWORD; + pbData: PByteArray; + end; + CRYPT_INTEGER_BLOB = CRYPTOAPI_BLOB; + CERT_NAME_BLOB = CRYPTOAPI_BLOB; + CRYPT_OBJID_BLOB = CRYPTOAPI_BLOB; + CRYPT_DATA_BLOB = CRYPTOAPI_BLOB; + PCRYPT_DATA_BLOB = ^CRYPT_DATA_BLOB; + + CRYPT_BIT_BLOB = record + cbData: DWORD; + pbData: PByteArray; + cUnusedBits: DWORD; + end; + + CRYPT_ALGORITHM_IDENTIFIER = record + pszObjId: PAnsiChar; + Parameters: CRYPT_OBJID_BLOB; + end; + + CERT_PUBLIC_KEY_INFO = record + Algorithm: CRYPT_ALGORITHM_IDENTIFIER; + PublicKey: CRYPT_BIT_BLOB; + end; + + CERT_EXTENSION = record + pszObjId: PAnsiChar; + fCritical: BOOL; + Blob: CRYPT_OBJID_BLOB; + end; + PCERT_EXTENSION = ^CERT_EXTENSION; + CERT_EXTENSIONS = array[word] of CERT_EXTENSION; + PCERT_EXTENSIONS = ^CERT_EXTENSIONS; + + CERT_INFO = record + dwVersion: DWORD; + SerialNumber: CRYPT_INTEGER_BLOB; + SignatureAlgorithm: CRYPT_ALGORITHM_IDENTIFIER; + Issuer: CERT_NAME_BLOB; + NotBefore: TFileTime; + NotAfter: TFileTime; + Subject: CERT_NAME_BLOB; + SubjectPublicKeyInfo: CERT_PUBLIC_KEY_INFO; + IssuerUniqueId: CRYPT_BIT_BLOB; + SubjectUniqueId: CRYPT_BIT_BLOB; + cExtension: DWORD; + rgExtension: PCERT_EXTENSIONS; + end; + PCERT_INFO = ^CERT_INFO; + + CERT_CONTEXT = record + dwCertEncodingType: DWORD; + pbCertEncoded: PByte; + cbCertEncoded: DWORD; + pCertInfo: PCERT_INFO; + hCertStore: HCERTSTORE; + end; + PCCERT_CONTEXT = ^CERT_CONTEXT; + PPCCERT_CONTEXT = ^PCCERT_CONTEXT; + +CRYPT_KEY_PROV_PARAM = record + dwParam: DWORD; + pbData: PByte; + cbData: DWORD; + dwFlags: DWORD; + end; + PCRYPT_KEY_PROV_PARAM = ^CRYPT_KEY_PROV_PARAM; + + CRYPT_KEY_PROV_INFO = record + pwszContainerName: PWideChar; + pwszProvName: PWideChar; + dwProvType: DWORD; + dwFlags: DWORD; + cProvParam: DWORD; + rgProvParam: PCRYPT_KEY_PROV_PARAM; + dwKeySpec: DWORD; + end; + PCRYPT_KEY_PROV_INFO = ^CRYPT_KEY_PROV_INFO; + + CRYPT_OID_INFO = record + cbSize: DWORD; + pszOID: PAnsiChar; + pwszName: PWideChar; + dwGroupId: DWORD; + Union: record + case integer of + 0: (dwValue: DWORD); + 1: (Algid: DWORD); + 2: (dwLength: DWORD); + end; + ExtraInfo: CRYPTOAPI_BLOB; + end; + PCRYPT_OID_INFO = ^CRYPT_OID_INFO; + + PCCRL_CONTEXT = pointer; + PPCCRL_CONTEXT = ^PCCRL_CONTEXT; + PCRYPT_ATTRIBUTE = pointer; + + CRYPT_SIGN_MESSAGE_PARA = record + cbSize: DWORD; + dwMsgEncodingType: DWORD; + pSigningCert: PCCERT_CONTEXT; + HashAlgorithm: CRYPT_ALGORITHM_IDENTIFIER; + pvHashAuxInfo: pointer; + cMsgCert: DWORD; + rgpMsgCert: PPCCERT_CONTEXT; + cMsgCrl: DWORD; + rgpMsgCrl: PPCCRL_CONTEXT; + cAuthAttr: DWORD; + rgAuthAttr: PCRYPT_ATTRIBUTE; + cUnauthAttr: DWORD; + rgUnauthAttr: PCRYPT_ATTRIBUTE; + dwFlags: DWORD; + dwInnerContentType: DWORD; + HashEncryptionAlgorithm: CRYPT_ALGORITHM_IDENTIFIER; + pvHashEncryptionAuxInfo: pointer; + end; + + PFN_CRYPT_GET_SIGNER_CERTIFICATE = function(pvGetArg: pointer; + dwCertEncodingType: DWORD; pSignerId: PCERT_INFO; + hMsgCertStore: HCERTSTORE): PCCERT_CONTEXT; stdcall; + CRYPT_VERIFY_MESSAGE_PARA = record + cbSize: DWORD; + dwMsgAndCertEncodingType: DWORD; + hCryptProv: HCRYPTPROV; + pfnGetSignerCertificate: PFN_CRYPT_GET_SIGNER_CERTIFICATE; + pvGetArg: pointer; + end; + +//****************************************************************************** +// Low-Level SSPI/SChannel +//****************************************************************************** +const + SECBUFFER_VERSION = 0; + + SECBUFFER_EMPTY = 0; + SECBUFFER_DATA = 1; + SECBUFFER_TOKEN = 2; + SECBUFFER_EXTRA = 5; + SECBUFFER_STREAM_TRAILER = 6; + SECBUFFER_STREAM_HEADER = 7; + SECBUFFER_PADDING = 9; + SECBUFFER_STREAM = 10; + SECBUFFER_ALERT = 17; + + SECPKG_CRED_INBOUND = 1; + SECPKG_CRED_OUTBOUND = 2; + + SECPKG_ATTR_SIZES = 0; + SECPKG_ATTR_NAMES = 1; + SECPKG_ATTR_STREAM_SIZES = 4; + SECPKG_ATTR_NEGOTIATION_INFO = 12; + SECPKG_ATTR_ACCESS_TOKEN = 13; + SECPKG_ATTR_REMOTE_CERT_CONTEXT = $53; + SECPKG_ATTR_CONNECTION_INFO = $5a; + SECPKG_ATTR_CIPHER_INFO = $64; // Vista+ new API + SECPKG_ATTR_C_ACCESS_TOKEN = $80000012; + SECPKG_ATTR_C_FULL_ACCESS_TOKEN = $80000082; + + SECPKGCONTEXT_CIPHERINFO_V1 = 1; + + SECURITY_NETWORK_DREP = 0; + SECURITY_NATIVE_DREP = $10; + + ISC_REQ_DELEGATE = $00000001; + ISC_REQ_MUTUAL_AUTH = $00000002; + ISC_REQ_REPLAY_DETECT = $00000004; + ISC_REQ_SEQUENCE_DETECT = $00000008; + ISC_REQ_CONFIDENTIALITY = $00000010; + ISC_REQ_USE_SESSION_KEY = $00000020; + ISC_REQ_PROMPT_FOR_CREDS = $00000040; + ISC_REQ_USE_SUPPLIED_CREDS = $00000080; + ISC_REQ_ALLOCATE_MEMORY = $00000100; + ISC_REQ_USE_DCE_STYLE = $00000200; + ISC_REQ_DATAGRAM = $00000400; + ISC_REQ_CONNECTION = $00000800; + ISC_REQ_CALL_LEVEL = $00001000; + ISC_REQ_FRAGMENT_SUPPLIED = $00002000; + ISC_REQ_EXTENDED_ERROR = $00004000; + ISC_REQ_STREAM = $00008000; + ISC_REQ_INTEGRITY = $00010000; + ISC_REQ_IDENTIFY = $00020000; + ISC_REQ_NULL_SESSION = $00040000; + ISC_REQ_MANUAL_CRED_VALIDATION = $00080000; + ISC_REQ_RESERVED1 = $00100000; + ISC_REQ_FRAGMENT_TO_FIT = $00200000; + ISC_REQ_FLAGS = ISC_REQ_SEQUENCE_DETECT or + ISC_REQ_REPLAY_DETECT or + ISC_REQ_CONFIDENTIALITY or + ISC_REQ_EXTENDED_ERROR or + ISC_REQ_ALLOCATE_MEMORY or + ISC_REQ_STREAM; + + ASC_REQ_REPLAY_DETECT = $00000004; + ASC_REQ_SEQUENCE_DETECT = $00000008; + ASC_REQ_CONFIDENTIALITY = $00000010; + ASC_REQ_ALLOCATE_MEMORY = $00000100; + ASC_REQ_EXTENDED_ERROR = $00008000; + ASC_REQ_STREAM = $00010000; + ASC_REQ_FLAGS = ASC_REQ_SEQUENCE_DETECT or + ASC_REQ_REPLAY_DETECT or + ASC_REQ_CONFIDENTIALITY or + ASC_REQ_EXTENDED_ERROR or + ASC_REQ_ALLOCATE_MEMORY or + ASC_REQ_STREAM; + + SEC_E_OK = 0; + + SEC_I_CONTINUE_NEEDED = $00090312; + SEC_I_COMPLETE_NEEDED = $00090313; + SEC_I_COMPLETE_AND_CONTINUE = $00090314; + SEC_I_CONTEXT_EXPIRED = $00090317; + SEC_I_INCOMPLETE_CREDENTIALS = $00090320; + SEC_I_RENEGOTIATE = $00090321; + + SEC_E_UNSUPPORTED_FUNCTION = $80090302; + SEC_E_INVALID_TOKEN = $80090308; + SEC_E_MESSAGE_ALTERED = $8009030F; + SEC_E_CONTEXT_EXPIRED = $80090317; + SEC_E_INCOMPLETE_MESSAGE = $80090318; + SEC_E_BUFFER_TOO_SMALL = $80090321; + SEC_E_ILLEGAL_MESSAGE = $80090326; + SEC_E_CERT_UNKNOWN = $80090327; + SEC_E_CERT_EXPIRED = $80090328; + SEC_E_ENCRYPT_FAILURE = $80090329; + SEC_E_DECRYPT_FAILURE = $80090330; + SEC_E_ALGORITHM_MISMATCH = $80090331; + + SEC_WINNT_AUTH_IDENTITY_UNICODE = $02; + + SCHANNEL_SHUTDOWN = 1; + + SCHANNEL_CRED_VERSION = 4; + SCH_CREDENTIALS_VERSION = 5; + + SCH_CRED_NO_SYSTEM_MAPPER = $00000002; + SCH_CRED_NO_SERVERNAME_CHECK = $00000004; + SCH_CRED_MANUAL_CRED_VALIDATION = $00000008; + SCH_CRED_NO_DEFAULT_CREDS = $00000010; + SCH_CRED_AUTO_CRED_VALIDATION = $00000020; + SCH_CRED_USE_DEFAULT_CREDS = $00000040; + SCH_CRED_DISABLE_RECONNECTS = $00000080; + SCH_CRED_REVOCATION_CHECK_END_CERT = $00000100; + SCH_CRED_REVOCATION_CHECK_CHAIN = $00000200; + SCH_CRED_REVOCATION_CHECK_CHAIN_EXCLUDE_ROOT = $00000400; + SCH_CRED_IGNORE_NO_REVOCATION_CHECK = $00000800; + SCH_CRED_IGNORE_REVOCATION_OFFLINE = $00001000; + SCH_CRED_RESTRICTED_ROOTS = $00002000; + SCH_CRED_REVOCATION_CHECK_CACHE_ONLY = $00004000; + SCH_CRED_CACHE_ONLY_URL_RETRIEVAL = $00008000; + SCH_CRED_MEMORY_STORE_CERT = $00010000; + SCH_CRED_CACHE_ONLY_URL_RETRIEVAL_ON_CREATE = $00020000; + SCH_SEND_ROOT_CERT = $00040000; + SCH_USE_STRONG_CRYPTO = $00400000; + + UNISP_NAME = 'Microsoft Unified Security Protocol Provider'; + + SP_PROT_TLS1_0_SERVER = $0040; + SP_PROT_TLS1_0_CLIENT = $0080; + SP_PROT_TLS1_1_SERVER = $0100; + SP_PROT_TLS1_1_CLIENT = $0200; + SP_PROT_TLS1_2_SERVER = $0400; // first SP_PROT_TLS_SAFE protocol + SP_PROT_TLS1_2_CLIENT = $0800; + SP_PROT_TLS1_3_SERVER = $1000; // Windows 11 or Windows Server 2022 ;) + SP_PROT_TLS1_3_CLIENT = $2000; + // SSL 2/3 protocols ($04,$08,$10,$20) are just not defined at all + SP_PROT_TLS1_0 = SP_PROT_TLS1_0_CLIENT or SP_PROT_TLS1_0_SERVER; + SP_PROT_TLS1_1 = SP_PROT_TLS1_1_CLIENT or SP_PROT_TLS1_1_SERVER; + SP_PROT_TLS1_2 = SP_PROT_TLS1_2_CLIENT or SP_PROT_TLS1_2_SERVER; + SP_PROT_TLS1_3 = SP_PROT_TLS1_3_CLIENT or SP_PROT_TLS1_3_SERVER; + // TLS 1.0 and TLS 1.1 are universally deprecated + SP_PROT_TLS_SAFE = SP_PROT_TLS1_2 or SP_PROT_TLS1_3; + SP_PROT_TLS_UNSAFE = pred(SP_PROT_TLS1_2_SERVER); + + +type + {$ifdef WIN64} + LONG_PTR = Int64; + {$else} + LONG_PTR = integer; + {$endif} + + ALG_ID = cardinal; + TALG_IDs = array[word] of ALG_ID; + PALG_IDs = ^TALG_IDs; + + _HMAPPER = pointer; + + /// SSPI context handle + TSecHandle = record + dwLower: LONG_PTR; + dwUpper: LONG_PTR; + end; + PSecHandle = ^TSecHandle; + + // some context aliases, as defined in SSPI headers + TCredHandle = type TSecHandle; + PCredHandle = type PSecHandle; + TCtxtHandle = type TSecHandle; + PCtxtHandle = type PSecHandle; + + TSChannelCred = record + dwVersion: cardinal; + cCreds: cardinal; + paCred: PPCCERT_CONTEXT; + hRootStore: HCERTSTORE; + cMappers: cardinal; + aphMappers: _HMAPPER; + cSupportedAlgs: cardinal; + palgSupportedAlgs: PALG_IDs; + grbitEnabledProtocols: cardinal; + dwMinimumCipherStrength: cardinal; + dwMaximumCipherStrength: cardinal; + dwSessionLifespan: cardinal; + dwFlags: cardinal; + dwCredFormat: cardinal; + end; + PSChannelCred = ^TSChannelCred; + + TSecBuffer = record + cbBuffer: cardinal; + BufferType: cardinal; + pvBuffer: pointer; + end; + PSecBuffer = ^TSecBuffer; + + TSecBufferDesc = record + ulVersion: cardinal; + cBuffers: cardinal; + pBuffers: PSecBuffer; + end; + PSecBufferDesc = ^TSecBufferDesc; + + TTimeStamp = record + dwLowDateTime: cardinal; + dwHighDateTime: cardinal; + end; + PTimeStamp = ^TTimeStamp; + + TSecPkgContextStreamSizes = record + cbHeader: cardinal; + cbTrailer: cardinal; + cbMaximumMessage: cardinal; + cBuffers: cardinal; + cbBlockSize: cardinal; + end; + PSecPkgContextStreamSizes = ^TSecPkgContextStreamSizes; + + /// store information about a SSPI package + TSecPkgInfoW = record + fCapabilities: Cardinal; + wVersion: Word; + wRPCID: Word; + cbMaxToken: Cardinal; + Name: PWideChar; + Comment: PWideChar; + end; + /// pointer to information about a SSPI package + PSecPkgInfoW = ^TSecPkgInfoW; + + ESChannel = class(Exception); + + + {$ifdef USERECORDWITHMETHODS}TSChannelClient = record + {$else}TSChannelClient = object{$endif} + private + Cred: TCredHandle; + Ctxt: TCtxtHandle; + Sizes: TSecPkgContextStreamSizes; + Data, Input: AnsiString; + InputSize, DataPos, DataCount, InputCount: integer; + SessionClosed: boolean; + procedure HandshakeLoop(aLine: TObject); + procedure AppendData(const aBuffer: TSecBuffer); + public + Initialized: boolean; + procedure AfterConnection(aLine: TObject; const aTargetHost: AnsiString; aIgnoreCertificateErrors: boolean); + procedure BeforeDisconnection(aLine: TObject); + function Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + function Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + end; + + // Server-side SChannel implementation + {$ifdef USERECORDWITHMETHODS}TSChannelServer = record + {$else}TSChannelServer = object{$endif} + private + Cred: TCredHandle; + Ctxt: TCtxtHandle; + Sizes: TSecPkgContextStreamSizes; + Data, Input: AnsiString; + InputSize, DataPos, DataCount, InputCount: integer; + SessionClosed: boolean; + procedure HandshakeLoop(aLine: TObject); + procedure AppendData(const aBuffer: TSecBuffer); + public + Initialized: boolean; + HandshakeCompleted: boolean; + procedure AfterConnection(aLine: TObject; const aCertificateFile, aPrivateKeyPassword: AnsiString); + procedure BeforeDisconnection(aLine: TObject); + function Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + function Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; + end; + + +// crypt32.dll API calls + +function CertOpenStore(lpszStoreProvider: PAnsiChar; dwEncodingType: cardinal; + hCryptProv: HCRYPTPROV; dwFlags: cardinal; pvPara: pointer): HCERTSTORE; stdcall; + external 'crypt32.dll'; + +function CertCloseStore(hCertStore: HCERTSTORE; dwFlags: cardinal): BOOL; stdcall; + external 'crypt32.dll'; + +function CertEnumCertificatesInStore(hCertStore: HCERTSTORE; + pPrevCertContext: PCCERT_CONTEXT): PCCERT_CONTEXT; stdcall; + external 'crypt32.dll'; + +function CertFreeCertificateContext(pCertContext: PCCERT_CONTEXT): BOOL; stdcall; + external 'crypt32.dll'; + +function PFXImportCertStore(pPFX: pointer; szPassword: PWideChar; + dwFlags: cardinal): HCERTSTORE; stdcall; + external 'crypt32.dll'; + +// secur32.dll API calls + +function AcquireCredentialsHandleW(pszPrincipal, pszPackage: PWideChar; + fCredentialUse: cardinal; pvLogonId: pointer; pAuthData: PSChannelCred; + pGetKeyFn: pointer; pvGetKeyArgument: pointer; phCredential: PCredHandle; + ptsExpiry: PTimeStamp): cardinal; stdcall; + external 'secur32.dll'; + +function QuerySecurityPackageInfoW(pszPackageName: PWideChar; + var ppPackageInfo: PSecPkgInfoW): cardinal; stdcall; + external 'secur32.dll'; + +function FreeCredentialsHandle(phCredential: PCredHandle): cardinal; stdcall; + external 'secur32.dll'; + +function InitializeSecurityContextW(phCredential: PCredHandle; phContext: PCtxtHandle; + pszTargetName: PWideChar; fContextReq, Reserved1, TargetDataRep: cardinal; + pInput: PSecBufferDesc; Reserved2: cardinal; phNewContext: PCtxtHandle; + pOutput: PSecBufferDesc; var pfContextAttr: cardinal; + ptsExpiry: PTimeStamp): cardinal; stdcall; + external 'secur32.dll'; + +function AcceptSecurityContext(phCredential: PCredHandle; phContext: PCtxtHandle; + pInput: PSecBufferDesc; fContextReq, TargetDataRep: cardinal; + phNewContext: PCtxtHandle; pOutput: PSecBufferDesc; var pfContextAttr: cardinal; + ptsExpiry: PTimeStamp): cardinal; stdcall; + external 'secur32.dll'; + +function DeleteSecurityContext(phContext: PCtxtHandle): cardinal; stdcall; + external 'secur32.dll'; + +function ApplyControlToken(phContext: PCtxtHandle; + pInput: PSecBufferDesc): cardinal; stdcall; + external 'secur32.dll'; + +function QueryContextAttributesW(phContext: PCtxtHandle; ulAttribute: cardinal; + pBuffer: pointer): cardinal; stdcall; + external 'secur32.dll'; + +function FreeContextBuffer(pvContextBuffer: pointer): cardinal; stdcall; + external 'secur32.dll'; + +function EncryptMessage(phContext: PCtxtHandle; fQOP: cardinal; + pMessage: PSecBufferDesc; MessageSeqNo: cardinal): cardinal; stdcall; + external 'secur32.dll'; + +function DecryptMessage(phContext: PCtxtHandle; pMessage: PSecBufferDesc; + MessageSeqNo: cardinal; pfQOP: PCardinal): cardinal; stdcall; + external 'secur32.dll'; + +implementation + +// Add reference to NetCom7 lines unit +uses ncLines; + +// We make a descendant of TncLine so that we can access the protected methods +type + TncLineInternal = class(TncLine); + +{ Certificate Loading Functions } + +function LoadCertificateFromPFX(const FileName: AnsiString; const Password: AnsiString): PCCERT_CONTEXT; +var + FileHandle: THandle; + FileSize: DWORD; + PFXData: array of Byte; + BytesRead: DWORD; + PFXBlob: CRYPT_DATA_BLOB; + CertStore: HCERTSTORE; + PasswordW: WideString; +begin + Result := nil; + + // Read PFX file + FileHandle := CreateFileA(PAnsiChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); + if FileHandle = INVALID_HANDLE_VALUE then + begin + // Failed to open file + Exit; + end; + + try + FileSize := GetFileSize(FileHandle, nil); + if FileSize = INVALID_FILE_SIZE then + begin + // Invalid file size + Exit; + end; + + SetLength(PFXData, FileSize); + if not ReadFile(FileHandle, PFXData[0], FileSize, BytesRead, nil) or (BytesRead <> FileSize) then + begin + // Failed to read file data + Exit; + end; + finally + CloseHandle(FileHandle); + end; + + // Import PFX + PFXBlob.cbData := FileSize; + PFXBlob.pbData := @PFXData[0]; + PasswordW := WideString(string(Password)); // Convert AnsiString to WideString + + // Import with no flags to allow full private key access for TLS operations + CertStore := PFXImportCertStore(@PFXBlob, PWideChar(PasswordW), 0); + if CertStore = nil then + begin + // PFXImportCertStore failed + Exit; + end; + + try + // Get first certificate from store + Result := CertEnumCertificatesInStore(CertStore, nil); + finally + CertCloseStore(CertStore, 0); + end; +end; + +{ SChannel Simplified Cleanup Functions} + +/// Simplified cleanup for security context handles +procedure FreeSecurityContextSafe(var handle: TCtxtHandle); +begin + if (handle.dwLower <> 0) or (handle.dwUpper <> 0) then begin + DeleteSecurityContext(@handle); + FillChar(handle, SizeOf(handle), 0); + end; +end; + +/// Simplified cleanup for credential handles +procedure FreeCredentialsHandleSafe(var handle: TCredHandle); +begin + if (handle.dwLower <> 0) or (handle.dwUpper <> 0) then begin + FreeCredentialsHandle(@handle); + FillChar(handle, SizeOf(handle), 0); + end; +end; + +/// Check if credential handle is in uninitialized state +function IsCredHandleInvalid(const handle: TCredHandle): Boolean; +begin + Result := (handle.dwLower = 0) and (handle.dwUpper = 0); +end; + +{ TSChannel Helper Functions } + +procedure RaiseLastError; // not defined e.g. with Delphi 5 +var + LastError: Integer; +begin + LastError := GetLastError; + if LastError <> 0 then + raise ESChannel.CreateFmt('System Error %d [%s]', [LastError, SysErrorMessage(LastError)]) + else + raise ESChannel.Create('Unknown SChannel error'); +end; + +function CheckSEC_E_OK(res: cardinal): cardinal; +begin + if res <> SEC_E_OK then + begin + case res of + $80090318: raise ESChannel.Create('SEC_E_INCOMPLETE_MESSAGE'); + $80090308: raise ESChannel.Create('SEC_E_INVALID_TOKEN'); + $00090312: raise ESChannel.Create('SEC_I_CONTINUE_NEEDED (unexpected)'); + $00090320: raise ESChannel.Create('SEC_I_INCOMPLETE_CREDENTIALS (unexpected)'); + $00090321: raise ESChannel.Create('SEC_I_RENEGOTIATE (unexpected)'); + $00090317: raise ESChannel.Create('SEC_I_CONTEXT_EXPIRED (unexpected)'); + else + raise ESChannel.CreateFmt('SChannel error: 0x%08X', [res]); + end; + end; + result := res; +end; + +function CheckSocket(res: integer): cardinal; +begin + if res <= 0 then + raise ESChannel.CreateFmt('Socket Error %d', [res]); + result := res; +end; + +const + TLSRECMAXSIZE = 19000; // stack buffers for TSChannelClient.Receive/Send + +type + {$ifdef USERECORDWITHMETHODS}THandshakeBuf = record + {$else}THandshakeBuf = object{$endif} + public + buf: array[0..4] of TSecBuffer; + input, output: TSecBufferDesc; + procedure Init; + end; + +procedure THandshakeBuf.Init; +begin + input.ulVersion := SECBUFFER_VERSION; + input.cBuffers := 2; + input.pBuffers := @buf[0]; + buf[0].cbBuffer := 0; + buf[0].BufferType := SECBUFFER_TOKEN; + buf[0].pvBuffer := nil; + buf[1].cbBuffer := 0; + buf[1].BufferType := SECBUFFER_EMPTY; + buf[1].pvBuffer := nil; + output.ulVersion := SECBUFFER_VERSION; + output.cBuffers := 1; + output.pBuffers := @buf[2]; + buf[2].cbBuffer := 0; + buf[2].BufferType := SECBUFFER_TOKEN; + buf[2].pvBuffer := nil; +end; + +{ TSChannelClient - Client-side SChannel implementation } + +procedure TSChannelClient.AppendData(const aBuffer: TSecBuffer); +var + newlen: integer; +begin + newlen := DataCount + integer(aBuffer.cbBuffer); + if newlen > Length(Data) then + SetLength(Data, newlen); + Move(aBuffer.pvBuffer^, PByteArray(Data)[DataCount], aBuffer.cbBuffer); + inc(DataCount, aBuffer.cbBuffer); +end; + +procedure TSChannelClient.AfterConnection(aLine: TObject; const aTargetHost: AnsiString; aIgnoreCertificateErrors: boolean); +var + TargetHostString: WideString; + f: cardinal; + res: cardinal; + schannelCred: TSChannelCred; + buf: THandshakeBuf; + trial: integer; + lastError: cardinal; + +begin + trial := 0; + + // Retry loop for Windows 7/8 TLS bugs + while true do + try + // Clean up any existing TLS context from previous connection + if Initialized then + begin + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + Initialized := false; + SessionClosed := false; + DataCount := 0; + DataPos := 0; + end; + + // Setup target host for handshake + TargetHostString := WideString(string(aTargetHost)); + + // Setup SChannel credentials + FillChar(schannelCred, SizeOf(schannelCred), 0); + schannelCred.dwVersion := SCHANNEL_CRED_VERSION; + if aIgnoreCertificateErrors then + schannelCred.dwFlags := SCH_CRED_MANUAL_CRED_VALIDATION or SCH_CRED_NO_DEFAULT_CREDS + else + schannelCred.dwFlags := SCH_CRED_REVOCATION_CHECK_CHAIN or SCH_CRED_IGNORE_REVOCATION_OFFLINE; + + // Direct credential acquisition + res := AcquireCredentialsHandleW( + nil, UNISP_NAME, SECPKG_CRED_OUTBOUND, nil, @schannelCred, nil, nil, @Cred, nil); + if res <> SEC_E_OK then + raise ESChannel.CreateFmt('AcquireCredentialsHandleW failed: 0x%08X', [res]); + + // Initialize data buffers + DataPos := 0; + DataCount := 0; + SetLength(Data, TLSRECMAXSIZE); + + // Setup handshake flags - simplified approach + f := ISC_REQ_FLAGS; + if aIgnoreCertificateErrors then + f := f or ISC_REQ_MANUAL_CRED_VALIDATION or ISC_REQ_USE_SUPPLIED_CREDS; + + // Initialize handshake buffer + buf.Init; + + // Initiate client handshake + res := InitializeSecurityContextW(@Cred, nil, PWideChar(TargetHostString), + f, 0, SECURITY_NATIVE_DREP, nil, 0, @Ctxt, @buf.output, f, nil); + + if res <> SEC_I_CONTINUE_NEEDED then + raise ESChannel.CreateFmt('InitializeSecurityContext failed: 0x%08X', [res]); + + // Send initial handshake data + if (buf.buf[2].cbBuffer = 0) or (buf.buf[2].pvBuffer = nil) then + raise ESChannel.CreateFmt('Void Hello answer to %s', [string(aTargetHost)]); + + try + TncLineInternal(TncLine(aLine)).SendBuffer(buf.buf[2].pvBuffer^, buf.buf[2].cbBuffer); + finally + FreeContextBuffer(buf.buf[2].pvBuffer); + end; + + // Complete the handshake + HandshakeLoop(aLine); + + // Query stream sizes after successful handshake + res := QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes); + if res <> SEC_E_OK then + raise ESChannel.CreateFmt('QueryContextAttributes failed: 0x%08X', [res]); + + InputSize := Sizes.cbHeader + Sizes.cbMaximumMessage + Sizes.cbTrailer; + if InputSize > TLSRECMAXSIZE then + raise ESChannel.CreateFmt('InputSize=%d>%d', [InputSize, TLSRECMAXSIZE]); + + SetLength(Input, InputSize); + InputCount := 0; + Initialized := true; + + break; // Success - exit retry loop + + except + // Retry for known Windows 7/8 TLS bugs + on E: ESChannel do + begin + lastError := GetLastError; + if (trial = 0) and + ((res = SEC_E_BUFFER_TOO_SMALL) or (res = SEC_E_MESSAGE_ALTERED)) then + begin + // Cleanup and retry once for Windows TLS bug + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + inc(trial); + // Continue retry loop + end + else + raise; // Re-raise if not a retryable error or already tried + end; + end; +end; + +procedure TSChannelClient.HandshakeLoop(aLine: TObject); +var + buf: THandshakeBuf; + res, f: cardinal; + Line: TncLine; + LoopCount: Integer; + RecvResult: Integer; +begin + Line := TncLine(aLine); + res := SEC_I_CONTINUE_NEEDED; + LoopCount := 0; + + while (res = SEC_I_CONTINUE_NEEDED) or (res = SEC_E_INCOMPLETE_MESSAGE) do begin + Inc(LoopCount); + + RecvResult := TncLineInternal(Line).RecvBuffer(PByteArray(Data)[DataCount], length(Data) - DataCount); + + inc(DataCount, CheckSocket(RecvResult)); + + buf.Init; + buf.buf[0].cbBuffer := DataCount; + buf.buf[0].BufferType := SECBUFFER_TOKEN; + buf.buf[0].pvBuffer := pointer(Data); + + res := InitializeSecurityContextW(@Cred, @Ctxt, nil, ISC_REQ_FLAGS, 0, + SECURITY_NATIVE_DREP, @buf.input, 0, @Ctxt, @buf.output, f, nil); + + if res = SEC_I_INCOMPLETE_CREDENTIALS then + begin + // check https://stackoverflow.com/a/47479968/458259 + res := InitializeSecurityContextW(@Cred, @Ctxt, nil, ISC_REQ_FLAGS, 0, + SECURITY_NATIVE_DREP, @buf.input, 0, @Ctxt, @buf.output, f, nil); + end; + + if (res = SEC_E_OK) or (res = SEC_I_CONTINUE_NEEDED) or + ((f and ISC_REQ_EXTENDED_ERROR) <> 0) then begin + if (buf.buf[2].cbBuffer <> 0) and (buf.buf[2].pvBuffer <> nil) then begin + CheckSocket(TncLineInternal(Line).SendBuffer(buf.buf[2].pvBuffer^, buf.buf[2].cbBuffer)); + CheckSEC_E_OK(FreeContextBuffer(buf.buf[2].pvBuffer)); + end; + end; + + if buf.buf[1].BufferType = SECBUFFER_EXTRA then begin + // reuse pending Data bytes to avoid SEC_E_INVALID_TOKEN + Move(PByteArray(Data)[cardinal(DataCount) - buf.buf[1].cbBuffer], + PByteArray(Data)[0], buf.buf[1].cbBuffer); + DataCount := buf.buf[1].cbBuffer; + end else + if res <> SEC_E_INCOMPLETE_MESSAGE then + DataCount := 0; + end; + + CheckSEC_E_OK(res); +end; + +procedure TSChannelClient.BeforeDisconnection(aLine: TObject); +var + desc: TSecBufferDesc; + buf: TSecBuffer; + dt, f: cardinal; + Line: TncLine; +begin + if Initialized then + try + Line := TncLine(aLine); + if (Line <> nil) and Line.Active then begin + // Send TLS shutdown notification + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 1; + desc.pBuffers := @buf; + buf.cbBuffer := 4; + buf.BufferType := SECBUFFER_TOKEN; + dt := SCHANNEL_SHUTDOWN; + buf.pvBuffer := @dt; + if ApplyControlToken(@Ctxt, @desc) = SEC_E_OK then begin + buf.cbBuffer := 0; + buf.BufferType := SECBUFFER_TOKEN; + buf.pvBuffer := nil; + if InitializeSecurityContextW(@Cred, @Ctxt, nil, ISC_REQ_FLAGS, 0, + SECURITY_NATIVE_DREP, nil, 0, @Ctxt, @desc, f, nil) = SEC_E_OK then begin + TncLineInternal(Line).SendBuffer(buf.pvBuffer^, buf.cbBuffer); + FreeContextBuffer(buf.pvBuffer); + end; + end; + end; + // Simple cleanup with zero-fill + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + finally + // Simple zero-fill + FillChar(Cred, SizeOf(Cred), 0); + FillChar(Ctxt, SizeOf(Ctxt), 0); + Initialized := false; + end; +end; + +function TSChannelClient.Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res: cardinal; + read, i: integer; + needsRenegotiate: boolean; + Line: TncLine; + + function DecryptInput: cardinal; + begin + buf[0].cbBuffer := InputCount; + buf[0].BufferType := SECBUFFER_DATA; + buf[0].pvBuffer := pointer(Input); + buf[1].cbBuffer := 0; + buf[1].BufferType := SECBUFFER_EMPTY; + buf[1].pvBuffer := nil; + buf[2].cbBuffer := 0; + buf[2].BufferType := SECBUFFER_EMPTY; + buf[2].pvBuffer := nil; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + result := DecryptMessage(@Ctxt, @desc, 0, nil); + end; +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).RecvBuffer(aBuffer^, aLength); + exit; + end; + result := 0; + if not SessionClosed then + while DataCount = 0 do + try + DataPos := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + repeat + read := TncLineInternal(Line).RecvBuffer(PByteArray(Input)[InputCount], InputSize - InputCount); + if read <= 0 then begin + result := read; // return socket error + exit; + end; + inc(InputCount, read); + res := DecryptInput; + until res <> SEC_E_INCOMPLETE_MESSAGE; + needsRenegotiate := false; + repeat + case res of + SEC_I_RENEGOTIATE: + begin + needsRenegotiate := true; + end; + SEC_I_CONTEXT_EXPIRED: + begin + SessionClosed := true; + end; + SEC_E_INCOMPLETE_MESSAGE: break; + else CheckSEC_E_OK(res); + end; + InputCount := 0; + for i := 1 to 3 do + case buf[i].BufferType of + SECBUFFER_DATA: + begin + AppendData(buf[i]); + end; + SECBUFFER_EXTRA: + begin + Move(buf[i].pvBuffer^, pointer(Input)^, buf[i].cbBuffer); + InputCount := buf[i].cbBuffer; + end; + end; + if InputCount = 0 then + break; + res := DecryptInput; + until false; + if needsRenegotiate then + begin + HandshakeLoop(aLine); + end; + except + on E: Exception do + begin + exit; // shutdown the connection on ESChannel fatal error + end; + end; + result := DataCount; + if aLength < result then + result := aLength; + Move(PByteArray(Data)[DataPos], aBuffer^, result); + inc(DataPos, result); + dec(DataCount, result); +end; + +function TSChannelClient.Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res, sent, s, len, trailer, pending, templen: cardinal; + temp: array[0..TLSRECMAXSIZE] of byte; + Line: TncLine; + +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).SendBuffer(aBuffer^, aLength); + exit; + end; + + // Check if Sizes has been initialized + if Sizes.cbMaximumMessage = 0 then + begin + if QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes) <> SEC_E_OK then + begin + result := -1; + exit; + end; + end; + + result := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + pending := aLength; + while pending > 0 do begin + templen := pending; + if templen > Sizes.cbMaximumMessage then + templen := Sizes.cbMaximumMessage; + Move(aBuffer^, temp[Sizes.cbHeader], templen); + inc(PByte(aBuffer), templen); + dec(pending, templen); + trailer := Sizes.cbHeader + templen; + buf[0].cbBuffer := Sizes.cbHeader; + buf[0].BufferType := SECBUFFER_STREAM_HEADER; + buf[0].pvBuffer := @temp; + buf[1].cbBuffer := templen; + buf[1].BufferType := SECBUFFER_DATA; + buf[1].pvBuffer := @temp[Sizes.cbHeader]; + buf[2].cbBuffer := Sizes.cbTrailer; + buf[2].BufferType := SECBUFFER_STREAM_TRAILER; + buf[2].pvBuffer := @temp[trailer]; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + if EncryptMessage(@Ctxt, 0, @desc, 0) <> SEC_E_OK then + begin + exit; // shutdown the connection on SChannel error + end; + len := buf[0].cbBuffer + buf[1].cbBuffer + buf[2].cbBuffer; + sent := 0; + repeat + s := TncLineInternal(Line).SendBuffer(PByteArray(@temp)[sent], len); + if s = len then + break; // whole message sent + if s = 0 then + begin + exit; // report connection closed + end; + if integer(s) < 0 then begin + result := s; + exit; // report socket fatal error + end + else begin + dec(len, s); + inc(sent, s); + end; + Sleep(1); // try again + until false; + end; + result := aLength; +end; + +{ TSChannelServer - Server-side SChannel implementation } + +procedure TSChannelServer.AppendData(const aBuffer: TSecBuffer); +var + newlen: integer; +begin + newlen := DataCount + integer(aBuffer.cbBuffer); + if newlen > Length(Data) then + SetLength(Data, newlen); + Move(aBuffer.pvBuffer^, PByteArray(Data)[DataCount], aBuffer.cbBuffer); + inc(DataCount, aBuffer.cbBuffer); +end; + +procedure TSChannelServer.AfterConnection(aLine: TObject; const aCertificateFile, aPrivateKeyPassword: AnsiString); +var + res: cardinal; + Line: TncLine; + SchannelCred: TSChannelCred; + pCertContext: PCCERT_CONTEXT; + pCertArray: PCCERT_CONTEXT; // Array of one certificate context for paCred + +begin + // Clean up any existing TLS context from previous connection + if Initialized then + begin + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + Initialized := false; + HandshakeCompleted := false; + SessionClosed := false; + DataCount := 0; + DataPos := 0; + end; + + Line := TncLine(aLine); + + // Initialize server credentials with certificate + FillChar(SchannelCred, SizeOf(SchannelCred), 0); + SchannelCred.dwVersion := SCHANNEL_CRED_VERSION; + SchannelCred.grbitEnabledProtocols := SP_PROT_TLS1_2_SERVER or SP_PROT_TLS1_3_SERVER; + SchannelCred.dwFlags := 0; // No special flags for server + + // Load certificate from PFX file + pCertContext := nil; + if aCertificateFile <> '' then + begin + pCertContext := LoadCertificateFromPFX(aCertificateFile, aPrivateKeyPassword); + if pCertContext <> nil then + begin + pCertArray := pCertContext; // Create array element + SchannelCred.cCreds := 1; + SchannelCred.paCred := @pCertArray; // Point to the array + end + else + raise ESChannel.CreateFmt('Failed to load certificate from: %s', [string(aCertificateFile)]); + end + else + raise ESChannel.Create('Certificate file required for TLS server'); + + try + // Direct credential acquisition + res := AcquireCredentialsHandleW( + nil, UNISP_NAME, SECPKG_CRED_INBOUND, nil, @SchannelCred, nil, nil, @Cred, nil); + if res <> SEC_E_OK then + raise ESChannel.CreateFmt('AcquireCredentialsHandleW failed: 0x%08X', [res]); + + // Initialize buffers + DataPos := 0; + DataCount := 0; + SetLength(Data, TLSRECMAXSIZE); + SetLength(Input, TLSRECMAXSIZE); + InputCount := 0; + Initialized := true; // Mark as initialized but handshake not yet completed + HandshakeCompleted := false; // Handshake will be triggered when first TLS data arrives + + finally + // Free certificate context + if pCertContext <> nil then + CertFreeCertificateContext(pCertContext); + end; +end; + +procedure TSChannelServer.HandshakeLoop(aLine: TObject); +var + buf: THandshakeBuf; + res, f: cardinal; + Line: TncLine; + fDone: boolean; + fInitContext: boolean; + LoopCount: Integer; + RecvResult: Integer; + +begin + Line := TncLine(aLine); + fDone := false; + fInitContext := true; + LoopCount := 0; + + try + while not fDone do + begin + Inc(LoopCount); + + // Read client data + try + RecvResult := TncLineInternal(Line).RecvBuffer(PByteArray(Data)[DataCount], length(Data) - DataCount); + inc(DataCount, CheckSocket(RecvResult)); + except + on E: Exception do + begin + raise ESChannel.CreateFmt('Failed to receive client data: %s', [E.Message]); + end; + end; + + buf.Init; + buf.buf[0].cbBuffer := DataCount; + buf.buf[0].BufferType := SECBUFFER_TOKEN; + buf.buf[0].pvBuffer := pointer(Data); + + // Server-side handshake using AcceptSecurityContext + if fInitContext then + begin + // CRITICAL: Server must use AcceptSecurityContext, not InitializeSecurityContext + res := AcceptSecurityContext(@Cred, nil, @buf.input, + ASC_REQ_FLAGS, SECURITY_NATIVE_DREP, @Ctxt, @buf.output, f, nil); + fInitContext := false; + end + else + begin + res := AcceptSecurityContext(@Cred, @Ctxt, @buf.input, + ASC_REQ_FLAGS, SECURITY_NATIVE_DREP, @Ctxt, @buf.output, f, nil); + end; + + case res of + SEC_E_OK: + begin + fDone := true; + end; + SEC_I_CONTINUE_NEEDED: + begin + // Continue handshake + end; + SEC_I_INCOMPLETE_CREDENTIALS: + begin + // Continue with current data + end; + SEC_E_INCOMPLETE_MESSAGE: + begin + // Need more data from client + continue; + end; + else + begin + raise ESChannel.CreateFmt('AcceptSecurityContext failed: 0x%08X', [res]); + end; + end; + + // Send response to client if needed + if (buf.buf[2].cbBuffer <> 0) and (buf.buf[2].pvBuffer <> nil) then + begin + try + CheckSocket(TncLineInternal(Line).SendBuffer(buf.buf[2].pvBuffer^, buf.buf[2].cbBuffer)); + CheckSEC_E_OK(FreeContextBuffer(buf.buf[2].pvBuffer)); + except + on E: Exception do + begin + raise ESChannel.CreateFmt('Failed to send server response: %s', [E.Message]); + end; + end; + end; + + // Handle extra data + if buf.buf[1].BufferType = SECBUFFER_EXTRA then + begin + Move(PByteArray(Data)[cardinal(DataCount) - buf.buf[1].cbBuffer], + PByteArray(Data)[0], buf.buf[1].cbBuffer); + DataCount := buf.buf[1].cbBuffer; + end + else if not fDone then + begin + DataCount := 0; + end; + end; + + except + on E: Exception do + begin + raise ESChannel.CreateFmt('TLS handshake failed: %s', [E.Message]); + end; + end; +end; + +procedure TSChannelServer.BeforeDisconnection(aLine: TObject); +var + desc: TSecBufferDesc; + buf: TSecBuffer; + dt, f: cardinal; + Line: TncLine; +begin + if Initialized then + try + Line := TncLine(aLine); + if (Line <> nil) and Line.Active then begin + // Send TLS shutdown notification + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 1; + desc.pBuffers := @buf; + buf.cbBuffer := 4; + buf.BufferType := SECBUFFER_TOKEN; + dt := SCHANNEL_SHUTDOWN; + buf.pvBuffer := @dt; + if ApplyControlToken(@Ctxt, @desc) = SEC_E_OK then begin + buf.cbBuffer := 0; + buf.BufferType := SECBUFFER_TOKEN; + buf.pvBuffer := nil; + if AcceptSecurityContext(@Cred, @Ctxt, nil, ASC_REQ_FLAGS, + SECURITY_NATIVE_DREP, @Ctxt, @desc, f, nil) = SEC_E_OK then begin + TncLineInternal(Line).SendBuffer(buf.pvBuffer^, buf.cbBuffer); + FreeContextBuffer(buf.pvBuffer); + end; + end; + end; + // Simple cleanup with zero-fill + FreeSecurityContextSafe(Ctxt); + FreeCredentialsHandleSafe(Cred); + finally + // Simple zero-fill + FillChar(Cred, SizeOf(Cred), 0); + FillChar(Ctxt, SizeOf(Ctxt), 0); + Initialized := false; + HandshakeCompleted := false; + end; +end; + +function TSChannelServer.Receive(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res: cardinal; + read, i: integer; + needsRenegotiate: boolean; + Line: TncLine; + + function DecryptInput: cardinal; + begin + buf[0].cbBuffer := InputCount; + buf[0].BufferType := SECBUFFER_DATA; + buf[0].pvBuffer := pointer(Input); + buf[1].cbBuffer := 0; + buf[1].BufferType := SECBUFFER_EMPTY; + buf[1].pvBuffer := nil; + buf[2].cbBuffer := 0; + buf[2].BufferType := SECBUFFER_EMPTY; + buf[2].pvBuffer := nil; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + result := DecryptMessage(@Ctxt, @desc, 0, nil); + end; +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).RecvBuffer(aBuffer^, aLength); + exit; + end; + + // Check if handshake needs to be performed + if not HandshakeCompleted then + begin + try + HandshakeLoop(aLine); + CheckSEC_E_OK(QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes)); + InputSize := Sizes.cbHeader + Sizes.cbMaximumMessage + Sizes.cbTrailer; + if InputSize > TLSRECMAXSIZE then + raise ESChannel.CreateFmt('InputSize=%d>%d', [InputSize, TLSRECMAXSIZE]); + SetLength(Input, InputSize); + HandshakeCompleted := true; + + // CRITICAL FIX: Clear any leftover handshake data to prevent it from being returned as application data + DataCount := 0; + DataPos := 0; + InputCount := 0; + + // CRITICAL: Return immediately to trigger handshake completion callback + // We'll return 0 to indicate no application data was received, + // but set a special result to indicate handshake completion + result := 0; + exit; + except + on E: Exception do + begin + result := -1; // Return error + exit; + end; + end; + end; + + result := 0; + if not SessionClosed then + while DataCount = 0 do + try + DataPos := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + repeat + read := TncLineInternal(Line).RecvBuffer(PByteArray(Input)[InputCount], InputSize - InputCount); + if read <= 0 then begin + result := read; // return socket error + exit; + end; + inc(InputCount, read); + res := DecryptInput; + until res <> SEC_E_INCOMPLETE_MESSAGE; + needsRenegotiate := false; + repeat + case res of + SEC_I_RENEGOTIATE: + begin + needsRenegotiate := true; + end; + SEC_I_CONTEXT_EXPIRED: + begin + SessionClosed := true; + end; + SEC_E_INCOMPLETE_MESSAGE: break; + else CheckSEC_E_OK(res); + end; + InputCount := 0; + for i := 1 to 3 do + case buf[i].BufferType of + SECBUFFER_DATA: AppendData(buf[i]); + SECBUFFER_EXTRA: begin + Move(buf[i].pvBuffer^, pointer(Input)^, buf[i].cbBuffer); + InputCount := buf[i].cbBuffer; + end; + end; + if InputCount = 0 then + break; + res := DecryptInput; + until false; + if needsRenegotiate then + HandshakeLoop(aLine); + except + exit; // shutdown the connection on ESChannel fatal error + end; + result := DataCount; + if aLength < result then + result := aLength; + Move(PByteArray(Data)[DataPos], aBuffer^, result); + inc(DataPos, result); + dec(DataCount, result); +end; + +function TSChannelServer.Send(aLine: TObject; aBuffer: pointer; aLength: integer): integer; +var + desc: TSecBufferDesc; + buf: array[0..3] of TSecBuffer; + res, sent, s, len, trailer, pending, templen: cardinal; + temp: array[0..TLSRECMAXSIZE] of byte; + Line: TncLine; + +begin + Line := TncLine(aLine); + if not Initialized then begin // use plain socket API + result := TncLineInternal(Line).SendBuffer(aBuffer^, aLength); + exit; + end; + + // Check if Sizes has been initialized + if Sizes.cbMaximumMessage = 0 then + begin + if QueryContextAttributesW(@Ctxt, SECPKG_ATTR_STREAM_SIZES, @Sizes) <> SEC_E_OK then + begin + result := -1; + exit; + end; + end; + + result := 0; + desc.ulVersion := SECBUFFER_VERSION; + desc.cBuffers := 4; + desc.pBuffers := @buf[0]; + pending := aLength; + while pending > 0 do begin + templen := pending; + if templen > Sizes.cbMaximumMessage then + templen := Sizes.cbMaximumMessage; + Move(aBuffer^, temp[Sizes.cbHeader], templen); + inc(PByte(aBuffer), templen); + dec(pending, templen); + trailer := Sizes.cbHeader + templen; + buf[0].cbBuffer := Sizes.cbHeader; + buf[0].BufferType := SECBUFFER_STREAM_HEADER; + buf[0].pvBuffer := @temp; + buf[1].cbBuffer := templen; + buf[1].BufferType := SECBUFFER_DATA; + buf[1].pvBuffer := @temp[Sizes.cbHeader]; + buf[2].cbBuffer := Sizes.cbTrailer; + buf[2].BufferType := SECBUFFER_STREAM_TRAILER; + buf[2].pvBuffer := @temp[trailer]; + buf[3].cbBuffer := 0; + buf[3].BufferType := SECBUFFER_EMPTY; + buf[3].pvBuffer := nil; + if EncryptMessage(@Ctxt, 0, @desc, 0) <> SEC_E_OK then + begin + exit; // shutdown the connection on SChannel error + end; + len := buf[0].cbBuffer + buf[1].cbBuffer + buf[2].cbBuffer; + sent := 0; + repeat + s := TncLineInternal(Line).SendBuffer(PByteArray(@temp)[sent], len); + if s = len then + break; // whole message sent + if s = 0 then + begin + exit; // report connection closed + end; + if integer(s) < 0 then begin + result := s; + exit; // report socket fatal error + end + else begin + dec(len, s); + inc(sent, s); + end; + Sleep(1); // try again + until false; + end; + result := aLength; +end; + + +end. diff --git a/Source_using_TMonitor/ncSerializeADO.pas b/Source_using_TMonitor/ncSerializeADO.pas new file mode 100644 index 0000000..73efa57 --- /dev/null +++ b/Source_using_TMonitor/ncSerializeADO.pas @@ -0,0 +1,368 @@ +unit ncSerializeADO; + +interface + +uses System.Classes, System.SysUtils, System.Variants, Data.DB, Data.Win.ADODB, System.Win.ComObj, Winapi.ADOInt, Winapi.ActiveX; + +// SysUtils: Need TBytes +// Classes: Need TBytesStream +// ADODB: Need TPersistFormat +// ADOInt: Need function PersistFormatEnum +// ActiveX: Need IStream + +function ReadString(var aBuffer: TBytes; var aOfs: Integer): string; inline; +procedure WriteString(const aValue: string; var aBuffer: TBytes; var aBufLen: Integer); inline; +function ReadBytes(var aBuffer: TBytes; var aOfs: Integer): TBytes; inline; +procedure WriteBytes(const aValue: TBytes; var aBuffer: TBytes; var aBufLen: Integer); inline; + +function RecordsetToStream(const aRecordset: _Recordset; aFormat: TPersistFormat): TBytesStream; +function RecordsetToBytes(const aRecordset: _Recordset; aFormat: TPersistFormat = pfADTG): TBytes; + +function StreamToRecordset(const aStream: TBytesStream; aConnection: TADOConnection = nil): _Recordset; +function BytesToRecordset(const aBytes: TBytes; aConnection: TADOConnection = nil): _Recordset; + +function VariantToBytes(aVar: Variant): TBytes; +function BytesToVariant(aBytes: TBytes): Variant; + +function ParametersToBytes(aParameters: TParameters): TBytes; +procedure BytesToParameters(aBytes: TBytes; aParameters: TParameters); + +implementation + +uses ncSources; + +function ReadInteger(var aBuffer: TBytes; var aOfs: Integer): Integer; inline; +const + ResultCount = SizeOf(Result); +begin + move(aBuffer[aOfs], Result, ResultCount); + aOfs := aOfs + ResultCount; +end; + +function ReadInt64(var aBuffer: TBytes; var aOfs: Integer): Int64; inline; +const + ResultCount = SizeOf(Result); +begin + move(aBuffer[aOfs], Result, ResultCount); + aOfs := aOfs + ResultCount; +end; + +function ReadDouble(var aBuffer: TBytes; var aOfs: Integer): Double; +const + ResultCount = SizeOf(Result); +begin + move(aBuffer[aOfs], Result, ResultCount); + aOfs := aOfs + ResultCount; +end; + +function ReadSingle(var aBuffer: TBytes; var aOfs: Integer): Single; inline; +const + ResultCount = SizeOf(Result); +begin + move(aBuffer[aOfs], Result, ResultCount); + aOfs := aOfs + ResultCount; +end; + +function ReadDate(var aBuffer: TBytes; var aOfs: Integer): TDateTime; inline; +begin + Result := ReadDouble(aBuffer, aOfs); +end; + +function ReadCurrency(var aBuffer: TBytes; var aOfs: Integer): Currency; inline; +begin + Result := ReadDouble(aBuffer, aOfs); +end; + +function ReadBool(var aBuffer: TBytes; var aOfs: Integer): Boolean; inline; +const + ResultCount = SizeOf(Result); +begin + move(aBuffer[aOfs], Result, ResultCount); + aOfs := aOfs + ResultCount; +end; + +function ReadByte(var aBuffer: TBytes; var aOfs: Integer): Byte; inline; +const + ResultCount = SizeOf(Result); +begin + move(aBuffer[aOfs], Result, ResultCount); + aOfs := aOfs + ResultCount; +end; + +function ReadBytes(var aBuffer: TBytes; var aOfs: Integer): TBytes; inline; +var + ResultCount: Integer; +begin + ResultCount := ReadInteger(aBuffer, aOfs); + SetLength(Result, ResultCount); + + if ResultCount > 0 then + begin + move(aBuffer[aOfs], Result[0], ResultCount); + aOfs := aOfs + ResultCount; + end; +end; + +function ReadString(var aBuffer: TBytes; var aOfs: Integer): string; inline; +begin + Result := StringOf(ReadBytes(aBuffer, aOfs)); +end; + +procedure WriteInteger(const aValue: Integer; var aBuffer: TBytes; var aBufLen: Integer); inline; +const + ValByteCount = SizeOf(aValue); +begin + SetLength(aBuffer, aBufLen + ValByteCount); + move(aValue, aBuffer[aBufLen], ValByteCount); + aBufLen := aBufLen + ValByteCount; +end; + +procedure WriteInt64(const aValue: Int64; var aBuffer: TBytes; var aBufLen: Integer); inline; +const + ValByteCount = SizeOf(aValue); +begin + SetLength(aBuffer, aBufLen + ValByteCount); + move(aValue, aBuffer[aBufLen], ValByteCount); + aBufLen := aBufLen + ValByteCount; +end; + +procedure WriteDouble(const aValue: Double; var aBuffer: TBytes; var aBufLen: Integer); +const + ValByteCount = SizeOf(aValue); +begin + SetLength(aBuffer, aBufLen + ValByteCount); + move(aValue, aBuffer[aBufLen], ValByteCount); + aBufLen := aBufLen + ValByteCount; +end; + +procedure WriteSingle(const aValue: Single; var aBuffer: TBytes; var aBufLen: Integer); inline; +const + ValByteCount = SizeOf(aValue); +begin + SetLength(aBuffer, aBufLen + ValByteCount); + move(aValue, aBuffer[aBufLen], ValByteCount); + aBufLen := aBufLen + ValByteCount; +end; + +procedure WriteDate(const aValue: TDateTime; var aBuffer: TBytes; var aBufLen: Integer); inline; +begin + WriteDouble(aValue, aBuffer, aBufLen); +end; + +procedure WriteCurrency(const aValue: Currency; var aBuffer: TBytes; var aBufLen: Integer); inline; +begin + WriteDouble(aValue, aBuffer, aBufLen); +end; + +procedure WriteBool(const aValue: Boolean; var aBuffer: TBytes; var aBufLen: Integer); inline; +const + ValByteCount = SizeOf(aValue); +begin + SetLength(aBuffer, aBufLen + ValByteCount); + move(aValue, aBuffer[aBufLen], ValByteCount); + aBufLen := aBufLen + ValByteCount; +end; + +procedure WriteByte(const aValue: Byte; var aBuffer: TBytes; var aBufLen: Integer); inline; +const + ValByteCount = SizeOf(aValue); +begin + SetLength(aBuffer, aBufLen + ValByteCount); + move(aValue, aBuffer[aBufLen], ValByteCount); + aBufLen := aBufLen + ValByteCount; +end; + +procedure WriteBytes(const aValue: TBytes; var aBuffer: TBytes; var aBufLen: Integer); inline; +var + ValByteCount: Integer; +begin + ValByteCount := Length(aValue); + WriteInteger(ValByteCount, aBuffer, aBufLen); + + if ValByteCount > 0 then + begin + SetLength(aBuffer, aBufLen + ValByteCount); + move(aValue[0], aBuffer[aBufLen], ValByteCount); + aBufLen := aBufLen + ValByteCount; + end; +end; + +procedure WriteString(const aValue: string; var aBuffer: TBytes; var aBufLen: Integer); inline; +begin + WriteBytes(BytesOf(aValue), aBuffer, aBufLen); +end; + +function VariantToBytes(aVar: Variant): TBytes; +var + VariantType: TVarType; + BufLen: Integer; +begin + VariantType := FindVarData(aVar)^.VType; + SetLength(Result, SizeOf(VariantType)); + move(VariantType, Result[0], SizeOf(VariantType)); + BufLen := Length(Result); + if not(VariantType in [varEmpty, varNull]) then + begin + case VariantType of + varByte, varSmallint, varShortInt, varInteger, varWord, varLongWord: + WriteInteger(aVar, Result, BufLen); + varSingle, varDouble: + WriteDouble(aVar, Result, BufLen); + varCurrency: + WriteCurrency(aVar, Result, BufLen); + varDate: + WriteDate(aVar, Result, BufLen); + varBoolean: + WriteBool(aVar, Result, BufLen); + varInt64, varUInt64: + WriteInt64(aVar, Result, BufLen); + varOleStr, varStrArg, varString, varUString: + WriteString(aVar, Result, BufLen); + else + raise Exception.Create('Cannot pack specified parameter'); + end; + end; + +end; + +function BytesToVariant(aBytes: TBytes): Variant; +var + VariantType: TVarType; + Ofs: Integer; +begin + move(aBytes[0], VariantType, SizeOf(VariantType)); + Ofs := SizeOf(VariantType); + + if not(VariantType in [varEmpty, varNull]) then + begin + case VariantType of + varEmpty: + Result := System.Variants.Unassigned; + varNull: + Result := System.Variants.Null; + varByte, varSmallint, varShortInt, varInteger, varWord, varLongWord: + Result := ReadInteger(aBytes, Ofs); + varSingle, varDouble: + Result := ReadDouble(aBytes, Ofs); + varCurrency: + Result := ReadCurrency(aBytes, Ofs); + varDate: + Result := ReadDate(aBytes, Ofs); + varBoolean: + Result := ReadBool(aBytes, Ofs); + varInt64, varUInt64: + Result := ReadInt64(aBytes, Ofs); + varOleStr, varStrArg, varString, varUString: + Result := ReadString(aBytes, Ofs); + else + raise Exception.Create('Cannot pack specified parameter'); + end; + end; +end; + +function ParametersToBytes(aParameters: TParameters): TBytes; +var + BufLen: Integer; + i: Integer; +begin + BufLen := 0; + WriteInteger(aParameters.Count, Result, BufLen); + for i := 0 to aParameters.Count - 1 do + WriteBytes(VariantToBytes(aParameters.Items[i].Value), Result, BufLen); +end; + +procedure BytesToParameters(aBytes: TBytes; aParameters: TParameters); +var + ParameterCount: Integer; + Ofs: Integer; + i: Integer; +begin + if Length(aBytes) > 0 then + begin + Ofs := 0; + if not Assigned(aParameters) then + raise Exception.Create('Parameters object not assigned'); + ParameterCount := ReadInteger(aBytes, Ofs); + if ParameterCount <> aParameters.Count then + raise Exception.Create('Bytes stream parameters differ from SQL Parameters'); + + for i := 0 to ParameterCount - 1 do + aParameters.Items[i].Value := BytesToVariant(ReadBytes(aBytes, Ofs)); + end; +end; + +function RecordsetToStream(const aRecordset: _Recordset; aFormat: TPersistFormat): TBytesStream; +var + ADOStream: IStream; +begin + // Create a stream to hold the data + Result := TBytesStream.Create; + try + // Since ADO can't write directly to a Delphi stream, we must wrap the Delphi stream + ADOStream := TStreamAdapter.Create(Result, soReference) as IStream; + try + // Save the content of the recordset to the stream + aRecordset.Save(ADOStream, PersistFormatEnum(aFormat)); + finally + ADOStream := nil; + end; + + // The Stream now contains the data + // Position the stream at the start + Result.Position := 0; + except + Result.Free; + raise; + end; +end; + +function RecordsetToBytes(const aRecordset: _Recordset; aFormat: TPersistFormat = pfADTG): TBytes; +var + tmpSS: TBytesStream; +begin + tmpSS := RecordsetToStream(aRecordset, aFormat); + try + Result := tmpSS.Bytes; + finally + tmpSS.Free; + end; +end; + +function StreamToRecordset(const aStream: TBytesStream; aConnection: TADOConnection = nil): _Recordset; +var + ADOStream: IStream; +begin + Result := CoRecordset.Create; + try + // Since ADO can't write directly to a Delphi stream, we must wrap the Delphi stream + ADOStream := TStreamAdapter.Create(aStream, soReference) as IStream; + try + // Save the content of the stream to the recordset + Result.Open(ADOStream, EmptyParam, adOpenKeyset, adLockBatchOptimistic, adCmdFile); + + // You need to Set_ActiveConnection in order to be able to update a recordset. + if Assigned(aConnection) then + Result.Set_ActiveConnection(aConnection.ConnectionObject); + finally + ADOStream := nil; + end; + except + Result := nil; + raise; + end; +end; + +function BytesToRecordset(const aBytes: TBytes; aConnection: TADOConnection = nil): _Recordset; +var + Stream: TBytesStream; +begin + Stream := TBytesStream.Create(aBytes); + try + Stream.Position := 0; + Result := StreamToRecordset(Stream, aConnection); + finally + Stream.Free; + end; +end; + +end. diff --git a/Source_using_TMonitor/ncSerializeValue.pas b/Source_using_TMonitor/ncSerializeValue.pas new file mode 100644 index 0000000..121f167 --- /dev/null +++ b/Source_using_TMonitor/ncSerializeValue.pas @@ -0,0 +1,46 @@ +unit ncSerializeValue; + +interface + +uses Rtti; + +implementation + var + RttiContext: TRttiContext; + + { Value ToBytes: + if Data.IsEmpty then + WriteString('nil') + else + begin + // Write Data (TncValue) string name + + WriteString(RttiContext.GetType(Data.TypeInfo).QualifiedName); + + // Append Data (TncValue) contents + Len := Length(Result); + SetLength(Result, Len + Data.DataSize); + Data.ExtractRawData(@Result[Len]); + end; + + Value FromBytes: + // Read Data (TncValue) string name + TypeName := ReadString; + + // Read Data (TncValue) contents + if TypeName = 'nil' then + Data := nil + else + TValue.Make(@aBytes[Ofs], RttiContext.FindType(TypeName).Handle, Data); + + } + +initialization + + RttiContext := TRttiContext.Create; + +finalization + + RttiContext.Free; + +end. diff --git a/Source_using_TMonitor/ncSocketList.pas b/Source_using_TMonitor/ncSocketList.pas new file mode 100644 index 0000000..5c508b3 --- /dev/null +++ b/Source_using_TMonitor/ncSocketList.pas @@ -0,0 +1,202 @@ +unit ncSocketList; + +/// //////////////////////////////////////////////////////////////////////////// +// +// TSocketList +// Written by Demos Bill, Tue 21/10/2004 +// +// SocketList, the equivalent of TStringList +// but for the type of TSocket handles +// +/// //////////////////////////////////////////////////////////////////////////// + +interface + +uses System.Classes, System.SysUtils, System.RTLConsts, ncLines; + +type + TSocketItem = record + FSocketHandle: TSocketHandle; + FLine: TncLine; + end; + + PSocketItem = ^TSocketItem; + + TSocketItemList = array of TSocketItem; + PSocketItemList = ^TSocketItemList; + + TSocketList = class(TPersistent) + private + FList: TSocketItemList; + FCount: Integer; + FCapacity: Integer; + function GetSocketHandles(Index: Integer): TSocketHandle; register; + function GetLines(Index: Integer): TncLine; register; + procedure PutLines(Index: Integer; aLine: TncLine); + procedure SetCapacity(aNewCapacity: Integer); + protected + procedure AssignTo(Dest: TPersistent); override; + procedure Insert(aIndex: Integer; const aSocketHandle: TSocketHandle; aLine: TncLine); + procedure Grow; + public + destructor Destroy; override; + + function Add(const aSocketHandle: TSocketHandle; aLine: TncLine): Integer; + procedure Clear; + procedure Delete(aIndex: Integer); register; + function Find(const aSocketHandle: TSocketHandle; var aIndex: Integer): Boolean; register; + function IndexOf(const aSocketHandle: TSocketHandle): Integer; register; + + property Count: Integer read FCount; + property SocketHandles[index: Integer]: TSocketHandle read GetSocketHandles; default; + property Lines[index: Integer]: TncLine read GetLines write PutLines; + end; + +implementation + +resourcestring + SDuplicateSocketHandle = 'Socket handle list does not allow duplicates'; + + { TSocketList } + +destructor TSocketList.Destroy; +begin + inherited Destroy; + FCount := 0; + SetCapacity(0); +end; + +procedure TSocketList.AssignTo(Dest: TPersistent); +var + DestList: TSocketList; +begin + if Dest is TSocketList then + begin + DestList := TSocketList(Dest); + DestList.FCapacity := FCapacity; + DestList.FCount := FCount; + DestList.FList := Copy(FList); + end + else + raise EConvertError.CreateResFmt(@SAssignError, [ClassName, Dest.ClassName]); +end; + +function TSocketList.Add(const aSocketHandle: TSocketHandle; aLine: TncLine): Integer; +begin + if Find(aSocketHandle, Result) then + raise Exception.Create(SDuplicateSocketHandle); + Insert(Result, aSocketHandle, aLine); +end; + +procedure TSocketList.Clear; +begin + if FCount <> 0 then + begin + FCount := 0; + SetCapacity(0); + end; +end; + +procedure TSocketList.Delete(aIndex: Integer); +begin + if (aIndex < 0) or (aIndex >= FCount) then + raise Exception.Create(Format(SListIndexError, [aIndex])); + + Dec(FCount); + if aIndex < FCount then + System.Move(FList[aIndex + 1], FList[aIndex], (FCount - aIndex) * SizeOf(TSocketItem)); +end; + +// Binary Searching + +function TSocketList.Find(const aSocketHandle: TSocketHandle; var aIndex: Integer): Boolean; +var + Low, High, Mid: Integer; +begin + Result := False; + Low := 0; + High := FCount - 1; + while Low <= High do + begin + Mid := (Low + High) shr 1; + if aSocketHandle > FList[Mid].FSocketHandle then + Low := Mid + 1 + else + begin + High := Mid - 1; + if aSocketHandle = FList[Mid].FSocketHandle then + begin + Result := True; + Low := Mid; + end; + end; + end; + aIndex := Low; +end; + +procedure TSocketList.Grow; +var + Delta: Integer; +begin + if FCapacity > 64 then + Delta := FCapacity div 4 + else if FCapacity > 8 then + Delta := 16 + else + Delta := 4; + SetCapacity(FCapacity + Delta); +end; + +function TSocketList.IndexOf(const aSocketHandle: TSocketHandle): Integer; +begin + if not Find(aSocketHandle, Result) then + Result := -1; +end; + +procedure TSocketList.Insert(aIndex: Integer; const aSocketHandle: TSocketHandle; aLine: TncLine); +begin + if FCount = FCapacity then + Grow; + if aIndex < FCount then + System.Move(FList[aIndex], FList[aIndex + 1], (FCount - aIndex) * SizeOf(TSocketItem)); + with FList[aIndex] do + begin + FSocketHandle := aSocketHandle; + FLine := aLine; + end; + Inc(FCount); +end; + +function TSocketList.GetSocketHandles(Index: Integer): TSocketHandle; +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + Result := FList[index].FSocketHandle; +end; + +function TSocketList.GetLines(Index: Integer): TncLine; +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + Result := FList[index].FLine; +end; + +procedure TSocketList.PutLines(Index: Integer; aLine: TncLine); +begin + if (index < 0) or (index >= FCount) then + raise Exception.Create(Format(SListIndexError, [index])); + FList[index].FLine := aLine; +end; + +procedure TSocketList.SetCapacity(aNewCapacity: Integer); +begin + if aNewCapacity < FCount then + raise Exception.Create(Format(SListCapacityError, [aNewCapacity])); + if aNewCapacity <> FCapacity then + begin + SetLength(FList, aNewCapacity); + FCapacity := aNewCapacity; + end; +end; + +end. diff --git a/Source_using_TMonitor/ncSockets.pas b/Source_using_TMonitor/ncSockets.pas new file mode 100644 index 0000000..5e314ad --- /dev/null +++ b/Source_using_TMonitor/ncSockets.pas @@ -0,0 +1,2045 @@ +unit ncSockets; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// +// This unit creates a TCP Server and TCP Client socket, along with their +// threads dealing with reading from the socket +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// 13/07/2025 - by J.Pauwels +// - Added TLS implementation support through SChannel integration +// - Added TLS properties (UseTLS, TlsProvider, CertificateFile) to TncTCPBase +// - Integrated TLS handshake callbacks in OnBeforeConnected architecture +// - Added secure communication capabilities for both server and client +// - CRITICAL FIX: Implemented per-connection TLS context storage to support multiple concurrent TLS connections +// +// 14/01/2025 - by J.Pauwels +// - Defined DefReadBufferLen as a new property +// - Ajust TncCustomTCPServer.DataSocketDisconnected +// - Explicitly set this unit to use TCP +// - Update Client Send method so data cannot be send while socket is inactive +// - Added IPV6 support +// +// 9/8/2020 +// - Added a ShutDownLine in the TCPServer component so as to allow to +// shutdown a line even when within a read operation +// +// 8/8/2020 +// - Got rid of any windows specific api calls so that we can compile for +// all plaforms. All platform specific stuff are now dealt in ncLines.pas +// +// 6/8/2010 +// - Optimised performance +// - Put a lock in Active property so as to make sure reconnect works properly +// - Got rid of disconnect exceptions +// - Added resource strings to all exception messages +// +// 16/12/2010 +// - Initial creation +// +// Written by Demos Bill +// +// ///////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON } +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.SysUtils, + System.Classes, + System.Diagnostics, + System.Math, + System.TimeSpan, + System.SyncObjs, + {$IFDEF MSWINDOWS} + Winapi.Windows, + Winapi.Winsock2, + ncSChannel, + {$ELSE} + Posix.SysSocket, + Posix.Unistd, + {$ENDIF} + ncSocketList, + ncLines, + ncThreads; + +type + // TLS Provider enumeration (declared early for use in constants) + TncTlsProvider = ( + tpSChannel, // Windows SChannel (Windows only, no external dependencies) + tpOpenSSL // OpenSSL (cross-platform, requires OpenSSL DLLs) + ); + + // Forward declarations for SChannel types + PSChannelClient = ^TSChannelClient; + PSChannelServer = ^TSChannelServer; + + // Per-connection TLS context storage + TncTlsConnectionContext = class + private + FIsServer: Boolean; + FClientContext: TSChannelClient; + FServerContext: TSChannelServer; + public + constructor Create(aIsServer: Boolean); + destructor Destroy; override; + function GetClientContext: PSChannelClient; + function GetServerContext: PSChannelServer; + property IsServer: Boolean read FIsServer; + end; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 1024 * 1024; // 1 MB + DefReaderThreadPriority = ntpNormal; + DefCntReconnectInterval = 1000; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefNoDelay = False; + DefKeepAlive = True; + DefFamily = afIPv4; + DefUseTLS = False; + DefTlsProvider = tpSChannel; + DefIgnoreCertificateErrors = False; + +resourcestring + ECannotSetPortWhileConnectionIsActiveStr = 'Cannot set Port property whilst the connection is active'; + ECannotSetHostWhileConnectionIsActiveStr = 'Cannot set Host property whilst the connection is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileActiveStr = 'Cannot set UseReaderThread property whilst the connection is active'; + ECannotReceiveIfUseReaderThreadStr = + 'Cannot receive data if UseReaderThread is set. Use OnReadData event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; + ETlsProviderNotSupportedStr = 'TLS provider not supported on this platform'; + EOpenSSLNotAvailableStr = 'OpenSSL libraries not available'; + +type + EPropertySetError = class(Exception); + ENonActiveSocket = class(Exception); + ECannotReceiveIfUseReaderThread = class(Exception); + ETlsProviderNotSupported = class(Exception); + EOpenSSLNotAvailable = class(Exception); + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + + // Forward declarations + TncCustomTCPServer = class; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TThreadLineList + // Thread safe object, used by the main components + + TThreadLineList = class + private + FList: TSocketList; + FListCopy: TSocketList; + FLockCount: Integer; + protected + procedure Add(const Item: TncLine); inline; + procedure Clear; inline; + procedure Remove(Item: TncLine); inline; + function LockListNoCopy: TSocketList; + procedure UnlockListNoCopy; + public + constructor Create; + destructor Destroy; override; + function LockList: TSocketList; + procedure UnlockList; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Base object for all TCP Sockets + TncOnConnectDisconnect = procedure(Sender: TObject; aLine: TncLine) of object; + TncOnReadData = procedure(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer) of object; + TncOnReconnected = procedure(Sender: TObject; aLine: TncLine) of object; + + TncTCPBase = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FNoDelay: Boolean; + FKeepAlive: Boolean; + FReadBufferLen: Integer; // Update + FOnConnected: TncOnConnectDisconnect; + FOnDisconnected: TncOnConnectDisconnect; + FOnReadData: TncOnReadData; + FLine: TncLine; + + // TLS Properties + FUseTLS: Boolean; + FTlsProvider: TncTlsProvider; + FCertificateFile: string; + FPrivateKeyFile: string; + FPrivateKeyPassword: string; + FCACertificatesFile: string; + FIgnoreCertificateErrors: Boolean; + FTlsContext: TSChannelClient; + FTlsServerContext: TSChannelServer; + FIsServer: Boolean; // Flag to determine if this is a server or client + + function GetReadBufferLen: Integer; // Update + procedure SetReadBufferLen(const Value: Integer); // Update + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetEventsUseMainThread: Boolean; + procedure SetEventsUseMainThread(const Value: Boolean); + function GetNoDelay: Boolean; + procedure SetNoDelay(const Value: Boolean); + function GetKeepAlive: Boolean; + procedure SetKeepAlive(const Value: Boolean); + + // TLS Property Methods + function GetUseTLS: Boolean; + procedure SetUseTLS(const Value: Boolean); + function GetTlsProvider: TncTlsProvider; + procedure SetTlsProvider(const Value: TncTlsProvider); + function GetCertificateFile: string; + procedure SetCertificateFile(const Value: string); + function GetPrivateKeyFile: string; + procedure SetPrivateKeyFile(const Value: string); + function GetPrivateKeyPassword: string; + procedure SetPrivateKeyPassword(const Value: string); + function GetCACertificatesFile: string; + procedure SetCACertificatesFile(const Value: string); + function GetIgnoreCertificateErrors: Boolean; + procedure SetIgnoreCertificateErrors(const Value: Boolean); + + private + FUseReaderThread: Boolean; + PropertyLock, ShutDownLock: TObject; // TMonitor synchronization objects + ReadBuf: TBytes; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetHost: string; virtual; // Virtual method for TLS + procedure InitializeTLS(aLine: TncLine); virtual; + procedure FinalizeTLS(aLine: TncLine); virtual; + function SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; virtual; + function ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; virtual; + procedure HandleTLSHandshake(aLine: TncLine); virtual; + procedure HandleTLSHandshakeComplete(aLine: TncLine); virtual; + property Line: TncLine read FLine; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default DefNoDelay; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default DefKeepAlive; + property OnConnected: TncOnConnectDisconnect read FOnConnected write FOnConnected; + property OnDisconnected: TncOnConnectDisconnect read FOnDisconnected write FOnDisconnected; + property OnReadData: TncOnReadData read FOnReadData write FOnReadData; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; // Update + + // TLS Properties + property UseTLS: Boolean read GetUseTLS write SetUseTLS default DefUseTLS; + property TlsProvider: TncTlsProvider read GetTlsProvider write SetTlsProvider default DefTlsProvider; + property CertificateFile: string read GetCertificateFile write SetCertificateFile; + property PrivateKeyFile: string read GetPrivateKeyFile write SetPrivateKeyFile; + property PrivateKeyPassword: string read GetPrivateKeyPassword write SetPrivateKeyPassword; + property CACertificatesFile: string read GetCACertificatesFile write SetCACertificatesFile; + property IgnoreCertificateErrors: Boolean read GetIgnoreCertificateErrors write SetIgnoreCertificateErrors default DefIgnoreCertificateErrors; + published + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Client Socket + TncClientProcessor = class; + + TncCustomTCPClient = class(TncTCPBase) + private + FHost: string; + FReconnect: Boolean; + FReconnectInterval: Cardinal; + FOnReconnected: TncOnReconnected; + function GetActive: Boolean; override; + procedure SetHost(const Value: string); + function GetHost: string; + function GetReconnect: Boolean; + procedure SetReconnect(const Value: Boolean); + function GetReconnectInterval: Cardinal; + procedure SetReconnectInterval(const Value: Cardinal); + protected + WasConnected: Boolean; + LastConnectAttempt: Int64; + procedure DoActivate(aActivate: Boolean); override; + procedure DataSocketConnected(aLine: TncLine); + procedure DataSocketDisconnected(aLine: TncLine); + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Send(const aBuf; aBufSize: Integer); overload; inline; + procedure Send(const aBytes: TBytes); overload; inline; + procedure Send(const aStr: string); overload; inline; + function Receive(aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(var aBytes: TBytes): Integer; inline; + property Host: string read GetHost write SetHost; + property Reconnect: Boolean read GetReconnect write SetReconnect default True; + property ReconnectInterval: Cardinal read GetReconnectInterval write SetReconnectInterval default DefCntReconnectInterval; + property OnReconnected: TncOnReconnected read FOnReconnected write FOnReconnected; + end; + + TncTCPClient = class(TncCustomTCPClient) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property NoDelay; + property KeepAlive; + property ReadBufferLen; + property Reconnect; + property ReconnectInterval; + property OnConnected; + property OnDisconnected; + property OnReadData; + property OnReconnected; + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; + end; + + TncClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomTCPClient; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomTCPClient); + procedure SocketWasReconnected; + procedure SocketProcess; inline; + procedure ProcessEvent; override; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Server Socket + TncServerProcessor = class; + + TncCustomTCPServer = class(TncTCPBase) + private + function GetActive: Boolean; override; + protected + Listener: TncLine; + LinesToShutDown: array of TncLine; + procedure DataSocketConnected(aLine: TncLine); + procedure DataSocketDisconnected(aLine: TncLine); + procedure DoActivate(aActivate: Boolean); override; + public + ReadSocketHandles: TSocketHandleArray; + Lines: TThreadLineList; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure ShutDownLine(aLine: TncLine); + procedure Send(aLine: TncLine; const aBuf; aBufSize: Integer); overload; inline; + procedure Send(aLine: TncLine; const aBytes: TBytes); overload; inline; + procedure Send(aLine: TncLine; const aStr: string); overload; inline; + function Receive(aLine: TncLine; aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; inline; + end; + + TncTCPServer = class(TncCustomTCPServer) + public + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property NoDelay; + property KeepAlive; + property ReadBufferLen; // Update + property OnConnected; + property OnDisconnected; + property OnReadData; + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; + end; + + TncServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomTCPServer; + procedure CheckLinesToShutDown; + public + ReadySockets: TSocketHandleArray; + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomTCPServer); + procedure SocketProcess; inline; + procedure ProcessEvent; override; + end; + +implementation + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TThreadLineList } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TThreadLineList.Create; +begin + inherited Create; + FList := TSocketList.Create; + FLockCount := 0; +end; + +destructor TThreadLineList.Destroy; +begin + LockListNoCopy; + try + FList.Free; + inherited Destroy; + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Add(const Item: TncLine); +begin + LockListNoCopy; + try + // FList has Duplicates to dupError, so we know if this is already in the + // list it will not be accepted + FList.Add(Item.Handle, Item); + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Clear; +begin + LockListNoCopy; + try + FList.Clear; + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Remove(Item: TncLine); +begin + LockListNoCopy; + try + FList.Delete(FList.IndexOf(Item.Handle)); + finally + UnlockListNoCopy; + end; +end; + +function TThreadLineList.LockListNoCopy: TSocketList; +begin + TMonitor.Enter(Self); + Result := FList; +end; + +procedure TThreadLineList.UnlockListNoCopy; +begin + TMonitor.Exit(Self); +end; + +function TThreadLineList.LockList: TSocketList; +begin + TMonitor.Enter(Self); + try + if FLockCount = 0 then + begin + FListCopy := TSocketList.Create; + FListCopy.Assign(FList); + end; + Result := FListCopy; + + FLockCount := FLockCount + 1; + finally + TMonitor.Exit(Self); + end; +end; + +procedure TThreadLineList.UnlockList; +begin + TMonitor.Enter(Self); + try + if FLockCount = 0 then + raise Exception.Create('Cannot unlock a non-locked list'); + + FLockCount := FLockCount - 1; + + if FLockCount = 0 then + FListCopy.Free; + finally + TMonitor.Exit(Self); + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTlsConnectionContext } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTlsConnectionContext.Create(aIsServer: Boolean); +begin + inherited Create; + FIsServer := aIsServer; + + // Initialize TLS contexts using FillChar and then set public fields + FillChar(FClientContext, SizeOf(FClientContext), 0); + FClientContext.Initialized := False; + + FillChar(FServerContext, SizeOf(FServerContext), 0); + FServerContext.Initialized := False; + FServerContext.HandshakeCompleted := False; +end; + +destructor TncTlsConnectionContext.Destroy; +begin + // In a perfect world, FinalizeTLS was already called + // and all cleanup is done - destructor should be nearly empty + + {$IFDEF DEBUG} + // Debug check - verify cleanup already happened + if FIsServer then + Assert(not FServerContext.Initialized, 'Server TLS context not cleaned up!') + else + Assert(not FClientContext.Initialized, 'Client TLS context not cleaned up!'); + {$ENDIF} + + inherited Destroy; +end; + +function TncTlsConnectionContext.GetClientContext: PSChannelClient; +begin + Result := @FClientContext; +end; + +function TncTlsConnectionContext.GetServerContext: PSChannelServer; +begin + Result := @FServerContext; +end; + + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTCPBase } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTCPBase.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TObject.Create; + ShutDownLock := TObject.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FNoDelay := DefNoDelay; + FKeepAlive := DefKeepAlive; + FReadBufferLen := DefReadBufferLen; // Update + FOnConnected := nil; + FOnDisconnected := nil; + FOnReadData := nil; + + // Initialize TLS properties + FUseTLS := DefUseTLS; + FTlsProvider := DefTlsProvider; + FCertificateFile := ''; + FPrivateKeyFile := ''; + FPrivateKeyPassword := ''; + FCACertificatesFile := ''; + FIgnoreCertificateErrors := DefIgnoreCertificateErrors; + + // Initialize TLS contexts using FillChar and then set public fields + FillChar(FTlsContext, SizeOf(FTlsContext), 0); + FTlsContext.Initialized := False; + + FillChar(FTlsServerContext, SizeOf(FTlsServerContext), 0); + FTlsServerContext.Initialized := False; + FTlsServerContext.HandshakeCompleted := False; + + FIsServer := False; + + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncTCPBase.Kind: TSocketType; +begin + Result := stTCP; +end; + +destructor TncTCPBase.Destroy; +begin + Active := False; + + // TLS contexts are now managed per-connection and cleaned up in FinalizeTLS + // No global TLS context cleanup needed + + PropertyLock.Free; + ShutDownLock.Free; + + inherited Destroy; +end; + +procedure TncTCPBase.Loaded; +begin + inherited Loaded; + + if FInitActive then + DoActivate(True); +end; + +function TncTCPBase.CreateLineObject: TncLine; +begin + Result := TncLineInternal.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); + + // Set up TLS callback if TLS is enabled + if FUseTLS then + TncLineInternal(Result).OnBeforeConnected := HandleTLSHandshake; +end; + +procedure TncTCPBase.SetActive(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + if not(csLoading in ComponentState) then + DoActivate(Value); + + FInitActive := GetActive; // we only care here for the loaded event + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetFamily: TAddressType; +begin + TMonitor.Enter(PropertyLock); + try + Result := FFamily; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetFamily(const Value: TAddressType); +begin + if not (csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create(ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + TMonitor.Enter(PropertyLock); + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetPort: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPort; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileConnectionIsActiveStr); + + TMonitor.Enter(PropertyLock); + try + FPort := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetReaderThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetEventsUseMainThread: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEventsUseMainThread; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetEventsUseMainThread(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FEventsUseMainThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileActiveStr); + + TMonitor.Enter(PropertyLock); + try + FUseReaderThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetNoDelay: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FNoDelay; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetNoDelay(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FNoDelay := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetKeepAlive: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FKeepAlive; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetKeepAlive(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FKeepAlive := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// Update +function TncTCPBase.GetReadBufferLen: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReadBufferLen; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// Update +procedure TncTCPBase.SetReadBufferLen(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// TLS Property Methods +function TncTCPBase.GetUseTLS: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FUseTLS; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetUseTLS(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set UseTLS property whilst the connection is active'); + + TMonitor.Enter(PropertyLock); + try + FUseTLS := Value; + + // Add TLS callback assignment when TLS is enabled + if Value then + begin + if FIsServer and (Self is TncCustomTCPServer) then + begin + // Server callback assignment + var Server := TncCustomTCPServer(Self); + if Server.Listener <> nil then + begin + TncLineInternal(Server.Listener).OnBeforeConnected := HandleTLSHandshake; + end; + end + else if not FIsServer and (Self is TncCustomTCPClient) then + begin + // Client callback assignment + var Client := TncCustomTCPClient(Self); + if Client.Line <> nil then + begin + TncLineInternal(Client.Line).OnBeforeConnected := HandleTLSHandshake; + end; + end; + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetTlsProvider: TncTlsProvider; +begin + TMonitor.Enter(PropertyLock); + try + Result := FTlsProvider; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetTlsProvider(const Value: TncTlsProvider); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set TlsProvider property whilst the connection is active'); + + TMonitor.Enter(PropertyLock); + try + // Validate provider availability + case Value of + tpSChannel: + begin + {$IFNDEF MSWINDOWS} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL validation - for now, not supported + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + + FTlsProvider := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetCertificateFile: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCertificateFile; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetCertificateFile(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FCertificateFile := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetPrivateKeyFile: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPrivateKeyFile; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetPrivateKeyFile(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FPrivateKeyFile := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetPrivateKeyPassword: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPrivateKeyPassword; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetPrivateKeyPassword(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FPrivateKeyPassword := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetCACertificatesFile: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCACertificatesFile; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetCACertificatesFile(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FCACertificatesFile := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBase.GetIgnoreCertificateErrors: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FIgnoreCertificateErrors; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBase.SetIgnoreCertificateErrors(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FIgnoreCertificateErrors := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// TLS base implementation +function TncTCPBase.GetHost: string; +begin + Result := ''; // Default implementation, override in client +end; + +// TLS Functionality Methods +procedure TncTCPBase.InitializeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if not FUseTLS then + Exit; + + if aLine = nil then + Exit; + + // Get or create per-connection TLS context + if TncLineInternal(aLine).DataObject = nil then + begin + TlsContext := TncTlsConnectionContext.Create(FIsServer); + TncLineInternal(aLine).DataObject := TlsContext; + end + else + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + end; + + // Check if TLS is already initialized for this specific connection + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Exit; + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Exit; + end; + + // Initialize TLS for this specific connection + if FIsServer then + begin + TlsContext.GetServerContext^.AfterConnection(aLine, AnsiString(FCertificateFile), AnsiString(FPrivateKeyPassword)); + end + else + begin + TlsContext.GetClientContext^.AfterConnection(aLine, AnsiString(GetHost), FIgnoreCertificateErrors); + end; +end; + +procedure TncTCPBase.HandleTLSHandshake(aLine: TncLine); +begin + // This method is called automatically before OnConnected fires + // It performs the TLS handshake synchronously + if FUseTLS and (aLine <> nil) then + begin + InitializeTLS(aLine); // Perform the complete TLS handshake + end; +end; + +procedure TncTCPBase.HandleTLSHandshakeComplete(aLine: TncLine); +begin + // Call OnConnected for TLS connections after handshake completes + if FUseTLS and Assigned(OnConnected) then + begin + try + OnConnected(Self, aLine); + except + on E: Exception do + // OnConnected failed - could log this if needed + end; + end; +end; + +procedure TncTCPBase.FinalizeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (aLine <> nil) and (TncLineInternal(aLine).DataObject <> nil) then + begin + try + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + TlsContext.GetServerContext^.BeforeDisconnection(aLine); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + TlsContext.GetClientContext^.BeforeDisconnection(aLine); + end; + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL cleanup + end; + end; + + // Clean up the TLS context object + TncLineInternal(aLine).DataObject := nil; + TlsContext.Free; + except + on E: Exception do + // Log error but don't raise exception during cleanup + end; + end; +end; + +function TncTCPBase.SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Result := TlsContext.GetServerContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Result := TlsContext.GetClientContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL send implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); +end; + +function TncTCPBase.ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; + WasHandshakeCompleted: Boolean; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + begin + WasHandshakeCompleted := TlsContext.GetServerContext^.HandshakeCompleted; + + Result := TlsContext.GetServerContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and WasHandshakeCompleted then + begin + raise Exception.Create('TLS client disconnected'); + end; + + // Check if handshake just completed + if not WasHandshakeCompleted and TlsContext.GetServerContext^.HandshakeCompleted then + begin + // Handshake just completed, call OnConnected + HandleTLSHandshakeComplete(aLine); + + // CRITICAL FIX: Return -1 to prevent OnReadData from being triggered with empty data + // The handshake completion callback has already been called above + Result := -1; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + begin + // For client, handshake is complete when Initialized becomes true + // But we need to track when it JUST became initialized (not if it was already initialized) + // Since the client calls AfterConnection during OnBeforeConnected, we know that + // the first call to Receive after OnBeforeConnected is when handshake is complete + + Result := TlsContext.GetClientContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and TlsContext.GetClientContext^.Initialized then + begin + raise Exception.Create('TLS server disconnected'); + end; + + // Client-side handshake completion detection: + // The client TLS handshake is handled in OnBeforeConnected event + // So by the time we get here, handshake is already complete + // We don't need to do anything special for client handshake completion + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL receive implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPClient } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomTCPClient.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FIsServer := False; // Set client flag for TLS context selection + FHost := DefHost; + FReconnect := True; + FReconnectInterval := DefCntReconnectInterval; + FOnReconnected := nil; + + LastConnectAttempt := TStopWatch.GetTimeStamp; + WasConnected := False; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + TncLineInternal(Line).OnConnected := DataSocketConnected; + TncLineInternal(Line).OnDisconnected := DataSocketDisconnected; + + // Set up TLS handshake callback if TLS is enabled + if FUseTLS then + TncLineInternal(Line).OnBeforeConnected := HandleTLSHandshake; + + LineProcessor := TncClientProcessor.Create(Self); + try + if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; + LineProcessor.WaitForReady; +end; + + +destructor TncCustomTCPClient.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +procedure TncCustomTCPClient.DoActivate(aActivate: Boolean); +begin + + if aActivate = GetActive then + Exit; + + if aActivate then + begin + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + TncLineInternal(Line).CreateClientHandle(FHost, FPort); + + // if there were no exceptions, and line is still not active, + // that means the user has deactivated it in the OnConnect handler + if not Line.Active then + WasConnected := False; + end + else + begin + WasConnected := False; + TncLineInternal(Line).DestroyHandle; + end; +end; + +procedure TncCustomTCPClient.DataSocketConnected(aLine: TncLine); +begin + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if NoDelay then + try + TncLineInternal(Line).EnableNoDelay; + except + end; + + if KeepAlive then + try + TncLineInternal(Line).EnableKeepAlive; + except + end; + + try + TncLineInternal(Line).SetReceiveSize(1048576); // 1MB + TncLineInternal(Line).SetWriteSize(1048576); // 1MB + //TncLineInternal(Line).SetReceiveSize(20 * 1048576); + + except + end; + + // TLS initialization is now handled by OnBeforeConnected event + + if Assigned(OnConnected) then + try + OnConnected(Self, aLine); + except + end; + + LastConnectAttempt := TStopWatch.GetTimeStamp; + WasConnected := True; + + if UseReaderThread then + LineProcessor.Run; // Will just set events, this does not wait +end; + +procedure TncCustomTCPClient.DataSocketDisconnected(aLine: TncLine); +begin + // Finalize TLS if enabled + if UseTLS then + FinalizeTLS(aLine); + + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, aLine); + except + end; +end; + + +procedure TncCustomTCPClient.Send(const aBuf; aBufSize: Integer); +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + SendTLS(Line, aBuf, aBufSize); +end; + +procedure TncCustomTCPClient.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPClient.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +function TncCustomTCPClient.Receive(aTimeout: Cardinal): TBytes; +var + BufRead: Integer; +begin + if UseReaderThread then + raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); + Result := Copy(ReadBuf, 0, BufRead) +end; + +function TncCustomTCPClient.ReceiveRaw(var aBytes: TBytes): Integer; +begin + Result := ReceiveTLS(Line, aBytes[0], Length(aBytes)); +end; + +function TncCustomTCPClient.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomTCPClient.GetHost: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FHost; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomTCPClient.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileConnectionIsActiveStr); + + TMonitor.Enter(PropertyLock); + try + FHost := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncCustomTCPClient.GetReconnect: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReconnect; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomTCPClient.SetReconnect(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FReconnect := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncCustomTCPClient.GetReconnectInterval: Cardinal; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReconnectInterval; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomTCPClient.SetReconnectInterval(const Value: Cardinal); +begin + TMonitor.Enter(PropertyLock); + try + FReconnectInterval := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncClientProcessor } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncClientProcessor.Create(aClientSocket: TncCustomTCPClient); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncClientProcessor.SocketProcess; +var + BufRead: Integer; +begin + BufRead := FClientSocket.ReceiveTLS(FClientSocket.Line, FClientSocket.ReadBuf[0], Length(FClientSocket.ReadBuf)); + if Assigned(FClientSocket.OnReadData) and (BufRead > 0) then + try + FClientSocket.OnReadData(FClientSocket, FClientSocket.Line, FClientSocket.ReadBuf, BufRead); + except + end; +end; + +procedure TncClientProcessor.SocketWasReconnected; +begin + if Assigned(FClientSocket.FOnReconnected) then + FClientSocket.FOnReconnected(FClientSocket, FClientSocket.Line); + if Assigned(FClientSocket.FOnConnected) then + FClientSocket.FOnConnected(FClientSocket, FClientSocket.Line); +end; + +procedure TncClientProcessor.ProcessEvent; +var + PrevOnConnect: TncOnConnectDisconnect; + WasReconnected: Boolean; +begin + while (not Terminated) do // Repeat handling until terminated + try + if FClientSocket.Line.Active then // Repeat reading socket until disconnected + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(SocketProcess) // for synchronize + else + SocketProcess; + end; + end + else + // Is not Active, try reconnecting if was connected + begin + // Logic for reconnect mode + if FClientSocket.Reconnect and FClientSocket.WasConnected then + begin + // A minimal sleep time of 30 msec is required in Android before + // reattempting to connect on a recently deactivated network connection. + // We have put it to 60 for safety + Sleep(60); + if Terminated then + Break; + if TStopWatch.GetTimeStamp - FClientSocket.LastConnectAttempt > FClientSocket.ReconnectInterval * TTimeSpan.TicksPerMillisecond then + begin + FClientSocket.LastConnectAttempt := TStopWatch.GetTimeStamp; + + WasReconnected := False; + TMonitor.Enter(FClientSocket.PropertyLock); + try + if not FClientSocket.Active then + begin + PrevOnConnect := FClientSocket.OnConnected; + try + // Disable firing the event in the wrong thread in case it gets connected + FClientSocket.OnConnected := nil; + FClientSocket.Active := True; + WasReconnected := True; + finally + FClientSocket.OnConnected := PrevOnConnect; + end; + end; + finally + TMonitor.Exit(FClientSocket.PropertyLock); + end; + if WasReconnected then + if FClientSocket.EventsUseMainThread then + Synchronize(SocketWasReconnected) + else + SocketWasReconnected; + end; + end + else + Exit; + end; + except + // Something was disconnected, continue processing + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPServer } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomTCPServer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FIsServer := True; // Set server flag for TLS context selection + + Listener := CreateLineObject; + if Listener.Family <> FFamily then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; + + TncLineInternal(Listener).OnConnected := DataSocketConnected; + TncLineInternal(Listener).OnDisconnected := DataSocketDisconnected; + + // Set up TLS handshake callback if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Listener).OnBeforeConnected := HandleTLSHandshake; + end; + Lines := TThreadLineList.Create(); + + LineProcessor := TncServerProcessor.Create(Self); + try + if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; + LineProcessor.WaitForReady; +end; + +destructor TncCustomTCPServer.Destroy; +begin + // Will get Sockets.Lines disposed off + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Lines.Free; + Listener.Free; + + inherited Destroy; +end; + +function TncCustomTCPServer.GetActive: Boolean; +begin + Result := Listener.Active; +end; + +procedure TncCustomTCPServer.DoActivate(aActivate: Boolean); +var + DataSockets: TSocketList; + i: Integer; +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + // Verify family setting before creating handle + if Assigned(Listener) and (Listener.Family <> FFamily) then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; + TncLineInternal(Listener).CreateServerHandle(FPort); + end + else + begin + if Assigned(Listener) then + TncLineInternal(Listener).DestroyHandle; + + // Cleanup connected sockets +{$HINTS OFF} + DataSockets := Lines.LockListNoCopy; + try + for i := 0 to DataSockets.Count - 1 do + try + if Assigned(DataSockets.Lines[i]) then + begin + TncLineInternal(DataSockets.Lines[i]).DestroyHandle; + DataSockets.Lines[i].Free; + end; + except + // + end; + DataSockets.Clear; + finally + Lines.UnlockListNoCopy; + end; + end; +end; + +procedure TncCustomTCPServer.ShutDownLine(aLine: TncLine); +var + i: Integer; +begin + if UseReaderThread then + begin + TMonitor.Enter(ShutDownLock); + try + for i := 0 to High(LinesToShutDown) do + if LinesToShutDown[i] = aLine then + Exit; + + SetLength(LinesToShutDown, Length(LinesToShutDown) + 1); + LinesToShutDown[High(LinesToShutDown)] := aLine; + finally + TMonitor.Exit(ShutDownLock); + end; + end + else + begin + Lines.Remove(aLine); + aLine.Free; + end; +end; + +procedure TncCustomTCPServer.DataSocketConnected(aLine: TncLine); +begin + if aLine = Listener then + begin + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Listener.Handle; + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + SetLength(ReadSocketHandles, Length(ReadSocketHandles) + 1); + ReadSocketHandles[High(ReadSocketHandles)] := aLine.Handle; + + if NoDelay then + try + TncLineInternal(aLine).EnableNoDelay; + except + end; + + if KeepAlive then + try + TncLineInternal(aLine).EnableKeepAlive; + except + end; + + try + TncLineInternal(aLine).SetReceiveSize(1048576); + TncLineInternal(aLine).SetWriteSize(1048576); + except + end; + + // TLS initialization is now handled by OnBeforeConnected event + + // For TLS connections, delay OnConnected until after handshake completes + if not UseTLS then + begin + if Assigned(OnConnected) then + try + OnConnected(Self, aLine); + except + end; + end + else + begin + // For TLS connections, OnConnected will be called after handshake completes + // This is handled in the first successful TLS receive operation + end; + end; +end; + +// Update : Moves the handle removal before the disconnect event handling +// This prevents other threads from trying to use the handle while the disconnect event is processing. +procedure TncCustomTCPServer.DataSocketDisconnected(aLine: TncLine); +var + i: Integer; +begin + if aLine = Listener then + SetLength(ReadSocketHandles, 0) + else + begin + // Finalize TLS if enabled + if UseTLS then + FinalizeTLS(aLine); + + // First remove the handle to prevent further processing + TMonitor.Enter(PropertyLock); + try + for i := 0 to High(ReadSocketHandles) do + if ReadSocketHandles[i] = aLine.Handle then + begin + ReadSocketHandles[i] := ReadSocketHandles[High(ReadSocketHandles)]; + SetLength(ReadSocketHandles, Length(ReadSocketHandles) - 1); + Break; + end; + finally + TMonitor.Exit(PropertyLock); + end; + + // Then handle disconnect event + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, aLine); + except + end; + end; +end; + +procedure TncCustomTCPServer.Send(aLine: TncLine; const aBuf; aBufSize: Integer); +begin + SendTLS(aLine, aBuf, aBufSize); +end; + +procedure TncCustomTCPServer.Send(aLine: TncLine; const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aLine, aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPServer.Send(aLine: TncLine; const aStr: string); +begin + Send(aLine, BytesOf(aStr)); +end; + +function TncCustomTCPServer.Receive(aLine: TncLine; aTimeout: Cardinal): TBytes; +var + i, BufRead, LineNdx: Integer; + DataSockets: TSocketList; + Line: TncLine; + ReadySockets: TSocketHandleArray; +begin + if UseReaderThread then + raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + + SetLength(Result, 0); + ReadySockets := Readable(ReadSocketHandles, aTimeout); + + for i := 0 to High(ReadySockets) do + try + if ReadySockets[i] = Listener.Handle then + // New line is here, accept it and create a new TncLine object + Lines.Add(TncLineInternal(Listener).AcceptLine); + except + end; + + DataSockets := Lines.LockListNoCopy; + try + for i := 0 to High(ReadySockets) do + try + if aLine.Handle = ReadySockets[i] then + begin + LineNdx := DataSockets.IndexOf(ReadySockets[i]); + if LineNdx = -1 then + Continue; + Line := DataSockets.Lines[LineNdx]; + try + if not Line.Active then + Abort; + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); + Result := Copy(ReadBuf, 0, BufRead); + except + // Line has disconnected, destroy the line + DataSockets.Delete(LineNdx); + Line.Free; + end; + end; + except + end; + finally + Lines.UnlockListNoCopy; + end; +end; + +function TncCustomTCPServer.ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; +begin + Result := ReceiveTLS(aLine, aBytes[0], Length(aBytes)); +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncServerProcessor } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncServerProcessor.Create(aServerSocket: TncCustomTCPServer); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncServerProcessor.CheckLinesToShutDown; +var + i: Integer; +begin + // The list may be locked from custom code executed in the OnReadData handler + // So we will not delete anything, or lock the list, until this lock is freed + if TMonitor.TryEnter(FServerSocket.Lines) then + try + TMonitor.Enter(FServerSocket.ShutDownLock); + try + for i := 0 to High(FServerSocket.LinesToShutDown) do + try + FServerSocket.Lines.Remove(FServerSocket.LinesToShutDown[i]); + TncLineInternal(FServerSocket.LinesToShutDown[i]).DestroyHandle; + TncLineInternal(FServerSocket.LinesToShutDown[i]).Free; + except + end; + SetLength(FServerSocket.LinesToShutDown, 0); + finally + TMonitor.Exit(FServerSocket.ShutDownLock); + end; + finally + TMonitor.Exit(FServerSocket.Lines); + end; +end; + +procedure TncServerProcessor.SocketProcess; +var + i, LineNdx, BufRead, ReadySocketsHigh: Integer; + DataSockets: TSocketList; + Line: TncLine; + j: Integer; +begin + ReadySocketsHigh := High(ReadySockets); + + // First accept new lines + i := 0; + while i <= ReadySocketsHigh do + begin + try + if ReadySockets[i] = FServerSocket.Listener.Handle then + begin + // New line is here, accept it and create a new TncLine object + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + FServerSocket.Lines.Add(TncLineInternal(FServerSocket.Listener).AcceptLine); + + Delete(ReadySockets, i, 1); + ReadySocketsHigh := ReadySocketsHigh - 1; + i := i - 1; + end; + except + end; + i := i + 1; + end; + + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + + // Check for new data + DataSockets := FServerSocket.Lines.FList; + for i := 0 to ReadySocketsHigh do + try + LineNdx := DataSockets.IndexOf(ReadySockets[i]); + if LineNdx = -1 then + begin + for j := 0 to High(FServerSocket.ReadSocketHandles) do + if FServerSocket.ReadSocketHandles[j] = ReadySockets[i] then + begin + FServerSocket.ReadSocketHandles[j] := FServerSocket.ReadSocketHandles[High(FServerSocket.ReadSocketHandles)]; + SetLength(FServerSocket.ReadSocketHandles, Length(FServerSocket.ReadSocketHandles) - 1); + Break; + end; + Continue; + end; + Line := DataSockets.Lines[LineNdx]; + try + if not Line.Active then + Abort; + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + BufRead := FServerSocket.ReceiveTLS(Line, FServerSocket.ReadBuf[0], Length(FServerSocket.ReadBuf)); + if Assigned(FServerSocket.OnReadData) and (BufRead > 0) then + FServerSocket.OnReadData(FServerSocket, Line, FServerSocket.ReadBuf, BufRead); + except + // Line has disconnected, destroy the line + DataSockets.Delete(LineNdx); + Line.Free; + end; + + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + except + end; +end; + +procedure TncServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Listener.Active and (not Terminated) do + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + Synchronize(SocketProcess); + CheckLinesToShutDown; + except + end + else + while FServerSocket.Listener.Active and (not Terminated) do + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + SocketProcess; + CheckLinesToShutDown; + except + end; +end; + +end. diff --git a/Source_using_TMonitor/ncSocketsDual.pas b/Source_using_TMonitor/ncSocketsDual.pas new file mode 100644 index 0000000..f255c39 --- /dev/null +++ b/Source_using_TMonitor/ncSocketsDual.pas @@ -0,0 +1,2901 @@ +unit ncSocketsDual; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 ncSocketsDual - Enhanced TCP Components with Dual Protocol Support +// +// This unit extends ncSockets with dual protocol capabilities, allowing both +// raw data (text/binary) and structured command protocols to coexist on the +// same connection. +// +// Key Features: +// - Automatic protocol detection via magic header ($ACF0FF00) +// - OnReadData: Handles raw data and custom protocols (like ncSockets) +// - OnCommand: Handles structured binary commands with guaranteed delivery +// - Full backward compatibility with ncSockets +// - Advanced TCP fragmentation handling with state machine +// - TLS support, IPv6, and all ncSockets features preserved +// - CRITICAL FIX: Per-connection TLS context storage for multiple concurrent TLS connections +// +// Usage: +// - Drop-in replacement for ncSockets (TncTCPClient -> TncTCPClientDual) +// - Custom protocols work exactly like ncSockets via OnReadData +// - Enhanced features available via SendCommand/OnCommand for guaranteed delivery +// +// 11/08/2025 - by J.Pauwels +// - Added original compression and encryption from ncSources +// +// 29/07/2025 - by J.Pauwels +// - CRITICAL FIX: Fixed TLS disconnection crash by changing from event-driven to direct TLS cleanup +// - Removed OnBeforeDisconnected := FinalizeTLS assignments from constructors and SetUseTLS +// - Added direct FinalizeTLS(aLine) calls in DataSocketDisconnected methods for better timing +// - This aligns ncSocketsDual TLS cleanup pattern with the proven ncSockets approach +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// 15/07/2025 - by J.Pauwels +// - CRITICAL FIX: Implemented per-connection TLS context storage to support multiple concurrent TLS connections +// - Fixed TLS multiple client connection issue using TncTlsConnectionContext class +// +// 15/07/2025 - by J.Pauwels +// - Added OnCommand event for guaranteed delivery of commands +// - Added SendCommand method for sending commands +// - Added TncCommand type for command handling +// - Added TncCommandPacking unit for command packing/unpacking +// +// 15/07/2025 - by J.Pauwels +// - Initial creation +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON } +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses + System.SysUtils, + System.Classes, + System.Diagnostics, + System.Math, + System.TimeSpan, + System.SyncObjs, + System.ZLib, // For compression support + Generics.Collections, + {$IFDEF MSWINDOWS} + Winapi.Windows, + Winapi.Winsock2, + ncSChannel, + {$ELSE} + Posix.SysSocket, + Posix.Unistd, + {$ENDIF} + ncSocketList, + ncLines, + ncThreads, + ncCommandPacking, // For TncCommand type + ncCompression, // For compression utilities + ncEncryption; // For encryption utilities + +type + // TLS Provider enumeration (declared early for use in constants) + TncTlsProvider = ( + tpSChannel, // Windows SChannel (Windows only, no external dependencies) + tpOpenSSL // OpenSSL (cross-platform, requires OpenSSL DLLs) + ); + + // Forward declarations for SChannel types + PSChannelClient = ^TSChannelClient; + PSChannelServer = ^TSChannelServer; + + // Per-connection TLS context storage + TncTlsConnectionContext = class + private + FIsServer: Boolean; + FClientContext: TSChannelClient; + FServerContext: TSChannelServer; + public + constructor Create(aIsServer: Boolean); + destructor Destroy; override; + function GetClientContext: PSChannelClient; + function GetServerContext: PSChannelServer; + property IsServer: Boolean read FIsServer; + end; + + // Protocol magic header type (same as ncSources) + TMagicHeaderType = UInt32; + PMagicHeaderType = ^TMagicHeaderType; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 1024 * 1024; // 1 MB + DefReaderThreadPriority = ntpNormal; + DefCntReconnectInterval = 1000; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefNoDelay = False; + DefKeepAlive = True; + DefFamily = afIPv4; + DefUseTLS = False; + DefTlsProvider = tpSChannel; + DefIgnoreCertificateErrors = False; + + // Compression and Encryption defaults (same as ncSources) + DefCompression = zcNone; + DefEncryption = etNoEncryption; + DefEncryptionKey = 'SetEncryptionKey'; + DefEncryptOnHashedKey = True; + + // Thread Pool Constants (from ncSources) + DefCommandProcessorThreadPriority = ntpNormal; + DefCommandProcessorThreads = 0; + DefCommandProcessorThreadsPerCPU = 4; + DefCommandProcessorThreadsGrowUpto = 32; + + // Protocol magic header (same as ncSources) + MagicHeader: TMagicHeaderType = $ACF0FF00; + +resourcestring + ECannotSetPortWhileConnectionIsActiveStr = 'Cannot set Port property whilst the connection is active'; + ECannotSetHostWhileConnectionIsActiveStr = 'Cannot set Host property whilst the connection is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileActiveStr = 'Cannot set UseReaderThread property whilst the connection is active'; + ECannotReceiveIfUseReaderThreadStr = + 'Cannot receive data if UseReaderThread is set. Use OnReadData event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; + ETlsProviderNotSupportedStr = 'TLS provider not supported on this platform'; + EOpenSSLNotAvailableStr = 'OpenSSL libraries not available'; + +type + EPropertySetError = class(Exception); + ENonActiveSocket = class(Exception); + ECannotReceiveIfUseReaderThread = class(Exception); + ETlsProviderNotSupported = class(Exception); + EOpenSSLNotAvailable = class(Exception); + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + + // Forward declarations + TncCustomTCPServerDual = class; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TThreadLineList + // Thread safe object, used by the main components + + TThreadLineList = class + private + FList: TSocketList; + FListCopy: TSocketList; + // FLock converted to TMonitor.Enter(Self) + FLockCount: Integer; + protected + procedure Add(const Item: TncLine); inline; + procedure Clear; inline; + procedure Remove(Item: TncLine); inline; + function LockListNoCopy: TSocketList; + procedure UnlockListNoCopy; + public + constructor Create; + destructor Destroy; override; + function LockList: TSocketList; + procedure UnlockList; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Base object for all TCP Sockets + TncOnConnectDisconnect = procedure(Sender: TObject; aLine: TncLine) of object; + TncOnReadData = procedure(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer) of object; + TncOnReconnected = procedure(Sender: TObject; aLine: TncLine) of object; + TncOnCommandReceived = procedure(Sender: TObject; aLine: TncLine; + aCmd: Integer; const aData: TBytes) of object; // Binary protocol event + + // Command Processing Thread for Thread Pool (from ncSources) + THandleCommandWorkType = (htwtOnCommand); + + THandleCommandThread = class(TncReadyThread) + private + FWorkType: THandleCommandWorkType; + FSource: TComponent; + FLine: TncLine; + FCmd: Integer; + FData: TBytes; + FOnCommand: TncOnCommandReceived; + FEventsUseMainThread: Boolean; + + procedure CallOnCommandEvent; + protected + procedure ProcessEvent; override; + public + property WorkType: THandleCommandWorkType read FWorkType write FWorkType; + property Source: TComponent read FSource write FSource; + property Line: TncLine read FLine write FLine; + property Cmd: Integer read FCmd write FCmd; + property Data: TBytes read FData write FData; + property OnCommand: TncOnCommandReceived read FOnCommand write FOnCommand; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread; + end; + + TncTCPBaseDual = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FNoDelay: Boolean; + FKeepAlive: Boolean; + FReadBufferLen: Integer; + FOnConnected: TncOnConnectDisconnect; + FOnDisconnected: TncOnConnectDisconnect; + FOnReadData: TncOnReadData; + FLine: TncLine; + + // Thread Pool Properties (from ncSources) + FCommandProcessorThreadPriority: TncThreadPriority; + FCommandProcessorThreads: Integer; + FCommandProcessorThreadsPerCPU: Integer; + FCommandProcessorThreadsGrowUpto: Integer; + + // TLS Properties + FUseTLS: Boolean; + FTlsProvider: TncTlsProvider; + FCertificateFile: string; + FPrivateKeyFile: string; + FPrivateKeyPassword: string; + FCACertificatesFile: string; + FIgnoreCertificateErrors: Boolean; + FIsServer: Boolean; + + // Compression and Encryption Properties (same as ncSources) + FCompression: TZCompressionLevel; + FEncryption: TEncryptorType; + FEncryptionKey: AnsiString; + FEncryptOnHashedKey: Boolean; + + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetEventsUseMainThread: Boolean; + procedure SetEventsUseMainThread(const Value: Boolean); + function GetNoDelay: Boolean; + procedure SetNoDelay(const Value: Boolean); + function GetKeepAlive: Boolean; + procedure SetKeepAlive(const Value: Boolean); + + // TLS Property Methods + function GetUseTLS: Boolean; + procedure SetUseTLS(const Value: Boolean); + function GetTlsProvider: TncTlsProvider; + procedure SetTlsProvider(const Value: TncTlsProvider); + function GetCertificateFile: string; + procedure SetCertificateFile(const Value: string); + function GetPrivateKeyFile: string; + procedure SetPrivateKeyFile(const Value: string); + function GetPrivateKeyPassword: string; + procedure SetPrivateKeyPassword(const Value: string); + function GetCACertificatesFile: string; + procedure SetCACertificatesFile(const Value: string); + function GetIgnoreCertificateErrors: Boolean; + procedure SetIgnoreCertificateErrors(const Value: Boolean); + + // Compression and Encryption Property Methods (same as ncSources) + function GetCompression: TZCompressionLevel; + procedure SetCompression(const Value: TZCompressionLevel); + function GetEncryption: TEncryptorType; + procedure SetEncryption(const Value: TEncryptorType); + function GetEncryptionKey: AnsiString; + procedure SetEncryptionKey(const Value: AnsiString); + function GetEncryptOnHashedKey: Boolean; + procedure SetEncryptOnHashedKey(const Value: Boolean); + + // Thread Pool Property Methods (from ncSources) + function GetCommandProcessorThreadPriority: TncThreadPriority; + procedure SetCommandProcessorThreadPriority(const Value: TncThreadPriority); + function GetCommandProcessorThreads: Integer; + procedure SetCommandProcessorThreads(const Value: Integer); + function GetCommandProcessorThreadsPerCPU: Integer; + procedure SetCommandProcessorThreadsPerCPU(const Value: Integer); + function GetCommandProcessorThreadsGrowUpto: Integer; + procedure SetCommandProcessorThreadsGrowUpto(const Value: Integer); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock, ShutDownLock: TObject; // TMonitor synchronization objects + ReadBuf: TBytes; + + // Thread Pool Infrastructure (from ncSources) + HandleCommandThreadPool: TncThreadPool; + + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetHost: string; virtual; // Virtual method for TLS + procedure InitializeTLS(aLine: TncLine); virtual; + procedure FinalizeTLS(aLine: TncLine); virtual; + function SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; virtual; + function ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; virtual; + procedure HandleTLSHandshake(aLine: TncLine); virtual; + procedure HandleTLSHandshakeComplete(aLine: TncLine); virtual; + property Line: TncLine read FLine; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default DefNoDelay; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default DefKeepAlive; + property OnConnected: TncOnConnectDisconnect read FOnConnected write FOnConnected; + property OnDisconnected: TncOnConnectDisconnect read FOnDisconnected write FOnDisconnected; + property OnReadData: TncOnReadData read FOnReadData write FOnReadData; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + + // Thread Pool Properties (from ncSources) + property CommandProcessorThreadPriority: TncThreadPriority read GetCommandProcessorThreadPriority write SetCommandProcessorThreadPriority default DefCommandProcessorThreadPriority; + property CommandProcessorThreads: Integer read GetCommandProcessorThreads write SetCommandProcessorThreads default DefCommandProcessorThreads; + property CommandProcessorThreadsPerCPU: Integer read GetCommandProcessorThreadsPerCPU write SetCommandProcessorThreadsPerCPU default DefCommandProcessorThreadsPerCPU; + property CommandProcessorThreadsGrowUpto: Integer read GetCommandProcessorThreadsGrowUpto write SetCommandProcessorThreadsGrowUpto default DefCommandProcessorThreadsGrowUpto; + + // TLS Properties + property UseTLS: Boolean read GetUseTLS write SetUseTLS default DefUseTLS; + property TlsProvider: TncTlsProvider read GetTlsProvider write SetTlsProvider default DefTlsProvider; + property CertificateFile: string read GetCertificateFile write SetCertificateFile; + property PrivateKeyFile: string read GetPrivateKeyFile write SetPrivateKeyFile; + property PrivateKeyPassword: string read GetPrivateKeyPassword write SetPrivateKeyPassword; + property CACertificatesFile: string read GetCACertificatesFile write SetCACertificatesFile; + property IgnoreCertificateErrors: Boolean read GetIgnoreCertificateErrors write SetIgnoreCertificateErrors default DefIgnoreCertificateErrors; + + // Compression and Encryption Properties (same as ncSources) + property Compression: TZCompressionLevel read GetCompression write SetCompression default DefCompression; + property Encryption: TEncryptorType read GetEncryption write SetEncryption default DefEncryption; + property EncryptionKey: AnsiString read GetEncryptionKey write SetEncryptionKey; + property EncryptOnHashedKey: Boolean read GetEncryptOnHashedKey write SetEncryptOnHashedKey default DefEncryptOnHashedKey; + published + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Client Socket + TncClientProcessor = class; + + // Connection state for efficient message handling (ncSources-style) + TConnectionState = record + MessageBuffer: TBytes; // Accumulated message data + BytesToEndOfMessage: UInt64; // How many bytes still needed + MessageType: (mtUnknown, mtBinary, mtText); // Protocol type + ExpectedMessageLength: UInt64; // Total expected message length + HeaderComplete: Boolean; // Have we read the complete header? + procedure Reset; + end; + + TncCustomTCPClientDual = class(TncTCPBaseDual) + private + FHost: string; + FReconnect: Boolean; + FReconnectInterval: Cardinal; + FOnReconnected: TncOnReconnected; + FOnCommand: TncOnCommandReceived; // Binary protocol event + OriginalOnReadData: TncOnReadData; // Store original handler for protocol detection + FConnectionState: TConnectionState; // State-based message handling + function GetActive: Boolean; override; + // Override OnReadData property to preserve protocol detection + procedure SetOnReadData(const Value: TncOnReadData); + procedure SetHost(const Value: string); + function GetHost: string; + function GetReconnect: Boolean; + procedure SetReconnect(const Value: Boolean); + function GetReconnectInterval: Cardinal; + procedure SetReconnectInterval(const Value: Cardinal); + protected + WasConnected: Boolean; + LastConnectAttempt: Int64; + procedure DoActivate(aActivate: Boolean); override; + procedure DataSocketConnected(aLine: TncLine); + procedure DataSocketDisconnected(aLine: TncLine); + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Send(const aBuf; aBufSize: Integer); overload; inline; + procedure Send(const aBytes: TBytes); overload; inline; + procedure Send(const aStr: string); overload; inline; + procedure SendCommand(aCmd: Integer; const aData: TBytes = nil); // Binary protocol method + function Receive(aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(var aBytes: TBytes): Integer; inline; + procedure InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); // Protocol detection handler + property Host: string read GetHost write SetHost; + property Reconnect: Boolean read GetReconnect write SetReconnect default True; + property ReconnectInterval: Cardinal read GetReconnectInterval write SetReconnectInterval default DefCntReconnectInterval; + property OnReconnected: TncOnReconnected read FOnReconnected write FOnReconnected; + property OnCommand: TncOnCommandReceived read FOnCommand write FOnCommand; + // Override OnReadData to preserve protocol detection + property OnReadData: TncOnReadData read FOnReadData write SetOnReadData; + end; + + TncTCPClientDual = class(TncCustomTCPClientDual) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property NoDelay; + property KeepAlive; + property ReadBufferLen; + property Reconnect; + property ReconnectInterval; + property OnConnected; + property OnDisconnected; + property OnReadData; + property OnReconnected; + property OnCommand; + + // Thread Pool Properties (from ncSources) + property CommandProcessorThreadPriority; + property CommandProcessorThreads; + property CommandProcessorThreadsPerCPU; + property CommandProcessorThreadsGrowUpto; + + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; + + // Compression and Encryption Properties + property Compression; + property Encryption; + property EncryptionKey; + property EncryptOnHashedKey; + end; + + TncClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomTCPClientDual; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomTCPClientDual); + procedure SocketWasReconnected; + procedure SocketProcess; inline; + procedure ProcessEvent; override; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // Server Socket + TncServerProcessor = class; + + TncCustomTCPServerDual = class(TncTCPBaseDual) + private + FOnCommand: TncOnCommandReceived; // Binary protocol event + OriginalOnReadData: TncOnReadData; // Store original handler for protocol detection + FConnectionStates: TDictionary; // Per-connection state tracking + function GetActive: Boolean; override; + // Override OnReadData property to preserve protocol detection + procedure SetOnReadData(const Value: TncOnReadData); + protected + Listener: TncLine; + LinesToShutDown: array of TncLine; + procedure DataSocketConnected(aLine: TncLine); + procedure DataSocketDisconnected(aLine: TncLine); + procedure DoActivate(aActivate: Boolean); override; + public + ReadSocketHandles: TSocketHandleArray; + Lines: TThreadLineList; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure ShutDownLine(aLine: TncLine); + procedure Send(aLine: TncLine; const aBuf; aBufSize: Integer); overload; inline; + procedure Send(aLine: TncLine; const aBytes: TBytes); overload; inline; + procedure Send(aLine: TncLine; const aStr: string); overload; inline; + function Receive(aLine: TncLine; aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; inline; + procedure SendCommand(aLine: TncLine; aCmd: Integer; const aData: TBytes = nil); // Binary protocol method + procedure InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); // Protocol detection handler + property OnCommand: TncOnCommandReceived read FOnCommand write FOnCommand; + // Override OnReadData to preserve protocol detection + property OnReadData: TncOnReadData read FOnReadData write SetOnReadData; + end; + + TncTCPServerDual = class(TncCustomTCPServerDual) + public + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property NoDelay; + property KeepAlive; + property ReadBufferLen; + property OnConnected; + property OnDisconnected; + property OnReadData; + property OnCommand; + + // Thread Pool Properties (from ncSources) + property CommandProcessorThreadPriority; + property CommandProcessorThreads; + property CommandProcessorThreadsPerCPU; + property CommandProcessorThreadsGrowUpto; + + // TLS Properties + property UseTLS; + property TlsProvider; + property CertificateFile; + property PrivateKeyFile; + property PrivateKeyPassword; + property CACertificatesFile; + property IgnoreCertificateErrors; + + // Compression and Encryption Properties + property Compression; + property Encryption; + property EncryptionKey; + property EncryptOnHashedKey; + end; + + TncServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomTCPServerDual; + procedure CheckLinesToShutDown; + public + ReadySockets: TSocketHandleArray; + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomTCPServerDual); + procedure SocketProcess; inline; + procedure ProcessEvent; override; + end; + +implementation + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TConnectionState } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +procedure TConnectionState.Reset; +begin + SetLength(MessageBuffer, 0); + BytesToEndOfMessage := 0; + MessageType := mtUnknown; + ExpectedMessageLength := 0; + HeaderComplete := False; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TThreadLineList } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TThreadLineList.Create; +begin + inherited Create; + FList := TSocketList.Create; + FLockCount := 0; +end; + +destructor TThreadLineList.Destroy; +begin + LockListNoCopy; + try + FList.Free; + inherited Destroy; + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Add(const Item: TncLine); +begin + LockListNoCopy; + try + // FList has Duplicates to dupError, so we know if this is already in the + // list it will not be accepted + FList.Add(Item.Handle, Item); + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Clear; +begin + LockListNoCopy; + try + FList.Clear; + finally + UnlockListNoCopy; + end; +end; + +procedure TThreadLineList.Remove(Item: TncLine); +begin + LockListNoCopy; + try + FList.Delete(FList.IndexOf(Item.Handle)); + finally + UnlockListNoCopy; + end; +end; + +function TThreadLineList.LockListNoCopy: TSocketList; +begin + TMonitor.Enter(Self); + Result := FList; +end; + +procedure TThreadLineList.UnlockListNoCopy; +begin + TMonitor.Exit(Self); +end; + +function TThreadLineList.LockList: TSocketList; +begin + TMonitor.Enter(Self); + try + if FLockCount = 0 then + begin + FListCopy := TSocketList.Create; + FListCopy.Assign(FList); + end; + Result := FListCopy; + + FLockCount := FLockCount + 1; + finally + TMonitor.Exit(Self); + end; +end; + +procedure TThreadLineList.UnlockList; +begin + TMonitor.Enter(Self); + try + if FLockCount = 0 then + raise Exception.Create('Cannot unlock a non-locked list'); + + FLockCount := FLockCount - 1; + + if FLockCount = 0 then + FListCopy.Free; + finally + TMonitor.Exit(Self); + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTlsConnectionContext } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTlsConnectionContext.Create(aIsServer: Boolean); +begin + inherited Create; + FIsServer := aIsServer; + + // Initialize TLS contexts using FillChar and then set public fields + FillChar(FClientContext, SizeOf(FClientContext), 0); + FClientContext.Initialized := False; + + FillChar(FServerContext, SizeOf(FServerContext), 0); + FServerContext.Initialized := False; + FServerContext.HandshakeCompleted := False; +end; + +destructor TncTlsConnectionContext.Destroy; +begin + // In a perfect world, FinalizeTLS was already called + // and all cleanup is done - destructor should be nearly empty + + {$IFDEF DEBUG} + // Debug check - verify cleanup already happened + if FIsServer then + Assert(not FServerContext.Initialized, 'Server TLS context not cleaned up!') + else + Assert(not FClientContext.Initialized, 'Client TLS context not cleaned up!'); + {$ENDIF} + + inherited Destroy; +end; + +function TncTlsConnectionContext.GetClientContext: PSChannelClient; +begin + Result := @FClientContext; +end; + +function TncTlsConnectionContext.GetServerContext: PSChannelServer; +begin + Result := @FServerContext; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTCPBaseDual } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTCPBaseDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TObject.Create; + ShutDownLock := TObject.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FNoDelay := DefNoDelay; + FKeepAlive := DefKeepAlive; + FReadBufferLen := DefReadBufferLen; + FOnConnected := nil; + FOnDisconnected := nil; + FOnReadData := nil; + + // Initialize Thread Pool Properties (from ncSources) + FCommandProcessorThreadPriority := DefCommandProcessorThreadPriority; + FCommandProcessorThreads := DefCommandProcessorThreads; + FCommandProcessorThreadsPerCPU := DefCommandProcessorThreadsPerCPU; + FCommandProcessorThreadsGrowUpto := DefCommandProcessorThreadsGrowUpto; + + // Initialize TLS properties + FUseTLS := DefUseTLS; + FTlsProvider := DefTlsProvider; + FCertificateFile := ''; + FPrivateKeyFile := ''; + FPrivateKeyPassword := ''; + FCACertificatesFile := ''; + FIgnoreCertificateErrors := DefIgnoreCertificateErrors; + + // Initialize Compression and Encryption properties (same as ncSources) + FCompression := DefCompression; + FEncryption := DefEncryption; + FEncryptionKey := DefEncryptionKey; + FEncryptOnHashedKey := DefEncryptOnHashedKey; + + FIsServer := False; + + SetLength(ReadBuf, DefReadBufferLen); + + // Create Thread Pool for Command Processing (from ncSources) + HandleCommandThreadPool := TncThreadPool.Create(THandleCommandThread); + +end; + +function TncTCPBaseDual.Kind: TSocketType; +begin + Result := stTCP; +end; + +destructor TncTCPBaseDual.Destroy; +begin + Active := False; + // Clean up Thread Pool (from ncSources) + HandleCommandThreadPool.Free; + + PropertyLock.Free; + ShutDownLock.Free; + inherited Destroy; +end; + +procedure TncTCPBaseDual.Loaded; +begin + inherited Loaded; + + // Configure Thread Pool (from ncSources) + HandleCommandThreadPool.SetThreadPriority(FCommandProcessorThreadPriority); + HandleCommandThreadPool.SetExecThreads( + Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + HandleCommandThreadPool.GrowUpto := FCommandProcessorThreadsGrowUpto; + + if FInitActive then + DoActivate(True); +end; + +function TncTCPBaseDual.CreateLineObject: TncLine; +begin + Result := TncLineInternal.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); + + // Set up TLS callbacks if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Result).OnBeforeConnected := HandleTLSHandshake; + TncLineInternal(Result).OnBeforeDisconnected := FinalizeTLS; + end; +end; + +procedure TncTCPBaseDual.SetActive(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + if not(csLoading in ComponentState) then + DoActivate(Value); + + FInitActive := GetActive; // we only care here for the loaded event + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetFamily: TAddressType; +begin + TMonitor.Enter(PropertyLock); + try + Result := FFamily; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetFamily(const Value: TAddressType); +begin + if not (csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create(ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + TMonitor.Enter(PropertyLock); + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetPort: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPort; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileConnectionIsActiveStr); + + TMonitor.Enter(PropertyLock); + try + FPort := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetReaderThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetEventsUseMainThread: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEventsUseMainThread; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetEventsUseMainThread(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FEventsUseMainThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileActiveStr); + + TMonitor.Enter(PropertyLock); + try + FUseReaderThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetNoDelay: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FNoDelay; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetNoDelay(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FNoDelay := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetKeepAlive: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FKeepAlive; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetKeepAlive(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FKeepAlive := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// Update +function TncTCPBaseDual.GetReadBufferLen: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReadBufferLen; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// Update +procedure TncTCPBaseDual.SetReadBufferLen(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// TLS Property Methods +function TncTCPBaseDual.GetUseTLS: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FUseTLS; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetUseTLS(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set UseTLS property whilst the connection is active'); + + TMonitor.Enter(PropertyLock); + try + FUseTLS := Value; + + // Add TLS callback assignment when TLS is enabled + if Value then + begin + if FIsServer and (Self is TncCustomTCPServerDual) then + begin + // Server callback assignment + var Server := TncCustomTCPServerDual(Self); + if Server.Listener <> nil then + begin + TncLineInternal(Server.Listener).OnBeforeConnected := HandleTLSHandshake; + end; + end + else if not FIsServer and (Self is TncCustomTCPClientDual) then + begin + // Client callback assignment + var Client := TncCustomTCPClientDual(Self); + if Client.Line <> nil then + begin + TncLineInternal(Client.Line).OnBeforeConnected := HandleTLSHandshake; + end; + end; + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetTlsProvider: TncTlsProvider; +begin + TMonitor.Enter(PropertyLock); + try + Result := FTlsProvider; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetTlsProvider(const Value: TncTlsProvider); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create('Cannot set TlsProvider property whilst the connection is active'); + + TMonitor.Enter(PropertyLock); + try + // Validate provider availability + case Value of + tpSChannel: + begin + {$IFNDEF MSWINDOWS} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL validation - for now, not supported + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + + FTlsProvider := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetCertificateFile: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCertificateFile; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetCertificateFile(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FCertificateFile := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetPrivateKeyFile: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPrivateKeyFile; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetPrivateKeyFile(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FPrivateKeyFile := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetPrivateKeyPassword: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPrivateKeyPassword; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetPrivateKeyPassword(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FPrivateKeyPassword := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetCACertificatesFile: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCACertificatesFile; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetCACertificatesFile(const Value: string); +begin + TMonitor.Enter(PropertyLock); + try + FCACertificatesFile := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetIgnoreCertificateErrors: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FIgnoreCertificateErrors; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetIgnoreCertificateErrors(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FIgnoreCertificateErrors := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// Compression and Encryption Property Implementations (same as ncSources) + +function TncTCPBaseDual.GetCompression: TZCompressionLevel; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCompression; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetCompression(const Value: TZCompressionLevel); +begin + TMonitor.Enter(PropertyLock); + try + FCompression := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetEncryption: TEncryptorType; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEncryption; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetEncryption(const Value: TEncryptorType); +begin + TMonitor.Enter(PropertyLock); + try + FEncryption := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetEncryptionKey: AnsiString; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEncryptionKey; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetEncryptionKey(const Value: AnsiString); +begin + TMonitor.Enter(PropertyLock); + try + FEncryptionKey := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetEncryptOnHashedKey: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEncryptOnHashedKey; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetEncryptOnHashedKey(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FEncryptOnHashedKey := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// TLS base implementation + +function TncTCPBaseDual.GetHost: string; +begin + Result := ''; // Default implementation, override in client +end; + +// TLS Functionality Methods +procedure TncTCPBaseDual.InitializeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if not FUseTLS then + Exit; + + if aLine = nil then + Exit; + + // Get or create per-connection TLS context + if TncLineInternal(aLine).DataObject = nil then + begin + TlsContext := TncTlsConnectionContext.Create(FIsServer); + TncLineInternal(aLine).DataObject := TlsContext; + end + else + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + end; + + // Check if TLS is already initialized for this specific connection + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Exit; + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Exit; + end; + + // Initialize TLS for this specific connection + if FIsServer then + begin + TlsContext.GetServerContext^.AfterConnection(aLine, AnsiString(FCertificateFile), AnsiString(FPrivateKeyPassword)); + end + else + begin + TlsContext.GetClientContext^.AfterConnection(aLine, AnsiString(GetHost), FIgnoreCertificateErrors); + end; +end; + +procedure TncTCPBaseDual.HandleTLSHandshake(aLine: TncLine); +begin + // This method is called automatically before OnConnected fires + // It performs the TLS handshake synchronously + if FUseTLS and (aLine <> nil) then + begin + InitializeTLS(aLine); // Perform the complete TLS handshake + end; +end; + +procedure TncTCPBaseDual.HandleTLSHandshakeComplete(aLine: TncLine); +begin + // Call OnConnected for TLS connections after handshake completes + if FUseTLS and Assigned(OnConnected) then + begin + try + OnConnected(Self, aLine); + except + on E: Exception do + // OnConnected failed - could log this if needed + end; + end; +end; + +procedure TncTCPBaseDual.FinalizeTLS(aLine: TncLine); +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (aLine <> nil) and (TncLineInternal(aLine).DataObject <> nil) then + begin + try + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + TlsContext.GetServerContext^.BeforeDisconnection(aLine); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + TlsContext.GetClientContext^.BeforeDisconnection(aLine); + end; + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL cleanup + end; + end; + + // Clean up the TLS context object + TncLineInternal(aLine).DataObject := nil; + TlsContext.Free; + except + on E: Exception do + // Log error but don't raise exception during cleanup + end; + end; +end; + +function TncTCPBaseDual.SendTLS(aLine: TncLine; const aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + Result := TlsContext.GetServerContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + Result := TlsContext.GetClientContext^.Send(aLine, @aBuf, aBufSize) + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL send implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); +end; + +function TncTCPBaseDual.ReceiveTLS(aLine: TncLine; var aBuf; aBufSize: Integer): Integer; +var + TlsContext: TncTlsConnectionContext; + WasHandshakeCompleted: Boolean; +begin + if FUseTLS and (TncLineInternal(aLine).DataObject <> nil) then + begin + TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + + case FTlsProvider of + tpSChannel: + begin + {$IFDEF MSWINDOWS} + if FIsServer then + begin + if TlsContext.GetServerContext^.Initialized then + begin + WasHandshakeCompleted := TlsContext.GetServerContext^.HandshakeCompleted; + + Result := TlsContext.GetServerContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and WasHandshakeCompleted then + begin + raise Exception.Create('TLS client disconnected'); + end; + + // Check if handshake just completed + if not WasHandshakeCompleted and TlsContext.GetServerContext^.HandshakeCompleted then + begin + // Handshake just completed, call OnConnected + HandleTLSHandshakeComplete(aLine); + + // CRITICAL FIX: Return -1 to prevent OnReadData from being triggered with empty data + // The handshake completion callback has already been called above + Result := -1; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end + else + begin + if TlsContext.GetClientContext^.Initialized then + begin + // For client, handshake is complete when Initialized becomes true + // But we need to track when it JUST became initialized (not if it was already initialized) + // Since the client calls AfterConnection during OnBeforeConnected, we know that + // the first call to Receive after OnBeforeConnected is when handshake is complete + + Result := TlsContext.GetClientContext^.Receive(aLine, @aBuf, aBufSize); + + // CRITICAL FIX: Detect TLS disconnection when Receive returns 0 after handshake completion + if (Result = 0) and TlsContext.GetClientContext^.Initialized then + begin + raise Exception.Create('TLS server disconnected'); + end; + + // Client-side handshake completion detection: + // The client TLS handshake is handled in OnBeforeConnected event + // So by the time we get here, handshake is already complete + // We don't need to do anything special for client handshake completion + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); + end; + {$ELSE} + raise ETlsProviderNotSupported.Create(ETlsProviderNotSupportedStr); + {$ENDIF} + end; + tpOpenSSL: + begin + // Future OpenSSL receive implementation + raise EOpenSSLNotAvailable.Create(EOpenSSLNotAvailableStr); + end; + end; + end + else + Result := TncLineInternal(aLine).RecvBuffer(aBuf, aBufSize); +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPClientDual } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomTCPClientDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FIsServer := False; // Set client flag for TLS context selection + FHost := DefHost; + FReconnect := True; + FReconnectInterval := DefCntReconnectInterval; + FOnReconnected := nil; + FOnCommand := nil; // Initialize the new field + OriginalOnReadData := OnReadData; // Store original handler + OnReadData := InternalReadDataHandler; // Set up protocol detection handler + FConnectionState.Reset; // Initialize connection state + + LastConnectAttempt := TStopWatch.GetTimeStamp; + WasConnected := False; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + TncLineInternal(Line).OnConnected := DataSocketConnected; + TncLineInternal(Line).OnDisconnected := DataSocketDisconnected; + + // Set up TLS callbacks if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Line).OnBeforeConnected := HandleTLSHandshake; + // REMOVED: OnBeforeDisconnected - now using direct FinalizeTLS call like ncSockets.pas + end; + + LineProcessor := TncClientProcessor.Create(Self); + try + if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; + LineProcessor.WaitForReady; +end; + + +destructor TncCustomTCPClientDual.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +procedure TncCustomTCPClientDual.DoActivate(aActivate: Boolean); +begin + + if aActivate = GetActive then + Exit; + + if aActivate then + begin + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + TncLineInternal(Line).CreateClientHandle(FHost, FPort); + + // if there were no exceptions, and line is still not active, + // that means the user has deactivated it in the OnConnect handler + if not Line.Active then + WasConnected := False; + end + else + begin + WasConnected := False; + TncLineInternal(Line).DestroyHandle; + end; +end; + +procedure TncCustomTCPClientDual.DataSocketConnected(aLine: TncLine); +begin + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if NoDelay then + try + TncLineInternal(Line).EnableNoDelay; + except + end; + + if KeepAlive then + try + TncLineInternal(Line).EnableKeepAlive; + except + end; + + try + TncLineInternal(Line).SetReceiveSize(1048576); // 1MB + TncLineInternal(Line).SetWriteSize(1048576); // 1MB + //TncLineInternal(Line).SetReceiveSize(20 * 1048576); + + except + end; + + // TLS initialization is now handled by OnBeforeConnected event + + if Assigned(OnConnected) then + try + OnConnected(Self, aLine); + except + end; + + LastConnectAttempt := TStopWatch.GetTimeStamp; + WasConnected := True; + + if UseReaderThread then + LineProcessor.Run; // Will just set events, this does not wait +end; + +procedure TncCustomTCPClientDual.DataSocketDisconnected(aLine: TncLine); +begin + // FIXED: Use same pattern as ncSockets.pas - direct TLS cleanup call + if UseTLS then + FinalizeTLS(aLine); + + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, aLine); + except + end; +end; + + +procedure TncCustomTCPClientDual.Send(const aBuf; aBufSize: Integer); +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + SendTLS(Line, aBuf, aBufSize); +end; + +procedure TncCustomTCPClientDual.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPClientDual.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +procedure TncCustomTCPClientDual.SendCommand(aCmd: Integer; const aData: TBytes = nil); +var + Command: TncCommand; + MessageBytes, FinalBuf: TBytes; + MsgByteCount, HeaderBytes: UInt64; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Create command like ncSources does + Command.CommandType := ctInitiator; + Command.UniqueID := 0; // Simplified for now + Command.Cmd := aCmd; + Command.Data := aData; + Command.RequiresResult := False; + Command.AsyncExecute := False; + Command.ResultIsErrorString := False; + Command.SourceComponentHandler := ''; + Command.PeerComponentHandler := ''; + + // Convert to bytes like ncSources + MessageBytes := Command.ToBytes; + + // Apply compression and encryption (same order as ncSources) + // Step 1: Encrypt first (if enabled) + if Encryption <> etNoEncryption then + MessageBytes := EncryptBytes(MessageBytes, EncryptionKey, Encryption, EncryptOnHashedKey, False); + + // Step 2: Compress second (if enabled) + if Compression <> zcNone then + MessageBytes := CompressBytes(MessageBytes, Compression); + + MsgByteCount := Length(MessageBytes); + + // Use ncSources protocol format: [Magic: 4][MessageLength: 8][Data: variable] + HeaderBytes := SizeOf(TMagicHeaderType) + SizeOf(MsgByteCount); + SetLength(FinalBuf, HeaderBytes + MsgByteCount); + + // Write protocol header (same as ncSources) + PMagicHeaderType(@FinalBuf[0])^ := MagicHeader; // Magic: 4 bytes + PUInt64(@FinalBuf[SizeOf(MagicHeader)])^ := MsgByteCount; // MessageLength: 8 bytes + Move(MessageBytes[0], FinalBuf[HeaderBytes], MsgByteCount); // Data: variable + + Send(FinalBuf); +end; + +procedure TncCustomTCPClientDual.InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + Command: TncCommand; + Ofs: Integer; + BytesToRead: Integer; + OldLen: Integer; + TextData: TBytes; +begin + // CRITICAL FIX: When TLS is enabled, bypass protocol detection during handshake + // TLS handshake data should never reach the application layer + if UseTLS then + begin + // Check if TLS handshake is still in progress using per-connection context + if (TncLineInternal(aLine).DataObject <> nil) then + begin + var TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + if not TlsContext.GetClientContext^.Initialized then + begin + // During handshake, pass all data directly to original handler (TLS layer) + // Protocol detection should only happen AFTER TLS handshake completes + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, aBuf, aBufCount); + Exit; // Don't process for protocol detection during handshake + end; + end; + // If we reach here, TLS handshake is complete and data is decrypted application data + // Continue with normal protocol detection below + end; + + Ofs := 0; + + // Process incoming data using ncSources-style state machine + while Ofs < aBufCount do + begin + // Are we in the middle of accumulating a message? + if FConnectionState.BytesToEndOfMessage > 0 then + begin + // ncSources approach: We know exactly how many bytes we need + BytesToRead := Min(FConnectionState.BytesToEndOfMessage, aBufCount - Ofs); + + // Accumulate data efficiently + OldLen := Length(FConnectionState.MessageBuffer); + SetLength(FConnectionState.MessageBuffer, OldLen + BytesToRead); + Move(aBuf[Ofs], FConnectionState.MessageBuffer[OldLen], BytesToRead); + + Ofs := Ofs + BytesToRead; + FConnectionState.BytesToEndOfMessage := FConnectionState.BytesToEndOfMessage - BytesToRead; + end; + + // Do we have a complete message? + if FConnectionState.BytesToEndOfMessage = 0 then + begin + if Length(FConnectionState.MessageBuffer) > 0 then + begin + // Process complete message based on detected protocol + case FConnectionState.MessageType of + mtBinary: + begin + // Process binary command - Route to Thread Pool (from ncSources) + try + // Apply decompression and decryption (reverse order of sending) + var ProcessedData := FConnectionState.MessageBuffer; + + // Step 1: Decompress first (reverse order) + if Compression <> zcNone then + ProcessedData := DecompressBytes(ProcessedData); + + // Step 2: Decrypt second + if Encryption <> etNoEncryption then + ProcessedData := DecryptBytes(ProcessedData, EncryptionKey, Encryption, EncryptOnHashedKey, False); + + // Parse the processed data + Command.FromBytes(ProcessedData); + + // Route to thread pool for processing like ncSources + TMonitor.Enter(HandleCommandThreadPool); + try + var HandleCommandThread := THandleCommandThread(HandleCommandThreadPool.RequestReadyThread); + HandleCommandThread.WorkType := htwtOnCommand; + HandleCommandThread.Source := Self; + HandleCommandThread.Line := aLine; + HandleCommandThread.Cmd := Command.Cmd; + HandleCommandThread.Data := Command.Data; + HandleCommandThread.OnCommand := FOnCommand; + HandleCommandThread.EventsUseMainThread := EventsUseMainThread; + HandleCommandThreadPool.RunRequestedThread(HandleCommandThread); + finally + TMonitor.Exit(HandleCommandThreadPool); + end; + except + // If decompression/decryption/parsing fails, treat as text + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, FConnectionState.MessageBuffer, Length(FConnectionState.MessageBuffer)); + end; + end; + mtText: + begin + // Process text data + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, FConnectionState.MessageBuffer, Length(FConnectionState.MessageBuffer)); + end; + end; + + // Reset for next message + FConnectionState.Reset; + end; + + // Start new message detection if we have more data + if Ofs < aBufCount then + begin + // Protocol detection: Check for magic header + if (aBufCount - Ofs) >= SizeOf(TMagicHeaderType) then + begin + if PMagicHeaderType(@aBuf[Ofs])^ = MagicHeader then + begin + // Binary protocol detected + FConnectionState.MessageType := mtBinary; + + // Do we have the complete header? + if (aBufCount - Ofs) >= (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) then + begin + // Read message length and set up state + FConnectionState.ExpectedMessageLength := PUInt64(@aBuf[Ofs + SizeOf(TMagicHeaderType)])^; + FConnectionState.BytesToEndOfMessage := FConnectionState.ExpectedMessageLength; + FConnectionState.HeaderComplete := True; + + // Skip past header + Ofs := Ofs + SizeOf(TMagicHeaderType) + SizeOf(UInt64); + + // Continue to accumulate message data + Continue; + end + else + begin + // Incomplete header - buffer remaining data and wait + SetLength(TextData, aBufCount - Ofs); + Move(aBuf[Ofs], TextData[0], aBufCount - Ofs); + FConnectionState.MessageBuffer := TextData; + FConnectionState.BytesToEndOfMessage := (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) - (aBufCount - Ofs); + FConnectionState.MessageType := mtUnknown; // Still detecting + Break; + end; + end + else + begin + // Unknown protocol - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing, don't accumulate + end; + end + else + begin + // Not enough data for magic header check - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing + end; + end; + end; + end; +end; + +procedure TncCustomTCPClientDual.SetOnReadData(const Value: TncOnReadData); +begin + // Store the user's handler and keep protocol detection active + OriginalOnReadData := Value; + inherited OnReadData := InternalReadDataHandler; +end; + +function TncCustomTCPClientDual.Receive(aTimeout: Cardinal): TBytes; +var + BufRead: Integer; +begin + if UseReaderThread then + raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); + Result := Copy(ReadBuf, 0, BufRead) +end; + +function TncCustomTCPClientDual.ReceiveRaw(var aBytes: TBytes): Integer; +begin + Result := ReceiveTLS(Line, aBytes[0], Length(aBytes)); +end; + +function TncCustomTCPClientDual.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomTCPClientDual.GetHost: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FHost; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomTCPClientDual.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileConnectionIsActiveStr); + + TMonitor.Enter(PropertyLock); + try + FHost := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncCustomTCPClientDual.GetReconnect: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReconnect; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomTCPClientDual.SetReconnect(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FReconnect := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncCustomTCPClientDual.GetReconnectInterval: Cardinal; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReconnectInterval; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomTCPClientDual.SetReconnectInterval(const Value: Cardinal); +begin + TMonitor.Enter(PropertyLock); + try + FReconnectInterval := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncClientProcessor } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncClientProcessor.Create(aClientSocket: TncCustomTCPClientDual); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncClientProcessor.SocketProcess; +var + BufRead: Integer; +begin + BufRead := FClientSocket.ReceiveTLS(FClientSocket.Line, FClientSocket.ReadBuf[0], Length(FClientSocket.ReadBuf)); + if Assigned(FClientSocket.OnReadData) and (BufRead > 0) then + try + FClientSocket.OnReadData(FClientSocket, FClientSocket.Line, FClientSocket.ReadBuf, BufRead); + except + end; +end; + +procedure TncClientProcessor.SocketWasReconnected; +begin + if Assigned(FClientSocket.FOnReconnected) then + FClientSocket.FOnReconnected(FClientSocket, FClientSocket.Line); + if Assigned(FClientSocket.FOnConnected) then + FClientSocket.FOnConnected(FClientSocket, FClientSocket.Line); +end; + +procedure TncClientProcessor.ProcessEvent; +var + PrevOnConnect: TncOnConnectDisconnect; + WasReconnected: Boolean; +begin + while (not Terminated) do // Repeat handling until terminated + try + if FClientSocket.Line.Active then // Repeat reading socket until disconnected + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(SocketProcess) // for synchronize + else + SocketProcess; + end; + end + else + // Is not Active, try reconnecting if was connected + begin + // Logic for reconnect mode + if FClientSocket.Reconnect and FClientSocket.WasConnected then + begin + // A minimal sleep time of 30 msec is required in Android before + // reattempting to connect on a recently deactivated network connection. + // We have put it to 60 for safety + Sleep(60); + if Terminated then + Break; + if TStopWatch.GetTimeStamp - FClientSocket.LastConnectAttempt > FClientSocket.ReconnectInterval * TTimeSpan.TicksPerMillisecond then + begin + FClientSocket.LastConnectAttempt := TStopWatch.GetTimeStamp; + + WasReconnected := False; + TMonitor.Enter(FClientSocket.PropertyLock); + try + if not FClientSocket.Active then + begin + PrevOnConnect := FClientSocket.OnConnected; + try + // Disable firing the event in the wrong thread in case it gets connected + FClientSocket.OnConnected := nil; + FClientSocket.Active := True; + WasReconnected := True; + finally + FClientSocket.OnConnected := PrevOnConnect; + end; + end; + finally + TMonitor.Exit(FClientSocket.PropertyLock); + end; + if WasReconnected then + if FClientSocket.EventsUseMainThread then + Synchronize(SocketWasReconnected) + else + SocketWasReconnected; + end; + end + else + Exit; + end; + except + // Something was disconnected, continue processing + end; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPServerDual } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomTCPServerDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FIsServer := True; // Set server flag for TLS context selection + FOnCommand := nil; // Initialize the new field + OriginalOnReadData := OnReadData; // Store original handler + OnReadData := InternalReadDataHandler; // Set up protocol detection handler + FConnectionStates := TDictionary.Create; // Initialize state tracking dictionary + + Listener := CreateLineObject; + if Listener.Family <> FFamily then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; + + TncLineInternal(Listener).OnConnected := DataSocketConnected; + TncLineInternal(Listener).OnDisconnected := DataSocketDisconnected; + + // Set up TLS callbacks if TLS is enabled + if FUseTLS then + begin + TncLineInternal(Listener).OnBeforeConnected := HandleTLSHandshake; + // REMOVED: OnBeforeDisconnected - now using direct FinalizeTLS call like ncSockets.pas + end; + Lines := TThreadLineList.Create(); + + LineProcessor := TncServerProcessor.Create(Self); + try + if LineProcessor.Priority <> FromNcThreadPriority(DefReaderThreadPriority) then + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; + LineProcessor.WaitForReady; +end; + +destructor TncCustomTCPServerDual.Destroy; +begin + // Will get Sockets.Lines disposed off + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Lines.Free; + Listener.Free; + + FConnectionStates.Free; // Cleanup state tracking dictionary + + inherited Destroy; +end; + +function TncCustomTCPServerDual.GetActive: Boolean; +begin + Result := Listener.Active; +end; + +procedure TncCustomTCPServerDual.DoActivate(aActivate: Boolean); +var + DataSockets: TSocketList; + i: Integer; +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + // Verify family setting before creating handle + if Assigned(Listener) and (Listener.Family <> FFamily) then + begin + TncLineInternal(Listener).SetFamily(FFamily); + end; + TncLineInternal(Listener).CreateServerHandle(FPort); + end + else + begin + if Assigned(Listener) then + TncLineInternal(Listener).DestroyHandle; + + // Cleanup connected sockets + DataSockets := Lines.LockListNoCopy; + try + for i := 0 to DataSockets.Count - 1 do + try + if Assigned(DataSockets.Lines[i]) then + begin + TncLineInternal(DataSockets.Lines[i]).DestroyHandle; + DataSockets.Lines[i].Free; + end; + except + // + end; + DataSockets.Clear; + finally + Lines.UnlockListNoCopy; + end; + end; +end; + +procedure TncCustomTCPServerDual.ShutDownLine(aLine: TncLine); +var + i: Integer; +begin + if UseReaderThread then + begin + TMonitor.Enter(ShutDownLock); + try + for i := 0 to High(LinesToShutDown) do + if LinesToShutDown[i] = aLine then + Exit; + + SetLength(LinesToShutDown, Length(LinesToShutDown) + 1); + LinesToShutDown[High(LinesToShutDown)] := aLine; + finally + TMonitor.Exit(ShutDownLock); + end; + end + else + begin + Lines.Remove(aLine); + aLine.Free; + end; +end; + +procedure TncCustomTCPServerDual.DataSocketConnected(aLine: TncLine); +begin + if aLine = Listener then + begin + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Listener.Handle; + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + SetLength(ReadSocketHandles, Length(ReadSocketHandles) + 1); + ReadSocketHandles[High(ReadSocketHandles)] := aLine.Handle; + + if NoDelay then + try + TncLineInternal(aLine).EnableNoDelay; + except + end; + + if KeepAlive then + try + TncLineInternal(aLine).EnableKeepAlive; + except + end; + + try + TncLineInternal(aLine).SetReceiveSize(1048576); + TncLineInternal(aLine).SetWriteSize(1048576); + except + end; + + // TLS initialization is now handled by OnBeforeConnected event + + // For TLS connections, delay OnConnected until after handshake completes + if not UseTLS then + begin + if Assigned(OnConnected) then + try + OnConnected(Self, aLine); + except + end; + end + else + begin + // For TLS connections, OnConnected will be called after handshake completes + // This is handled in the first successful TLS receive operation + end; + end; +end; + +// Update : Moves the handle removal before the disconnect event handling +// This prevents other threads from trying to use the handle while the disconnect event is processing. +procedure TncCustomTCPServerDual.DataSocketDisconnected(aLine: TncLine); +var + i: Integer; +begin + if aLine = Listener then + SetLength(ReadSocketHandles, 0) + else + begin + // FIXED: Use same pattern as ncSockets.pas - direct TLS cleanup call + if UseTLS then + FinalizeTLS(aLine); + + // Clean up connection state + FConnectionStates.Remove(aLine); + + // First remove the handle to prevent further processing + TMonitor.Enter(PropertyLock); + try + for i := 0 to High(ReadSocketHandles) do + if ReadSocketHandles[i] = aLine.Handle then + begin + ReadSocketHandles[i] := ReadSocketHandles[High(ReadSocketHandles)]; + SetLength(ReadSocketHandles, Length(ReadSocketHandles) - 1); + Break; + end; + finally + TMonitor.Exit(PropertyLock); + end; + + // Then handle disconnect event + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, aLine); + except + end; + end; +end; + +procedure TncCustomTCPServerDual.Send(aLine: TncLine; const aBuf; aBufSize: Integer); +begin + SendTLS(aLine, aBuf, aBufSize); +end; + +procedure TncCustomTCPServerDual.Send(aLine: TncLine; const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aLine, aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPServerDual.Send(aLine: TncLine; const aStr: string); +begin + Send(aLine, BytesOf(aStr)); +end; + +function TncCustomTCPServerDual.Receive(aLine: TncLine; aTimeout: Cardinal): TBytes; +var + i, BufRead, LineNdx: Integer; + DataSockets: TSocketList; + Line: TncLine; + ReadySockets: TSocketHandleArray; +begin + if UseReaderThread then + raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + + SetLength(Result, 0); + ReadySockets := Readable(ReadSocketHandles, aTimeout); + + for i := 0 to High(ReadySockets) do + try + if ReadySockets[i] = Listener.Handle then + // New line is here, accept it and create a new TncLine object + Lines.Add(TncLineInternal(Listener).AcceptLine); + except + end; + + DataSockets := Lines.LockListNoCopy; + try + for i := 0 to High(ReadySockets) do + try + if aLine.Handle = ReadySockets[i] then + begin + LineNdx := DataSockets.IndexOf(ReadySockets[i]); + if LineNdx = -1 then + Continue; + Line := DataSockets.Lines[LineNdx]; + try + if not Line.Active then + Abort; + BufRead := ReceiveTLS(Line, ReadBuf[0], Length(ReadBuf)); + Result := Copy(ReadBuf, 0, BufRead); + except + // Line has disconnected, destroy the line + DataSockets.Delete(LineNdx); + Line.Free; + end; + end; + except + end; + finally + Lines.UnlockListNoCopy; + end; +end; + +function TncCustomTCPServerDual.ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; +begin + Result := ReceiveTLS(aLine, aBytes[0], Length(aBytes)); +end; + +procedure TncCustomTCPServerDual.SendCommand(aLine: TncLine; aCmd: Integer; const aData: TBytes = nil); +var + Command: TncCommand; + MessageBytes, FinalBuf: TBytes; + MsgByteCount, HeaderBytes: UInt64; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Create command like ncSources does + Command.CommandType := ctInitiator; + Command.UniqueID := 0; // Simplified for now + Command.Cmd := aCmd; + Command.Data := aData; + Command.RequiresResult := False; + Command.AsyncExecute := False; + Command.ResultIsErrorString := False; + Command.SourceComponentHandler := ''; + Command.PeerComponentHandler := ''; + + // Convert to bytes like ncSources + MessageBytes := Command.ToBytes; + + // Apply compression and encryption (same order as ncSources) + // Step 1: Encrypt first (if enabled) + if Encryption <> etNoEncryption then + MessageBytes := EncryptBytes(MessageBytes, EncryptionKey, Encryption, EncryptOnHashedKey, False); + + // Step 2: Compress second (if enabled) + if Compression <> zcNone then + MessageBytes := CompressBytes(MessageBytes, Compression); + + MsgByteCount := Length(MessageBytes); + + // Use ncSources protocol format: [Magic: 4][MessageLength: 8][Data: variable] + HeaderBytes := SizeOf(TMagicHeaderType) + SizeOf(MsgByteCount); + SetLength(FinalBuf, HeaderBytes + MsgByteCount); + + // Write protocol header (same as ncSources) + PMagicHeaderType(@FinalBuf[0])^ := MagicHeader; // Magic: 4 bytes + PUInt64(@FinalBuf[SizeOf(MagicHeader)])^ := MsgByteCount; // MessageLength: 8 bytes + Move(MessageBytes[0], FinalBuf[HeaderBytes], MsgByteCount); // Data: variable + + Send(aLine, FinalBuf); +end; + +procedure TncCustomTCPServerDual.InternalReadDataHandler(Sender: TObject; aLine: TncLine; + const aBuf: TBytes; aBufCount: Integer); +var + Command: TncCommand; + ConnectionState: TConnectionState; + Ofs: Integer; + BytesToRead: Integer; + OldLen: Integer; + TextData: TBytes; +begin + // CRITICAL FIX: When TLS is enabled, bypass protocol detection during handshake + // TLS handshake data should never reach the application layer + if UseTLS then + begin + // Check if TLS handshake is still in progress using per-connection context + if (TncLineInternal(aLine).DataObject <> nil) then + begin + var TlsContext := TncTlsConnectionContext(TncLineInternal(aLine).DataObject); + if not TlsContext.GetServerContext^.HandshakeCompleted then + begin + // During handshake, pass all data directly to original handler (TLS layer) + // Protocol detection should only happen AFTER TLS handshake completes + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, aBuf, aBufCount); + Exit; // Don't process for protocol detection during handshake + end; + end; + // If we reach here, TLS handshake is complete and data is decrypted application data + // Continue with normal protocol detection below + end; + + // Get or create connection state + if not FConnectionStates.TryGetValue(aLine, ConnectionState) then + begin + ConnectionState.Reset; + FConnectionStates.Add(aLine, ConnectionState); + end; + + Ofs := 0; + + // Process incoming data using ncSources-style state machine + while Ofs < aBufCount do + begin + // Are we in the middle of accumulating a message? + if ConnectionState.BytesToEndOfMessage > 0 then + begin + // ncSources approach: We know exactly how many bytes we need + BytesToRead := Min(ConnectionState.BytesToEndOfMessage, aBufCount - Ofs); + + // Accumulate data efficiently + OldLen := Length(ConnectionState.MessageBuffer); + SetLength(ConnectionState.MessageBuffer, OldLen + BytesToRead); + Move(aBuf[Ofs], ConnectionState.MessageBuffer[OldLen], BytesToRead); + + Ofs := Ofs + BytesToRead; + ConnectionState.BytesToEndOfMessage := ConnectionState.BytesToEndOfMessage - BytesToRead; + end; + + // Do we have a complete message? + if ConnectionState.BytesToEndOfMessage = 0 then + begin + if Length(ConnectionState.MessageBuffer) > 0 then + begin + // Process complete message based on detected protocol + case ConnectionState.MessageType of + mtBinary: + begin + // Process binary command - Route to Thread Pool (from ncSources) + try + // Apply decompression and decryption (reverse order of sending) + var ProcessedData := ConnectionState.MessageBuffer; + + // Step 1: Decompress first (reverse order) + if Compression <> zcNone then + ProcessedData := DecompressBytes(ProcessedData); + + // Step 2: Decrypt second + if Encryption <> etNoEncryption then + ProcessedData := DecryptBytes(ProcessedData, EncryptionKey, Encryption, EncryptOnHashedKey, False); + + // Parse the processed data + Command.FromBytes(ProcessedData); + + // Route to thread pool for processing like ncSources + TMonitor.Enter(HandleCommandThreadPool); + try + var HandleCommandThread := THandleCommandThread(HandleCommandThreadPool.RequestReadyThread); + HandleCommandThread.WorkType := htwtOnCommand; + HandleCommandThread.Source := Self; + HandleCommandThread.Line := aLine; + HandleCommandThread.Cmd := Command.Cmd; + HandleCommandThread.Data := Command.Data; + HandleCommandThread.OnCommand := FOnCommand; + HandleCommandThread.EventsUseMainThread := EventsUseMainThread; + HandleCommandThreadPool.RunRequestedThread(HandleCommandThread); + finally + TMonitor.Exit(HandleCommandThreadPool); + end; + except + // If decompression/decryption/parsing fails, treat as text + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, ConnectionState.MessageBuffer, Length(ConnectionState.MessageBuffer)); + end; + end; + mtText: + begin + // Process text data + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, ConnectionState.MessageBuffer, Length(ConnectionState.MessageBuffer)); + end; + end; + + // Reset for next message + ConnectionState.Reset; + end; + + // Start new message detection if we have more data + if Ofs < aBufCount then + begin + // Protocol detection: Check for magic header + if (aBufCount - Ofs) >= SizeOf(TMagicHeaderType) then + begin + if PMagicHeaderType(@aBuf[Ofs])^ = MagicHeader then + begin + // Binary protocol detected + ConnectionState.MessageType := mtBinary; + + // Do we have the complete header? + if (aBufCount - Ofs) >= (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) then + begin + // Read message length and set up state + ConnectionState.ExpectedMessageLength := PUInt64(@aBuf[Ofs + SizeOf(TMagicHeaderType)])^; + ConnectionState.BytesToEndOfMessage := ConnectionState.ExpectedMessageLength; + ConnectionState.HeaderComplete := True; + + // Skip past header + Ofs := Ofs + SizeOf(TMagicHeaderType) + SizeOf(UInt64); + + // Continue to accumulate message data + Continue; + end + else + begin + // Incomplete header - buffer remaining data and wait + SetLength(TextData, aBufCount - Ofs); + Move(aBuf[Ofs], TextData[0], aBufCount - Ofs); + ConnectionState.MessageBuffer := TextData; + ConnectionState.BytesToEndOfMessage := (SizeOf(TMagicHeaderType) + SizeOf(UInt64)) - (aBufCount - Ofs); + ConnectionState.MessageType := mtUnknown; // Still detecting + Break; + end; + end + else + begin + // Unknown protocol - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing, don't accumulate + end; + end + else + begin + // Not enough data for magic header check - pass through directly like ncSockets + if Assigned(OriginalOnReadData) then + OriginalOnReadData(Self, aLine, Copy(aBuf, Ofs, aBufCount - Ofs), aBufCount - Ofs); + Break; // Exit processing + end; + end; + end; + end; + + // Update connection state + FConnectionStates.AddOrSetValue(aLine, ConnectionState); +end; + +procedure TncCustomTCPServerDual.SetOnReadData(const Value: TncOnReadData); +begin + // Store the user's handler and keep protocol detection active + OriginalOnReadData := Value; + inherited OnReadData := InternalReadDataHandler; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncServerProcessor } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncServerProcessor.Create(aServerSocket: TncCustomTCPServerDual); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncServerProcessor.CheckLinesToShutDown; +var + i: Integer; +begin + // The list may be locked from custom code executed in the OnReadData handler + // So we will not delete anything, or lock the list, until this lock is freed + if TMonitor.TryEnter(FServerSocket.Lines) then + try + TMonitor.Enter(FServerSocket.ShutDownLock); + try + for i := 0 to High(FServerSocket.LinesToShutDown) do + try + FServerSocket.Lines.Remove(FServerSocket.LinesToShutDown[i]); + TncLineInternal(FServerSocket.LinesToShutDown[i]).DestroyHandle; + TncLineInternal(FServerSocket.LinesToShutDown[i]).Free; + except + end; + SetLength(FServerSocket.LinesToShutDown, 0); + finally + TMonitor.Exit(FServerSocket.ShutDownLock); + end; + finally + TMonitor.Exit(FServerSocket.Lines); + end; +end; + +procedure TncServerProcessor.SocketProcess; +var + i, LineNdx, BufRead, ReadySocketsHigh: Integer; + DataSockets: TSocketList; + Line: TncLine; + j: Integer; +begin + ReadySocketsHigh := High(ReadySockets); + + // First accept new lines + i := 0; + while i <= ReadySocketsHigh do + begin + try + if ReadySockets[i] = FServerSocket.Listener.Handle then + begin + // New line is here, accept it and create a new TncLine object + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + FServerSocket.Lines.Add(TncLineInternal(FServerSocket.Listener).AcceptLine); + + Delete(ReadySockets, i, 1); + ReadySocketsHigh := ReadySocketsHigh - 1; + i := i - 1; + end; + except + end; + i := i + 1; + end; + + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + + // Check for new data + DataSockets := FServerSocket.Lines.FList; + for i := 0 to ReadySocketsHigh do + try + LineNdx := DataSockets.IndexOf(ReadySockets[i]); + if LineNdx = -1 then + begin + for j := 0 to High(FServerSocket.ReadSocketHandles) do + if FServerSocket.ReadSocketHandles[j] = ReadySockets[i] then + begin + FServerSocket.ReadSocketHandles[j] := FServerSocket.ReadSocketHandles[High(FServerSocket.ReadSocketHandles)]; + SetLength(FServerSocket.ReadSocketHandles, Length(FServerSocket.ReadSocketHandles) - 1); + Break; + end; + Continue; + end; + Line := DataSockets.Lines[LineNdx]; + try + if not Line.Active then + Abort; + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + BufRead := FServerSocket.ReceiveTLS(Line, FServerSocket.ReadBuf[0], Length(FServerSocket.ReadBuf)); + if Assigned(FServerSocket.OnReadData) and (BufRead > 0) then + FServerSocket.OnReadData(FServerSocket, Line, FServerSocket.ReadBuf, BufRead); + except + // Line has disconnected, destroy the line + DataSockets.Delete(LineNdx); + Line.Free; + end; + + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; + end; + except + end; +end; + +procedure TncServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Listener.Active and (not Terminated) do + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + Synchronize(SocketProcess); + CheckLinesToShutDown; + except + end + else + while FServerSocket.Listener.Active and (not Terminated) do + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + SocketProcess; + CheckLinesToShutDown; + except + end; +end; + +// Thread Pool Property Implementations (from ncSources) +function TncTCPBaseDual.GetCommandProcessorThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreadPriority; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreadPriority := Value; + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetThreadPriority(Value); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetCommandProcessorThreads: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreads; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreads(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreads := Value; + if Value <> 0 then + FCommandProcessorThreadsPerCPU := 0; + + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetExecThreads(Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetCommandProcessorThreadsPerCPU: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreadsPerCPU; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreadsPerCPU(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreadsPerCPU := Value; + if Value <> 0 then + FCommandProcessorThreads := 0; + + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetExecThreads(Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncTCPBaseDual.GetCommandProcessorThreadsGrowUpto: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreadsGrowUpto; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncTCPBaseDual.SetCommandProcessorThreadsGrowUpto(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreadsGrowUpto := Value; + if not(csLoading in ComponentState) then + HandleCommandThreadPool.GrowUpto := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +{ THandleCommandThread } + +procedure THandleCommandThread.CallOnCommandEvent; +begin + if Assigned(FOnCommand) then + try + FOnCommand(FSource, FLine, FCmd, FData); + except + // Swallow exceptions in worker thread to prevent thread termination + end; +end; + +procedure THandleCommandThread.ProcessEvent; +begin + if FEventsUseMainThread then + Synchronize(CallOnCommandEvent) + else + CallOnCommandEvent; +end; + + +end. + + diff --git a/Source_using_TMonitor/ncSocketsThd.pas b/Source_using_TMonitor/ncSocketsThd.pas new file mode 100644 index 0000000..b04c60b --- /dev/null +++ b/Source_using_TMonitor/ncSocketsThd.pas @@ -0,0 +1,942 @@ +unit ncSocketsThd; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - Threaded Socket Components +// +// This unit creates TncTCPServerThd and TncTCPClientThd components that provide +// raw socket functionality with thread pool processing for received data. +// +// Unlike TncSourceBase which is limited to command protocol processing, +// these components allow custom protocol handling while still benefiting +// from the thread pool architecture for performance. +// +// Component Architecture: +// - TncTCPServerThd: Raw TCP server with thread pool data processing +// - TncTCPClientThd: Raw TCP client with thread pool data processing +// - TncSocketBase: Base class with common thread pool functionality +// - TDataProcessingThread: Worker thread for processing raw data +// +// Key Features: +// - Raw socket data processing with thread pool +// - Reader threads for network I/O (non-blocking) +// - Processing threads for data handling (OnReadData event) +// - Component composition pattern wrapping TncTCPServer/TncTCPClient +// - All socket properties delegated to underlying components +// - TLS/SSL support through SChannel integration (Windows) +// +// Architecture: +// Network Data -> Reader Thread -> Processing Thread Pool -> OnReadData Event +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// 13/07/2025 - by J.Pauwels +// - Added TLS/SSL support through SChannel integration +// - Added TLS properties (UseTLS, TlsProvider, CertificateFile) +// - Integrated secure communication capabilities for both server and client +// +// 12/07/2025 - by J.Pauwels +// - Initial creation +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, + System.Diagnostics, System.TimeSpan, System.RTLConsts, System.Types, + ncLines, ncSocketList, ncThreads, ncSockets; + +type + // Event type for raw data processing + TncOnServerReadData = procedure( + Sender: TObject; + aLine: TncLine; + const aBuf: TBytes; + aBufCount: Integer) of object; + + TncOnServerConnectDisconnect = procedure( + Sender: TObject; + aLine: TncLine) of object; + + TncOnServerReconnected = procedure( + Sender: TObject; + aLine: TncLine) of object; + +const + DefDataProcessorThreadPriority = ntpNormal; + DefDataProcessorThreads = 0; + DefDataProcessorThreadsPerCPU = 4; + DefDataProcessorThreadsGrowUpto = 32; + DefServerEventsUseMainThread = False; + +type + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncSocketBase + // Base class for TncTCPServerThd and TncTCPClientThd providing thread pool data processing + // Copies the TncSourceBase pattern but for raw data instead of commands + + TncSocketBase = class(TComponent) + private + FDataProcessorThreadPriority: TncThreadPriority; + FDataProcessorThreads: Integer; + FDataProcessorThreadsPerCPU: Integer; + FDataProcessorThreadsGrowUpto: Integer; + FEventsUseMainThread: Boolean; + + FOnConnected: TncOnServerConnectDisconnect; + FOnDisconnected: TncOnServerConnectDisconnect; + FOnReconnected: TncOnServerReconnected; + FOnReadData: TncOnServerReadData; + + // Socket property delegation getters/setters + function GetActive: Boolean; + procedure SetActive(const Value: Boolean); + function GetKeepAlive: Boolean; + procedure SetKeepAlive(const Value: Boolean); + function GetNoDelay: Boolean; + procedure SetNoDelay(const Value: Boolean); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetUseReaderThread: Boolean; + procedure SetUseReaderThread(const Value: Boolean); + function GetUseTLS: Boolean; + procedure SetUseTLS(const Value: Boolean); + function GetTlsProvider: TncTlsProvider; + procedure SetTlsProvider(const Value: TncTlsProvider); + function GetCertificateFile: string; + procedure SetCertificateFile(const Value: string); + function GetIgnoreCertificateErrors: Boolean; + procedure SetIgnoreCertificateErrors(const Value: Boolean); + function GetPrivateKeyPassword: string; + procedure SetPrivateKeyPassword(const Value: string); + + // Thread pool property getters/setters + function GetDataProcessorThreadPriority: TncThreadPriority; + procedure SetDataProcessorThreadPriority(const Value: TncThreadPriority); + function GetDataProcessorThreads: Integer; + procedure SetDataProcessorThreads(const Value: Integer); + function GetDataProcessorThreadsPerCPU: Integer; + procedure SetDataProcessorThreadsPerCPU(const Value: Integer); + function GetDataProcessorThreadsGrowUpto: Integer; + procedure SetDataProcessorThreadsGrowUpto(const Value: Integer); + function GetEventsUseMainThread: Boolean; + procedure SetEventsUseMainThread(const Value: Boolean); + private + // To set the component active on loaded if was set at design time + WasSetActive: Boolean; + WithinConnectionHandler: Boolean; + protected + PropertyLock: TObject; // TMonitor synchronization object + DataProcessorThreadPool: TncThreadPool; + Socket: TncTCPBase; + + LastConnectedLine, LastDisconnectedLine, LastReconnectedLine: TncLine; + + procedure Loaded; override; + procedure TLSHandshakeWrapper(aLine: TncLine); + procedure CallConnectedEvents; + procedure SocketConnected(Sender: TObject; aLine: TncLine); + procedure CallDisconnectedEvents; + procedure SocketDisconnected(Sender: TObject; aLine: TncLine); + procedure CallReconnectedEvents; + procedure SocketReconnected(Sender: TObject; aLine: TncLine); + procedure SocketReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function GetThreadPoolThreadCount: Integer; + function GetThreadPoolActiveThreadCount: Integer; + published + // Socket properties (delegated to underlying socket) + property Active: Boolean read GetActive write SetActive default False; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default DefNoDelay; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default DefKeepAlive; + property Family: TAddressType read GetFamily write SetFamily default DefFamily; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + property UseReaderThread: Boolean read GetUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property UseTLS: Boolean read GetUseTLS write SetUseTLS default False; + property TlsProvider: TncTlsProvider read GetTlsProvider write SetTlsProvider default DefTlsProvider; + property CertificateFile: string read GetCertificateFile write SetCertificateFile; + property IgnoreCertificateErrors: Boolean read GetIgnoreCertificateErrors write SetIgnoreCertificateErrors default DefIgnoreCertificateErrors; + property PrivateKeyPassword: string read GetPrivateKeyPassword write SetPrivateKeyPassword; + + // Thread pool properties + property DataProcessorThreadPriority: TncThreadPriority read GetDataProcessorThreadPriority write SetDataProcessorThreadPriority default DefDataProcessorThreadPriority; + property DataProcessorThreads: Integer read GetDataProcessorThreads write SetDataProcessorThreads default DefDataProcessorThreads; + property DataProcessorThreadsPerCPU: Integer read GetDataProcessorThreadsPerCPU write SetDataProcessorThreadsPerCPU default DefDataProcessorThreadsPerCPU; + property DataProcessorThreadsGrowUpto: Integer read GetDataProcessorThreadsGrowUpto write SetDataProcessorThreadsGrowUpto default DefDataProcessorThreadsGrowUpto; + property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefServerEventsUseMainThread; + + // Events + property OnConnected: TncOnServerConnectDisconnect read FOnConnected write FOnConnected; + property OnDisconnected: TncOnServerConnectDisconnect read FOnDisconnected write FOnDisconnected; + property OnReadData: TncOnServerReadData read FOnReadData write FOnReadData; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TDataProcessingThread + // Worker thread that processes raw data from the thread pool + // Copies the THandleCommandThread pattern for consistency + + TDataProcessingThread = class(TncReadyThread) + public + OnReadData: TncOnServerReadData; + Server: TncSocketBase; + Line: TncLine; + Buffer: TBytes; + BufferCount: Integer; + + procedure CallOnReadDataEvent; + procedure ProcessEvent; override; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncTCPServerThd + // Server component providing raw socket functionality with thread pool processing + + TncTCPServerThd = class(TncSocketBase) + private + function GetLines: TThreadLineList; + protected + function GetReaderThreadPriority: TncThreadPriority; // Override to access server-specific property + procedure SetReaderThreadPriority(const Value: TncThreadPriority); // Override to access server-specific property + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure Send(aLine: TncLine; const aBuf; aBufSize: Integer); overload; inline; + procedure Send(aLine: TncLine; const aBytes: TBytes); overload; inline; + procedure Send(aLine: TncLine; const aStr: string); overload; inline; + procedure ShutDownLine(aLine: TncLine); + property Lines: TThreadLineList read GetLines; + published + // Inherited properties from TncSocketBase + property Active; + property Port; + property ReaderThreadPriority; + property NoDelay; + property KeepAlive; + property Family; + property ReadBufferLen; + property UseReaderThread; + property UseTLS; + property TlsProvider; + property CertificateFile; + property IgnoreCertificateErrors; + property PrivateKeyPassword; + property DataProcessorThreadPriority; + property DataProcessorThreads; + property DataProcessorThreadsPerCPU; + property DataProcessorThreadsGrowUpto; + property EventsUseMainThread; + property OnConnected; + property OnDisconnected; + property OnReadData; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncTCPClientThd + // Client component providing raw socket functionality with thread pool processing + + TncTCPClientThd = class(TncSocketBase) + private + FOnReconnected: TncOnServerReconnected; + function GetHost: string; + procedure SetHost(const Value: string); + function GetReconnect: Boolean; + procedure SetReconnect(const Value: Boolean); + function GetReconnectInterval: Cardinal; + procedure SetReconnectInterval(const Value: Cardinal); + function GetLine: TncLine; + protected + function GetReaderThreadPriority: TncThreadPriority; // Override to access client-specific property + procedure SetReaderThreadPriority(const Value: TncThreadPriority); // Override to access client-specific property + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + procedure Send(const aBuf; aBufSize: Integer); overload; inline; + procedure Send(const aBytes: TBytes); overload; inline; + procedure Send(const aStr: string); overload; inline; + function Receive(aTimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(var aBytes: TBytes): Integer; inline; + + property Line: TncLine read GetLine; + published + // Inherited properties from TncSocketBase + property Active; + property Port; + property ReaderThreadPriority; + property NoDelay; + property KeepAlive; + property Family; + property ReadBufferLen; + property UseReaderThread; + property UseTLS; + property TlsProvider; + property CertificateFile; + property IgnoreCertificateErrors; + property PrivateKeyPassword; + property DataProcessorThreadPriority; + property DataProcessorThreads; + property DataProcessorThreadsPerCPU; + property DataProcessorThreadsGrowUpto; + property EventsUseMainThread; + property OnConnected; + property OnDisconnected; + property OnReadData; + + // Client-specific properties + property Host: string read GetHost write SetHost; + property Reconnect: Boolean read GetReconnect write SetReconnect default True; + property ReconnectInterval: Cardinal read GetReconnectInterval write SetReconnectInterval default DefCntReconnectInterval; + property OnReconnected: TncOnServerReconnected read FOnReconnected write FOnReconnected; + end; + +implementation + +uses + System.TypInfo; + +type + // Friend class declarations to access protected members + TncLineInternal = class(TncLine); + TncTCPBaseInternal = class(TncTCPBase); + TncCustomTCPServerInternal = class(TncCustomTCPServer); + TncTCPServerInternal = class(TncTCPServer); + +{ TncDataProcessingThread } + +procedure TDataProcessingThread.CallOnReadDataEvent; +begin + if Assigned(OnReadData) then + try + OnReadData(Server, Line, Buffer, BufferCount); + except + // Swallow exceptions to prevent thread termination + end; +end; + +procedure TDataProcessingThread.ProcessEvent; +begin + if Server.EventsUseMainThread then + Synchronize(CallOnReadDataEvent) + else + CallOnReadDataEvent; +end; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncSocketBase } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncSocketBase.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TObject.Create; + + Socket := nil; + WasSetActive := False; + WithinConnectionHandler := False; + + FDataProcessorThreadPriority := DefDataProcessorThreadPriority; + FDataProcessorThreads := DefDataProcessorThreads; + FDataProcessorThreadsPerCPU := DefDataProcessorThreadsPerCPU; + FDataProcessorThreadsGrowUpto := DefDataProcessorThreadsGrowUpto; + FEventsUseMainThread := DefServerEventsUseMainThread; + + FOnConnected := nil; + FOnDisconnected := nil; + FOnReconnected := nil; + FOnReadData := nil; + + DataProcessorThreadPool := TncThreadPool.Create(TDataProcessingThread); +end; + +destructor TncSocketBase.Destroy; +begin + DataProcessorThreadPool.Free; + PropertyLock.Free; + inherited Destroy; +end; + +function TncSocketBase.GetThreadPoolThreadCount: Integer; +begin + Result := DataProcessorThreadPool.GetThreadCount; +end; + +function TncSocketBase.GetThreadPoolActiveThreadCount: Integer; +begin + Result := DataProcessorThreadPool.GetActiveThreadCount; +end; + +procedure TncSocketBase.Loaded; +begin + inherited Loaded; + + DataProcessorThreadPool.SetThreadPriority(FDataProcessorThreadPriority); + DataProcessorThreadPool.SetExecThreads( + Max(1, Max(FDataProcessorThreads, GetNumberOfProcessors * FDataProcessorThreadsPerCPU)), + FDataProcessorThreadPriority); + + if WasSetActive then + Socket.Active := True; +end; + +procedure TncSocketBase.CallConnectedEvents; +begin + WithinConnectionHandler := True; + try + if Assigned(OnConnected) then + OnConnected(Self, LastConnectedLine); + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSocketBase.SocketConnected(Sender: TObject; aLine: TncLine); +begin + LastConnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallConnectedEvents) + else + CallConnectedEvents; +end; + +procedure TncSocketBase.CallDisconnectedEvents; +begin + WithinConnectionHandler := True; + try + if Assigned(OnDisconnected) then + try + OnDisconnected(Self, LastDisconnectedLine); + except + end; + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSocketBase.SocketDisconnected(Sender: TObject; aLine: TncLine); +begin + LastDisconnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallDisconnectedEvents) + else + CallDisconnectedEvents; +end; + +procedure TncSocketBase.CallReconnectedEvents; +begin + WithinConnectionHandler := True; + try + if Assigned(TncTCPClientThd(Self).OnReconnected) then + try + TncTCPClientThd(Self).OnReconnected(Self, LastReconnectedLine); + except + end; + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSocketBase.SocketReconnected(Sender: TObject; aLine: TncLine); +begin + LastReconnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallReconnectedEvents) + else + CallReconnectedEvents; +end; + +// This is the key method - it queues raw data processing to the thread pool +procedure TncSocketBase.SocketReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); +var + DataProcessingThread: TDataProcessingThread; +begin + // The base socket handles TLS handshake internally and only fires OnReadData for application data + // So we can safely queue all data to the thread pool + if Assigned(OnReadData) then + begin + TMonitor.Enter(DataProcessorThreadPool); + try + DataProcessingThread := TDataProcessingThread(DataProcessorThreadPool.RequestReadyThread); + DataProcessingThread.OnReadData := OnReadData; + DataProcessingThread.Server := Self; + DataProcessingThread.Line := aLine; + DataProcessingThread.Buffer := Copy(aBuf, 0, aBufCount); // Copy the buffer to avoid race conditions + DataProcessingThread.BufferCount := aBufCount; + DataProcessorThreadPool.RunRequestedThread(DataProcessingThread); + finally + TMonitor.Exit(DataProcessorThreadPool); + end; + end; +end; + +// Socket property delegation methods +function TncSocketBase.GetActive: Boolean; +begin + Result := Socket.Active; +end; + +procedure TncSocketBase.SetActive(const Value: Boolean); +begin + if csLoading in ComponentState then + WasSetActive := Value + else + Socket.Active := Value; +end; + +function TncSocketBase.GetFamily: TAddressType; +begin + Result := Socket.Family; +end; + +procedure TncSocketBase.SetFamily(const Value: TAddressType); +begin + Socket.Family := Value; +end; + +function TncSocketBase.GetKeepAlive: Boolean; +begin + Result := Socket.KeepAlive; +end; + +procedure TncSocketBase.SetKeepAlive(const Value: Boolean); +begin + Socket.KeepAlive := Value; +end; + +function TncSocketBase.GetNoDelay: Boolean; +begin + Result := Socket.NoDelay; +end; + +procedure TncSocketBase.SetNoDelay(const Value: Boolean); +begin + Socket.NoDelay := Value; +end; + +function TncSocketBase.GetPort: Integer; +begin + Result := Socket.Port; +end; + +procedure TncSocketBase.SetPort(const Value: Integer); +begin + Socket.Port := Value; +end; + +function TncSocketBase.GetReaderThreadPriority: TncThreadPriority; +begin + Result := Socket.ReaderThreadPriority; +end; + +procedure TncSocketBase.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + Socket.ReaderThreadPriority := Value; +end; + +function TncSocketBase.GetReadBufferLen: Integer; +begin + Result := Socket.ReadBufferLen; +end; + +procedure TncSocketBase.SetReadBufferLen(const Value: Integer); +begin + Socket.ReadBufferLen := Value; +end; + +function TncSocketBase.GetUseReaderThread: Boolean; +begin + Result := Socket.UseReaderThread; +end; + +procedure TncSocketBase.SetUseReaderThread(const Value: Boolean); +begin + Socket.UseReaderThread := Value; +end; + +function TncSocketBase.GetUseTLS: Boolean; +begin + Result := Socket.UseTLS; +end; + +procedure TncSocketBase.SetUseTLS(const Value: Boolean); +begin + Socket.UseTLS := Value; + + // Set up TLS handshake callback if Line objects already exist + // The underlying ncSockets components will handle TLS setup during Line creation + if Value then + begin + if Socket is TncTCPClient then + begin + var Client := TncTCPClient(Socket); + if Client.Line <> nil then + begin + TncLineInternal(Client.Line).OnBeforeConnected := TLSHandshakeWrapper; + end; + // If Line doesn't exist yet, it will be set up automatically when Line is created + end + else if Socket is TncTCPServer then + begin + var Server := TncTCPServer(Socket); + if TncTCPServerInternal(Server).Listener <> nil then + begin + TncLineInternal(TncTCPServerInternal(Server).Listener).OnBeforeConnected := TLSHandshakeWrapper; + end; + end; + end; +end; + +function TncSocketBase.GetTlsProvider: TncTlsProvider; +begin + Result := Socket.TlsProvider; +end; + +procedure TncSocketBase.SetTlsProvider(const Value: TncTlsProvider); +begin + Socket.TlsProvider := Value; +end; + +function TncSocketBase.GetCertificateFile: string; +begin + Result := Socket.CertificateFile; +end; + +procedure TncSocketBase.SetCertificateFile(const Value: string); +begin + Socket.CertificateFile := Value; +end; + +function TncSocketBase.GetIgnoreCertificateErrors: Boolean; +begin + Result := Socket.IgnoreCertificateErrors; +end; + +procedure TncSocketBase.SetIgnoreCertificateErrors(const Value: Boolean); +begin + Socket.IgnoreCertificateErrors := Value; +end; + +function TncSocketBase.GetPrivateKeyPassword: string; +begin + Result := Socket.PrivateKeyPassword; +end; + +procedure TncSocketBase.SetPrivateKeyPassword(const Value: string); +begin + Socket.PrivateKeyPassword := Value; +end; + +// Thread pool property methods +function TncSocketBase.GetDataProcessorThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := FDataProcessorThreadPriority; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSocketBase.SetDataProcessorThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + FDataProcessorThreadPriority := Value; + if not (csLoading in ComponentState) then + DataProcessorThreadPool.SetThreadPriority(Value); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSocketBase.GetDataProcessorThreads: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FDataProcessorThreads; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSocketBase.SetDataProcessorThreads(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FDataProcessorThreads := Value; + if Value <> 0 then + FDataProcessorThreadsPerCPU := 0; + + if not (csLoading in ComponentState) then + DataProcessorThreadPool.SetExecThreads( + Max(1, Max(FDataProcessorThreads, GetNumberOfProcessors * FDataProcessorThreadsPerCPU)), + FDataProcessorThreadPriority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSocketBase.GetDataProcessorThreadsPerCPU: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FDataProcessorThreadsPerCPU; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSocketBase.SetDataProcessorThreadsPerCPU(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FDataProcessorThreadsPerCPU := Value; + if Value <> 0 then + FDataProcessorThreads := 0; + + if not (csLoading in ComponentState) then + DataProcessorThreadPool.SetExecThreads( + Max(1, Max(FDataProcessorThreads, GetNumberOfProcessors * FDataProcessorThreadsPerCPU)), + FDataProcessorThreadPriority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSocketBase.GetDataProcessorThreadsGrowUpto: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FDataProcessorThreadsGrowUpto; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSocketBase.SetDataProcessorThreadsGrowUpto(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FDataProcessorThreadsGrowUpto := Value; + if not (csLoading in ComponentState) then + DataProcessorThreadPool.GrowUpto := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSocketBase.GetEventsUseMainThread: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEventsUseMainThread; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSocketBase.SetEventsUseMainThread(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FEventsUseMainThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSocketBase.TLSHandshakeWrapper(aLine: TncLine); +begin + TncTCPBaseInternal(Socket).HandleTLSHandshake(aLine); +end; + + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTCPServerThd } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTCPServerThd.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + // Create the underlying TCP server socket + Socket := TncTCPServer.Create(Self); + Socket.Family := afIPv4; + Socket.Port := DefPort; + Socket.NoDelay := DefNoDelay; + Socket.EventsUseMainThread := False; + Socket.OnConnected := SocketConnected; + Socket.OnDisconnected := SocketDisconnected; + Socket.OnReadData := SocketReadData; +end; + +destructor TncTCPServerThd.Destroy; +begin + Socket.Free; + inherited Destroy; +end; + +function TncTCPServerThd.GetLines: TThreadLineList; +begin + Result := TncTCPServer(Socket).Lines; +end; + +procedure TncTCPServerThd.Send(aLine: TncLine; const aBuf; aBufSize: Integer); +begin + TncTCPServer(Socket).Send(aLine, aBuf, aBufSize); +end; + +procedure TncTCPServerThd.Send(aLine: TncLine; const aBytes: TBytes); +begin + TncTCPServer(Socket).Send(aLine, aBytes); +end; + +procedure TncTCPServerThd.Send(aLine: TncLine; const aStr: string); +begin + TncTCPServer(Socket).Send(aLine, aStr); +end; + +procedure TncTCPServerThd.ShutDownLine(aLine: TncLine); +begin + TncTCPServer(Socket).ShutDownLine(aLine); +end; + +// Override to access server-specific property +function TncTCPServerThd.GetReaderThreadPriority: TncThreadPriority; +begin + Result := TncTCPServer(Socket).ReaderThreadPriority; +end; + +procedure TncTCPServerThd.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TncTCPServer(Socket).ReaderThreadPriority := Value; +end; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncTCPClientThd } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncTCPClientThd.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Socket := TncTCPClient.Create(Self); + Socket.Family := afIPv4; + Socket.Port := DefPort; + Socket.NoDelay := DefNoDelay; + Socket.EventsUseMainThread := False; + Socket.OnConnected := SocketConnected; + Socket.OnDisconnected := SocketDisconnected; + Socket.OnReadData := SocketReadData; + TncTCPClient(Socket).OnReconnected := SocketReconnected; +end; + +destructor TncTCPClientThd.Destroy; +begin + Socket.Free; + inherited Destroy; +end; + +function TncTCPClientThd.GetLine: TncLine; +begin + Result := TncTCPClient(Socket).Line; +end; + +procedure TncTCPClientThd.Send(const aBuf; aBufSize: Integer); +begin + TncTCPClient(Socket).Send(aBuf, aBufSize); +end; + +procedure TncTCPClientThd.Send(const aBytes: TBytes); +begin + TncTCPClient(Socket).Send(aBytes); +end; + +procedure TncTCPClientThd.Send(const aStr: string); +begin + TncTCPClient(Socket).Send(aStr); +end; + +function TncTCPClientThd.Receive(aTimeout: Cardinal = 2000): TBytes; +begin + Result := TncTCPClient(Socket).Receive(aTimeout); +end; + +function TncTCPClientThd.ReceiveRaw(var aBytes: TBytes): Integer; +begin + Result := TncTCPClient(Socket).ReceiveRaw(aBytes); +end; + +function TncTCPClientThd.GetHost: string; +begin + Result := TncTCPClient(Socket).Host; +end; + +procedure TncTCPClientThd.SetHost(const Value: string); +begin + TncTCPClient(Socket).Host := Value; +end; + +function TncTCPClientThd.GetReconnect: Boolean; +begin + Result := TncTCPClient(Socket).Reconnect; +end; + +procedure TncTCPClientThd.SetReconnect(const Value: Boolean); +begin + TncTCPClient(Socket).Reconnect := Value; +end; + +function TncTCPClientThd.GetReconnectInterval: Cardinal; +begin + Result := TncTCPClient(Socket).ReconnectInterval; +end; + +procedure TncTCPClientThd.SetReconnectInterval(const Value: Cardinal); +begin + TncTCPClient(Socket).ReconnectInterval := Value; +end; + +// Override to access client-specific property +function TncTCPClientThd.GetReaderThreadPriority: TncThreadPriority; +begin + Result := TncTCPClient(Socket).ReaderThreadPriority; +end; + +procedure TncTCPClientThd.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TncTCPClient(Socket).ReaderThreadPriority := Value; +end; + +end. + diff --git a/Source_using_TMonitor/ncSources.pas b/Source_using_TMonitor/ncSources.pas new file mode 100644 index 0000000..1a3a022 --- /dev/null +++ b/Source_using_TMonitor/ncSources.pas @@ -0,0 +1,1413 @@ +unit ncSources; + +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// +// This unit creates a TCP Server Source and a TCP Client Source compoents, +// along with their threads dealing with handling commands. +// +// The idea behind the source components is to be able to extend the sockets +// to handle well defined buffers. Sockets on their own are streaming so +// you have to implement a mechanism of picking the buffers from the stream +// to process. +// +// The components implemented here introduce an ExecCommand which sends to +// the peer (be it a client or a server) the command along with its data to +// be executed. The peer then calls the OnHandleCommand with the data supplied, +// and packs the result back to the calling peer. If an exception is raised, +// it is packed and raised back at the caller, so that client/server applications +// can utilise the exception mechanisms. +// +// The buffer packing and unpacking from the stream can handle garbage thrown +// at it. +// +// These components have built in encryption and compression, set by the +// corresponding properties. +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// 14/01/2025 - by J.Pauwels +// - Explicitly set this unit to use TCP +// - Added IPV6 support +// +// 12/8/2020 +// - Complete re-engineering of the base component +// +// 16/12/2010 +// - Initial creation +// +// Written by Demos Bill +// +// ///////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.ZLib, + System.Diagnostics, System.TimeSpan, System.RTLConsts, System.Types, + ncCommandPacking, ncLines, ncSocketList, ncThreads, ncSockets, ncPendingCommandsList, ncCompression, ncEncryption; + +type + TncCommandDirection = (cdIncoming, cdOutgoing); + + ENetComInvalidCommandHandler = class(Exception); + ENetComCommandExecutionTimeout = class(Exception); + ENetComResultIsException = class(Exception); + +resourcestring + ENetComInvalidCommandHandlerMessage = 'Cannot attach component, it does not support the command handler interface'; + ENetComCommandExecutionTimeoutMessage = 'Command execution timeout'; + +type + TMagicHeaderType = UInt32; + PMagicHeaderType = ^TMagicHeaderType; + +const + MagicHeader: TMagicHeaderType = $ACF0FF00; // Bin: 10101100111100001111111100000000 + + DefPort = 17233; + + DefExecThreadPriority = ntpNormal; + DefExecThreads = 0; + DefExecThreadsPerCPU = 4; + DefExecThreadsGrowUpto = 32; + + DefExecCommandTimeout = 15000; + + DefEventsUseMainThread = False; + DefNoDelay = True; + + DefCompression = zcNone; + DefEncryption = etNoEncryption; + DefEncryptionKey = 'SetEncryptionKey'; + DefEncryptOnHashedKey = True; + +type + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncSourceLine + + // Bring in TncLine from ncLines so that components placed on a form will + // not have to reference ncLines unit + TncLine = ncLines.TncLine; + + TncSourceLine = class(TncLine) + protected + MessageData, HeaderBytes: TBytes; + BytesToEndOfMessage: UInt64; + protected + function CreateLineObject: TncLine; override; + public + constructor Create; overload; override; + end; + + TncOnSourceConnectDisconnect = procedure( + + Sender: TObject; aLine: TncLine) of object; + + TncOnSourceReconnected = procedure( + + Sender: TObject; aLine: TncLine) of object; + + TncOnSourceHandleCommand = function( + + Sender: TObject; aLine: TncLine; + + aCmd: Integer; const aData: TBytes; aRequiresResult: Boolean; + + const aSenderComponent, aReceiverComponent: string): TBytes of object; + + TncOnAsyncExecCommandResult = procedure( + + Sender: TObject; + + aLine: TncLine; aCmd: Integer; const aResult: TBytes; aResultIsError: Boolean; + + const aSenderComponent, aReceiverComponent: string) of object; + + IncCommandHandler = interface + ['{22337701-9561-489A-8593-82EAA3B1B431}'] + function GetOnConnected: TncOnSourceConnectDisconnect; + procedure SetOnConnected(const Value: TncOnSourceConnectDisconnect); + function GetOnDisconnected: TncOnSourceConnectDisconnect; + procedure SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); + function GetOnHandleCommand: TncOnSourceHandleCommand; + procedure SetOnHandleCommand(const Value: TncOnSourceHandleCommand); + function GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; + procedure SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); + + function GetComponentName: string; + + property OnConnected: TncOnSourceConnectDisconnect read GetOnConnected write SetOnConnected; + property OnDisconnected: TncOnSourceConnectDisconnect read GetOnDisconnected write SetOnDisconnected; + property OnHandleCommand: TncOnSourceHandleCommand read GetOnHandleCommand write SetOnHandleCommand; + property OnAsyncExecCommandResult: TncOnAsyncExecCommandResult read GetOnAsyncExecCommandResult write SetOnAsyncExecCommandResult; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncSourceBase + // Is the base for handling Exec and Handle command for the ServerSource and ClientSource + + TncSourceBase = class(TComponent, IncCommandHandler) + private + FCommandExecTimeout: Cardinal; + FCommandProcessorThreadPriority: TncThreadPriority; + FCommandProcessorThreads: Integer; + FCommandProcessorThreadsPerCPU: Integer; + FCommandProcessorThreadsGrowUpto: Integer; + FEventsUseMainThread: Boolean; + FCompression: TncCompressionLevel; + FEncryption: TEncryptorType; + FEncryptionKey: AnsiString; + FEncryptOnHashedKey: Boolean; + + FOnConnected: TncOnSourceConnectDisconnect; + FOnDisconnected: TncOnSourceConnectDisconnect; + FOnHandleCommand: TncOnSourceHandleCommand; + FOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; + + // From socket + function GetActive: Boolean; + procedure SetActive(const Value: Boolean); + function GetKeepAlive: Boolean; + procedure SetKeepAlive(const Value: Boolean); + function GetNoDelay: Boolean; + procedure SetNoDelay(const Value: Boolean); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + + // For implementing the IncCommandHandler interface + function GetComponentName: string; + function GetOnConnected: TncOnSourceConnectDisconnect; + procedure SetOnConnected(const Value: TncOnSourceConnectDisconnect); + function GetOnDisconnected: TncOnSourceConnectDisconnect; + procedure SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); + function GetOnHandleCommand: TncOnSourceHandleCommand; + procedure SetOnHandleCommand(const Value: TncOnSourceHandleCommand); + function GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; + procedure SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); + + // Property getters and setters + function GetExecCommandTimeout: Cardinal; + procedure SetExecCommandTimeout(const Value: Cardinal); + function GetCommandProcessorThreadPriority: TncThreadPriority; + procedure SetCommandProcessorThreadPriority(const Value: TncThreadPriority); + function GetCommandProcessorThreads: Integer; + procedure SetCommandProcessorThreads(const Value: Integer); + function GetCommandProcessorThreadsPerCPU: Integer; + procedure SetCommandProcessorThreadsPerCPU(const Value: Integer); + function GetCommandProcessorThreadsGrowUpto: Integer; + procedure SetCommandProcessorThreadsGrowUpto(const Value: Integer); + function GetEventsUseMainThread: Boolean; + procedure SetEventsUseMainThread(const Value: Boolean); + function GetCompression: TncCompressionLevel; + procedure SetCompression(const Value: TncCompressionLevel); + function GetEncryption: TEncryptorType; + procedure SetEncryption(const Value: TEncryptorType); + function GetEncryptionKey: AnsiString; + procedure SetEncryptionKey(const Value: AnsiString); + function GetEncryptOnHashedKey: Boolean; + procedure SetEncryptOnHashedKey(const Value: Boolean); + private + // To set the component active on loaded if was set at design time + WasSetActive: Boolean; + WithinConnectionHandler: Boolean; + protected + PropertyLock: TObject; // TMonitor synchronization object + CommandHandlers: array of IncCommandHandler; + UniqueSentID: TncCommandUniqueID; + HandleCommandThreadPool: TncThreadPool; + Socket: TncTCPBase; + ExecuteSerialiser: TObject; // TMonitor synchronization object + + LastConnectedLine, LastDisconnectedLine, LastReconnectedLine: TncLine; + + PendingCommandsList: TPendingCommandsList; + + procedure Loaded; override; + procedure CallConnectedEvents; + procedure SocketConnected(Sender: TObject; aLine: TncLine); + procedure CallDisconnectedEvents; + procedure SocketDisconnected(Sender: TObject; aLine: TncLine); + procedure CallReconnectedEvents; + procedure SocketReconnected(Sender: TObject; aLine: TncLine); + procedure SocketReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); + procedure WriteMessage(aLine: TncSourceLine; const aBuf: TBytes); virtual; + procedure WriteCommand(aLine: TncSourceLine; const aCmd: TncCommand); inline; + procedure HandleReceivedCommand(aLine: TncSourceLine; const aCommandBytes: TBytes); inline; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function ExecCommand( + + aLine: TncLine; const aCmd: Integer; const aData: TBytes = nil; + + const aRequiresResult: Boolean = True; const aAsyncExecute: Boolean = False; + + const aPeerComponentHandler: string = ''; const aSourceComponentHandler: string = ''): TBytes; overload; virtual; + + procedure AddCommandHandler(aHandler: TComponent); + procedure RemoveCommandHandler(aHandler: TComponent); + published + // From socket + property Active: Boolean read GetActive write SetActive default False; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default True; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default True; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + + // New properties for sources + property CommandProcessorThreadPriority: TncThreadPriority read GetCommandProcessorThreadPriority write SetCommandProcessorThreadPriority + default DefExecThreadPriority; + property CommandProcessorThreads: Integer read GetCommandProcessorThreads write SetCommandProcessorThreads default DefExecThreads; + property CommandProcessorThreadsPerCPU: Integer read GetCommandProcessorThreadsPerCPU write SetCommandProcessorThreadsPerCPU default DefExecThreadsPerCPU; + property CommandProcessorThreadsGrowUpto: Integer read GetCommandProcessorThreadsGrowUpto write SetCommandProcessorThreadsGrowUpto + default DefExecThreadsGrowUpto; + property ExecCommandTimeout: Cardinal read GetExecCommandTimeout write SetExecCommandTimeout default DefExecCommandTimeout; + property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefEventsUseMainThread; + property Compression: TncCompressionLevel read GetCompression write SetCompression default DefCompression; + property Encryption: TEncryptorType read GetEncryption write SetEncryption default DefEncryption; + property EncryptionKey: AnsiString read GetEncryptionKey write SetEncryptionKey; + property EncryptOnHashedKey: Boolean read GetEncryptOnHashedKey write SetEncryptOnHashedKey default DefEncryptOnHashedKey; + + property OnConnected: TncOnSourceConnectDisconnect read GetOnConnected write SetOnConnected; + property OnDisconnected: TncOnSourceConnectDisconnect read GetOnDisconnected write SetOnDisconnected; + property OnHandleCommand: TncOnSourceHandleCommand read GetOnHandleCommand write SetOnHandleCommand; + property OnAsyncExecCommandResult: TncOnAsyncExecCommandResult read GetOnAsyncExecCommandResult write SetOnAsyncExecCommandResult; + end; + + THandleCommandThreadWorkType = (htwtAsyncResponse, htwtOnHandleCommand); + + THandleCommandThread = class(TncReadyThread) + public + WorkType: THandleCommandThreadWorkType; + OnHandleCommand: TncOnSourceHandleCommand; + OnAsyncExecCommandResult: TncOnAsyncExecCommandResult; + Source: TncSourceBase; + Line: TncSourceLine; + Command: TncCommand; + CommandHandler: IncCommandHandler; + procedure CallOnAsyncEvents; + procedure CallOnHandleEvents; + procedure ProcessEvent; override; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncClientSource + // Connects to a server source + TncClientSource = class(TncSourceBase) + private + FOnReconnected: TncOnSourceReconnected; + function GetHost: string; + procedure SetHost(const Value: string); + function GetReconnect: Boolean; + procedure SetReconnect(const Value: Boolean); + function GetReconnectInterval: Cardinal; + procedure SetReconnectInterval(const Value: Cardinal); + protected + procedure WriteMessage(aLine: TncSourceLine; const aBuf: TBytes); override; + function GetLine: TncLine; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function ExecCommand( + + const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; + + const aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''; + + const aSourceComponentHandler: string = ''): TBytes; overload; virtual; + + property Line: TncLine read GetLine; + published + property Host: string read GetHost write SetHost; + property Reconnect: Boolean read GetReconnect write SetReconnect default True; + property ReconnectInterval: Cardinal read GetReconnectInterval write SetReconnectInterval default DefCntReconnectInterval; + property OnReconnected: TncOnSourceReconnected read FOnReconnected write FOnReconnected; + end; + + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + // TncServerSource + TncServerSource = class(TncSourceBase) + private + protected + function GetLines: TThreadLineList; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure ShutDownLine(aLine: TncLine); + property Lines: TThreadLineList read GetLines; + end; + +implementation + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncSourceLine } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncSourceLine.Create; +begin + inherited Create; + BytesToEndOfMessage := 0; + SetLength(HeaderBytes, 0); +end; + +function TncSourceLine.CreateLineObject: TncLine; +begin + Result := TncSourceLine.Create; // Create its own kind of objects + TncSourceLine(Result).SetKind(stTCP); // Explicitly set to TCP +end; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncSourceBase } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncSourceBase.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TObject.Create; + ExecuteSerialiser := TObject.Create; + + Socket := nil; + WasSetActive := False; + WithinConnectionHandler := False; + + // For encryption purposes this is not set to zero + Randomize; + UniqueSentID := Random(4096); + + FCommandProcessorThreadPriority := DefExecThreadPriority; + FCommandProcessorThreads := DefExecThreads; + FCommandProcessorThreadsPerCPU := DefExecThreadsPerCPU; + FCommandProcessorThreadsGrowUpto := DefExecThreadsGrowUpto; + + FCommandExecTimeout := DefExecCommandTimeout; + FEventsUseMainThread := DefEventsUseMainThread; + FCompression := DefCompression; + FEncryption := DefEncryption; + FEncryptionKey := DefEncryptionKey; + FEncryptOnHashedKey := DefEncryptOnHashedKey; + + FOnConnected := nil; + FOnDisconnected := nil; + FOnHandleCommand := nil; + FOnAsyncExecCommandResult := nil; + + PendingCommandsList := TPendingCommandsList.Create; + HandleCommandThreadPool := TncThreadPool.Create(THandleCommandThread); +end; + +destructor TncSourceBase.Destroy; +begin + HandleCommandThreadPool.Free; + PendingCommandsList.Free; + ExecuteSerialiser.Free; + PropertyLock.Free; + inherited Destroy; +end; + +procedure TncSourceBase.Loaded; +begin + inherited Loaded; + + HandleCommandThreadPool.SetThreadPriority(FCommandProcessorThreadPriority); + HandleCommandThreadPool.SetExecThreads(Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + + if WasSetActive then + Socket.Active := True; +end; + +procedure TncSourceBase.AddCommandHandler(aHandler: TComponent); +var + Handler: IncCommandHandler; + Len: Integer; +begin + if aHandler.GetInterface(IncCommandHandler, Handler) then + try + Len := Length(CommandHandlers); + SetLength(CommandHandlers, Len + 1); + CommandHandlers[Len] := Handler; + finally + Handler := nil; + end + else + raise ENetComInvalidCommandHandler.Create(ENetComInvalidCommandHandlerMessage); +end; + +procedure TncSourceBase.RemoveCommandHandler(aHandler: TComponent); +var + Handler: IncCommandHandler; + i: Integer; +begin + if aHandler.GetInterface(IncCommandHandler, Handler) then + try + for i := 0 to High(CommandHandlers) do + if CommandHandlers[i] = Handler then + begin + CommandHandlers[i] := CommandHandlers[High(CommandHandlers)]; + CommandHandlers[High(CommandHandlers)] := nil; + SetLength(CommandHandlers, Length(CommandHandlers) - 1); + Break; + end; + finally + Handler := nil; + end +end; + +procedure TncSourceBase.CallConnectedEvents; +var + i: Integer; +begin + WithinConnectionHandler := True; + try + if Assigned(OnConnected) then + try + OnConnected(Self, LastConnectedLine); + except + end; + + for i := 0 to High(CommandHandlers) do + try + if Assigned(CommandHandlers[i].OnConnected) then + CommandHandlers[i].OnConnected(Self, LastConnectedLine); + except + end; + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSourceBase.SocketConnected(Sender: TObject; aLine: TncLine); +begin + LastConnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallConnectedEvents) + else + CallConnectedEvents; +end; + +procedure TncSourceBase.CallDisconnectedEvents; +var + i: Integer; +begin + WithinConnectionHandler := True; + try + if Assigned(FOnDisconnected) then + try + OnDisconnected(Self, LastDisconnectedLine); + except + end; + + for i := 0 to High(CommandHandlers) do + try + if Assigned(CommandHandlers[i].OnDisconnected) then + CommandHandlers[i].OnDisconnected(Self, LastDisconnectedLine); + except + end; + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSourceBase.SocketDisconnected(Sender: TObject; aLine: TncLine); +begin + LastDisconnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallDisconnectedEvents) + else + CallDisconnectedEvents; +end; + +procedure TncSourceBase.CallReconnectedEvents; +begin + WithinConnectionHandler := True; + try + if Assigned(TncClientSource(Self).OnReconnected) then + try + TncClientSource(Self).OnReconnected(Self, LastReconnectedLine); + except + end; + finally + WithinConnectionHandler := False; + end; +end; + +procedure TncSourceBase.SocketReconnected(Sender: TObject; aLine: TncLine); +begin + LastReconnectedLine := aLine; + if EventsUseMainThread then + Socket.LineProcessor.Synchronize(Socket.LineProcessor, CallReconnectedEvents) + else + CallReconnectedEvents; +end; + +procedure TncSourceBase.WriteMessage(aLine: TncSourceLine; const aBuf: TBytes); +var + MessageBytes, FinalBuf: TBytes; + MsgByteCount, HeaderBytes: UInt64; +begin + MessageBytes := aBuf; + // Get message data compressed and encrypted + if Encryption <> etNoEncryption then + MessageBytes := EncryptBytes(MessageBytes, EncryptionKey, Encryption, EncryptOnHashedKey, False); + if Compression <> zcNone then + MessageBytes := CompressBytes(MessageBytes, Compression); + MsgByteCount := Length(MessageBytes); + + // Send 4 bytes of header, and 4 bytes how long the message will be + HeaderBytes := SizeOf(TMagicHeaderType) + SizeOf(MsgByteCount); + SetLength(FinalBuf, HeaderBytes + MsgByteCount); + + PMagicHeaderType(@FinalBuf[0])^ := MagicHeader; // Write MagicHeader + PUint64(@FinalBuf[SizeOf(MagicHeader)])^ := MsgByteCount; // Write ByteCount + move(MessageBytes[0], FinalBuf[HeaderBytes], MsgByteCount); // Write actual message + + aLine.SendBuffer(FinalBuf[0], Length(FinalBuf)); +end; + +procedure TncSourceBase.WriteCommand(aLine: TncSourceLine; const aCmd: TncCommand); +begin + WriteMessage(aLine, aCmd.ToBytes); +end; + +function TncSourceBase.ExecCommand( + + aLine: TncLine; const aCmd: Integer; const aData: TBytes = nil; + + const aRequiresResult: Boolean = True; const aAsyncExecute: Boolean = False; + + const aPeerComponentHandler: string = ''; const aSourceComponentHandler: string = ''): TBytes; + +var + Command: TncCommand; + IDSent: TncCommandUniqueID; + ReceivedResultEvent: TLightweightEvent; + PendingNdx: Integer; + WaitForEventTimeout: Integer; +begin + TMonitor.Enter(PropertyLock); + try + IDSent := UniqueSentID; + + // Random is here for encryption purposes + UniqueSentID := UniqueSentID + TncCommandUniqueID(Random(4096)) mod High(TncCommandUniqueID); + + Command.CommandType := ctInitiator; + Command.UniqueID := IDSent; + Command.Cmd := aCmd; + Command.Data := aData; + Command.RequiresResult := aRequiresResult; + Command.AsyncExecute := aAsyncExecute; + Command.ResultIsErrorString := False; + if aSourceComponentHandler = '' then + Command.SourceComponentHandler := Name + else + Command.SourceComponentHandler := aSourceComponentHandler; + Command.PeerComponentHandler := aPeerComponentHandler; + + if aRequiresResult and (not aAsyncExecute) then + begin + ReceivedResultEvent := TLightweightEvent.Create; + PendingNdx := PendingCommandsList.Add(IDSent, ReceivedResultEvent); + try + // Send command over to peer + WriteCommand(TncSourceLine(aLine), Command); + except + PendingCommandsList.Delete(PendingNdx); + ReceivedResultEvent.Free; + raise; + end; + end + else + begin + // Send command over to peer + WriteCommand(TncSourceLine(aLine), Command); + Exit; // Nothing more to do + end; + finally + TMonitor.Exit(PropertyLock); + end; + + // We are here because we require a result and this is not an AsyncExecute + SetLength(Result, 0); + try + try + aLine.LastReceived := TStopWatch.GetTimeStamp; + if WithinConnectionHandler then + WaitForEventTimeout := 0 + else + WaitForEventTimeout := ExecCommandTimeout; + while ReceivedResultEvent.WaitFor(WaitForEventTimeout) <> wrSignaled do + begin + if not aLine.Active then + Abort; + + // If we are withing an OnConnect/OnDisconnect/OnReconnect handler, + // the socket reading is paused, so we need to process it here + if WithinConnectionHandler then + begin + TMonitor.Enter(ExecuteSerialiser); + try + if (Socket is TncTCPClient) then + begin + if ReadableAnySocket(TncTCPClient(Socket).ReadSocketHandles, ExecCommandTimeout) then + begin + TncClientProcessor(TncTCPClient(Socket).LineProcessor).SocketProcess; + TncClientProcessor(TncTCPClient(Socket).LineProcessor).ReadySocketsChanged := True; + end; + end + else + begin + TncServerProcessor(TncTCPServer(Socket).LineProcessor).ReadySockets := Readable(TncTCPServer(Socket).ReadSocketHandles, ExecCommandTimeout); + if Length(TncServerProcessor(TncTCPServer(Socket).LineProcessor).ReadySockets) > 0 then + TncServerProcessor(TncTCPServer(Socket).LineProcessor).SocketProcess; + TncServerProcessor(TncTCPServer(Socket).LineProcessor).ReadySocketsChanged := True; + end; + finally + TMonitor.Exit(ExecuteSerialiser); + end; + end; + + if TStopWatch.GetTimeStamp - aLine.LastReceived >= ExecCommandTimeout * TTimeSpan.TicksPerMillisecond then + raise ENetComCommandExecutionTimeout.Create(ENetComCommandExecutionTimeoutMessage); + end; + except + TMonitor.Enter(PropertyLock); + try + PendingCommandsList.Delete(PendingCommandsList.IndexOf(IDSent)); + finally + TMonitor.Exit(PropertyLock); + end; + raise; + end; + + // We are here because we got the result + // Get the result of the command into the result of this function + TMonitor.Enter(PropertyLock); + try + PendingNdx := PendingCommandsList.IndexOf(IDSent); + try + Command := PendingCommandsList.Results[PendingNdx]; + if Command.ResultIsErrorString then + raise ENetComResultIsException.Create(StringOf(Command.Data)) + else + Result := Command.Data; + finally + PendingCommandsList.Delete(PendingNdx); + end; + finally + TMonitor.Exit(PropertyLock); + end; + finally + ReceivedResultEvent.Free; // Event not needed any more + end; +end; + +// This is run in the reader's thread context +procedure TncSourceBase.HandleReceivedCommand(aLine: TncSourceLine; const aCommandBytes: TBytes); +var + Command: TncCommand; + HandleCommandThread: THandleCommandThread; + PendingNdx: Integer; +begin + Command.FromBytes(aCommandBytes); + case Command.CommandType of + ctInitiator: + begin + // Handle the command from the thread pool + TMonitor.Enter(HandleCommandThreadPool); + try + HandleCommandThread := THandleCommandThread(HandleCommandThreadPool.RequestReadyThread); + HandleCommandThread.WorkType := htwtOnHandleCommand; + HandleCommandThread.OnHandleCommand := OnHandleCommand; + HandleCommandThread.Source := Self; + HandleCommandThread.Line := aLine; + HandleCommandThread.Command := Command; + HandleCommandThreadPool.RunRequestedThread(HandleCommandThread); + finally + TMonitor.Exit(HandleCommandThreadPool); + end; + end; + ctResponse: + if Command.AsyncExecute then + begin + // Handle the command from the thread pool + TMonitor.Enter(HandleCommandThreadPool); + try + HandleCommandThread := THandleCommandThread(HandleCommandThreadPool.RequestReadyThread); + HandleCommandThread.WorkType := htwtAsyncResponse; + HandleCommandThread.OnAsyncExecCommandResult := OnAsyncExecCommandResult; + HandleCommandThread.Source := Self; + HandleCommandThread.Line := aLine; + HandleCommandThread.Command := Command; + HandleCommandThreadPool.RunRequestedThread(HandleCommandThread); + finally + TMonitor.Exit(HandleCommandThreadPool); + end; + end + else + begin + TMonitor.Enter(PropertyLock); + try + // Find the event to set from the PendingCommandsList + PendingNdx := PendingCommandsList.IndexOf(Command.UniqueID); + // We may not find a pending command as the ExecCommand may have + // timed out, so do nothing in that case + if PendingNdx <> -1 then + begin + PendingCommandsList.Results[PendingNdx] := Command; + PendingCommandsList.ReceivedResultEvents[PendingNdx].SetEvent; + end; + finally + TMonitor.Exit(PropertyLock); + end; + end; + end; +end; + +// Only from one thread called here, the reader thread, or the main vcl +procedure TncSourceBase.SocketReadData(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer); +var + Line: TncSourceLine; + MagicInt: TMagicHeaderType; + Ofs, BytesToRead, MesLen: UInt64; +begin + // From SocketProcess from + Line := TncSourceLine(aLine); + + Ofs := 0; + while Ofs < aBufCount do + begin + if Line.BytesToEndOfMessage > 0 then + begin + BytesToRead := Min(Line.BytesToEndOfMessage, UInt64(aBufCount) - Ofs); + + // Add to MessageData, BytesToRead from aBuf [Ofs] + MesLen := Length(Line.MessageData); + SetLength(Line.MessageData, MesLen + BytesToRead); + move(aBuf[Ofs], Line.MessageData[MesLen], BytesToRead); + + Ofs := Ofs + BytesToRead; + + Line.BytesToEndOfMessage := Line.BytesToEndOfMessage - BytesToRead; + end; + + if Line.BytesToEndOfMessage = 0 then + begin + if Length(Line.MessageData) > 0 then + try + try + // Get message data uncompressed and unencrypted + if Compression <> zcNone then + Line.MessageData := DecompressBytes(Line.MessageData); + if Encryption <> etNoEncryption then + Line.MessageData := DecryptBytes(Line.MessageData, EncryptionKey, Encryption, EncryptOnHashedKey, False); + + HandleReceivedCommand(Line, Line.MessageData); + finally + // Dispose MessageData, we are complete + SetLength(Line.MessageData, 0); + end; + except + end; + + // Read a character + if Ofs < aBufCount then + begin + if Length(Line.HeaderBytes) < SizeOf(TMagicHeaderType) + SizeOf(UInt64) then + begin + SetLength(Line.HeaderBytes, Length(Line.HeaderBytes) + 1); + + Line.HeaderBytes[High(Line.HeaderBytes)] := aBuf[Ofs]; + Inc(Ofs); + end + else + begin + MagicInt := PMagicHeaderType(@Line.HeaderBytes[0])^; + if MagicInt <> MagicHeader then + begin + SetLength(Line.HeaderBytes, 0); + Dec(Ofs, SizeOf(TMagicHeaderType) + SizeOf(UInt64) - 1); + end + else + begin + // If a whole integer is read, prepare to read message + Line.BytesToEndOfMessage := PUint64(@Line.HeaderBytes[SizeOf(TMagicHeaderType)])^; + SetLength(Line.HeaderBytes, 0); + end; + end; + end; + end; // if Line.BytesToEndOfMessage = 0 + end; // while Ofs < aBufCount +end; + +function TncSourceBase.GetActive: Boolean; +begin + Result := Socket.Active; +end; + +procedure TncSourceBase.SetActive(const Value: Boolean); +begin + if csLoading in ComponentState then + WasSetActive := Value + else + Socket.Active := Value; +end; + +function TncSourceBase.GetFamily: TAddressType; +begin + Result := Socket.Family; +end; + +procedure TncSourceBase.SetFamily(const Value: TAddressType); +begin + Socket.Family := Value; +end; + +function TncSourceBase.GetKeepAlive: Boolean; +begin + Result := Socket.KeepAlive; +end; + +procedure TncSourceBase.SetKeepAlive(const Value: Boolean); +begin + Socket.KeepAlive := Value; +end; + +function TncSourceBase.GetNoDelay: Boolean; +begin + Result := Socket.NoDelay; +end; + +procedure TncSourceBase.SetNoDelay(const Value: Boolean); +begin + Socket.NoDelay := Value; +end; + +function TncSourceBase.GetPort: Integer; +begin + Result := Socket.Port; +end; + +procedure TncSourceBase.SetPort(const Value: Integer); +begin + Socket.Port := Value; +end; + +function TncSourceBase.GetReaderThreadPriority: TncThreadPriority; +begin + Result := Socket.ReaderThreadPriority; +end; + +procedure TncSourceBase.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + Socket.ReaderThreadPriority := Value; +end; + +function TncSourceBase.GetExecCommandTimeout: Cardinal; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandExecTimeout; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetExecCommandTimeout(const Value: Cardinal); +begin + TMonitor.Enter(PropertyLock); + try + FCommandExecTimeout := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetCommandProcessorThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreadPriority; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetCommandProcessorThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreadPriority := Value; + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetThreadPriority(Value); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetCommandProcessorThreads: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreads; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetCommandProcessorThreads(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreads := Value; + if Value <> 0 then + FCommandProcessorThreadsPerCPU := 0; + + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetExecThreads(Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetCommandProcessorThreadsPerCPU: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreadsPerCPU; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetCommandProcessorThreadsPerCPU(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreadsPerCPU := Value; + if Value <> 0 then + FCommandProcessorThreads := 0; + + if not(csLoading in ComponentState) then + HandleCommandThreadPool.SetExecThreads(Max(1, Max(FCommandProcessorThreads, GetNumberOfProcessors * FCommandProcessorThreadsPerCPU)), + FCommandProcessorThreadPriority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetCommandProcessorThreadsGrowUpto: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCommandProcessorThreadsGrowUpto; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetCommandProcessorThreadsGrowUpto(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FCommandProcessorThreadsGrowUpto := Value; + HandleCommandThreadPool.GrowUpto := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetEventsUseMainThread: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEventsUseMainThread; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetEventsUseMainThread(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FEventsUseMainThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetCompression: TZCompressionLevel; +begin + TMonitor.Enter(PropertyLock); + try + Result := FCompression; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetCompression(const Value: TZCompressionLevel); +begin + TMonitor.Enter(PropertyLock); + try + FCompression := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetEncryption: TEncryptorType; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEncryption; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetEncryption(const Value: TEncryptorType); +begin + TMonitor.Enter(PropertyLock); + try + FEncryption := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetEncryptionKey: AnsiString; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEncryptionKey; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetEncryptionKey(const Value: AnsiString); +begin + TMonitor.Enter(PropertyLock); + try + FEncryptionKey := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetEncryptOnHashedKey: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FEncryptOnHashedKey; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncSourceBase.SetEncryptOnHashedKey(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FEncryptOnHashedKey := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncSourceBase.GetComponentName: string; +begin + Result := Name; +end; + +function TncSourceBase.GetOnConnected: TncOnSourceConnectDisconnect; +begin + Result := FOnConnected; +end; + +procedure TncSourceBase.SetOnConnected(const Value: TncOnSourceConnectDisconnect); +begin + FOnConnected := Value; +end; + +function TncSourceBase.GetOnDisconnected: TncOnSourceConnectDisconnect; +begin + Result := FOnDisconnected; +end; + +procedure TncSourceBase.SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); +begin + FOnDisconnected := Value; +end; + +function TncSourceBase.GetOnHandleCommand: TncOnSourceHandleCommand; +begin + Result := FOnHandleCommand; +end; + +procedure TncSourceBase.SetOnHandleCommand(const Value: TncOnSourceHandleCommand); +begin + FOnHandleCommand := Value; +end; + +function TncSourceBase.GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; +begin + Result := FOnAsyncExecCommandResult; +end; + +procedure TncSourceBase.SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); +begin + FOnAsyncExecCommandResult := Value; +end; + +{ THandleCommandThread } + +procedure THandleCommandThread.CallOnAsyncEvents; +begin + if Assigned(CommandHandler.OnAsyncExecCommandResult) then + + CommandHandler.OnAsyncExecCommandResult( + + Source, Line, + + Command.Cmd, Command.Data, + + Command.ResultIsErrorString, + + Command.SourceComponentHandler, Command.PeerComponentHandler); +end; + +procedure THandleCommandThread.CallOnHandleEvents; +begin + if Assigned(CommandHandler.OnHandleCommand) then + try + Command.Data := CommandHandler.OnHandleCommand( + + Source, Line, + + Command.Cmd, Command.Data, Command.RequiresResult, + + Command.SourceComponentHandler, Command.PeerComponentHandler); + + Command.ResultIsErrorString := False; + except + on E: Exception do + begin + Command.ResultIsErrorString := True; + Command.Data := BytesOf(E.ClassName + ' error: ' + E.Message); + end; + end + else + SetLength(Command.Data, 0); +end; + +procedure THandleCommandThread.ProcessEvent; +var + i: Integer; +begin + // Find which command handler handles the events + CommandHandler := nil; + for i := 0 to High(Source.CommandHandlers) do + if Source.CommandHandlers[i].GetComponentName = Command.PeerComponentHandler then + begin + CommandHandler := Source.CommandHandlers[i]; + Break; + end; + if not Assigned(CommandHandler) then + Source.GetInterface(IncCommandHandler, CommandHandler); + + case WorkType of + htwtAsyncResponse: + if Source.EventsUseMainThread then + Synchronize(CallOnAsyncEvents) + else + CallOnAsyncEvents; + htwtOnHandleCommand: + begin + Command.ResultIsErrorString := False; + + if Source.EventsUseMainThread then + Synchronize(CallOnHandleEvents) + else + CallOnHandleEvents; + + // Send the response + if Command.RequiresResult then + begin + Command.CommandType := ctResponse; + Source.WriteCommand(Line, Command); + end; + end; + end; +end; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncClientSource } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +type + TncTCPClientSourceSocket = class(TncTCPClient) + protected + function CreateLineObject: TncLine; override; + end; + +function TncTCPClientSourceSocket.CreateLineObject: TncLine; +begin + Result := TncSourceLine.Create; + TncSourceLine(Result).SetKind(stTCP); +end; + +constructor TncClientSource.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FOnReconnected := nil; + + Socket := TncTCPClientSourceSocket.Create(nil); + Socket.Family := afIPv4; // Set default family + Socket.Port := DefPort; + Socket.NoDelay := DefNoDelay; + Socket.EventsUseMainThread := False; + Socket.OnConnected := SocketConnected; + Socket.OnDisconnected := SocketDisconnected; + Socket.OnReadData := SocketReadData; + TncTCPClient(Socket).OnReconnected := SocketReconnected; +end; + +destructor TncClientSource.Destroy; +begin + Socket.Free; + inherited Destroy; +end; + +function TncClientSource.GetLine: TncLine; +begin + Result := TncTCPClient(Socket).Line; +end; + +procedure TncClientSource.WriteMessage(aLine: TncSourceLine; const aBuf: TBytes); +begin + Active := True; + inherited WriteMessage(aLine, aBuf); +end; + +function TncClientSource.ExecCommand( + + const aCmd: Integer; const aData: TBytes = nil; + + const aRequiresResult: Boolean = True; const aAsyncExecute: Boolean = False; + + const aPeerComponentHandler: string = ''; const aSourceComponentHandler: string = ''): TBytes; +begin + if not Active then + Active := True; + + Result := ExecCommand(TncSourceLine(GetLine), aCmd, aData, aRequiresResult, aAsyncExecute, aPeerComponentHandler, aSourceComponentHandler); +end; + +function TncClientSource.GetHost: string; +begin + Result := TncTCPClient(Socket).Host; +end; + +procedure TncClientSource.SetHost(const Value: string); +begin + TncTCPClient(Socket).Host := Value; +end; + +function TncClientSource.GetReconnect: Boolean; +begin + Result := TncTCPClient(Socket).Reconnect; +end; + +procedure TncClientSource.SetReconnect(const Value: Boolean); +begin + TncTCPClient(Socket).Reconnect := Value; +end; + +function TncClientSource.GetReconnectInterval: Cardinal; +begin + Result := TncTCPClient(Socket).ReconnectInterval; +end; + +procedure TncClientSource.SetReconnectInterval(const Value: Cardinal); +begin + TncTCPClient(Socket).ReconnectInterval := Value; +end; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncServerSource } +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +type + TncTCPServerSourceSocket = class(TncTCPServer) + protected + function CreateLineObject: TncLine; override; + end; + +function TncTCPServerSourceSocket.CreateLineObject: TncLine; +begin + Result := TncSourceLine.Create; + TncSourceLine(Result).SetKind(stTCP); +end; + +constructor TncServerSource.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Socket := TncTCPServerSourceSocket.Create(nil); + Socket.Family := afIPv4; // Set default family + Socket.NoDelay := DefNoDelay; + Socket.Port := DefPort; + Socket.EventsUseMainThread := False; + Socket.OnConnected := SocketConnected; + Socket.OnDisconnected := SocketDisconnected; + Socket.OnReadData := SocketReadData; +end; + +destructor TncServerSource.Destroy; +begin + Socket.Free; + inherited Destroy; +end; + +function TncServerSource.GetLines: TThreadLineList; +begin + Result := TncTCPServer(Socket).Lines; +end; + +procedure TncServerSource.ShutDownLine(aLine: TncLine); +begin + TncTCPServer(Socket).ShutDownLine(aLine); +end; + +end. + + diff --git a/Source_using_TMonitor/ncThreads.pas b/Source_using_TMonitor/ncThreads.pas new file mode 100644 index 0000000..3130bab --- /dev/null +++ b/Source_using_TMonitor/ncThreads.pas @@ -0,0 +1,447 @@ +unit ncThreads; + +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// Written by Demos Bill, 17 Nov 2009 +// +// ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +// To disable as much of RTTI as possible (Delphi 2009/2010), +// Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} +{$WARN SYMBOL_PLATFORM OFF} + +interface + +uses +{$IFDEF MSWINDOWS} + WinApi.Windows, WinApi.ActiveX, +{$ENDIF} + System.Classes, System.SyncObjs, System.SysUtils; + +type + TncThreadPriority = (ntpIdle, ntpLowest, ntpLower, ntpNormal, ntpHigher, ntpHighest, ntpTimeCritical); + + // The thread waits for the wakeup event to start processing + // after the its ready event is set. + // After processing is complete, it sets again the ready event and waits + // again for the WakeUpEvent to be set. + TncReadyThread = class(TThread) + public + WakeupEvent, ReadyEvent: TEvent; + constructor Create; + destructor Destroy; override; + procedure Execute; override; + procedure ProcessEvent; virtual; abstract; + + function IsReady: Boolean; + function WaitForReady(aTimeOut: Cardinal = Infinite): TWaitResult; + procedure Run; + end; + + TncReadyThreadClass = class of TncReadyThread; + + // TncThreadPool is a thread pool of TncCommandExecThread that manages + // to assign a job with AddJob to a waiting thread. + // This Thread pool works as: + // Request a ready thread from it, with RequestReadyThread + // Set its data (normally this thread is a descendant of TncReadyThread with appropriate data fields + // Call RunRequestedThread to tell it to run its ProcessEvent + + TncThreadPool = class + private + FGrowUpto: Integer; + function GetGrowUpto: Integer; + procedure SetGrowUpto(const Value: Integer); + private + ThreadClass: TncReadyThreadClass; + procedure ShutDown; + protected + Threads: array of TncReadyThread; + public + constructor Create(aWorkerThreadClass: TncReadyThreadClass); + destructor Destroy; override; + function RequestReadyThread: TncReadyThread; + procedure RunRequestedThread(aRequestedThread: TncReadyThread); + + procedure SetExecThreads(aThreadCount: Integer; aThreadPriority: TncThreadPriority); + procedure SetThreadPriority(aPriority: TncThreadPriority); + + function GetThreadCount: Integer; + function GetActiveThreadCount: Integer; + + property GrowUpto: Integer read GetGrowUpto write SetGrowUpto; + end; + +function GetNumberOfProcessors: Integer; inline; +{$IFDEF MSWINDOWS} +function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): TThreadPriority; inline; +function ToNCThreadPriority(aThreadPriority: TThreadPriority): TncThreadPriority; inline; +{$ELSE} +function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): Integer; inline; +function ToNCThreadPriority(aThreadPriority: Integer): TncThreadPriority; inline; +{$ENDIF} + +implementation + +// ***************************************************************************** +// Helper functions +// ***************************************************************************** + +function GetNumberOfProcessors: Integer; +{$IFDEF MSWINDOWS} +var + lpSystemInfo: TSystemInfo; + i: Integer; +begin + Result := 0; + try + GetSystemInfo(lpSystemInfo); + for i := 0 to lpSystemInfo.dwNumberOfProcessors - 1 do + if lpSystemInfo.dwActiveProcessorMask or (1 shl i) <> 0 then + Result := Result + 1; + finally + if Result < 1 then + Result := 1; + end; +end; +{$ELSE} + +begin + Result := TThread.ProcessorCount; +end; +{$ENDIF} +{$IFDEF MSWINDOWS} + +function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): TThreadPriority; +begin + case ancThreadPriority of + ntpIdle: + Result := tpIdle; + ntpLowest: + Result := tpLowest; + ntpLower: + Result := tpLower; + ntpHigher: + Result := tpHigher; + ntpHighest: + Result := tpHighest; + ntpTimeCritical: + Result := tpTimeCritical; + else + Result := tpNormal; + end; +end; + +function ToNCThreadPriority(aThreadPriority: TThreadPriority): TncThreadPriority; +begin + case aThreadPriority of + tpIdle: + Result := ntpIdle; + tpLowest: + Result := ntpLowest; + tpLower: + Result := ntpLower; + tpHigher: + Result := ntpHigher; + tpHighest: + Result := ntpHighest; + tpTimeCritical: + Result := ntpTimeCritical; + else + Result := ntpNormal; + end; +end; +{$ELSE} + +function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): Integer; +begin + case ancThreadPriority of + ntpIdle: + Result := 19; + ntpLowest: + Result := 13; + ntpLower: + Result := 7; + ntpHigher: + Result := -7; + ntpHighest: + Result := -13; + ntpTimeCritical: + Result := -19; + else + Result := 0; + end; +end; + +function ToNCThreadPriority(aThreadPriority: Integer): TncThreadPriority; +begin + case aThreadPriority of + 14 .. 19: + Result := ntpIdle; + 8 .. 13: + Result := ntpLowest; + 3 .. 7: + Result := ntpLower; + -7 .. -3: + Result := ntpHigher; + -13 .. -8: + Result := ntpHighest; + -19 .. -14: + Result := ntpTimeCritical; + else + Result := ntpNormal; + end; +end; +{$ENDIF} +// ***************************************************************************** +{ TncReadyThread } +// ***************************************************************************** + +constructor TncReadyThread.Create; +begin + WakeupEvent := TEvent.Create; + ReadyEvent := TEvent.Create; + inherited Create(False); +end; + +destructor TncReadyThread.Destroy; +begin + ReadyEvent.Free; + WakeupEvent.Free; + inherited Destroy; +end; + +procedure TncReadyThread.Execute; +begin +{$IFDEF MSWINDOWS} + CoInitialize(nil); +{$ENDIF} + try + while True do + begin + ReadyEvent.SetEvent; + WakeupEvent.WaitFor(Infinite); + ReadyEvent.ResetEvent; + WakeupEvent.ResetEvent; // Next loop will wait again + + if Terminated then + Break; // Exit main loop + try + ProcessEvent; + except + end; + if Terminated then + Break; // Exit main loop + end; // Exiting main loop terminates thread + ReadyEvent.SetEvent; + finally +{$IFDEF MSWINDOWS} + CoUninitialize; +{$ENDIF} + end; +end; + +function TncReadyThread.IsReady: Boolean; +begin + Result := ReadyEvent.WaitFor(0) = wrSignaled; +end; + +function TncReadyThread.WaitForReady(aTimeOut: Cardinal = Infinite): TWaitResult; +begin + Result := ReadyEvent.WaitFor(aTimeOut); +end; + +procedure TncReadyThread.Run; +begin + ReadyEvent.ResetEvent; + WakeupEvent.SetEvent; +end; + +// ***************************************************************************** +{ TncThreadPool } +// ***************************************************************************** + +constructor TncThreadPool.Create(aWorkerThreadClass: TncReadyThreadClass); +begin + ThreadClass := aWorkerThreadClass; + FGrowUpto := 500; // can reach up to 500 threads by default +end; + +destructor TncThreadPool.Destroy; +begin + ShutDown; + inherited; +end; + +function TncThreadPool.RequestReadyThread: TncReadyThread; +var + i: Integer; +begin + // Keep repeating until a ready thread is found + repeat + for i := 0 to High(Threads) do + begin + if Threads[i].ReadyEvent.WaitFor(0) = wrSignaled then + begin + Threads[i].ReadyEvent.ResetEvent; + Result := Threads[i]; + Exit; + end; + end; + // We will get here if no threads were ready + if (Length(Threads) < FGrowUpto) then + begin + // Create a new thread to handle commands + i := Length(Threads); + SetLength(Threads, i + 1); // i now holds High(Threads) + try + Threads[i] := ThreadClass.Create; + except + // Cannot create any new thread + // Set length back to what it was, and continue waiting until + // any other thread is ready + SetLength(Threads, i); + Continue; + end; + Threads[i].Priority := Threads[0].Priority; + if Threads[i].ReadyEvent.WaitFor(1000) = wrSignaled then + begin + Threads[i].ReadyEvent.ResetEvent; + Result := Threads[i]; + Exit; + end; + end + else + TThread.Yield; // Was Sleep(1); + until False; +end; + +// Between requesting a ready thread and executing it, we normally fill in +// the thread's data (would be a descendant that we need to fill known data to work with) +procedure TncThreadPool.RunRequestedThread(aRequestedThread: TncReadyThread); +begin + aRequestedThread.WakeupEvent.SetEvent; +end; + +procedure TncThreadPool.SetExecThreads(aThreadCount: Integer; aThreadPriority: TncThreadPriority); +var + i: Integer; +begin + // Terminate any not needed threads + if aThreadCount < Length(Threads) then + begin + for i := aThreadCount to High(Threads) do + try + Threads[i].Terminate; + Threads[i].WakeupEvent.SetEvent; + except + end; + for i := aThreadCount to high(Threads) do + try + Threads[i].WaitFor; + Threads[i].Free; + except + end; + end; + + // Reallocate thread count + SetLength(Threads, aThreadCount); + + for i := 0 to high(Threads) do + if Threads[i] = nil then + begin + Threads[i] := ThreadClass.Create; + Threads[i].Priority := FromNCThreadPriority(aThreadPriority); + end + else + Threads[i].Priority := FromNCThreadPriority(aThreadPriority); +end; + +procedure TncThreadPool.SetThreadPriority(aPriority: TncThreadPriority); +var + i: Integer; +begin + for i := 0 to high(Threads) do + try + Threads[i].Priority := FromNCThreadPriority(aPriority); + except + // Sone android devices do not like this + end; +end; + +procedure TncThreadPool.ShutDown; +var + i: Integer; +begin + for i := 0 to high(Threads) do + try + Threads[i].Terminate; + Threads[i].WakeupEvent.SetEvent; + except + end; + + for i := 0 to high(Threads) do + try + Threads[i].WaitFor; + Threads[i].Free; + except + end; +end; + +function TncThreadPool.GetGrowUpto: Integer; +begin + TMonitor.Enter(Self); + try + Result := FGrowUpto; + finally + TMonitor.Exit(Self); + end; +end; + +procedure TncThreadPool.SetGrowUpto(const Value: Integer); +begin + TMonitor.Enter(Self); + try + FGrowUpto := Value; + finally + TMonitor.Exit(Self); + end; +end; + +function TncThreadPool.GetThreadCount: Integer; +begin + TMonitor.Enter(Self); + try + Result := Length(Threads); + finally + TMonitor.Exit(Self); + end; +end; + +function TncThreadPool.GetActiveThreadCount: Integer; +var + i: Integer; +begin + TMonitor.Enter(Self); + try + Result := 0; + for i := 0 to High(Threads) do + begin + if Assigned(Threads[i]) and (Threads[i].ReadyEvent.WaitFor(0) <> wrSignaled) then + Inc(Result); + end; + finally + TMonitor.Exit(Self); + end; +end; + +end. diff --git a/Source_using_TMonitor/ncUDPSockets.pas b/Source_using_TMonitor/ncUDPSockets.pas new file mode 100644 index 0000000..2dd9da9 --- /dev/null +++ b/Source_using_TMonitor/ncUDPSockets.pas @@ -0,0 +1,1098 @@ +unit ncUDPSockets; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - UDP Socket Components +// +// This unit implements UDP Server and UDP Client components +// +// 14/1/2025 +// - Initial creation +// Currently implemented : +// - Broadcast +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, + ncLines, ncSocketList, ncThreads, ncIPUtils; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 64 * 1024; // 64KB default for UDP + DefReaderThreadPriority = ntpNormal; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefBroadcast = False; + DefFamily = afIPv4; + +resourcestring + ECannotSetPortWhileSocketActiveStr = 'Cannot set Port property while socket is active'; + ECannotSetHostWhileSocketActiveStr = 'Cannot set Host property while socket is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileSocketActiveStr = 'Cannot set UseReaderThread property while socket is active'; + ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnReadDatagram event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; +type + EPropertySetError = class(Exception); + + // Event types for UDP + TncOnDatagramEvent = procedure(Sender: TObject; aLine: TncLine;const aBuf: TBytes; aBufCount: Integer;const SenderAddr: TSockAddrStorage) of object; + + + // Base UDP Socket class + TncUDPBase = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FBroadcast: Boolean; + FLine: TncLine; + FReadBufferLen: Integer; + FOnReadDatagram: TncOnDatagramEvent; + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetBroadcast: Boolean; + procedure SetBroadcast(const Value: Boolean); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock: TObject; // TMonitor synchronization object + ReadBuf: TBytes; + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetLine: TncLine; virtual; abstract; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property Broadcast: Boolean read GetBroadcast write SetBroadcast default DefBroadcast; + property OnReadDatagram: TncOnDatagramEvent read FOnReadDatagram write FOnReadDatagram; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + published + end; + + // UDP Client implementation + TncUDPClientProcessor = class; + + TncCustomUDPClient = class(TncUDPBase) + private + FHost: string; + function GetActive: Boolean; override; + procedure SetHost(const Value: string); + function GetHost: string; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + procedure Send(const aBuf; aBufSize: Integer); overload; + procedure Send(const aBytes: TBytes); overload; + procedure Send(const aStr: string); overload; + function Receive(aTimeout: Cardinal = 2000): TBytes; + property Host: string read GetHost write SetHost; + end; + + TncUDPClient = class(TncCustomUDPClient) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + end; + + TncUDPClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomUDPClient; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomUDPClient); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // UDP Server implementation + TncUDPServerProcessor = class; + + TncCustomUDPServer = class(TncUDPBase) + private + function GetActive: Boolean; override; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + function Receive(aTimeout: Cardinal = 2000): TBytes; + end; + + TncUDPServer = class(TncCustomUDPServer) + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + end; + + TncUDPServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomUDPServer; + public + ReadySockets: TSocketHandleArray; + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomUDPServer); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + +implementation + +{ TncUDPBase } + +constructor TncUDPBase.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TObject.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FBroadcast := DefBroadcast; + FReadBufferLen := DefReadBufferLen; + FOnReadDatagram := nil; + + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncUDPBase.Kind: TSocketType; +begin + Result := stUDP; +end; + +destructor TncUDPBase.Destroy; +begin + PropertyLock.Free; + inherited Destroy; +end; + +procedure TncUDPBase.Loaded; +begin + inherited Loaded; + if FInitActive then + DoActivate(True); +end; + +function TncUDPBase.CreateLineObject: TncLine; +begin + Result := TncLine.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); +end; + +procedure TncUDPBase.SetActive(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + if not(csLoading in ComponentState) then + DoActivate(Value); + FInitActive := GetActive; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBase.GetFamily: TAddressType; +begin + TMonitor.Enter(PropertyLock); + try + Result := FFamily; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBase.SetFamily(const Value: TAddressType); +begin + if not(csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create + (ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + TMonitor.Enter(PropertyLock); + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBase.GetPort: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPort; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBase.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FPort := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBase.GetReaderThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBase.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBase.GetBroadcast: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FBroadcast; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBase.SetBroadcast(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FBroadcast := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBase.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FUseReaderThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBase.GetReadBufferLen: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReadBufferLen; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBase.SetReadBufferLen(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +{ TncCustomUDPClient } + +constructor TncCustomUDPClient.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FHost := DefHost; + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPClientProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPClient.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPClient.GetLine: TncLine; +begin + Result := Line; +end; + +procedure TncCustomUDPClient.DoActivate(aActivate: Boolean); +begin + // Exit if socket is already in requested state + if aActivate = GetActive then + Exit; + + if aActivate then + begin + try + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // Create socket handle and establish connection + TncLineInternal(Line).CreateClientHandle(FHost, FPort, GetBroadcast); + + // Enable broadcast mode if requested + if GetBroadcast then + TncLineInternal(Line).EnableBroadcast; + + // Configure socket buffer sizes for optimal performance + try + TncLineInternal(Line).SetReceiveSize(GetReadBufferLen); + TncLineInternal(Line).SetWriteSize(GetReadBufferLen); + except + on E: Exception do + begin + TncLineInternal(Line).DestroyHandle; + raise; + end; + end; + + // Initialize socket handle array for reading + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + // Start reader thread if enabled + if UseReaderThread then + LineProcessor.Run; + except + on E: Exception do + begin + // Clean up on activation failure + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + raise; + end; + end; + end + else + begin + // Clean up when deactivating + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +function TncCustomUDPClient.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomUDPClient.GetHost: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FHost; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomUDPClient.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FHost := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomUDPClient.Send(const aBuf; aBufSize: Integer); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + case Family of + afIPv4: + begin + if GetBroadcast then + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(FPort); + + // Use Winsock API directly for IPv4 broadcast + var addr := inet_addr(PAnsiChar(AnsiString(FHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendTo(aBuf, aBufSize, storage); + end + else + TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + end; + + afIPv6: + begin + if GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.') + else if FHost = '' then + raise Exception.Create('Host address cannot be empty for IPv6') + else + begin + // Validate IPv6 address format + if not TncIPUtils.IsIPv6ValidAddress(FHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(FPort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(FHost) then + begin + var scopePos := Pos('%', FHost); + if scopePos > 0 then + begin + var hostAddr := Copy(FHost, 1, scopePos - 1); + var scope := Copy(FHost, scopePos + 1, Length(FHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + // Convert the address part without scope ID + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendTo(aBuf, aBufSize, storage); + end; + end; + end; +end; + +procedure TncCustomUDPClient.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomUDPClient.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPClient.SendTo(const aBuf; aBufSize: Integer; + const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPClient.SendTo(const aBytes: TBytes; + const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPClient.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPClient.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPClientProcessor } + +constructor TncUDPClientProcessor.Create(aClientSocket: TncCustomUDPClient); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncUDPClientProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; +begin + // Initialize sender address structure + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + // Receive datagram with proper address structure + BufRead := recvfrom(FClientSocket.Line.Handle, + FClientSocket.ReadBuf[0], + Length(FClientSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if (BufRead > 0) and Assigned(FClientSocket.OnReadDatagram) then + try + FClientSocket.OnReadDatagram(FClientSocket, + FClientSocket.Line, + FClientSocket.ReadBuf, + BufRead, + SenderAddr); + except + end; +end; + +procedure TncUDPClientProcessor.ProcessEvent; +begin + while (not Terminated) do + try + if FClientSocket.Line.Active then + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(ProcessDatagram) + else + ProcessDatagram; + end; + end + else + Exit; + except + // Continue processing even after errors + end; +end; + +{ TncCustomUDPServer } + +constructor TncCustomUDPServer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPServerProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPServer.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPServer.GetLine: TncLine; +begin + Result := Line; +end; + +function TncCustomUDPServer.GetActive: Boolean; +begin + Result := Line.Active; +end; + +procedure TncCustomUDPServer.DoActivate(aActivate: Boolean); +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // CreateServerHandle will bind to all interfaces (0.0.0.0) + // through the AI_PASSIVE flag in ncLines.CreateServerHandle + TncLineInternal(Line).CreateServerHandle(FPort); + + // Enable broadcast if needed + if Broadcast then + TncLineInternal(Line).EnableBroadcast; + + // Set socket buffer sizes for better performance + try + TncLineInternal(Line).SetReceiveSize(ReadBufferLen); + TncLineInternal(Line).SetWriteSize(ReadBufferLen); + except + // Ignore buffer size errors + end; + + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPServer.SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPServer.SendTo(const aBytes: TBytes; const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPServer.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPServer.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPServerProcessor } + +constructor TncUDPServerProcessor.Create(aServerSocket: TncCustomUDPServer); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + + +procedure TncUDPServerProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; +begin + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(FServerSocket.Line.Handle, + FServerSocket.ReadBuf[0], + Length(FServerSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if (BufRead > 0) and Assigned(FServerSocket.OnReadDatagram) then + try + FServerSocket.OnReadDatagram(FServerSocket, FServerSocket.Line, + FServerSocket.ReadBuf, BufRead, SenderAddr); + except + end; +end; + +procedure TncUDPServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + Synchronize(ProcessDatagram); + end; + except + end + else + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + ProcessDatagram; + end; + except + end; +end; + +end. + diff --git a/Source_using_TMonitor/ncUDPSocketsDual.pas b/Source_using_TMonitor/ncUDPSocketsDual.pas new file mode 100644 index 0000000..1d28e43 --- /dev/null +++ b/Source_using_TMonitor/ncUDPSocketsDual.pas @@ -0,0 +1,1999 @@ +unit ncUDPSocketsDual; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - UDP Socket Components (Dual Mode - Raw + Protocol) +// +// This unit implements UDP Server and UDP Client components with both +// raw UDP support and lightweight command protocol support +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// 23/07/2025 +// - Lightweight Command Protocol (LCP) +// - Auto-chunking for large data +// 14/1/2025 +// - Initial creation +// Currently implemented : +// - Broadcast +// - Raw UDP communication +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, System.DateUtils, + ncLines, ncSocketList, ncThreads, ncIPUtils, System.Generics.Collections; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 64 * 1024; // 64KB default for UDP + DefReaderThreadPriority = ntpNormal; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefBroadcast = False; + DefFamily = afIPv4; + + // UDP Performance constants + UDP_COMMAND_MAGIC = $4E43; // 'NC' + UDP_CHUNK_MAGIC = $4E44; // 'ND' signature for chunk packets + UDP_MAX_SAFE_PAYLOAD = 1392; // Optimal MTU (avoids fragmentation) + UDP_CHUNK_TIMEOUT = 5000; // 5 seconds timeout for incomplete transfers + +type + // UDP Command Header Structure + TUdpCommandHeader = packed record + Cmd: Integer; // Command ID (matches ncSocketsPro) + Flags: Byte; // Command flags for future extensibility + Sequence: UInt16; // Sequence number for tracking/ordering + end; + + // Complete UDP Command Packet Structure + TUdpCommandPacket = packed record + Magic: UInt16; // Protocol detection signature + Header: TUdpCommandHeader; // Command header + // Variable data follows after this structure + end; + + // UDP Chunk Header Structure (for auto-chunking large commands) + TUdpChunkHeader = packed record + Magic: UInt16; // Chunk magic signature ($4E44 = 'ND') + TransferID: UInt32; // Unique transfer identifier + ChunkIndex: UInt16; // Current chunk number (0-based) + TotalChunks: UInt16; // Total number of chunks + OriginalCmd: Integer; // Original command ID + OriginalFlags: Byte; // Original command flags + OriginalSequence: UInt16; // Original sequence number + end; + + // Pointer type for zero-copy operations + PUdpChunkHeader = ^TUdpChunkHeader; + + // Chunk reassembly tracking + TChunkTransfer = record + TransferID: UInt32; + OriginalCmd: Integer; + OriginalFlags: Byte; + OriginalSequence: UInt16; + TotalChunks: UInt16; + FragmentsRemaining: UInt16; + LastActivity: TDateTime; + CompleteData: TBytes; // Pre-allocated full buffer + Fragments: array of UInt32; // Bitwise tracking + ActualDataSize: UInt32; // Real size of the complete data (calculated when complete) + LastChunkSize: UInt16; // Size of the last chunk (for accurate total calculation) + + // Helper methods for bitwise operations + function IsFragmentReceived(FragmentIndex: UInt16): Boolean; + procedure SetFragmentReceived(FragmentIndex: UInt16); + end; + + // Chunk transfer manager + TncChunkManager = class + private + FTransfers: TDictionary; // Hash table for O(1) lookup + FLock: TObject; // TMonitor synchronization object + function GenerateTransferID: UInt32; + procedure CleanupExpiredTransfers; + public + constructor Create; + destructor Destroy; override; + function StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; + function CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; + function AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; + function CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; + end; + +resourcestring + ECannotSetPortWhileSocketActiveStr = 'Cannot set Port property while socket is active'; + ECannotSetHostWhileSocketActiveStr = 'Cannot set Host property while socket is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileSocketActiveStr = 'Cannot set UseReaderThread property while socket is active'; + ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnReadDatagram event handler to get the data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; +type + EPropertySetError = class(Exception); + + // Event types for UDP + TncOnDatagramEvent = procedure(Sender: TObject; aLine: TncLine;const aBuf: TBytes; aBufCount: Integer;const SenderAddr: TSockAddrStorage) of object; + + // UDP Command Protocol Event + TncOnUDPCommandEvent = procedure(Sender: TObject; aLine: TncLine; const aSenderAddr: TSockAddrStorage; + aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16) of object; + + + // Base UDP Socket class + TncUDPBaseDual = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FBroadcast: Boolean; + FLine: TncLine; + FReadBufferLen: Integer; + FOnReadDatagram: TncOnDatagramEvent; + FOnCommand: TncOnUDPCommandEvent; + FChunkManager: TncChunkManager; // For auto-chunking large commands + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetBroadcast: Boolean; + procedure SetBroadcast(const Value: Boolean); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock: TObject; // TMonitor synchronization object + ReadBuf: TBytes; + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetLine: TncLine; virtual; abstract; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property Broadcast: Boolean read GetBroadcast write SetBroadcast default DefBroadcast; + property OnReadDatagram: TncOnDatagramEvent read FOnReadDatagram write FOnReadDatagram; + property OnCommand: TncOnUDPCommandEvent read FOnCommand write FOnCommand; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + published + end; + + // UDP Client implementation + TncUDPClientProcessor = class; + + TncCustomUDPClientDual = class(TncUDPBaseDual) + private + FHost: string; + function GetActive: Boolean; override; + procedure SetHost(const Value: string); + function GetHost: string; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + procedure Send(const aBuf; aBufSize: Integer); overload; + procedure Send(const aBytes: TBytes); overload; + procedure Send(const aStr: string); overload; + + // UDP Command Protocol Methods + procedure SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + property Host: string read GetHost write SetHost; + end; + + TncUDPClientDual = class(TncCustomUDPClientDual) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + property OnCommand; + end; + + TncUDPClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomUDPClientDual; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomUDPClientDual); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // UDP Server implementation + TncUDPServerProcessor = class; + + TncCustomUDPServerDual = class(TncUDPBaseDual) + private + function GetActive: Boolean; override; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + + // UDP Command Protocol Methods + procedure SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + end; + + TncUDPServerDual = class(TncCustomUDPServerDual) + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnReadDatagram; + property OnCommand; + end; + + TncUDPServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomUDPServerDual; + public + ReadySockets: TSocketHandleArray; + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomUDPServerDual); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + +implementation + +{ TncUDPBaseDual } + +constructor TncUDPBaseDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TObject.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FBroadcast := DefBroadcast; + FReadBufferLen := DefReadBufferLen; + FOnReadDatagram := nil; + FOnCommand := nil; + FChunkManager := TncChunkManager.Create; // Initialize the chunk manager + + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncUDPBaseDual.Kind: TSocketType; +begin + Result := stUDP; +end; + +destructor TncUDPBaseDual.Destroy; +begin + PropertyLock.Free; + FChunkManager.Free; // Free the chunk manager + inherited Destroy; +end; + +procedure TncUDPBaseDual.Loaded; +begin + inherited Loaded; + if FInitActive then + DoActivate(True); +end; + +function TncUDPBaseDual.CreateLineObject: TncLine; +begin + Result := TncLine.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); +end; + +procedure TncUDPBaseDual.SetActive(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + if not(csLoading in ComponentState) then + DoActivate(Value); + FInitActive := GetActive; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseDual.GetFamily: TAddressType; +begin + TMonitor.Enter(PropertyLock); + try + Result := FFamily; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseDual.SetFamily(const Value: TAddressType); +begin + if not(csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create + (ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + TMonitor.Enter(PropertyLock); + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseDual.GetPort: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPort; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseDual.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FPort := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseDual.GetReaderThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseDual.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseDual.GetBroadcast: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FBroadcast; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseDual.SetBroadcast(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FBroadcast := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseDual.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FUseReaderThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseDual.GetReadBufferLen: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReadBufferLen; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseDual.SetReadBufferLen(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +{ TncCustomUDPClientDual } + +constructor TncCustomUDPClientDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FHost := DefHost; + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPClientProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPClientDual.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPClientDual.GetLine: TncLine; +begin + Result := Line; +end; + +procedure TncCustomUDPClientDual.DoActivate(aActivate: Boolean); +begin + // Exit if socket is already in requested state + if aActivate = GetActive then + Exit; + + if aActivate then + begin + try + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // Create socket handle and establish connection + TncLineInternal(Line).CreateClientHandle(FHost, FPort, GetBroadcast); + + // Enable broadcast mode if requested + if GetBroadcast then + TncLineInternal(Line).EnableBroadcast; + + // Configure socket buffer sizes for optimal performance + try + TncLineInternal(Line).SetReceiveSize(GetReadBufferLen); + TncLineInternal(Line).SetWriteSize(GetReadBufferLen); + except + on E: Exception do + begin + TncLineInternal(Line).DestroyHandle; + raise; + end; + end; + + // Initialize socket handle array for reading + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + // Start reader thread if enabled + if UseReaderThread then + LineProcessor.Run; + except + on E: Exception do + begin + // Clean up on activation failure + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + raise; + end; + end; + end + else + begin + // Clean up when deactivating + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +function TncCustomUDPClientDual.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomUDPClientDual.GetHost: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FHost; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomUDPClientDual.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FHost := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomUDPClientDual.Send(const aBuf; aBufSize: Integer); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + case Family of + afIPv4: + begin + if GetBroadcast then + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(FPort); + + // Use Winsock API directly for IPv4 broadcast + var addr := inet_addr(PAnsiChar(AnsiString(FHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendTo(aBuf, aBufSize, storage); + end + else + TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + end; + + afIPv6: + begin + if GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.') + else if FHost = '' then + raise Exception.Create('Host address cannot be empty for IPv6') + else + begin + // Validate IPv6 address format + if not TncIPUtils.IsIPv6ValidAddress(FHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(FPort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(FHost) then + begin + var scopePos := Pos('%', FHost); + if scopePos > 0 then + begin + var hostAddr := Copy(FHost, 1, scopePos - 1); + var scope := Copy(FHost, scopePos + 1, Length(FHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + // Convert the address part without scope ID + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendTo(aBuf, aBufSize, storage); + end; + end; + end; +end; + +procedure TncCustomUDPClientDual.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomUDPClientDual.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +// UDP Command Protocol Methods for TncCustomUDPClientDual + +procedure TncCustomUDPClientDual.SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +begin + SendCommand(FHost, FPort, aCmd, aData, aFlags, aSequence); +end; + +procedure TncCustomUDPClientDual.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // IPv6 broadcast validation + if (Family = afIPv6) and GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Build destination address first (common for both paths) + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end; + end; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, storage); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, storage); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPClientDual.SendTo(const aBuf; aBufSize: Integer; + const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPClientDual.SendTo(const aBytes: TBytes; + const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPClientDual.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPClientDual.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPClientProcessor } + +constructor TncUDPClientProcessor.Create(aClientSocket: TncCustomUDPClientDual); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncUDPClientProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + // Initialize sender address structure + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + // Receive datagram with proper address structure + BufRead := recvfrom(FClientSocket.Line.Handle, + FClientSocket.ReadBuf[0], + Length(FClientSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FClientSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FClientSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FClientSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FClientSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FClientSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FClientSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end + else + begin + // =============================================== + // RAW DATA PACKET + // =============================================== + if Assigned(FClientSocket.OnReadDatagram) then + try + FClientSocket.OnReadDatagram(FClientSocket, + FClientSocket.Line, + FClientSocket.ReadBuf, + BufRead, + SenderAddr); + except + end; + end; + end + else + begin + // =============================================== + // TOO SMALL - Raw data + // =============================================== + if Assigned(FClientSocket.OnReadDatagram) then + try + FClientSocket.OnReadDatagram(FClientSocket, + FClientSocket.Line, + FClientSocket.ReadBuf, + BufRead, + SenderAddr); + except + end; + end; + end; +end; + +procedure TncUDPClientProcessor.ProcessEvent; +begin + while (not Terminated) do + try + if FClientSocket.Line.Active then + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(ProcessDatagram) + else + ProcessDatagram; + end; + end + else + Exit; + except + // Continue processing even after errors + end; +end; + +{ TncChunkManager } + +constructor TncChunkManager.Create; +begin + inherited Create; + FLock := TObject.Create; + FTransfers := TDictionary.Create; +end; + +destructor TncChunkManager.Destroy; +begin + FLock.Free; + FTransfers.Free; + inherited Destroy; +end; + +function TncChunkManager.GenerateTransferID: UInt32; +begin + // Simple transfer ID generation (timestamp + random) + Result := UInt32(GetTickCount) xor UInt32(Random(65536)); +end; + +procedure TncChunkManager.CleanupExpiredTransfers; +var + Now: TDateTime; + TransferID: UInt32; + Transfer: TChunkTransfer; + ExpiredIDs: TArray; + I: Integer; +begin + Now := System.SysUtils.Now; + SetLength(ExpiredIDs, 0); + + // First pass: identify expired transfers + for Transfer in FTransfers.Values do + begin + if MilliSecondsBetween(Now, Transfer.LastActivity) > UDP_CHUNK_TIMEOUT then + begin + SetLength(ExpiredIDs, Length(ExpiredIDs) + 1); + ExpiredIDs[High(ExpiredIDs)] := Transfer.TransferID; + end; + end; + + // Second pass: remove expired transfers + for I := 0 to High(ExpiredIDs) do + FTransfers.Remove(ExpiredIDs[I]); +end; + +function TncChunkManager.StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + TMonitor.Enter(FLock); + try + CleanupExpiredTransfers; + + Transfer.TransferID := GenerateTransferID; + Transfer.OriginalCmd := ACmd; + Transfer.OriginalFlags := AFlags; + Transfer.OriginalSequence := ASequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := AActualDataSize; // Store the actual data size + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate only maximum needed size (not over-allocate) + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := Transfer.TransferID; + finally + TMonitor.Exit(FLock); + end; +end; + +function TncChunkManager.CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + Result := False; + TMonitor.Enter(FLock); + try + // Check if transfer already exists + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + Result := True; // Already exists + Exit; + end; + + // Create new transfer + Transfer.TransferID := ATransferID; + Transfer.OriginalCmd := AOriginalCmd; + Transfer.OriginalFlags := AOriginalFlags; + Transfer.OriginalSequence := AOriginalSequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := 0; // Will be calculated when all chunks received + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate buffer for maximum possible data size + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := True; + finally + TMonitor.Exit(FLock); + end; +end; + +function TncChunkManager.AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; +var + Transfer: TChunkTransfer; + ChunkOffset: Integer; + DataSize: Integer; + MaxChunkSize: Integer; +begin + Result := False; + DataSize := Length(AChunkData); + + // Quick validation before lock + if DataSize = 0 then Exit; + + // Single lock operation only + TMonitor.Enter(FLock); + try + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + // Transfer exists - add chunk + if (AChunkIndex < Transfer.TotalChunks) and (not Transfer.IsFragmentReceived(AChunkIndex)) then + begin + // Calculate offset once and copy directly + MaxChunkSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + ChunkOffset := AChunkIndex * MaxChunkSize; + + // Direct memory operation + if ChunkOffset + DataSize <= Length(Transfer.CompleteData) then + begin + Move(AChunkData[0], Transfer.CompleteData[ChunkOffset], DataSize); + + // Update tracking + Transfer.SetFragmentReceived(AChunkIndex); + Dec(Transfer.FragmentsRemaining); + Transfer.LastActivity := System.SysUtils.Now; + + // Track last chunk size for accurate total calculation + if AChunkIndex = Transfer.TotalChunks - 1 then + Transfer.LastChunkSize := DataSize; + + // If all chunks received, calculate actual data size + if Transfer.FragmentsRemaining = 0 then + Transfer.ActualDataSize := (Transfer.TotalChunks - 1) * MaxChunkSize + Transfer.LastChunkSize; + + // Update the transfer back to dictionary once + FTransfers.AddOrSetValue(ATransferID, Transfer); + Result := True; + end; + end; + end; + finally + TMonitor.Exit(FLock); + end; +end; + +function TncChunkManager.CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; +var + Transfer: TChunkTransfer; +begin + Result := False; + TMonitor.Enter(FLock); + try + if FTransfers.TryGetValue(ATransferID, Transfer) and (Transfer.FragmentsRemaining = 0) then + begin + // All chunks received - prepare output + ACmd := Transfer.OriginalCmd; + AFlags := Transfer.OriginalFlags; + ASequence := Transfer.OriginalSequence; + + // Use the stored actual data size (from sender) + if Transfer.ActualDataSize > 0 then + begin + SetLength(ACompleteData, Transfer.ActualDataSize); + Move(Transfer.CompleteData[0], ACompleteData[0], Transfer.ActualDataSize); + end + else + SetLength(ACompleteData, 0); + + // Remove completed transfer + FTransfers.Remove(ATransferID); + Result := True; + end; + finally + TMonitor.Exit(FLock); + end; +end; + +{ TChunkTransfer - bitwise fragment tracking } + +function TChunkTransfer.IsFragmentReceived(FragmentIndex: UInt16): Boolean; +begin + if FragmentIndex >= TotalChunks then + begin + Result := False; + Exit; + end; + // Bitwise check: (fragments[fragmentNumber / 32] & (1u << (fragmentNumber % 32))) == 0 + Result := (Fragments[FragmentIndex div 32] and (UInt32(1) shl (FragmentIndex mod 32))) <> 0; +end; + +procedure TChunkTransfer.SetFragmentReceived(FragmentIndex: UInt16); +begin + if FragmentIndex < TotalChunks then + // Bitwise set: fragments[fragmentNumber / 32] |= (1u << (fragmentNumber % 32)) + Fragments[FragmentIndex div 32] := Fragments[FragmentIndex div 32] or (UInt32(1) shl (FragmentIndex mod 32)); +end; + +{ TncCustomUDPServerDual } + +constructor TncCustomUDPServerDual.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPServerProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPServerDual.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPServerDual.GetLine: TncLine; +begin + Result := Line; +end; + +function TncCustomUDPServerDual.GetActive: Boolean; +begin + Result := Line.Active; +end; + +procedure TncCustomUDPServerDual.DoActivate(aActivate: Boolean); +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // CreateServerHandle will bind to all interfaces (0.0.0.0) + // through the AI_PASSIVE flag in ncLines.CreateServerHandle + TncLineInternal(Line).CreateServerHandle(FPort); + + // Enable broadcast if needed + if Broadcast then + TncLineInternal(Line).EnableBroadcast; + + // Set socket buffer sizes for better performance + try + TncLineInternal(Line).SetReceiveSize(ReadBufferLen); + TncLineInternal(Line).SetWriteSize(ReadBufferLen); + except + // Ignore buffer size errors + end; + + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPServerDual.SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPServerDual.SendTo(const aBytes: TBytes; const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPServerDual.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +// UDP Command Protocol Methods for TncCustomUDPServerDual + +procedure TncCustomUDPServerDual.SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, DestAddr); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, DestAddr); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +procedure TncCustomUDPServerDual.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + // IPv6 broadcast validation + if (Family = afIPv6) and Broadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Build destination address based on family + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + end; +end; + +function TncCustomUDPServerDual.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPServerProcessor } + +constructor TncUDPServerProcessor.Create(aServerSocket: TncCustomUDPServerDual); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + + +procedure TncUDPServerProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(FServerSocket.Line.Handle, + FServerSocket.ReadBuf[0], + Length(FServerSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FServerSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FServerSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FServerSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FServerSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FServerSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FServerSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end + else + begin + // =============================================== + // RAW DATA PACKET + // =============================================== + if Assigned(FServerSocket.OnReadDatagram) then + try + FServerSocket.OnReadDatagram(FServerSocket, FServerSocket.Line, + FServerSocket.ReadBuf, BufRead, SenderAddr); + except + end; + end; + end + else + begin + // =============================================== + // TOO SMALL - Raw data + // =============================================== + if Assigned(FServerSocket.OnReadDatagram) then + try + FServerSocket.OnReadDatagram(FServerSocket, FServerSocket.Line, + FServerSocket.ReadBuf, BufRead, SenderAddr); + except + end; + end; + end; +end; + +procedure TncUDPServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + Synchronize(ProcessDatagram); + end; + except + end + else + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + ProcessDatagram; + end; + except + end; +end; + +end. + + + + diff --git a/Source_using_TMonitor/ncUDPSocketsLCP.pas b/Source_using_TMonitor/ncUDPSocketsLCP.pas new file mode 100644 index 0000000..48b35d0 --- /dev/null +++ b/Source_using_TMonitor/ncUDPSocketsLCP.pas @@ -0,0 +1,1941 @@ +unit ncUDPSocketsLCP; +// ///////////////////////////////////////////////////////////////////////////// +// +// NetCom7 Package - UDP Socket Components (LCP Only - Protocol Only) +// +// This unit implements UDP Server and UDP Client components with +// lightweight command protocol support ONLY (no raw UDP support) +// +// 25/07/2025- by J.Pauwels +// - Replace TCriticalSection to TMonitor +// +// 23/07/2025 +// - Removed raw UDP support (OnReadData) +// - Protocol-only implementation +// Currently implemented : +// - Broadcast +// - Lightweight Command Protocol (LCP) ONLY +// - Auto-chunking for large data +// +// Written by J.Pauwels +// +// ///////////////////////////////////////////////////////////////////////////// + + +{$IF CompilerVersion >= 21.0} +{$WEAKLINKRTTI ON} +{$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} +{$ENDIF} + +interface + +uses +{$IFDEF MSWINDOWS} + Winapi.Windows, Winapi.Winsock2, +{$ELSE} + Posix.SysSocket, Posix.Unistd, +{$ENDIF} + System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, System.DateUtils, + ncLines, ncSocketList, ncThreads, ncIPUtils, System.Generics.Collections; + +const + DefPort = 16233; + DefHost = ''; + DefReadBufferLen = 64 * 1024; // 64KB default for UDP + DefReaderThreadPriority = ntpNormal; + DefEventsUseMainThread = False; + DefUseReaderThread = True; + DefBroadcast = False; + DefFamily = afIPv4; + + // UDP Performance constants + UDP_COMMAND_MAGIC = $4E43; // 'NC' + UDP_CHUNK_MAGIC = $4E44; // 'ND' signature for chunk packets + UDP_MAX_SAFE_PAYLOAD = 1392; // Optimal MTU (avoids fragmentation) + UDP_CHUNK_TIMEOUT = 5000; // 5 seconds timeout for incomplete transfers + +type + // UDP Command Header Structure + TUdpCommandHeader = packed record + Cmd: Integer; // Command ID (matches ncSocketsPro) + Flags: Byte; // Command flags for future extensibility + Sequence: UInt16; // Sequence number for tracking/ordering + end; + + // Complete UDP Command Packet Structure + TUdpCommandPacket = packed record + Magic: UInt16; // Protocol detection signature + Header: TUdpCommandHeader; // Command header + // Variable data follows after this structure + end; + + // UDP Chunk Header Structure (for auto-chunking large commands) + TUdpChunkHeader = packed record + Magic: UInt16; // Chunk magic signature ($4E44 = 'ND') + TransferID: UInt32; // Unique transfer identifier + ChunkIndex: UInt16; // Current chunk number (0-based) + TotalChunks: UInt16; // Total number of chunks + OriginalCmd: Integer; // Original command ID + OriginalFlags: Byte; // Original command flags + OriginalSequence: UInt16; // Original sequence number + end; + + // Pointer type for zero-copy operations + PUdpChunkHeader = ^TUdpChunkHeader; + + // Chunk reassembly tracking + TChunkTransfer = record + TransferID: UInt32; + OriginalCmd: Integer; + OriginalFlags: Byte; + OriginalSequence: UInt16; + TotalChunks: UInt16; + FragmentsRemaining: UInt16; + LastActivity: TDateTime; + CompleteData: TBytes; // Pre-allocated full buffer + Fragments: array of UInt32; // Bitwise tracking + ActualDataSize: UInt32; // Real size of the complete data (calculated when complete) + LastChunkSize: UInt16; // Size of the last chunk (for accurate total calculation) + + // Helper methods for bitwise operations + function IsFragmentReceived(FragmentIndex: UInt16): Boolean; + procedure SetFragmentReceived(FragmentIndex: UInt16); + end; + + // Chunk transfer manager + TncChunkManager = class + private + FTransfers: TDictionary; // Hash table for O(1) lookup + FLock: TObject; // TMonitor synchronization object + function GenerateTransferID: UInt32; + procedure CleanupExpiredTransfers; + public + constructor Create; + destructor Destroy; override; + function StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; + function CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; + function AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; + function CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; + end; + +resourcestring + ECannotSetPortWhileSocketActiveStr = 'Cannot set Port property while socket is active'; + ECannotSetHostWhileSocketActiveStr = 'Cannot set Host property while socket is active'; + ECannotSendWhileSocketInactiveStr = 'Cannot send data while socket is inactive'; + ECannotSetUseReaderThreadWhileSocketActiveStr = 'Cannot set UseReaderThread property while socket is active'; + ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnCommand event handler to get protocol data or set UseReaderThread property to false'; + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; +type + EPropertySetError = class(Exception); + + // Event types for UDP + TncOnDatagramEvent = procedure(Sender: TObject; aLine: TncLine;const aBuf: TBytes; aBufCount: Integer;const SenderAddr: TSockAddrStorage) of object; + + // UDP Command Protocol Event + TncOnUDPCommandEvent = procedure(Sender: TObject; aLine: TncLine; const aSenderAddr: TSockAddrStorage; + aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16) of object; + + + // Base UDP Socket class + TncUDPBaseLCP = class(TComponent) + private + FInitActive: Boolean; + FFamily: TAddressType; + FPort: Integer; + FEventsUseMainThread: Boolean; + FBroadcast: Boolean; + FLine: TncLine; + FReadBufferLen: Integer; + FOnCommand: TncOnUDPCommandEvent; + FChunkManager: TncChunkManager; // For auto-chunking large commands + function GetReadBufferLen: Integer; + procedure SetReadBufferLen(const Value: Integer); + function GetActive: Boolean; virtual; abstract; + procedure SetActive(const Value: Boolean); + function GetFamily: TAddressType; + procedure SetFamily(const Value: TAddressType); + function GetPort: Integer; + procedure SetPort(const Value: Integer); + function GetReaderThreadPriority: TncThreadPriority; + procedure SetReaderThreadPriority(const Value: TncThreadPriority); + function GetBroadcast: Boolean; + procedure SetBroadcast(const Value: Boolean); + + private + FUseReaderThread: Boolean; + procedure DoActivate(aActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const Value: Boolean); + protected + PropertyLock: TObject; // TMonitor synchronization object + ReadBuf: TBytes; + procedure Loaded; override; + function CreateLineObject: TncLine; virtual; + function GetLine: TncLine; virtual; abstract; + public + LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + + function Kind: TSocketType; virtual; + + property Active: Boolean read GetActive write SetActive default False; + property Family: TAddressType read GetFamily write SetFamily default afIPv4; + property Port: Integer read GetPort write SetPort default DefPort; + property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; + property EventsUseMainThread: Boolean read FEventsUseMainThread write FEventsUseMainThread default DefEventsUseMainThread; + property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; + property Broadcast: Boolean read GetBroadcast write SetBroadcast default DefBroadcast; + property OnCommand: TncOnUDPCommandEvent read FOnCommand write FOnCommand; + property ReadBufferLen: Integer read GetReadBufferLen write SetReadBufferLen default DefReadBufferLen; + published + end; + + // UDP Client implementation + TncUDPClientProcessor = class; + + TncCustomUDPClientLCP = class(TncUDPBaseLCP) + private + FHost: string; + function GetActive: Boolean; override; + procedure SetHost(const Value: string); + function GetHost: string; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + procedure Send(const aBuf; aBufSize: Integer); overload; + procedure Send(const aBytes: TBytes); overload; + procedure Send(const aStr: string); overload; + + // UDP Command Protocol Methods + procedure SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + property Host: string read GetHost write SetHost; + end; + + TncUDPClientLCP = class(TncCustomUDPClientLCP) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnCommand; + end; + + TncUDPClientProcessor = class(TncReadyThread) + private + FClientSocket: TncCustomUDPClientLCP; + public + ReadySocketsChanged: Boolean; + constructor Create(aClientSocket: TncCustomUDPClientLCP); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // UDP Server implementation + TncUDPServerProcessor = class; + + TncCustomUDPServerLCP = class(TncUDPBaseLCP) + private + function GetActive: Boolean; override; + protected + procedure DoActivate(aActivate: Boolean); override; + function GetLine: TncLine; override; + public + ReadSocketHandles: TSocketHandleArray; + Line: TncLine; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aBytes: TBytes;const DestAddr: TSockAddrStorage); overload; + procedure SendTo(const aStr: string; const DestAddr: TSockAddrStorage); overload; + + // UDP Command Protocol Methods + procedure SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + procedure SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte = 0; aSequence: UInt16 = 0); overload; + + function Receive(aTimeout: Cardinal = 2000): TBytes; + end; + + TncUDPServerLCP = class(TncCustomUDPServerLCP) + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property ReadBufferLen; + property OnCommand; + end; + + TncUDPServerProcessor = class(TncReadyThread) + private + FServerSocket: TncCustomUDPServerLCP; + public + ReadySocketsChanged: Boolean; + constructor Create(aServerSocket: TncCustomUDPServerLCP); + procedure ProcessDatagram; inline; + procedure ProcessEvent; override; + end; + + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line + TncLineInternal = class(TncLine); + +implementation + +{ TncUDPBaseLCP } + +constructor TncUDPBaseLCP.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + PropertyLock := TObject.Create; + + FInitActive := False; + FFamily := DefFamily; + FPort := DefPort; + FEventsUseMainThread := DefEventsUseMainThread; + FUseReaderThread := DefUseReaderThread; + FBroadcast := DefBroadcast; + FReadBufferLen := DefReadBufferLen; + FOnCommand := nil; + FChunkManager := TncChunkManager.Create; // Initialize the chunk manager + + SetLength(ReadBuf, DefReadBufferLen); + +end; + +function TncUDPBaseLCP.Kind: TSocketType; +begin + Result := stUDP; +end; + +destructor TncUDPBaseLCP.Destroy; +begin + PropertyLock.Free; + FChunkManager.Free; // Free the chunk manager + inherited Destroy; +end; + +procedure TncUDPBaseLCP.Loaded; +begin + inherited Loaded; + if FInitActive then + DoActivate(True); +end; + +function TncUDPBaseLCP.CreateLineObject: TncLine; +begin + Result := TncLine.Create; + TncLineInternal(Result).SetKind(Kind); + TncLineInternal(Result).SetFamily(FFamily); +end; + +procedure TncUDPBaseLCP.SetActive(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + if not(csLoading in ComponentState) then + DoActivate(Value); + FInitActive := GetActive; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseLCP.GetFamily: TAddressType; +begin + TMonitor.Enter(PropertyLock); + try + Result := FFamily; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseLCP.SetFamily(const Value: TAddressType); +begin + if not(csLoading in ComponentState) then + begin + if Active then + raise EPropertySetError.Create + (ECannotSetFamilyWhileConnectionIsActiveStr); + end; + + TMonitor.Enter(PropertyLock); + try + // Update base class family + FFamily := Value; + + // Update the Line's family + if FLine <> nil then + begin + TncLineInternal(FLine).SetFamily(Value); + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseLCP.GetPort: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FPort; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseLCP.SetPort(const Value: Integer); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetPortWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FPort := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseLCP.GetReaderThreadPriority: TncThreadPriority; +begin + TMonitor.Enter(PropertyLock); + try + Result := ToNcThreadPriority(LineProcessor.Priority); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseLCP.SetReaderThreadPriority(const Value: TncThreadPriority); +begin + TMonitor.Enter(PropertyLock); + try + try + LineProcessor.Priority := FromNcThreadPriority(Value); + except + // Some android devices cannot handle changing priority + end; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseLCP.GetBroadcast: Boolean; +begin + TMonitor.Enter(PropertyLock); + try + Result := FBroadcast; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseLCP.SetBroadcast(const Value: Boolean); +begin + TMonitor.Enter(PropertyLock); + try + FBroadcast := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseLCP.SetUseReaderThread(const Value: Boolean); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FUseReaderThread := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +function TncUDPBaseLCP.GetReadBufferLen: Integer; +begin + TMonitor.Enter(PropertyLock); + try + Result := FReadBufferLen; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncUDPBaseLCP.SetReadBufferLen(const Value: Integer); +begin + TMonitor.Enter(PropertyLock); + try + FReadBufferLen := Value; + SetLength(ReadBuf, FReadBufferLen); + finally + TMonitor.Exit(PropertyLock); + end; +end; + +{ TncCustomUDPClientLCP } + +constructor TncCustomUDPClientLCP.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FHost := DefHost; + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPClientProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPClientLCP.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPClientLCP.GetLine: TncLine; +begin + Result := Line; +end; + +procedure TncCustomUDPClientLCP.DoActivate(aActivate: Boolean); +begin + // Exit if socket is already in requested state + if aActivate = GetActive then + Exit; + + if aActivate then + begin + try + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // Create socket handle and establish connection + TncLineInternal(Line).CreateClientHandle(FHost, FPort, GetBroadcast); + + // Enable broadcast mode if requested + if GetBroadcast then + TncLineInternal(Line).EnableBroadcast; + + // Configure socket buffer sizes for optimal performance + try + TncLineInternal(Line).SetReceiveSize(GetReadBufferLen); + TncLineInternal(Line).SetWriteSize(GetReadBufferLen); + except + on E: Exception do + begin + TncLineInternal(Line).DestroyHandle; + raise; + end; + end; + + // Initialize socket handle array for reading + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + // Start reader thread if enabled + if UseReaderThread then + LineProcessor.Run; + except + on E: Exception do + begin + // Clean up on activation failure + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + raise; + end; + end; + end + else + begin + // Clean up when deactivating + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +function TncCustomUDPClientLCP.GetActive: Boolean; +begin + Result := Line.Active; +end; + +function TncCustomUDPClientLCP.GetHost: string; +begin + TMonitor.Enter(PropertyLock); + try + Result := FHost; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomUDPClientLCP.SetHost(const Value: string); +begin + if not(csLoading in ComponentState) then + if Active then + raise EPropertySetError.Create(ECannotSetHostWhileSocketActiveStr); + + TMonitor.Enter(PropertyLock); + try + FHost := Value; + finally + TMonitor.Exit(PropertyLock); + end; +end; + +procedure TncCustomUDPClientLCP.Send(const aBuf; aBufSize: Integer); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + case Family of + afIPv4: + begin + if GetBroadcast then + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(FPort); + + // Use Winsock API directly for IPv4 broadcast + var addr := inet_addr(PAnsiChar(AnsiString(FHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendTo(aBuf, aBufSize, storage); + end + else + TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + end; + + afIPv6: + begin + if GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.') + else if FHost = '' then + raise Exception.Create('Host address cannot be empty for IPv6') + else + begin + // Validate IPv6 address format + if not TncIPUtils.IsIPv6ValidAddress(FHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(FPort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(FHost) then + begin + var scopePos := Pos('%', FHost); + if scopePos > 0 then + begin + var hostAddr := Copy(FHost, 1, scopePos - 1); + var scope := Copy(FHost, scopePos + 1, Length(FHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + // Convert the address part without scope ID + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(FHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendTo(aBuf, aBufSize, storage); + end; + end; + end; +end; + +procedure TncCustomUDPClientLCP.Send(const aBytes: TBytes); +begin + if Length(aBytes) > 0 then + Send(aBytes[0], Length(aBytes)); +end; + +procedure TncCustomUDPClientLCP.Send(const aStr: string); +begin + Send(BytesOf(aStr)); +end; + +// UDP Command Protocol Methods for TncCustomUDPClientLCP + +procedure TncCustomUDPClientLCP.SendCommand(aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +begin + SendCommand(FHost, FPort, aCmd, aData, aFlags, aSequence); +end; + +procedure TncCustomUDPClientLCP.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // IPv6 broadcast validation + if (Family = afIPv6) and GetBroadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Build destination address first (common for both paths) + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end; + end; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, storage); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, storage); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPClientLCP.SendTo(const aBuf; aBufSize: Integer; + const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPClientLCP.SendTo(const aBytes: TBytes; + const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPClientLCP.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +function TncCustomUDPClientLCP.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPClientProcessor } + +constructor TncUDPClientProcessor.Create(aClientSocket: TncCustomUDPClientLCP); +begin + FClientSocket := aClientSocket; + ReadySocketsChanged := False; + inherited Create; +end; + +procedure TncUDPClientProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + // Initialize sender address structure + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + // Receive datagram with proper address structure + BufRead := recvfrom(FClientSocket.Line.Handle, + FClientSocket.ReadBuf[0], + Length(FClientSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FClientSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FClientSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FClientSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FClientSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FClientSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FClientSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FClientSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FClientSocket.OnCommand) then + try + FClientSocket.OnCommand(FClientSocket, + FClientSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end; + // NOTE: LCP ONLY - No else clause for raw data + // Any non-protocol packets are silently ignored + end; + // NOTE: LCP ONLY - Packets too small for protocol headers are silently ignored + end; +end; + +procedure TncUDPClientProcessor.ProcessEvent; +begin + while (not Terminated) do + try + if FClientSocket.Line.Active then + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 100) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + if FClientSocket.EventsUseMainThread then + Synchronize(ProcessDatagram) + else + ProcessDatagram; + end; + end + else + Exit; + except + // Continue processing even after errors + end; +end; + +{ TncChunkManager } + +constructor TncChunkManager.Create; +begin + inherited Create; + FLock := TObject.Create; + FTransfers := TDictionary.Create; +end; + +destructor TncChunkManager.Destroy; +begin + FLock.Free; + FTransfers.Free; + inherited Destroy; +end; + +function TncChunkManager.GenerateTransferID: UInt32; +begin + // Simple transfer ID generation (timestamp + random) + Result := UInt32(GetTickCount) xor UInt32(Random(65536)); +end; + +procedure TncChunkManager.CleanupExpiredTransfers; +var + Now: TDateTime; + TransferID: UInt32; + Transfer: TChunkTransfer; + ExpiredIDs: TArray; + I: Integer; +begin + Now := System.SysUtils.Now; + SetLength(ExpiredIDs, 0); + + // First pass: identify expired transfers + for Transfer in FTransfers.Values do + begin + if MilliSecondsBetween(Now, Transfer.LastActivity) > UDP_CHUNK_TIMEOUT then + begin + SetLength(ExpiredIDs, Length(ExpiredIDs) + 1); + ExpiredIDs[High(ExpiredIDs)] := Transfer.TransferID; + end; + end; + + // Second pass: remove expired transfers + for I := 0 to High(ExpiredIDs) do + FTransfers.Remove(ExpiredIDs[I]); +end; + +function TncChunkManager.StartTransfer(ACmd: Integer; AFlags: Byte; ASequence: UInt16; ATotalChunks: UInt16; AActualDataSize: UInt32): UInt32; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + TMonitor.Enter(FLock); + try + CleanupExpiredTransfers; + + Transfer.TransferID := GenerateTransferID; + Transfer.OriginalCmd := ACmd; + Transfer.OriginalFlags := AFlags; + Transfer.OriginalSequence := ASequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := AActualDataSize; // Store the actual data size + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate only maximum needed size (not over-allocate) + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := Transfer.TransferID; + finally + TMonitor.Exit(FLock); + end; +end; + +function TncChunkManager.CreateTransferFromChunk(ATransferID: UInt32; ATotalChunks: UInt16; AOriginalCmd: Integer; AOriginalFlags: Byte; AOriginalSequence: UInt16): Boolean; +var + Transfer: TChunkTransfer; + MaxDataSize: Integer; + BitArraySize: Integer; +begin + Result := False; + TMonitor.Enter(FLock); + try + // Check if transfer already exists + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + Result := True; // Already exists + Exit; + end; + + // Create new transfer + Transfer.TransferID := ATransferID; + Transfer.OriginalCmd := AOriginalCmd; + Transfer.OriginalFlags := AOriginalFlags; + Transfer.OriginalSequence := AOriginalSequence; + Transfer.TotalChunks := ATotalChunks; + Transfer.FragmentsRemaining := ATotalChunks; // Initialize FragmentsRemaining + Transfer.LastActivity := System.SysUtils.Now; + Transfer.ActualDataSize := 0; // Will be calculated when all chunks received + Transfer.LastChunkSize := 0; // Will be set when last chunk is received + + // Pre-allocate buffer for maximum possible data size + MaxDataSize := ATotalChunks * (UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader)); + SetLength(Transfer.CompleteData, MaxDataSize); + + // Calculate bit array size (32 fragments per UInt32) + BitArraySize := (ATotalChunks + 31) div 32; + SetLength(Transfer.Fragments, BitArraySize); + // Initialize all bits to 0 + if BitArraySize > 0 then + FillChar(Transfer.Fragments[0], BitArraySize * SizeOf(UInt32), 0); + + FTransfers.Add(Transfer.TransferID, Transfer); + + Result := True; + finally + TMonitor.Exit(FLock); + end; +end; + +function TncChunkManager.AddChunk(ATransferID: UInt32; AChunkIndex: UInt16; const AChunkData: TBytes): Boolean; +var + Transfer: TChunkTransfer; + ChunkOffset: Integer; + DataSize: Integer; + MaxChunkSize: Integer; +begin + Result := False; + DataSize := Length(AChunkData); + + // Quick validation before lock + if DataSize = 0 then Exit; + + // Single lock operation only + TMonitor.Enter(FLock); + try + if FTransfers.TryGetValue(ATransferID, Transfer) then + begin + // Transfer exists - add chunk + if (AChunkIndex < Transfer.TotalChunks) and (not Transfer.IsFragmentReceived(AChunkIndex)) then + begin + // Calculate offset once and copy directly + MaxChunkSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + ChunkOffset := AChunkIndex * MaxChunkSize; + + // Direct memory operation + if ChunkOffset + DataSize <= Length(Transfer.CompleteData) then + begin + Move(AChunkData[0], Transfer.CompleteData[ChunkOffset], DataSize); + + // Update tracking + Transfer.SetFragmentReceived(AChunkIndex); + Dec(Transfer.FragmentsRemaining); + Transfer.LastActivity := System.SysUtils.Now; + + // Track last chunk size for accurate total calculation + if AChunkIndex = Transfer.TotalChunks - 1 then + Transfer.LastChunkSize := DataSize; + + // If all chunks received, calculate actual data size + if Transfer.FragmentsRemaining = 0 then + Transfer.ActualDataSize := (Transfer.TotalChunks - 1) * MaxChunkSize + Transfer.LastChunkSize; + + // Update the transfer back to dictionary once + FTransfers.AddOrSetValue(ATransferID, Transfer); + Result := True; + end; + end; + end; + finally + TMonitor.Exit(FLock); + end; +end; + +function TncChunkManager.CompleteTransfer(ATransferID: UInt32; out ACmd: Integer; out AFlags: Byte; + out ASequence: UInt16; out ACompleteData: TBytes): Boolean; +var + Transfer: TChunkTransfer; +begin + Result := False; + TMonitor.Enter(FLock); + try + if FTransfers.TryGetValue(ATransferID, Transfer) and (Transfer.FragmentsRemaining = 0) then + begin + // All chunks received - prepare output + ACmd := Transfer.OriginalCmd; + AFlags := Transfer.OriginalFlags; + ASequence := Transfer.OriginalSequence; + + // Use the stored actual data size (from sender) + if Transfer.ActualDataSize > 0 then + begin + SetLength(ACompleteData, Transfer.ActualDataSize); + Move(Transfer.CompleteData[0], ACompleteData[0], Transfer.ActualDataSize); + end + else + SetLength(ACompleteData, 0); + + // Remove completed transfer + FTransfers.Remove(ATransferID); + Result := True; + end; + finally + TMonitor.Exit(FLock); + end; +end; + +{ TChunkTransfer - bitwise fragment tracking } + +function TChunkTransfer.IsFragmentReceived(FragmentIndex: UInt16): Boolean; +begin + if FragmentIndex >= TotalChunks then + begin + Result := False; + Exit; + end; + // Bitwise check: (fragments[fragmentNumber / 32] & (1u << (fragmentNumber % 32))) == 0 + Result := (Fragments[FragmentIndex div 32] and (UInt32(1) shl (FragmentIndex mod 32))) <> 0; +end; + +procedure TChunkTransfer.SetFragmentReceived(FragmentIndex: UInt16); +begin + if FragmentIndex < TotalChunks then + // Bitwise set: fragments[fragmentNumber / 32] |= (1u << (fragmentNumber % 32)) + Fragments[FragmentIndex div 32] := Fragments[FragmentIndex div 32] or (UInt32(1) shl (FragmentIndex mod 32)); +end; + +{ TncCustomUDPServerLCP } + +constructor TncCustomUDPServerLCP.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Line := CreateLineObject; + + // Create Line with correct family + Line := CreateLineObject; + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + LineProcessor := TncUDPServerProcessor.Create(Self); + try + LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); + except + // Some Android devices do not like this + end; +end; + +destructor TncCustomUDPServerLCP.Destroy; +begin + Active := False; + + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + LineProcessor.Free; + + Line.Free; + + inherited Destroy; +end; + +function TncCustomUDPServerLCP.GetLine: TncLine; +begin + Result := Line; +end; + +function TncCustomUDPServerLCP.GetActive: Boolean; +begin + Result := Line.Active; +end; + +procedure TncCustomUDPServerLCP.DoActivate(aActivate: Boolean); +begin + if aActivate = GetActive then + Exit; + + if aActivate then + begin + + // Verify family setting before creating handle + if Line.Family <> FFamily then + begin + TncLineInternal(Line).SetFamily(FFamily); + end; + + // CreateServerHandle will bind to all interfaces (0.0.0.0) + // through the AI_PASSIVE flag in ncLines.CreateServerHandle + TncLineInternal(Line).CreateServerHandle(FPort); + + // Enable broadcast if needed + if Broadcast then + TncLineInternal(Line).EnableBroadcast; + + // Set socket buffer sizes for better performance + try + TncLineInternal(Line).SetReceiveSize(ReadBufferLen); + TncLineInternal(Line).SetWriteSize(ReadBufferLen); + except + // Ignore buffer size errors + end; + + SetLength(ReadSocketHandles, 1); + ReadSocketHandles[0] := Line.Handle; + + if UseReaderThread then + begin + LineProcessor.WaitForReady; + LineProcessor.Run; + end; + end + else + begin + TncLineInternal(Line).DestroyHandle; + SetLength(ReadSocketHandles, 0); + end; +end; + +// 1. Base SendTo that does the actual sending +procedure TncCustomUDPServerLCP.SendTo(const aBuf; aBufSize: Integer; const DestAddr: TSockAddrStorage); +var + AddrLen: Integer; + {$IFDEF MSWINDOWS} + BytesSent: Integer; + {$ELSE} + BytesSent: ssize_t; + {$ENDIF} + DestIP: string; +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + try + // Get destination address for logging/error reporting + DestIP := TncIPUtils.GetIPFromStorage(DestAddr); + // Set proper address length based on family + case DestAddr.ss_family of + AF_INET: AddrLen := SizeOf(TSockAddr); + AF_INET6: AddrLen := SizeOf(TSockAddrIn6); + else + AddrLen := SizeOf(TSockAddrStorage); + end; + {$IFDEF MSWINDOWS} + BytesSent := Winapi.Winsock2.sendto(Line.Handle, aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent = SOCKET_ERROR then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(WSAGetLastError)]); + {$ELSE} + BytesSent := Posix.SysSocket.sendto(Line.Handle, @aBuf, aBufSize, 0, + Psockaddr(@DestAddr), AddrLen); + if BytesSent < 0 then + raise Exception.CreateFmt('Failed to send to %s: %s', + [DestIP, SysErrorMessage(GetLastError)]); + {$ENDIF} + except + on E: EIPError do + raise Exception.Create('Invalid destination address: ' + E.Message); + end; +end; + +// 2. SendTo for byte arrays +procedure TncCustomUDPServerLCP.SendTo(const aBytes: TBytes; const DestAddr: TSockAddrStorage); +begin + if Length(aBytes) > 0 then + SendTo(aBytes[0], Length(aBytes), DestAddr); +end; + +// 3. SendTo for strings +procedure TncCustomUDPServerLCP.SendTo(const aStr: string; const DestAddr: TSockAddrStorage); +var + bytes: TBytes; + len: Integer; +begin + bytes := BytesOf(aStr); + len := Length(bytes); + if len > 0 then + SendTo(bytes[0], len, DestAddr); +end; + +// UDP Command Protocol Methods for TncCustomUDPServerLCP + +procedure TncCustomUDPServerLCP.SendCommand(const DestAddr: TSockAddrStorage; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + HeaderSize, DataSize, TotalSize: Integer; + + // For normal sending + Packet: TBytes; + PacketHeader: TUdpCommandPacket; + + // For chunking + ChunkHeader: TUdpChunkHeader; + ChunkPacket: TBytes; + TransferID: UInt32; + TotalChunks: UInt16; + ChunkIndex: UInt16; + CurrentPos: Integer; + ChunkDataSize: Integer; + MaxChunkDataSize: Integer; + +begin + if not Active then + raise EPropertySetError.Create(ECannotSendWhileSocketInactiveStr); + + // Calculate total command packet size + HeaderSize := SizeOf(TUdpCommandPacket); + DataSize := Length(aData); + TotalSize := HeaderSize + DataSize; + + // Check if auto-chunking is needed + if TotalSize <= UDP_MAX_SAFE_PAYLOAD then + begin + // =============================================== + // NORMAL SEND - Single packet + // =============================================== + PacketHeader.Magic := UDP_COMMAND_MAGIC; + PacketHeader.Header.Cmd := aCmd; + PacketHeader.Header.Flags := aFlags; + PacketHeader.Header.Sequence := aSequence; + + SetLength(Packet, TotalSize); + Move(PacketHeader, Packet[0], HeaderSize); + if DataSize > 0 then + Move(aData[0], Packet[HeaderSize], DataSize); + + SendTo(Packet, DestAddr); + end + else + begin + // =============================================== + // AUTO-CHUNKING - Multiple packets + // =============================================== + + MaxChunkDataSize := UDP_MAX_SAFE_PAYLOAD - SizeOf(TUdpChunkHeader); + TotalChunks := (DataSize + MaxChunkDataSize - 1) div MaxChunkDataSize; + TransferID := FChunkManager.StartTransfer(aCmd, aFlags, aSequence, TotalChunks, DataSize); + + // Immediate packet sending for maximum speed + SetLength(ChunkPacket, UDP_MAX_SAFE_PAYLOAD); + + ChunkHeader.Magic := UDP_CHUNK_MAGIC; + ChunkHeader.TransferID := TransferID; + ChunkHeader.TotalChunks := TotalChunks; + ChunkHeader.OriginalCmd := aCmd; + ChunkHeader.OriginalFlags := aFlags; + ChunkHeader.OriginalSequence := aSequence; + + CurrentPos := 0; + + // Send packets immediately without preparation overhead + for ChunkIndex := 0 to TotalChunks - 1 do + begin + ChunkDataSize := MaxChunkDataSize; + if ChunkIndex = TotalChunks - 1 then + ChunkDataSize := DataSize - CurrentPos; + + ChunkHeader.ChunkIndex := ChunkIndex; + + // Build and send packet immediately (zero overhead) + Move(ChunkHeader, ChunkPacket[0], SizeOf(TUdpChunkHeader)); + if ChunkDataSize > 0 then + Move(aData[CurrentPos], ChunkPacket[SizeOf(TUdpChunkHeader)], ChunkDataSize); + + // Send immediately at maximum speed (no delays, no burst preparation) + SendTo(ChunkPacket[0], SizeOf(TUdpChunkHeader) + ChunkDataSize, DestAddr); + + Inc(CurrentPos, ChunkDataSize); + end; + end; +end; + +procedure TncCustomUDPServerLCP.SendCommand(const aRemoteHost: string; aRemotePort: Integer; aCmd: Integer; const aData: TBytes; aFlags: Byte; aSequence: UInt16); +var + storage: TSockAddrStorage; + addrV4: PSockAddrIn; + addrV6: PSockAddrIn6; +begin + // IPv6 broadcast validation + if (Family = afIPv6) and Broadcast then + raise Exception.Create('Broadcast is not supported in IPv6. Use multicast instead.'); + + // Build destination address based on family + case Family of + afIPv4: + begin + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET; + + addrV4 := PSockAddrIn(@storage); + addrV4^.sin_family := AF_INET; + addrV4^.sin_port := htons(aRemotePort); + + var addr := inet_addr(PAnsiChar(AnsiString(aRemoteHost))); + if addr <> INADDR_NONE then + addrV4^.sin_addr.S_addr := addr + else + raise Exception.Create('Invalid IPv4 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + + afIPv6: + begin + if not TncIPUtils.IsIPv6ValidAddress(aRemoteHost) then + raise Exception.Create('Invalid IPv6 address format'); + + FillChar(storage, SizeOf(storage), 0); + storage.ss_family := AF_INET6; + + addrV6 := PSockAddrIn6(@storage); + addrV6^.sin6_family := AF_INET6; + addrV6^.sin6_port := htons(aRemotePort); + + // Handle link-local address with scope ID + if TncIPUtils.IsLinkLocal(aRemoteHost) then + begin + var scopePos := Pos('%', aRemoteHost); + if scopePos > 0 then + begin + var hostAddr := Copy(aRemoteHost, 1, scopePos - 1); + var scope := Copy(aRemoteHost, scopePos + 1, Length(aRemoteHost)); + var scopeID: Cardinal; + if TryStrToUInt(scope, scopeID) then + begin + addrV6^.sin6_scope_id := scopeID; + if not TncIPUtils.StringToAddress(hostAddr, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else + raise Exception.Create('Invalid IPv6 scope ID'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + end + else if not TncIPUtils.StringToAddress(aRemoteHost, addrV6^.sin6_addr) then + raise Exception.Create('Invalid IPv6 address format'); + + SendCommand(storage, aCmd, aData, aFlags, aSequence); + end; + end; +end; + +function TncCustomUDPServerLCP.Receive(aTimeout: Cardinal = 2000): TBytes; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + SenderIP: string; +begin + if UseReaderThread then + raise Exception.Create(ECannotReceiveIfUseReaderThreadStr); + + Active := True; + + if not ReadableAnySocket([Line.Handle], aTimeout) then + begin + SetLength(Result, 0); + Exit; + end; + + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(Line.Handle, ReadBuf[0], Length(ReadBuf), 0, + PSockAddr(@SenderAddr)^, SenderAddrLen); + + try + if BufRead > 0 then + begin + // Get sender IP for logging if needed + SenderIP := TncIPUtils.GetIPFromStorage(SenderAddr); + Result := Copy(ReadBuf, 0, BufRead); + end + else if BufRead = 0 then + begin + SetLength(Result, 0); + // Optional: raise Exception.Create('Connection closed by peer'); + end + else + begin + SetLength(Result, 0); + {$IFDEF MSWINDOWS} + raise Exception.Create('Receive error: ' + SysErrorMessage(WSAGetLastError)); + {$ELSE} + raise Exception.Create('Receive error: ' + SysErrorMessage(GetLastError)); + {$ENDIF} + end; + except + on E: EIPError do + begin + SetLength(Result, 0); + raise Exception.Create('Invalid sender address: ' + E.Message); + end; + end; +end; + +{ TncUDPServerProcessor } + +constructor TncUDPServerProcessor.Create(aServerSocket: TncCustomUDPServerLCP); +begin + FServerSocket := aServerSocket; + ReadySocketsChanged := False; + inherited Create; +end; + + +procedure TncUDPServerProcessor.ProcessDatagram; +var + BufRead: Integer; + SenderAddr: TSockAddrStorage; + SenderAddrLen: Integer; + Magic: UInt16; + CommandHeader: TUdpCommandHeader; + CommandData: TBytes; + PacketSize: Integer; + + // For chunk handling + ChunkHeader: TUdpChunkHeader; + ChunkData: TBytes; + CompleteCmd: Integer; + CompleteFlags: Byte; + CompleteSequence: UInt16; + CompleteData: TBytes; +begin + SenderAddrLen := SizeOf(TSockAddrStorage); + FillChar(SenderAddr, SenderAddrLen, 0); + + BufRead := recvfrom(FServerSocket.Line.Handle, + FServerSocket.ReadBuf[0], + Length(FServerSocket.ReadBuf), + 0, + PSockAddr(@SenderAddr)^, + SenderAddrLen); + + if BufRead > 0 then + begin + // Check minimum size for any structured packet + if (BufRead >= SizeOf(UInt16)) then + begin + // Extract magic number to check protocol type + Move(FServerSocket.ReadBuf[0], Magic, SizeOf(Magic)); + + if Magic = UDP_COMMAND_MAGIC then + begin + // =============================================== + // NORMAL COMMAND PACKET + // =============================================== + if BufRead >= SizeOf(TUdpCommandPacket) then + begin + Move(FServerSocket.ReadBuf[SizeOf(UInt16)], CommandHeader, SizeOf(CommandHeader)); + + PacketSize := SizeOf(TUdpCommandPacket); + if BufRead > PacketSize then + begin + SetLength(CommandData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], CommandData[0], BufRead - PacketSize); + end + else + SetLength(CommandData, 0); + + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CommandHeader.Cmd, + CommandData, + CommandHeader.Flags, + CommandHeader.Sequence); + except + end; + end; + end + else if Magic = UDP_CHUNK_MAGIC then + begin + // =============================================== + // CHUNK PACKET - Auto-reassembly + // =============================================== + + if BufRead >= SizeOf(TUdpChunkHeader) then + begin + // Direct header access + Move(FServerSocket.ReadBuf[0], ChunkHeader, SizeOf(ChunkHeader)); + + // Direct chunk data extraction + PacketSize := SizeOf(TUdpChunkHeader); + if BufRead > PacketSize then + begin + // Use buffer slice directly instead of copying + SetLength(ChunkData, BufRead - PacketSize); + Move(FServerSocket.ReadBuf[PacketSize], ChunkData[0], BufRead - PacketSize); + end + else + SetLength(ChunkData, 0); + + // Ensure transfer exists (create if first chunk) + FServerSocket.FChunkManager.CreateTransferFromChunk(ChunkHeader.TransferID, ChunkHeader.TotalChunks, + ChunkHeader.OriginalCmd, ChunkHeader.OriginalFlags, ChunkHeader.OriginalSequence); + + // Add chunk to manager + if FServerSocket.FChunkManager.AddChunk(ChunkHeader.TransferID, ChunkHeader.ChunkIndex, ChunkData) then + begin + // Only check completion if chunk was successfully added + if FServerSocket.FChunkManager.CompleteTransfer(ChunkHeader.TransferID, CompleteCmd, CompleteFlags, CompleteSequence, CompleteData) then + begin + // Transfer complete - fire OnCommand with reassembled data + if Assigned(FServerSocket.OnCommand) then + try + FServerSocket.OnCommand(FServerSocket, + FServerSocket.Line, + SenderAddr, + CompleteCmd, + CompleteData, + CompleteFlags, + CompleteSequence); + except + end; + end; + end; + end; + end; + // NOTE: LCP ONLY - No else clause for raw data + // Any non-protocol packets are silently ignored + end; + // NOTE: LCP ONLY - Packets too small for protocol headers are silently ignored + end; +end; + +procedure TncUDPServerProcessor.ProcessEvent; +begin + if FServerSocket.EventsUseMainThread then + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + Synchronize(ProcessDatagram); + end; + except + end + else + while FServerSocket.Active and (not Terminated) do + try + if ReadableAnySocket(FServerSocket.ReadSocketHandles, 500) then + begin + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Continue; + end; + ProcessDatagram; + end; + except + end; +end; + +end. \ No newline at end of file