├── .gitattributes ├── AndroidManifest.template.xml ├── Demos ├── ChatDemo │ ├── Client │ │ ├── ChatClient.dpr │ │ ├── ChatClient.dproj │ │ ├── ChatClient.dproj.local │ │ ├── ChatClient.dsk │ │ ├── ChatClient.identcache │ │ ├── ChatClient.res │ │ ├── ufrmMain.fmx │ │ └── ufrmMain.pas │ └── Server │ │ ├── ChatServer.dpr │ │ ├── ChatServer.dproj │ │ ├── ChatServer.dproj.local │ │ ├── ChatServer.dsk │ │ ├── ChatServer.identcache │ │ ├── ChatServer.res │ │ ├── ufrmMain.fmx │ │ └── ufrmMain.pas ├── DB │ ├── ChatDemo │ │ ├── Client │ │ │ ├── ChatClient.dpr │ │ │ ├── ChatClient.dproj │ │ │ ├── ChatClient.dproj.local │ │ │ ├── ChatClient.dsk │ │ │ ├── ChatClient.identcache │ │ │ ├── ChatClient.res │ │ │ ├── Initial.txt │ │ │ ├── ufrmMain.fmx │ │ │ └── ufrmMain.pas │ │ ├── Server │ │ │ └── Initial.txt │ │ └── initial.txt │ ├── DBClient │ │ ├── DBClient.dpr │ │ ├── DBClient.dproj │ │ ├── DBClient.dproj.local │ │ ├── DBClient.dsk │ │ ├── DBClient.identcache │ │ ├── DBClient.res │ │ ├── DBClient.skincfg │ │ ├── DBClient_Icon.ico │ │ ├── udmMain.dfm │ │ ├── udmMain.pas │ │ ├── ufrmMain.dfm │ │ └── ufrmMain.pas │ └── DBServer │ │ ├── Service │ │ ├── DBServerService.dpr │ │ ├── DBServerService.dproj │ │ ├── DBServerService.dproj.local │ │ ├── DBServerService.dsk │ │ ├── DBServerService.identcache │ │ ├── DBServerService.res │ │ ├── DBServerService.skincfg │ │ ├── DBServerService_Icon.ico │ │ ├── uscvServiceCommands.pas │ │ ├── usvcMain.dfm │ │ └── usvcMain.pas │ │ ├── ServiceApplication │ │ ├── DBServerApplication.dpr │ │ ├── DBServerApplication.dproj │ │ ├── DBServerApplication.dproj.local │ │ ├── DBServerApplication.dsk │ │ ├── DBServerApplication.identcache │ │ ├── DBServerApplication.res │ │ ├── DBServerApplication.skincfg │ │ ├── DBServerApplication_Icon.ico │ │ ├── ufrmMain.dfm │ │ └── ufrmMain.pas │ │ └── TestData │ │ └── Customers.mdb ├── NetComVSIndy │ ├── Client │ │ ├── NetComVSIndyClient.dpr │ │ ├── NetComVSIndyClient.dproj │ │ ├── NetComVSIndyClient.dproj.local │ │ ├── NetComVSIndyClient.dsk │ │ ├── NetComVSIndyClient.identcache │ │ ├── NetComVSIndyClient.res │ │ ├── ufrmMain.dfm │ │ └── ufrmMain.pas │ └── Server │ │ ├── NetComVSIndyServer.dpr │ │ ├── NetComVSIndyServer.dproj │ │ ├── NetComVSIndyServer.dproj.local │ │ ├── NetComVSIndyServer.dsk │ │ ├── NetComVSIndyServer.identcache │ │ ├── NetComVSIndyServer.res │ │ ├── ufrmMain.dfm │ │ └── ufrmMain.pas ├── SimpleSockets │ ├── Client.dpr │ ├── Client.dproj │ ├── Client.dproj.local │ ├── Client.dsk │ ├── Client.identcache │ ├── Client.res │ ├── Client.skincfg │ ├── Client_Icon.ico │ ├── Srv │ │ ├── Server.dpr │ │ ├── Server.dproj │ │ ├── Server.dproj.local │ │ ├── Server.dsk │ │ ├── Server.identcache │ │ ├── Server.res │ │ ├── Server.skincfg │ │ ├── Server_Icon.ico │ │ ├── ufrmMain.dfm │ │ └── ufrmMain.pas │ ├── ufrmMain.dfm │ └── ufrmMain.pas └── VideoChat │ ├── Client │ ├── AndroidManifest.template.xml │ ├── VideoChatClient.deployproj │ ├── VideoChatClient.dpr │ ├── VideoChatClient.dproj │ ├── VideoChatClient.dproj.local │ ├── VideoChatClient.dsk │ ├── VideoChatClient.identcache │ ├── VideoChatClient.res │ ├── ufrmMain.fmx │ └── ufrmMain.pas │ └── Server │ ├── AndroidManifest.template.xml │ ├── CommonCommands.pas │ ├── VideoChatServer.dpr │ ├── VideoChatServer.dproj │ ├── VideoChatServer.dproj.local │ ├── VideoChatServer.dsk │ ├── VideoChatServer.identcache │ ├── VideoChatServer.res │ ├── ufrmMain.fmx │ └── ufrmMain.pas ├── LICENSE ├── NetCom7.dpk ├── NetCom7.dproj ├── NetCom7.dproj.local ├── NetCom7.dres ├── NetCom7.dsk ├── NetCom7.identcache ├── NetCom7.res ├── NetCom7.skincfg ├── NetCom7.stat ├── NetCom7Resource.rc ├── PaletteIcons ├── TncIcon.bmp └── TncIcon.png ├── README.md └── Source ├── Encryption ├── ncEncBlockciphers.pas ├── ncEncBlowfish.pas ├── ncEncCast128.pas ├── ncEncCast256.pas ├── ncEncCrypt2.pas ├── ncEncDes.pas ├── ncEncHaval.pas ├── ncEncIce.pas ├── ncEncIdea.pas ├── ncEncMars.pas ├── ncEncMd4.pas ├── ncEncMd5.pas ├── ncEncMisty1.pas ├── ncEncRc2.pas ├── ncEncRc4.pas ├── ncEncRc5.pas ├── ncEncRc6.pas ├── ncEncRijndael.pas ├── ncEncRipemd128.pas ├── ncEncRipemd160.pas ├── ncEncSerpent.pas ├── ncEncSha1.pas ├── ncEncSha256.pas ├── ncEncSha512.pas ├── ncEncTea.pas ├── ncEncTiger.pas └── ncEncTwofish.pas ├── NetComRegister.dcr ├── NetComRegister.pas ├── ncCommandHandlers.pas ├── ncCommandPacking.pas ├── ncCompression.pas ├── ncDBCnt.pas ├── ncDBCommands.pas ├── ncDBSrv.pas ├── ncEncryption.pas ├── ncLines.pas ├── ncPendingCommandsList.pas ├── ncSerializeADO.pas ├── ncSerializeValue.pas ├── ncSocketList.pas ├── ncSockets.pas ├── ncSources.pas └── ncThreads.pas /.gitattributes: -------------------------------------------------------------------------------- 1 | # direct Delphi 2 | *.* linguist-language=Delphi 3 | -------------------------------------------------------------------------------- /AndroidManifest.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | 9 | 10 | 11 | <%uses-permission%> 12 | 13 | 21 | 22 | <%application-meta-data%> 23 | <%services%> 24 | 26 | 30 | 31 | 33 | 34 | 35 | 36 | 37 | 38 | <%activity%> 39 | <%receivers%> 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Client/ChatClient.dpr: -------------------------------------------------------------------------------- 1 | program ChatClient; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | ufrmMain in 'ufrmMain.pas' {frmMain}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | {$IFDEF DEBUG} 12 | ReportMemoryLeaksOnShutdown := True; 13 | {$ENDIF} 14 | Application.Initialize; 15 | Application.CreateForm(TfrmMain, frmMain); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Client/ChatClient.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 5 | 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 6 | 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 7 | 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 8 | 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 9 | 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 10 | 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 11 | 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 12 | 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas 13 | 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 14 | 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 15 | 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 16 | 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 17 | 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 18 | 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 19 | 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 20 | 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 21 | 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 22 | 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 23 | 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 24 | 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 25 | 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 26 | 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 27 | 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 28 | 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 29 | 2020/06/01 10:58:58.000.571,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 30 | 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 31 | 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 32 | 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 33 | 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 34 | 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Client/ChatClient.identcache: -------------------------------------------------------------------------------- 1 | _C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pasaC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr -------------------------------------------------------------------------------- /Demos/ChatDemo/Client/ChatClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/ChatDemo/Client/ChatClient.res -------------------------------------------------------------------------------- /Demos/ChatDemo/Client/ufrmMain.fmx: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | ActiveControl = edtText 5 | Caption = 'Chat Client' 6 | ClientHeight = 480 7 | ClientWidth = 640 8 | Position = ScreenCenter 9 | FormFactor.Width = 320 10 | FormFactor.Height = 480 11 | FormFactor.Devices = [Desktop] 12 | OnDestroy = FormDestroy 13 | DesignerMasterStyle = 0 14 | object memLog: TMemo 15 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 16 | DataDetectorTypes = [] 17 | ReadOnly = True 18 | TextSettings.WordWrap = True 19 | Align = Client 20 | Margins.Left = 5.000000000000000000 21 | Margins.Top = 5.000000000000000000 22 | Margins.Right = 5.000000000000000000 23 | Margins.Bottom = 5.000000000000000000 24 | Size.Width = 630.000000000000000000 25 | Size.Height = 369.000000000000000000 26 | Size.PlatformDefault = False 27 | TabOrder = 1 28 | Viewport.Width = 626.000000000000000000 29 | Viewport.Height = 365.000000000000000000 30 | end 31 | object ltMain: TLayout 32 | Align = Bottom 33 | Margins.Left = 5.000000000000000000 34 | Margins.Right = 5.000000000000000000 35 | Margins.Bottom = 5.000000000000000000 36 | Position.X = 5.000000000000000000 37 | Position.Y = 446.000000000000000000 38 | Size.Width = 630.000000000000000000 39 | Size.Height = 29.000000000000000000 40 | Size.PlatformDefault = False 41 | TabOrder = 3 42 | TabStop = False 43 | object edtText: TEdit 44 | Touch.InteractiveGestures = [LongTap, DoubleTap] 45 | Align = Client 46 | TabOrder = 0 47 | Margins.Right = 4.000000000000000000 48 | Size.Width = 546.000000000000000000 49 | Size.Height = 29.000000000000000000 50 | Size.PlatformDefault = False 51 | OnEnter = edtTextEnter 52 | OnExit = edtTextExit 53 | end 54 | object btnSend: TButton 55 | Align = Right 56 | Default = True 57 | Position.X = 550.000000000000000000 58 | Size.Width = 80.000000000000000000 59 | Size.Height = 29.000000000000000000 60 | Size.PlatformDefault = False 61 | TabOrder = 1 62 | Text = 'Send' 63 | OnClick = btnSendClick 64 | end 65 | end 66 | object edtClientName: TEdit 67 | Touch.InteractiveGestures = [LongTap, DoubleTap] 68 | Align = Bottom 69 | TabOrder = 2 70 | Text = 'Happy texter' 71 | Position.X = 5.000000000000000000 72 | Position.Y = 419.000000000000000000 73 | Margins.Left = 5.000000000000000000 74 | Margins.Right = 5.000000000000000000 75 | Margins.Bottom = 5.000000000000000000 76 | Size.Width = 630.000000000000000000 77 | Size.Height = 22.000000000000000000 78 | Size.PlatformDefault = False 79 | TextPrompt = 'Enter your name' 80 | end 81 | object ToolBar1: TToolBar 82 | Size.Width = 640.000000000000000000 83 | Size.Height = 40.000000000000000000 84 | Size.PlatformDefault = False 85 | TabOrder = 0 86 | TabStop = False 87 | object btnActivateClient: TButton 88 | Align = Left 89 | Margins.Left = 5.000000000000000000 90 | Margins.Top = 5.000000000000000000 91 | Margins.Right = 5.000000000000000000 92 | Margins.Bottom = 5.000000000000000000 93 | Position.X = 5.000000000000000000 94 | Position.Y = 5.000000000000000000 95 | Size.Width = 137.000000000000000000 96 | Size.Height = 30.000000000000000000 97 | Size.PlatformDefault = False 98 | TabOrder = 0 99 | Text = 'Activate Client' 100 | OnClick = btnActivateClientClick 101 | end 102 | object edtHost: TEdit 103 | Touch.InteractiveGestures = [LongTap, DoubleTap] 104 | Align = Client 105 | TabOrder = 1 106 | Text = 'LocalHost' 107 | Margins.Top = 5.000000000000000000 108 | Margins.Right = 5.000000000000000000 109 | Margins.Bottom = 5.000000000000000000 110 | Size.Width = 488.000000000000000000 111 | Size.Height = 30.000000000000000000 112 | Size.PlatformDefault = False 113 | OnChange = edtHostChange 114 | end 115 | end 116 | object Client: TncClientSource 117 | EncryptionKey = 'SetEncryptionKey' 118 | OnConnected = ClientConnected 119 | OnDisconnected = ClientDisconnected 120 | OnHandleCommand = ClientHandleCommand 121 | Host = 'LocalHost' 122 | OnReconnected = ClientReconnected 123 | Left = 32 124 | Top = 32 125 | end 126 | end 127 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Client/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, 8 | FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, 9 | FMX.Memo, System.SyncObjs, ncSources; 10 | 11 | type 12 | TfrmMain = class(TForm) 13 | memLog: TMemo; 14 | ltMain: TLayout; 15 | edtText: TEdit; 16 | btnSend: TButton; 17 | Client: TncClientSource; 18 | edtClientName: TEdit; 19 | ToolBar1: TToolBar; 20 | btnActivateClient: TButton; 21 | edtHost: TEdit; 22 | procedure FormDestroy(Sender: TObject); 23 | procedure btnSendClick(Sender: TObject); 24 | function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 25 | const aSenderComponent, aReceiverComponent: string): TArray; 26 | procedure edtTextEnter(Sender: TObject); 27 | procedure edtTextExit(Sender: TObject); 28 | procedure btnActivateClientClick(Sender: TObject); 29 | procedure ClientConnected(Sender: TObject; aLine: TncLine); 30 | procedure ClientDisconnected(Sender: TObject; aLine: TncLine); 31 | procedure ClientReconnected(Sender: TObject; aLine: TncLine); 32 | procedure edtHostChange(Sender: TObject); 33 | private 34 | public 35 | procedure Log(aStr: string); 36 | end; 37 | 38 | var 39 | frmMain: TfrmMain; 40 | 41 | implementation 42 | 43 | {$R *.fmx} 44 | 45 | procedure TfrmMain.FormDestroy(Sender: TObject); 46 | begin 47 | Client.Active := False; 48 | end; 49 | 50 | procedure TfrmMain.Log(aStr: string); 51 | begin 52 | // This is thread safe 53 | TThread.Queue(nil, 54 | procedure 55 | begin 56 | memLog.Lines.Add(aStr); 57 | memLog.ScrollBy(0, 100); 58 | end); 59 | end; 60 | 61 | procedure TfrmMain.btnActivateClientClick(Sender: TObject); 62 | begin 63 | Client.Active := not Client.Active; 64 | end; 65 | 66 | procedure TfrmMain.btnSendClick(Sender: TObject); 67 | begin 68 | Client.ExecCommand(0, BytesOf(edtClientName.Text + ': ' + edtText.Text)); 69 | edtText.Text := ''; 70 | end; 71 | 72 | procedure TfrmMain.edtHostChange(Sender: TObject); 73 | begin 74 | Client.Host := edtHost.Text; 75 | end; 76 | 77 | procedure TfrmMain.edtTextEnter(Sender: TObject); 78 | begin 79 | btnSend.Default := True; 80 | end; 81 | 82 | procedure TfrmMain.edtTextExit(Sender: TObject); 83 | begin 84 | btnSend.Default := False; 85 | end; 86 | 87 | procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); 88 | begin 89 | Log('Client connected to peer: ' + aLine.PeerIP); 90 | TThread.Queue(nil, 91 | procedure 92 | begin 93 | btnActivateClient.Text := 'Deactivate client'; 94 | end); 95 | end; 96 | 97 | procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); 98 | begin 99 | Log('Client disconnected from peer: ' + aLine.PeerIP); 100 | TThread.Queue(nil, 101 | procedure 102 | begin 103 | btnActivateClient.Text := 'Activate client'; 104 | end); 105 | end; 106 | 107 | procedure TfrmMain.ClientReconnected(Sender: TObject; aLine: TncLine); 108 | begin 109 | Log('Client was reconnected to peer: ' + aLine.PeerIP); 110 | end; 111 | 112 | function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 113 | const aSenderComponent, aReceiverComponent: string): TArray; 114 | begin 115 | Log(Stringof(aData)); 116 | end; 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Server/ChatServer.dpr: -------------------------------------------------------------------------------- 1 | program ChatServer; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | ufrmMain in 'ufrmMain.pas' {frmMain}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | {$IFDEF DEBUG} 12 | ReportMemoryLeaksOnShutdown := True; 13 | {$ENDIF} 14 | Application.Initialize; 15 | Application.CreateForm(TfrmMain, frmMain); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Server/ChatServer.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 5 | 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 6 | 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 7 | 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 8 | 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 9 | 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 10 | 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 11 | 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 12 | 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas 13 | 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 14 | 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 15 | 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 16 | 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 17 | 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 18 | 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 19 | 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 20 | 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 21 | 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 22 | 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 23 | 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 24 | 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 25 | 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 26 | 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 27 | 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 28 | 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 29 | 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 30 | 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 31 | 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 32 | 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 33 | 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 34 | 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 35 | 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 36 | 2020/08/10 12:55:10.000.953,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 37 | 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 38 | 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 39 | 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 40 | 41 | 42 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Server/ChatServer.identcache: -------------------------------------------------------------------------------- 1 | aC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ChatServer.dpr_C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Server\ufrmMain.pas -------------------------------------------------------------------------------- /Demos/ChatDemo/Server/ChatServer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/ChatDemo/Server/ChatServer.res -------------------------------------------------------------------------------- /Demos/ChatDemo/Server/ufrmMain.fmx: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Chat Server' 5 | ClientHeight = 339 6 | ClientWidth = 583 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnDestroy = FormDestroy 11 | DesignerMasterStyle = 0 12 | object memLog: TMemo 13 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 14 | DataDetectorTypes = [] 15 | ReadOnly = True 16 | Align = Client 17 | Margins.Left = 5.000000000000000000 18 | Margins.Top = 5.000000000000000000 19 | Margins.Right = 5.000000000000000000 20 | Margins.Bottom = 5.000000000000000000 21 | Size.Width = 573.000000000000000000 22 | Size.Height = 289.000000000000000000 23 | Size.PlatformDefault = False 24 | TabOrder = 1 25 | Viewport.Width = 569.000000000000000000 26 | Viewport.Height = 285.000000000000000000 27 | end 28 | object ToolBar1: TToolBar 29 | Size.Width = 583.000000000000000000 30 | Size.Height = 40.000000000000000000 31 | Size.PlatformDefault = False 32 | TabOrder = 0 33 | TabStop = False 34 | object btnActivateServer: TButton 35 | Align = Left 36 | Margins.Left = 5.000000000000000000 37 | Margins.Top = 5.000000000000000000 38 | Margins.Bottom = 5.000000000000000000 39 | Position.X = 5.000000000000000000 40 | Position.Y = 5.000000000000000000 41 | Size.Width = 137.000000000000000000 42 | Size.Height = 30.000000000000000000 43 | Size.PlatformDefault = False 44 | TabOrder = 0 45 | Text = 'Activate Server' 46 | OnClick = btnActivateServerClick 47 | end 48 | object btnShutDownClients: TButton 49 | Align = Right 50 | Margins.Top = 5.000000000000000000 51 | Margins.Right = 5.000000000000000000 52 | Margins.Bottom = 5.000000000000000000 53 | Position.X = 424.000000000000000000 54 | Position.Y = 5.000000000000000000 55 | Size.Width = 154.000000000000000000 56 | Size.Height = 30.000000000000000000 57 | Size.PlatformDefault = False 58 | TabOrder = 2 59 | Text = 'Shutdown Clients' 60 | OnClick = btnShutDownClientsClick 61 | end 62 | end 63 | object Server: TncServerSource 64 | EncryptionKey = 'SetEncryptionKey' 65 | OnConnected = ServerConnected 66 | OnDisconnected = ServerDisconnected 67 | OnHandleCommand = ServerHandleCommand 68 | Left = 32 69 | Top = 32 70 | end 71 | end 72 | -------------------------------------------------------------------------------- /Demos/ChatDemo/Server/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, 8 | FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, 9 | System.SyncObjs, ncSocketList, ncSources; 10 | 11 | type 12 | TfrmMain = class(TForm) 13 | Server: TncServerSource; 14 | memLog: TMemo; 15 | ToolBar1: TToolBar; 16 | btnActivateServer: TButton; 17 | btnShutDownClients: TButton; 18 | procedure FormDestroy(Sender: TObject); 19 | function ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 20 | const aSenderComponent, aReceiverComponent: string): TArray; 21 | procedure ServerConnected(Sender: TObject; aLine: TncLine); 22 | procedure ServerDisconnected(Sender: TObject; aLine: TncLine); 23 | procedure btnActivateServerClick(Sender: TObject); 24 | procedure btnShutDownClientsClick(Sender: TObject); 25 | private 26 | public 27 | procedure Log(aStr: string); 28 | end; 29 | 30 | var 31 | frmMain: TfrmMain; 32 | 33 | implementation 34 | 35 | {$R *.fmx} 36 | 37 | procedure TfrmMain.FormDestroy(Sender: TObject); 38 | begin 39 | Server.Active := False; 40 | end; 41 | 42 | procedure TfrmMain.Log(aStr: string); 43 | begin 44 | // This is thread safe 45 | TThread.Queue(nil, 46 | procedure 47 | begin 48 | memLog.Lines.Add(aStr); 49 | memLog.ScrollBy(0, 100); 50 | end); 51 | end; 52 | 53 | procedure TfrmMain.btnActivateServerClick(Sender: TObject); 54 | begin 55 | try 56 | Server.Active := not Server.Active; 57 | finally 58 | if Server.Active then 59 | begin 60 | btnActivateServer.Text := 'Deactivate Server'; 61 | Log('Server is activated'); 62 | end 63 | else 64 | begin 65 | btnActivateServer.Text := 'Activate Server'; 66 | Log('Server was deactivated'); 67 | end; 68 | end; 69 | end; 70 | 71 | procedure TfrmMain.ServerConnected(Sender: TObject; aLine: TncLine); 72 | begin 73 | Log('Client connected: ' + aLine.PeerIP); 74 | end; 75 | 76 | procedure TfrmMain.ServerDisconnected(Sender: TObject; aLine: TncLine); 77 | begin 78 | Log('Client disconnected: ' + aLine.PeerIP); 79 | end; 80 | 81 | function TfrmMain.ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 82 | const aSenderComponent, aReceiverComponent: string): TArray; 83 | var 84 | Clients: TSocketList; 85 | i: Integer; 86 | begin 87 | Log('Received: "' + StringOf(aData) + '" from peer: ' + aLine.PeerIP); 88 | 89 | // Now send this to all clients 90 | Clients := Server.Lines.LockList; 91 | try 92 | for i := 0 to Clients.Count - 1 do 93 | // if Clients.Lines[i] <> aLine then // If you do not want to send text back to original client 94 | Server.ExecCommand(Clients.Lines[i], 0, aData, False); 95 | 96 | // You can shutdown a line here by calling Server.ShutdownLine, 97 | // see following procecure 98 | finally 99 | Server.Lines.UnlockList; 100 | end; 101 | end; 102 | 103 | procedure TfrmMain.btnShutDownClientsClick(Sender: TObject); 104 | var 105 | Clients: TSocketList; 106 | i: Integer; 107 | begin 108 | Clients := Server.Lines.LockList; 109 | try 110 | for i := 0 to Clients.Count - 1 do 111 | Server.ShutDownLine(Clients.Lines[i]); 112 | finally 113 | Server.Lines.UnlockList; 114 | end; 115 | 116 | end; 117 | 118 | end. 119 | -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Client/ChatClient.dpr: -------------------------------------------------------------------------------- 1 | program ChatClient; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | ufrmMain in 'ufrmMain.pas' {frmMain}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | {$IFDEF DEBUG} 12 | ReportMemoryLeaksOnShutdown := True; 13 | {$ENDIF} 14 | Application.Initialize; 15 | Application.CreateForm(TfrmMain, frmMain); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Client/ChatClient.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 5 | 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 6 | 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 7 | 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 8 | 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 9 | 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 10 | 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 11 | 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 12 | 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas 13 | 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 14 | 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 15 | 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 16 | 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 17 | 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 18 | 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 19 | 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 20 | 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 21 | 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 22 | 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 23 | 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 24 | 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 25 | 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 26 | 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 27 | 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 28 | 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 29 | 2020/06/01 10:58:58.000.571,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 30 | 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 31 | 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 32 | 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 33 | 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 34 | 35 | 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Client/ChatClient.identcache: -------------------------------------------------------------------------------- 1 | _C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ufrmMain.pasaC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\ChatDemo\Client\ChatClient.dpr -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Client/ChatClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/ChatDemo/Client/ChatClient.res -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Client/Initial.txt: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Client/ufrmMain.fmx: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | ActiveControl = edtText 5 | Caption = 'Chat Client' 6 | ClientHeight = 480 7 | ClientWidth = 640 8 | Position = ScreenCenter 9 | FormFactor.Width = 320 10 | FormFactor.Height = 480 11 | FormFactor.Devices = [Desktop] 12 | OnCreate = FormCreate 13 | OnDestroy = FormDestroy 14 | DesignerMasterStyle = 0 15 | object memLog: TMemo 16 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 17 | DataDetectorTypes = [] 18 | ReadOnly = True 19 | TextSettings.WordWrap = True 20 | Align = Client 21 | Margins.Left = 5.000000000000000000 22 | Margins.Top = 5.000000000000000000 23 | Margins.Right = 5.000000000000000000 24 | Margins.Bottom = 5.000000000000000000 25 | Size.Width = 630.000000000000000000 26 | Size.Height = 369.000000000000000000 27 | Size.PlatformDefault = False 28 | TabOrder = 1 29 | Viewport.Width = 626.000000000000000000 30 | Viewport.Height = 365.000000000000000000 31 | end 32 | object ltMain: TLayout 33 | Align = Bottom 34 | Margins.Left = 5.000000000000000000 35 | Margins.Right = 5.000000000000000000 36 | Margins.Bottom = 5.000000000000000000 37 | Position.X = 5.000000000000000000 38 | Position.Y = 446.000000000000000000 39 | Size.Width = 630.000000000000000000 40 | Size.Height = 29.000000000000000000 41 | Size.PlatformDefault = False 42 | TabOrder = 3 43 | TabStop = False 44 | object edtText: TEdit 45 | Touch.InteractiveGestures = [LongTap, DoubleTap] 46 | Align = Client 47 | TabOrder = 0 48 | Margins.Right = 4.000000000000000000 49 | Size.Width = 546.000000000000000000 50 | Size.Height = 29.000000000000000000 51 | Size.PlatformDefault = False 52 | OnEnter = edtTextEnter 53 | OnExit = edtTextExit 54 | end 55 | object btnSend: TButton 56 | Align = Right 57 | Default = True 58 | Position.X = 550.000000000000000000 59 | Size.Width = 80.000000000000000000 60 | Size.Height = 29.000000000000000000 61 | Size.PlatformDefault = False 62 | TabOrder = 1 63 | Text = 'Send' 64 | OnClick = btnSendClick 65 | end 66 | end 67 | object edtClientName: TEdit 68 | Touch.InteractiveGestures = [LongTap, DoubleTap] 69 | Align = Bottom 70 | TabOrder = 2 71 | Text = 'Happy texter' 72 | Position.X = 5.000000000000000000 73 | Position.Y = 419.000000000000000000 74 | Margins.Left = 5.000000000000000000 75 | Margins.Right = 5.000000000000000000 76 | Margins.Bottom = 5.000000000000000000 77 | Size.Width = 630.000000000000000000 78 | Size.Height = 22.000000000000000000 79 | Size.PlatformDefault = False 80 | TextPrompt = 'Enter your name' 81 | end 82 | object tmrUpdateLog: TTimer 83 | Interval = 1 84 | OnTimer = tmrUpdateLogTimer 85 | Left = 96 86 | Top = 32 87 | end 88 | object ToolBar1: TToolBar 89 | Size.Width = 640.000000000000000000 90 | Size.Height = 40.000000000000000000 91 | Size.PlatformDefault = False 92 | TabOrder = 0 93 | TabStop = False 94 | object btnActivateClient: TButton 95 | Align = Left 96 | Margins.Left = 5.000000000000000000 97 | Margins.Top = 5.000000000000000000 98 | Margins.Right = 5.000000000000000000 99 | Margins.Bottom = 5.000000000000000000 100 | Position.X = 5.000000000000000000 101 | Position.Y = 5.000000000000000000 102 | Size.Width = 137.000000000000000000 103 | Size.Height = 30.000000000000000000 104 | Size.PlatformDefault = False 105 | TabOrder = 0 106 | Text = 'Activate Client' 107 | OnClick = btnActivateClientClick 108 | end 109 | object edtHost: TEdit 110 | Touch.InteractiveGestures = [LongTap, DoubleTap] 111 | Align = Client 112 | TabOrder = 1 113 | Text = 'LocalHost' 114 | Margins.Top = 5.000000000000000000 115 | Margins.Right = 5.000000000000000000 116 | Margins.Bottom = 5.000000000000000000 117 | Size.Width = 488.000000000000000000 118 | Size.Height = 30.000000000000000000 119 | Size.PlatformDefault = False 120 | OnChange = edtHostChange 121 | end 122 | end 123 | object Client: TncClientSource 124 | EncryptionKey = 'SetEncryptionKey' 125 | OnConnected = ClientConnected 126 | OnDisconnected = ClientDisconnected 127 | OnHandleCommand = ClientHandleCommand 128 | Host = 'LocalHost' 129 | OnReconnected = ClientReconnected 130 | Left = 32 131 | Top = 32 132 | end 133 | end 134 | -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Client/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, 8 | FMX.Edit, FMX.Layouts, FMX.Controls.Presentation, FMX.ScrollBox, 9 | FMX.Memo, System.SyncObjs, ncSources; 10 | 11 | type 12 | TfrmMain = class(TForm) 13 | memLog: TMemo; 14 | ltMain: TLayout; 15 | edtText: TEdit; 16 | btnSend: TButton; 17 | Client: TncClientSource; 18 | tmrUpdateLog: TTimer; 19 | edtClientName: TEdit; 20 | ToolBar1: TToolBar; 21 | btnActivateClient: TButton; 22 | edtHost: TEdit; 23 | procedure FormCreate(Sender: TObject); 24 | procedure FormDestroy(Sender: TObject); 25 | procedure btnSendClick(Sender: TObject); 26 | procedure tmrUpdateLogTimer(Sender: TObject); 27 | function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; 28 | const aData: TArray; aRequiresResult: Boolean; 29 | const aSenderComponent, aReceiverComponent: string): TArray; 30 | procedure edtTextEnter(Sender: TObject); 31 | procedure edtTextExit(Sender: TObject); 32 | procedure btnActivateClientClick(Sender: TObject); 33 | procedure ClientConnected(Sender: TObject; aLine: TncLine); 34 | procedure ClientDisconnected(Sender: TObject; aLine: TncLine); 35 | procedure ClientReconnected(Sender: TObject; aLine: TncLine); 36 | procedure edtHostChange(Sender: TObject); 37 | private 38 | LogLock: TCriticalSection; 39 | LogLines, LogLinesCopy: TStringList; 40 | public 41 | procedure Log(aStr: string); 42 | end; 43 | 44 | var 45 | frmMain: TfrmMain; 46 | 47 | implementation 48 | 49 | {$R *.fmx} 50 | 51 | procedure TfrmMain.FormCreate(Sender: TObject); 52 | begin 53 | LogLock := TCriticalSection.Create; 54 | LogLines := TStringList.Create; 55 | LogLinesCopy := TStringList.Create; 56 | end; 57 | 58 | procedure TfrmMain.FormDestroy(Sender: TObject); 59 | begin 60 | Client.Active := False; 61 | 62 | LogLinesCopy.Free; 63 | LogLines.Free; 64 | LogLock.Free; 65 | end; 66 | 67 | procedure TfrmMain.Log(aStr: string); 68 | begin 69 | // This is thread safe 70 | LogLock.Acquire; 71 | try 72 | LogLines.Add (aStr); 73 | finally 74 | LogLock.Release; 75 | end; 76 | end; 77 | 78 | procedure TfrmMain.tmrUpdateLogTimer(Sender: TObject); 79 | var 80 | i: Integer; 81 | begin 82 | // Update the memLog from LogLines 83 | LogLock.Acquire; 84 | try 85 | LogLinesCopy.Assign(LogLines); 86 | LogLines.Clear; 87 | finally 88 | LogLock.Release; 89 | end; 90 | 91 | for i := 0 to LogLinesCopy.Count - 1 do 92 | begin 93 | memLog.Lines.Add(LogLinesCopy.Strings[i]); 94 | memLog.SelStart := Length(memLog.Text); 95 | end; 96 | LogLinesCopy.Clear; 97 | end; 98 | 99 | procedure TfrmMain.btnActivateClientClick(Sender: TObject); 100 | begin 101 | Client.Active := not Client.Active; 102 | end; 103 | 104 | procedure TfrmMain.btnSendClick(Sender: TObject); 105 | begin 106 | Client.ExecCommand(0, BytesOf (edtClientName.Text + ': ' + edtText.Text)); 107 | edtText.Text := ''; 108 | end; 109 | 110 | procedure TfrmMain.edtHostChange(Sender: TObject); 111 | begin 112 | if not Client.Active then 113 | Client.Host := edtHost.Text; 114 | end; 115 | 116 | procedure TfrmMain.edtTextEnter(Sender: TObject); 117 | begin 118 | btnSend.Default := True; 119 | end; 120 | 121 | procedure TfrmMain.edtTextExit(Sender: TObject); 122 | begin 123 | btnSend.Default := False; 124 | end; 125 | 126 | procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); 127 | begin 128 | Log ('Client connected to peer: ' + aLine.PeerIP); 129 | TThread.Synchronize(nil, 130 | procedure 131 | begin 132 | btnActivateClient.Text := 'Deactivate client'; 133 | end); 134 | end; 135 | 136 | procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); 137 | begin 138 | Log ('Client disconnected from peer: ' + aLine.PeerIP); 139 | TThread.Synchronize(nil, 140 | procedure 141 | begin 142 | btnActivateClient.Text := 'Activate client'; 143 | end); 144 | end; 145 | 146 | procedure TfrmMain.ClientReconnected(Sender: TObject; aLine: TncLine); 147 | begin 148 | Log ('Client was reconnected to peer: ' + aLine.PeerIP); 149 | end; 150 | 151 | function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; 152 | aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 153 | const aSenderComponent, aReceiverComponent: string): TArray; 154 | begin 155 | Log (Stringof (aData)); 156 | end; 157 | 158 | end. 159 | -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/Server/Initial.txt: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /Demos/DB/ChatDemo/initial.txt: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /Demos/DB/DBClient/DBClient.dpr: -------------------------------------------------------------------------------- 1 | program DBClient; 2 | 3 | uses 4 | Vcl.Forms, 5 | ufrmMain in 'ufrmMain.pas' {frmMain}, 6 | udmMain in 'udmMain.pas' {dmMain: TDataModule}; 7 | 8 | {$R *.res} 9 | 10 | begin 11 | ReportMemoryLeaksOnShutdown := True; 12 | Application.Initialize; 13 | Application.MainFormOnTaskbar := True; 14 | Application.CreateForm(TfrmMain, frmMain); 15 | Application.CreateForm(TdmMain, dmMain); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/DB/DBClient/DBClient.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 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 5 | 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 6 | 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 7 | 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 8 | 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 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /Demos/DB/DBClient/DBClient.identcache: -------------------------------------------------------------------------------- 1 | [C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\DBClient.dprFc:\program files (x86)\embarcadero\studio\20.0\source\data\Data.DB.pasQc:\program files (x86)\embarcadero\studio\20.0\SOURCE\RTL\SYS\System.SysUtils.pas[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\ufrmMain.pasSc:\program files (x86)\embarcadero\studio\20.0\source\rtl\common\System.Classes.pasZC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBClient\udmMain.pasQc:\program files (x86)\embarcadero\studio\20.0\source\data\ado\Data.Win.ADODB.pas -------------------------------------------------------------------------------- /Demos/DB/DBClient/DBClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/DBClient/DBClient.res -------------------------------------------------------------------------------- /Demos/DB/DBClient/DBClient.skincfg: -------------------------------------------------------------------------------- 1 | [ExpressSkins] 2 | Default=1 3 | ShowNotifications=1 4 | Enabled=1 5 | dxSkinBlack=0 6 | dxSkinBlue=0 7 | dxSkinCaramel=0 8 | dxSkinCoffee=0 9 | dxSkinDarkRoom=0 10 | dxSkinDarkSide=0 11 | dxSkinFoggy=0 12 | dxSkinGlassOceans=0 13 | dxSkiniMaginary=0 14 | dxSkinLilian=0 15 | dxSkinLiquidSky=0 16 | dxSkinLondonLiquidSky=0 17 | dxSkinMcSkin=0 18 | dxSkinMoneyTwins=0 19 | dxSkinOffice2007Black=0 20 | dxSkinOffice2007Blue=0 21 | dxSkinOffice2007Green=0 22 | dxSkinOffice2007Pink=0 23 | dxSkinOffice2007Silver=0 24 | dxSkinPumpkin=0 25 | dxSkinSeven=0 26 | dxSkinSharp=0 27 | dxSkinSilver=0 28 | dxSkinSpringTime=0 29 | dxSkinStardust=0 30 | dxSkinSummer2008=0 31 | dxSkinsDefaultPainters=0 32 | dxSkinValentine=0 33 | dxSkinXmas2008Blue=0 34 | -------------------------------------------------------------------------------- /Demos/DB/DBClient/DBClient_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/DBClient/DBClient_Icon.ico -------------------------------------------------------------------------------- /Demos/DB/DBClient/udmMain.dfm: -------------------------------------------------------------------------------- 1 | object dmMain: TdmMain 2 | OldCreateOrder = False 3 | OnCreate = DataModuleCreate 4 | Height = 351 5 | Width = 376 6 | object ncClientSource: TncClientSource 7 | Port = 18753 8 | EncryptionKey = 'SetEncryptionKey' 9 | Host = 'localhost' 10 | Left = 56 11 | Top = 36 12 | end 13 | object ncDBDataset1: TncDBDataset 14 | CursorType = ctStatic 15 | LockType = ltBatchOptimistic 16 | Source = ncClientSource 17 | PeerCommandHandler = 'DBServer' 18 | SQL.Strings = ( 19 | 'select * from Customers') 20 | Parameters = <> 21 | Left = 112 22 | Top = 116 23 | end 24 | object DataSource1: TDataSource 25 | DataSet = ncDBDataset1 26 | Left = 196 27 | Top = 116 28 | end 29 | object ncDBDataset2: TncDBDataset 30 | CursorType = ctStatic 31 | LockType = ltBatchOptimistic 32 | Source = ncClientSource 33 | PeerCommandHandler = 'DBServer' 34 | SQL.Strings = ( 35 | 'select * from Orders' 36 | 'where FKCustomersID=:ID') 37 | DataSource = DataSource1 38 | IndexFieldNames = 'FKCustomersID' 39 | Parameters = < 40 | item 41 | Name = 'ID' 42 | Size = -1 43 | Value = Null 44 | end> 45 | Left = 112 46 | Top = 184 47 | end 48 | object DataSource2: TDataSource 49 | DataSet = ncDBDataset2 50 | Left = 196 51 | Top = 184 52 | end 53 | object ADOQuery1: TADOQuery 54 | Parameters = <> 55 | Left = 56 56 | Top = 276 57 | end 58 | end 59 | -------------------------------------------------------------------------------- /Demos/DB/DBClient/udmMain.pas: -------------------------------------------------------------------------------- 1 | unit udmMain; 2 | 3 | interface 4 | 5 | uses 6 | System.Classes, System.SysUtils, Data.DB, Data.Win.ADODB, ncSockets, ncSources, ncDBCnt; 7 | 8 | type 9 | TdmMain = class(TDataModule) 10 | ncClientSource: TncClientSource; 11 | ncDBDataset1: TncDBDataset; 12 | DataSource1: TDataSource; 13 | ncDBDataset2: TncDBDataset; 14 | DataSource2: TDataSource; 15 | ADOQuery1: TADOQuery; 16 | procedure DataModuleCreate(Sender: TObject); 17 | private 18 | { Private declarations } 19 | public 20 | { Public declarations } 21 | end; 22 | 23 | var 24 | dmMain: TdmMain; 25 | 26 | implementation 27 | 28 | uses ufrmMain; 29 | 30 | {$R *.dfm} 31 | 32 | procedure TdmMain.DataModuleCreate(Sender: TObject); 33 | begin 34 | ncDBDataset1.Active := True; 35 | ncDBDataset2.Active := True; 36 | end; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Demos/DB/DBClient/ufrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'Client DB Tester' 5 | ClientHeight = 392 6 | ClientWidth = 945 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | PixelsPerInch = 96 15 | TextHeight = 13 16 | object Panel2: TPanel 17 | Left = 245 18 | Top = 0 19 | Width = 700 20 | Height = 373 21 | Align = alClient 22 | TabOrder = 2 23 | object dbGrid1: TDBGrid 24 | AlignWithMargins = True 25 | Left = 4 26 | Top = 4 27 | Width = 692 28 | Height = 150 29 | Align = alTop 30 | DataSource = dmMain.DataSource1 31 | TabOrder = 0 32 | TitleFont.Charset = DEFAULT_CHARSET 33 | TitleFont.Color = clWindowText 34 | TitleFont.Height = -11 35 | TitleFont.Name = 'Tahoma' 36 | TitleFont.Style = [] 37 | end 38 | object DBNavigator1: TDBNavigator 39 | AlignWithMargins = True 40 | Left = 4 41 | Top = 160 42 | Width = 692 43 | Height = 35 44 | DataSource = dmMain.DataSource1 45 | Align = alTop 46 | TabOrder = 1 47 | end 48 | object DBGrid2: TDBGrid 49 | AlignWithMargins = True 50 | Left = 4 51 | Top = 201 52 | Width = 692 53 | Height = 130 54 | Align = alClient 55 | DataSource = dmMain.DataSource2 56 | TabOrder = 2 57 | TitleFont.Charset = DEFAULT_CHARSET 58 | TitleFont.Color = clWindowText 59 | TitleFont.Height = -11 60 | TitleFont.Name = 'Tahoma' 61 | TitleFont.Style = [] 62 | end 63 | object DBNavigator2: TDBNavigator 64 | AlignWithMargins = True 65 | Left = 4 66 | Top = 337 67 | Width = 692 68 | Height = 32 69 | DataSource = dmMain.DataSource2 70 | Align = alBottom 71 | TabOrder = 3 72 | end 73 | end 74 | object StatusBar: TStatusBar 75 | Left = 0 76 | Top = 373 77 | Width = 945 78 | Height = 19 79 | Panels = <> 80 | SimplePanel = True 81 | end 82 | object Panel1: TPanel 83 | Left = 0 84 | Top = 0 85 | Width = 245 86 | Height = 373 87 | Align = alLeft 88 | TabOrder = 0 89 | object Button1: TButton 90 | Left = 6 91 | Top = 52 92 | Width = 219 93 | Height = 25 94 | Caption = 'Test Activate/Deactivate Recordset Cycle' 95 | TabOrder = 0 96 | OnClick = Button1Click 97 | end 98 | object Button2: TButton 99 | Left = 6 100 | Top = 111 101 | Width = 219 102 | Height = 25 103 | Caption = 'Test Requery' 104 | TabOrder = 1 105 | OnClick = Button2Click 106 | end 107 | object cbShowOpenClose: TCheckBox 108 | Left = 12 109 | Top = 83 110 | Width = 213 111 | Height = 17 112 | Caption = 'Show Open/Close' 113 | TabOrder = 2 114 | end 115 | object Button4: TButton 116 | Left = 6 117 | Top = 230 118 | Width = 161 119 | Height = 45 120 | Caption = 'Filter Pending' 121 | TabOrder = 3 122 | OnClick = Button4Click 123 | end 124 | object edtHost: TEdit 125 | Left = 6 126 | Top = 10 127 | Width = 121 128 | Height = 21 129 | TabOrder = 4 130 | Text = 'LocalHost' 131 | TextHint = 'Host' 132 | OnChange = edtHostChange 133 | end 134 | object btnApplyUpdates: TButton 135 | Left = 6 136 | Top = 281 137 | Width = 161 138 | Height = 45 139 | Caption = 'Apply Updates' 140 | TabOrder = 5 141 | OnClick = btnApplyUpdatesClick 142 | end 143 | end 144 | end 145 | -------------------------------------------------------------------------------- /Demos/DB/DBClient/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 7 | Dialogs, udmMain, DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ncSockets, ncDBCnt, 8 | ComCtrls, ADOInt, ADODB, Data.DB; 9 | 10 | type 11 | TfrmMain = class(TForm) 12 | StatusBar: TStatusBar; 13 | Panel1: TPanel; 14 | Panel2: TPanel; 15 | dbGrid1: TDBGrid; 16 | DBNavigator1: TDBNavigator; 17 | DBGrid2: TDBGrid; 18 | DBNavigator2: TDBNavigator; 19 | Button1: TButton; 20 | Button2: TButton; 21 | cbShowOpenClose: TCheckBox; 22 | Button4: TButton; 23 | edtHost: TEdit; 24 | btnApplyUpdates: TButton; 25 | procedure Button1Click(Sender: TObject); 26 | procedure Button2Click(Sender: TObject); 27 | procedure Button4Click(Sender: TObject); 28 | procedure edtHostChange(Sender: TObject); 29 | procedure btnApplyUpdatesClick(Sender: TObject); 30 | private 31 | { Private declarations } 32 | public 33 | { Public declarations } 34 | end; 35 | 36 | var 37 | frmMain: TfrmMain; 38 | 39 | implementation 40 | 41 | {$R *.dfm} 42 | 43 | var 44 | InButton1: Boolean = False; 45 | PrevBtn1Cap: string; 46 | 47 | procedure TfrmMain.Button1Click(Sender: TObject); 48 | var 49 | TimeStart, TimeEnd: Int64; 50 | 51 | Freq: Int64; 52 | i: Integer; 53 | begin 54 | if InButton1 then 55 | begin 56 | Button1.Caption := PrevBtn1Cap; 57 | 58 | InButton1 := False; 59 | Exit; 60 | end; 61 | 62 | // Test n alive queries 63 | InButton1 := True; 64 | try 65 | PrevBtn1Cap := Button1.Caption; 66 | Button1.Caption := 'Stop'; 67 | 68 | if not cbShowOpenClose.Checked then 69 | begin 70 | dmMain.DataSource1.DataSet := nil; 71 | dmMain.DataSource2.DataSet := nil; 72 | end; 73 | try 74 | QueryPerformanceFrequency(Freq); 75 | QueryPerformanceCounter(TimeStart); 76 | i := 0; 77 | while InButton1 and not Application.Terminated do 78 | begin 79 | i := i + 1; 80 | if i mod 100 = 0 then 81 | begin 82 | StatusBar.SimpleText := Format('Iteration: %4.4d, Mean Open/Close Time: %f (ms)', [i, 1000 * (TimeEnd - TimeStart) / (i * Freq)]); 83 | Application.ProcessMessages; 84 | end; 85 | // Test open/close time 86 | dmMain.ncDBDataset1.Active := False; 87 | dmMain.ncDBDataset1.Active := True; 88 | // Test ExecSQL time 89 | // dmMain.ncDBDataset1.SQL.Text := 'UPDATE Customers SET CustomerName = ''Bill'' where ID = 1'; 90 | // dmMain.ncDBDataset1.ExecSQL; 91 | QueryPerformanceCounter(TimeEnd); 92 | end; 93 | finally 94 | if dmMain.DataSource1.DataSet = nil then 95 | begin 96 | dmMain.DataSource1.DataSet := dmMain.ncDBDataset1; 97 | dmMain.DataSource2.DataSet := dmMain.ncDBDataset2; 98 | end; 99 | end; 100 | finally 101 | InButton1 := False; 102 | end; 103 | end; 104 | 105 | procedure TfrmMain.Button2Click(Sender: TObject); 106 | begin 107 | dmMain.ncDBDataset2.Requery; 108 | end; 109 | 110 | procedure TfrmMain.Button4Click(Sender: TObject); 111 | begin 112 | dmMain.ncDBDataset1.FilterGroup := fgPendingRecords; 113 | dmMain.ncDBDataset1.Filtered := not dmMain.ncDBDataset1.Filtered; 114 | end; 115 | 116 | procedure TfrmMain.btnApplyUpdatesClick(Sender: TObject); 117 | begin 118 | dmMain.ncDBDataset1.ApplyUpdates; 119 | dmMain.ncDBDataset2.ApplyUpdates; 120 | end; 121 | 122 | procedure TfrmMain.edtHostChange(Sender: TObject); 123 | begin 124 | dmMain.ncClientSource.Active := False; 125 | dmMain.ncClientSource.Host := edtHost.Text; 126 | end; 127 | 128 | end. 129 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/DBServerService.dpr: -------------------------------------------------------------------------------- 1 | program DBServerService; 2 | 3 | uses 4 | Windows, 5 | SysUtils, 6 | SvcMgr, 7 | usvcMain in 'usvcMain.pas' {NetcomDataServer: TService}, 8 | uscvServiceCommands in 'uscvServiceCommands.pas'; 9 | 10 | {$R *.RES} 11 | 12 | begin 13 | // Windows 2003 Server requires StartServiceCtrlDispatcher to be 14 | // called before CoRegisterClassObject, which can be called indirectly 15 | // by Application.Initialize. TServiceApplication.DelayInitialize allows 16 | // Application.Initialize to be called from TService.Main (after 17 | // StartServiceCtrlDispatcher has been called). 18 | // 19 | // Delayed initialization of the Application object may affect 20 | // events which then occur prior to initialization, such as 21 | // TService.OnCreate. It is only recommended if the ServiceApplication 22 | // registers a class object with OLE and is intended for use with 23 | // Windows 2003 Server. 24 | // 25 | // Application.DelayInitialize := True; 26 | // 27 | SetCurrentDirectory(PChar (ExtractFilePath (ParamStr (0)))); 28 | if not Application.DelayInitialize or Application.Installing then 29 | Application.Initialize; 30 | Application.CreateForm(TNetcomDataServer, Service); 31 | Application.Run; 32 | end. 33 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/DBServerService.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {1CE60A32-3682-445E-BC9A-10E419519CEC} 4 | 12.0 5 | DBServerService.dpr 6 | Debug 7 | DCC32 8 | 9 | 10 | true 11 | 12 | 13 | true 14 | Base 15 | true 16 | 17 | 18 | true 19 | Base 20 | true 21 | 22 | 23 | DBServerService.exe 24 | $(BDSCOMMONDIR)\DCU 25 | $(BDSCOMMONDIR)\DCP 26 | 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 27 | 00400000 28 | x86 29 | WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;$(DCC_UnitAlias) 30 | true 31 | 32 | 33 | false 34 | false 35 | RELEASE;$(DCC_Define) 36 | 0 37 | false 38 | 39 | 40 | true 41 | DEBUG;$(DCC_Define) 42 | 43 | 44 | 45 | MainSource 46 | 47 | 48 |
NetcomDataServer
49 | TService 50 | 51 | 52 | 53 | Base 54 | 55 | 56 | Cfg_2 57 | Base 58 | 59 | 60 | Cfg_1 61 | Base 62 | 63 | 64 | 65 | 66 | Delphi.Personality.12 67 | 68 | 69 | 70 | 71 | DBServerService.dpr 72 | 73 | 74 | False 75 | True 76 | False 77 | /install 78 | 79 | 80 | True 81 | False 82 | 1 83 | 0 84 | 0 85 | 0 86 | False 87 | False 88 | False 89 | False 90 | True 91 | 1033 92 | 1200 93 | 94 | 95 | 96 | Service Prototype 97 | 1.0.0.0 98 | 99 | 100 | 101 | 102 | 103 | 1.0.0.0 104 | 105 | 106 | Embarcadero C++Builder Office XP Servers Package 107 | Embarcadero C++Builder Office 2000 Servers Package 108 | Microsoft Office 2000 Sample Automation Server Wrapper Components 109 | ExpressPivotGrid 2 OLAP by Developer Express Inc. 110 | 111 | 112 | 113 | 12 114 | 115 | 116 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/DBServerService.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/DBServerService.identcache: -------------------------------------------------------------------------------- 1 | nC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\uscvServiceCommands.pascC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pasjC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\DBServerService.dpr -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/DBServerService.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/DBServer/Service/DBServerService.res -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/DBServerService.skincfg: -------------------------------------------------------------------------------- 1 | [ExpressSkins] 2 | Default=1 3 | ShowNotifications=1 4 | Enabled=1 5 | dxSkinBlack=0 6 | dxSkinBlue=0 7 | dxSkinCaramel=0 8 | dxSkinCoffee=0 9 | dxSkinDarkRoom=0 10 | dxSkinDarkSide=0 11 | dxSkinFoggy=0 12 | dxSkinGlassOceans=0 13 | dxSkiniMaginary=0 14 | dxSkinLilian=0 15 | dxSkinLiquidSky=0 16 | dxSkinLondonLiquidSky=0 17 | dxSkinMcSkin=0 18 | dxSkinMoneyTwins=0 19 | dxSkinOffice2007Black=0 20 | dxSkinOffice2007Blue=0 21 | dxSkinOffice2007Green=0 22 | dxSkinOffice2007Pink=0 23 | dxSkinOffice2007Silver=0 24 | dxSkinPumpkin=0 25 | dxSkinSeven=0 26 | dxSkinSharp=0 27 | dxSkinSilver=0 28 | dxSkinSpringTime=0 29 | dxSkinStardust=0 30 | dxSkinSummer2008=0 31 | dxSkinsDefaultPainters=0 32 | dxSkinValentine=0 33 | dxSkinXmas2008Blue=0 34 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/DBServerService_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/DBServer/Service/DBServerService_Icon.ico -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/uscvServiceCommands.pas: -------------------------------------------------------------------------------- 1 | unit uscvServiceCommands; 2 | 3 | interface 4 | 5 | implementation 6 | 7 | end. 8 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/usvcMain.dfm: -------------------------------------------------------------------------------- 1 | object NetcomDataServer: TNetcomDataServer 2 | OldCreateOrder = False 3 | OnCreate = ServiceCreate 4 | OnDestroy = ServiceDestroy 5 | DisplayName = 'Netcom7 Database Server' 6 | OnShutdown = ServiceShutdown 7 | OnStart = ServiceStart 8 | OnStop = ServiceStop 9 | Height = 254 10 | Width = 270 11 | object srvController: TncServerSource 12 | Port = 18753 13 | EncryptionKey = 'SetEncryptionKey' 14 | Left = 40 15 | Top = 32 16 | end 17 | object DBServer: TncDBServer 18 | ADOConnection = ADOConnection 19 | Source = srvController 20 | Left = 40 21 | Top = 92 22 | end 23 | object ADOConnection: TADOConnection 24 | ConnectionString = 25 | 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=.\..\TestData\Custo' + 26 | 'mers.mdb;Persist Security Info=False;' 27 | LoginPrompt = False 28 | Mode = cmShareDenyNone 29 | Provider = 'Microsoft.Jet.OLEDB.4.0' 30 | Left = 128 31 | Top = 92 32 | end 33 | end 34 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/Service/usvcMain.pas: -------------------------------------------------------------------------------- 1 | unit usvcMain; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, 7 | ncSources, ncSockets, Registry, DB, ADODB, ncCommandHandlers, ncDBSrv, ActiveX; 8 | 9 | type 10 | TsvcOnLogMessage = procedure(Sender: TObject; aMessage: string; aError: Boolean = False) of object; 11 | 12 | // Name property is the name we are going to use to uniquelly identify our service 13 | TNetcomDataServer = class(TService) 14 | srvController: TncServerSource; 15 | DBServer: TncDBServer; 16 | ADOConnection: TADOConnection; 17 | procedure ServiceCreate(Sender: TObject); 18 | procedure ServiceDestroy(Sender: TObject); 19 | procedure ServiceStart(Sender: TService; var Started: Boolean); 20 | procedure ServiceStop(Sender: TService; var Stopped: Boolean); 21 | procedure ServiceShutdown(Sender: TService); 22 | private 23 | FOnLogMessage: TsvcOnLogMessage; 24 | function GetServicePort: Integer; 25 | procedure SetServicePort(const Value: Integer); 26 | function GetDBConnectionString: string; 27 | procedure SetDBConnectionString(const Value: string); 28 | procedure StopAndShutdown; 29 | function GetCacheResponses: Boolean; 30 | procedure SetCacheResponses(const Value: Boolean); 31 | public 32 | Settings: TRegistry; 33 | procedure Log(aStr: string; aError: Boolean = False); 34 | function GetServiceController: TServiceController; override; 35 | property OnLogMessage: TsvcOnLogMessage read FOnLogMessage write FOnLogMessage; 36 | property ServicePort: Integer read GetServicePort write SetServicePort; 37 | property DBConnectionString: string read GetDBConnectionString write SetDBConnectionString; 38 | property CacheResponses: Boolean read GetCacheResponses write SetCacheResponses; 39 | end; 40 | 41 | var 42 | Service: TNetcomDataServer; 43 | 44 | implementation 45 | 46 | uses uscvServiceCommands; 47 | {$R *.DFM} 48 | 49 | procedure ServiceController(CtrlCode: DWord); stdcall; 50 | begin 51 | Service.Controller(CtrlCode); 52 | end; 53 | 54 | function TNetcomDataServer.GetServiceController: TServiceController; 55 | begin 56 | Result := ServiceController; 57 | end; 58 | 59 | procedure TNetcomDataServer.ServiceCreate(Sender: TObject); 60 | begin 61 | FOnLogMessage := nil; 62 | Settings := TRegistry.Create(KEY_READ or KEY_WRITE); 63 | Settings.LazyWrite := False; 64 | Settings.RootKey := HKEY_CURRENT_USER; 65 | if not Settings.OpenKey('\HKEY_CURRENT_USER\Software\' + Name, True) then 66 | Log('Cannot open settings key: \HKEY_CURRENT_USER\Software\' + Name); 67 | end; 68 | 69 | procedure TNetcomDataServer.ServiceDestroy(Sender: TObject); 70 | begin 71 | Settings.CloseKey; 72 | Settings.Free; 73 | end; 74 | 75 | procedure TNetcomDataServer.Log(aStr: string; aError: Boolean = False); 76 | var 77 | ErrType: DWord; 78 | begin 79 | if Assigned(FOnLogMessage) then 80 | // Call custom handler 81 | FOnLogMessage(Self, aStr, aError) 82 | else 83 | begin 84 | // Write to windows log system 85 | if aError then 86 | ErrType := EVENTLOG_AUDIT_FAILURE 87 | else 88 | ErrType := EVENTLOG_AUDIT_SUCCESS; 89 | Self.LogMessage(aStr, ErrType); 90 | end; 91 | end; 92 | 93 | procedure TNetcomDataServer.ServiceStart(Sender: TService; var Started: Boolean); 94 | begin 95 | try 96 | CoInitialize(nil); 97 | // Put critical startup code here 98 | srvController.Port := ServicePort; 99 | ADOConnection.ConnectionString := DBConnectionString; 100 | DBServer.CacheResponses := CacheResponses; 101 | 102 | ADOConnection.Connected := True; 103 | srvController.Active := True; 104 | 105 | Log('"' + DisplayName + '" (' + Name + ') service started successfully, on port: ' + IntTostr(srvController.Port)); 106 | except 107 | on E: Exception do 108 | begin 109 | Log('"' + DisplayName + '" (' + Name + ') service failed to start. ' + E.Message, True); 110 | Started := False; 111 | end; 112 | end; 113 | end; 114 | 115 | procedure TNetcomDataServer.ServiceStop(Sender: TService; var Stopped: Boolean); 116 | begin 117 | StopAndShutdown; 118 | 119 | Log('"' + DisplayName + '" service stopped successfully'); 120 | end; 121 | 122 | procedure TNetcomDataServer.ServiceShutdown(Sender: TService); 123 | begin 124 | StopAndShutdown; 125 | 126 | Log('"' + DisplayName + '" service stopped successfully'); 127 | end; 128 | 129 | procedure TNetcomDataServer.StopAndShutdown; 130 | begin 131 | srvController.Active := False; 132 | ADOConnection.Connected := False; 133 | CoUninitialize; 134 | end; 135 | 136 | function TNetcomDataServer.GetServicePort: Integer; 137 | begin 138 | try 139 | if not Settings.ValueExists('ServicePort') then 140 | Abort; 141 | Result := Settings.ReadInteger('ServicePort'); 142 | except 143 | Result := srvController.Port; 144 | end; 145 | end; 146 | 147 | procedure TNetcomDataServer.SetServicePort(const Value: Integer); 148 | begin 149 | Settings.WriteInteger('ServicePort', Value); 150 | end; 151 | 152 | function TNetcomDataServer.GetDBConnectionString: string; 153 | begin 154 | try 155 | if not Settings.ValueExists('DBConnection') then 156 | Abort; 157 | Result := Settings.ReadString('DBConnection'); 158 | except 159 | Result := ADOConnection.ConnectionString; 160 | end; 161 | end; 162 | 163 | procedure TNetcomDataServer.SetDBConnectionString(const Value: string); 164 | begin 165 | Settings.WriteString('DBConnection', Value); 166 | end; 167 | 168 | function TNetcomDataServer.GetCacheResponses: Boolean; 169 | begin 170 | try 171 | if not Settings.ValueExists('CacheResponses') then 172 | Abort; 173 | Result := Settings.ReadBool('CacheResponses'); 174 | except 175 | Result := DBServer.CacheResponses; 176 | end; 177 | end; 178 | 179 | procedure TNetcomDataServer.SetCacheResponses(const Value: Boolean); 180 | begin 181 | Settings.WriteBool('CacheResponses', Value); 182 | end; 183 | 184 | end. 185 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/ServiceApplication/DBServerApplication.dpr: -------------------------------------------------------------------------------- 1 | program DBServerApplication; 2 | 3 | uses 4 | Forms, 5 | ufrmMain in 'ufrmMain.pas' { frmMain } , 6 | uscvServiceCommands in '..\Service\uscvServiceCommands.pas', 7 | usvcMain in '..\Service\usvcMain.pas' { svcMain: TService } ; 8 | {$R *.res} 9 | 10 | begin 11 | ReportMemoryLeaksOnShutdown := True; 12 | 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.ShowMainForm := False; 16 | Service := TNetcomDataServer.Create(nil); 17 | try 18 | Application.Title := Service.DisplayName; 19 | Application.CreateForm(TfrmMain, frmMain); 20 | Application.Run; 21 | finally 22 | Service.Free; 23 | end; 24 | end. 25 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/ServiceApplication/DBServerApplication.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 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 5 | 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 6 | 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 7 | 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 8 | 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 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/ServiceApplication/DBServerApplication.identcache: -------------------------------------------------------------------------------- 1 | nC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\ufrmMain.pasyC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\ServiceApplication\DBServerApplication.dprnC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\uscvServiceCommands.pascC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\DB\DBServer\Service\usvcMain.pas -------------------------------------------------------------------------------- /Demos/DB/DBServer/ServiceApplication/DBServerApplication.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/DBServer/ServiceApplication/DBServerApplication.res -------------------------------------------------------------------------------- /Demos/DB/DBServer/ServiceApplication/DBServerApplication.skincfg: -------------------------------------------------------------------------------- 1 | [ExpressSkins] 2 | Default=1 3 | ShowNotifications=1 4 | Enabled=1 5 | dxSkinBlack=0 6 | dxSkinBlue=0 7 | dxSkinCaramel=0 8 | dxSkinCoffee=0 9 | dxSkinDarkRoom=0 10 | dxSkinDarkSide=0 11 | dxSkinFoggy=0 12 | dxSkinGlassOceans=0 13 | dxSkiniMaginary=0 14 | dxSkinLilian=0 15 | dxSkinLiquidSky=0 16 | dxSkinLondonLiquidSky=0 17 | dxSkinMcSkin=0 18 | dxSkinMoneyTwins=0 19 | dxSkinOffice2007Black=0 20 | dxSkinOffice2007Blue=0 21 | dxSkinOffice2007Green=0 22 | dxSkinOffice2007Pink=0 23 | dxSkinOffice2007Silver=0 24 | dxSkinPumpkin=0 25 | dxSkinSeven=0 26 | dxSkinSharp=0 27 | dxSkinSilver=0 28 | dxSkinSpringTime=0 29 | dxSkinStardust=0 30 | dxSkinSummer2008=0 31 | dxSkinsDefaultPainters=0 32 | dxSkinValentine=0 33 | dxSkinXmas2008Blue=0 34 | -------------------------------------------------------------------------------- /Demos/DB/DBServer/ServiceApplication/DBServerApplication_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/DBServer/ServiceApplication/DBServerApplication_Icon.ico -------------------------------------------------------------------------------- /Demos/DB/DBServer/TestData/Customers.mdb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/DB/DBServer/TestData/Customers.mdb -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Client/NetComVSIndyClient.dpr: -------------------------------------------------------------------------------- 1 | program NetComVSIndyClient; 2 | 3 | uses 4 | Vcl.Forms, 5 | ufrmMain in 'ufrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Client/NetComVSIndyClient.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 5 | 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 6 | 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 7 | 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 8 | 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 9 | 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 10 | 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 11 | 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 12 | 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas 13 | 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 14 | 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 15 | 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 16 | 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 17 | 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 18 | 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 19 | 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 20 | 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 21 | 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 22 | 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 23 | 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 24 | 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 25 | 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 26 | 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 27 | 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 28 | 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 29 | 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 30 | 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 31 | 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 32 | 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 33 | 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 34 | 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 35 | 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 36 | 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 37 | 2020/08/11 06:18:58.000.380,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 38 | 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 39 | 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 40 | 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 41 | 42 | 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Client/NetComVSIndyClient.identcache: -------------------------------------------------------------------------------- 1 | mC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\NetComVSIndyClient.dprcC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Client\ufrmMain.pas -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Client/NetComVSIndyClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/NetComVSIndy/Client/NetComVSIndyClient.res -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Client/ufrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'NetCom vs Indy speed testing' 5 | ClientHeight = 358 6 | ClientWidth = 802 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object pnlToolbar: TPanel 18 | Left = 0 19 | Top = 0 20 | Width = 802 21 | Height = 41 22 | Align = alTop 23 | BevelOuter = bvNone 24 | FullRepaint = False 25 | TabOrder = 0 26 | object Label1: TLabel 27 | Left = 328 28 | Top = 14 29 | Width = 51 30 | Height = 13 31 | Caption = 'Iterations:' 32 | end 33 | object btnTestSpeed: TButton 34 | Left = 0 35 | Top = 0 36 | Width = 121 37 | Height = 41 38 | Align = alLeft 39 | Caption = 'Test Speed' 40 | TabOrder = 0 41 | OnClick = btnTestSpeedClick 42 | end 43 | object edtIterations: TSpinEdit 44 | Left = 385 45 | Top = 11 46 | Width = 81 47 | Height = 22 48 | MaxValue = 0 49 | MinValue = 0 50 | TabOrder = 1 51 | Value = 10000 52 | end 53 | object rbTestNetCom: TRadioButton 54 | Left = 145 55 | Top = 12 56 | Width = 80 57 | Height = 17 58 | Caption = 'Test NetCom' 59 | Checked = True 60 | TabOrder = 2 61 | TabStop = True 62 | end 63 | object rbTestIndy: TRadioButton 64 | Left = 231 65 | Top = 12 66 | Width = 82 67 | Height = 17 68 | Caption = 'Test Indy' 69 | TabOrder = 3 70 | end 71 | end 72 | object memLog: TMemo 73 | Left = 0 74 | Top = 41 75 | Width = 802 76 | Height = 317 77 | Align = alClient 78 | TabOrder = 1 79 | end 80 | object ncClient: TncTCPClient 81 | Host = 'LocalHost' 82 | UseReaderThread = False 83 | NoDelay = True 84 | KeepAlive = False 85 | Reconnect = False 86 | Left = 304 87 | Top = 32 88 | end 89 | object idClient: TIdTCPClient 90 | ConnectTimeout = 0 91 | Host = 'LocalHost' 92 | IPVersion = Id_IPv4 93 | Port = 16234 94 | ReadTimeout = -1 95 | Left = 304 96 | Top = 88 97 | end 98 | end 99 | -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Client/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Samples.Spin, 8 | IdTCPConnection, IdTCPClient, IdBaseComponent, IdComponent, IdCustomTCPServer, 9 | IdTCPServer, IdContext, IdGlobal, 10 | Winapi.Winsock2, System.Diagnostics, ncSockets, ncLines; 11 | 12 | const 13 | // We are testing the socket mechanisms here and not how fast tcp/ip is, 14 | // therefore the buffer sent back and forth is kept at a fairly minimal size 15 | BuffSize = 256; 16 | 17 | type 18 | TfrmMain = class(TForm) 19 | ncClient: TncTCPClient; 20 | idClient: TIdTCPClient; 21 | pnlToolbar: TPanel; 22 | memLog: TMemo; 23 | btnTestSpeed: TButton; 24 | edtIterations: TSpinEdit; 25 | Label1: TLabel; 26 | rbTestNetCom: TRadioButton; 27 | rbTestIndy: TRadioButton; 28 | procedure FormCreate(Sender: TObject); 29 | procedure btnTestSpeedClick(Sender: TObject); 30 | private 31 | BufferSend, BufferRead: TBytes; 32 | idBufferSend, idBufferRead: TidBytes; 33 | public 34 | end; 35 | 36 | var 37 | frmMain: TfrmMain; 38 | 39 | implementation 40 | 41 | {$R *.dfm} 42 | 43 | procedure TfrmMain.FormCreate(Sender: TObject); 44 | begin 45 | SetLength(BufferSend, BuffSize); 46 | SetLength(BufferRead, BuffSize); 47 | SetLength(idBufferSend, BuffSize); 48 | SetLength(idBufferRead, BuffSize); 49 | end; 50 | 51 | procedure TfrmMain.btnTestSpeedClick(Sender: TObject); 52 | var 53 | i: Integer; 54 | TimeSt: Cardinal; 55 | TimeTaken: Cardinal; 56 | begin 57 | if rbTestNetCom.Checked then 58 | ncClient.Active := True; 59 | if rbTestIndy.Checked then 60 | idClient.Connect; 61 | 62 | if rbTestNetCom.Checked then 63 | begin 64 | memLog.Lines.Add('Testing NetCom...'); 65 | TimeSt := GetTickCount; 66 | for i := 1 to edtIterations.Value do 67 | begin 68 | ncClient.Send(BufferSend); 69 | ncClient.ReceiveRaw(BufferRead); 70 | end; 71 | TimeTaken := GetTickCount - TimeSt; 72 | memLog.Lines.Add('Time taken: ' + IntToStr(TimeTaken) + ' msec'); 73 | end; 74 | 75 | if rbTestIndy.Checked then 76 | begin 77 | memLog.Lines.Add('Testing Indy...'); 78 | TimeSt := GetTickCount; 79 | for i := 1 to edtIterations.Value do 80 | begin 81 | idClient.Socket.Write(idBufferSend); 82 | idClient.Socket.ReadBytes(idBufferRead, BuffSize, False); 83 | end; 84 | TimeTaken := GetTickCount - TimeSt; 85 | memLog.Lines.Add('Time taken: ' + IntToStr(TimeTaken) + ' msec'); 86 | end; 87 | 88 | if rbTestNetCom.Checked then 89 | ncClient.Active := False; 90 | if rbTestIndy.Checked then 91 | idClient.Disconnect; 92 | end; 93 | 94 | end. 95 | -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Server/NetComVSIndyServer.dpr: -------------------------------------------------------------------------------- 1 | program NetComVSIndyServer; 2 | 3 | uses 4 | Vcl.Forms, 5 | ufrmMain in 'ufrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TfrmMain, frmMain); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Server/NetComVSIndyServer.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 5 | 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 6 | 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 7 | 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 8 | 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 9 | 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 10 | 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 11 | 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 12 | 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas 13 | 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 14 | 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 15 | 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 16 | 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 17 | 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 18 | 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 19 | 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 20 | 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 21 | 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 22 | 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 23 | 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 24 | 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 25 | 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 26 | 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 27 | 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 28 | 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 29 | 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 30 | 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 31 | 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 32 | 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 33 | 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 34 | 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 35 | 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 36 | 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 37 | 2020/08/11 06:48:47.000.137,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 38 | 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 39 | 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 40 | 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 41 | 42 | 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Server/NetComVSIndyServer.identcache: -------------------------------------------------------------------------------- 1 | cC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\ufrmMain.pasmC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\NetComVSIndy\Server\NetComVSIndyServer.dpr -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Server/NetComVSIndyServer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/NetComVSIndy/Server/NetComVSIndyServer.res -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Server/ufrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'NetCom VS Indy Server' 5 | ClientHeight = 57 6 | ClientWidth = 601 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | PixelsPerInch = 96 16 | TextHeight = 13 17 | object Label1: TLabel 18 | Left = 24 19 | Top = 24 20 | Width = 555 21 | Height = 13 22 | Caption = 23 | 'Servers activate on creation (except if there was an error). You' + 24 | ' can now run the client while this program is running' 25 | end 26 | object ncServer: TncTCPServer 27 | NoDelay = True 28 | OnReadData = ncServerReadData 29 | Left = 456 30 | Top = 8 31 | end 32 | object idServer: TIdTCPServer 33 | Bindings = <> 34 | DefaultPort = 16234 35 | OnExecute = idServerExecute 36 | Left = 504 37 | Top = 8 38 | end 39 | end 40 | -------------------------------------------------------------------------------- /Demos/NetComVSIndy/Server/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.Winsock2, 8 | IdContext, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdGlobal, 9 | System.Diagnostics, ncLines, ncSockets, Vcl.StdCtrls; 10 | 11 | type 12 | TfrmMain = class(TForm) 13 | ncServer: TncTCPServer; 14 | idServer: TIdTCPServer; 15 | Label1: TLabel; 16 | procedure FormCreate(Sender: TObject); 17 | procedure ncServerReadData(Sender: TObject; aLine: TncLine; 18 | const aBuf: TArray; aBufCount: Integer); 19 | procedure idServerExecute(AContext: TIdContext); 20 | private 21 | { Private declarations } 22 | public 23 | { Public declarations } 24 | end; 25 | 26 | var 27 | frmMain: TfrmMain; 28 | 29 | implementation 30 | 31 | {$R *.dfm} 32 | 33 | procedure TfrmMain.FormCreate(Sender: TObject); 34 | begin 35 | ncServer.Active := True; 36 | idServer.Active := True; 37 | end; 38 | 39 | procedure TfrmMain.idServerExecute(AContext: TIdContext); 40 | var 41 | Data: TIdBytes; 42 | begin 43 | // Reply with data received 44 | if not aContext.Connection.IOHandler.InputBufferIsEmpty then 45 | begin 46 | aContext.Connection.IOHandler.InputBuffer.ExtractToBytes(Data); 47 | aContext.Binding.Send(Data); 48 | end; 49 | end; 50 | 51 | procedure TfrmMain.ncServerReadData(Sender: TObject; aLine: TncLine; 52 | const aBuf: TArray; aBufCount: Integer); 53 | var 54 | Data: TBytes; 55 | begin 56 | // Reply with data received 57 | Data := Copy (aBuf, 0, aBufCount); 58 | ncServer.Send(aLine, Data); 59 | end; 60 | 61 | end. 62 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Client.dpr: -------------------------------------------------------------------------------- 1 | program Client; 2 | 3 | uses 4 | Vcl.Forms, 5 | ufrmMain in 'ufrmMain.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | {$IFDEF DEBUG} 11 | ReportMemoryLeaksOnShutdown := True; 12 | {$ENDIF} 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TForm1, Form1); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Client.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Client.identcache: -------------------------------------------------------------------------------- 1 | ]C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\ufrmMain.pas[C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Client.dpr -------------------------------------------------------------------------------- /Demos/SimpleSockets/Client.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/SimpleSockets/Client.res -------------------------------------------------------------------------------- /Demos/SimpleSockets/Client.skincfg: -------------------------------------------------------------------------------- 1 | [ExpressSkins] 2 | Default=1 3 | ShowNotifications=1 4 | Enabled=1 5 | dxSkinBlack=1 6 | dxSkinBlue=0 7 | dxSkinCaramel=0 8 | dxSkinCoffee=0 9 | dxSkinDarkRoom=0 10 | dxSkinDarkSide=1 11 | dxSkinFoggy=0 12 | dxSkinGlassOceans=0 13 | dxSkiniMaginary=0 14 | dxSkinLilian=0 15 | dxSkinLiquidSky=0 16 | dxSkinLondonLiquidSky=0 17 | dxSkinMcSkin=0 18 | dxSkinMoneyTwins=0 19 | dxSkinOffice2007Black=1 20 | dxSkinOffice2007Blue=0 21 | dxSkinOffice2007Green=0 22 | dxSkinOffice2007Pink=0 23 | dxSkinOffice2007Silver=1 24 | dxSkinPumpkin=0 25 | dxSkinSeven=0 26 | dxSkinSharp=0 27 | dxSkinSilver=0 28 | dxSkinSpringTime=0 29 | dxSkinStardust=0 30 | dxSkinSummer2008=0 31 | dxSkinsDefaultPainters=0 32 | dxSkinValentine=0 33 | dxSkinXmas2008Blue=0 34 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Client_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/SimpleSockets/Client_Icon.ico -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/Server.dpr: -------------------------------------------------------------------------------- 1 | program Server; 2 | 3 | uses 4 | Vcl.Forms, 5 | ufrmMain in 'ufrmMain.pas' {frmMain}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | {$IFDEF DEBUG} 11 | ReportMemoryLeaksOnShutdown := True; 12 | {$ENDIF} 13 | Application.Initialize; 14 | Application.MainFormOnTaskbar := True; 15 | Application.CreateForm(TfrmMain, frmMain); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/Server.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/Server.identcache: -------------------------------------------------------------------------------- 1 | aC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\ufrmMain.pas_C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\SimpleSockets\Srv\Server.dpr -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/Server.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/SimpleSockets/Srv/Server.res -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/Server.skincfg: -------------------------------------------------------------------------------- 1 | [ExpressSkins] 2 | Default=1 3 | ShowNotifications=1 4 | Enabled=1 5 | dxSkinBlack=1 6 | dxSkinBlue=0 7 | dxSkinCaramel=0 8 | dxSkinCoffee=0 9 | dxSkinDarkRoom=0 10 | dxSkinDarkSide=1 11 | dxSkinFoggy=0 12 | dxSkinGlassOceans=0 13 | dxSkiniMaginary=0 14 | dxSkinLilian=0 15 | dxSkinLiquidSky=0 16 | dxSkinLondonLiquidSky=0 17 | dxSkinMcSkin=0 18 | dxSkinMoneyTwins=0 19 | dxSkinOffice2007Black=1 20 | dxSkinOffice2007Blue=0 21 | dxSkinOffice2007Green=0 22 | dxSkinOffice2007Pink=0 23 | dxSkinOffice2007Silver=1 24 | dxSkinPumpkin=0 25 | dxSkinSeven=0 26 | dxSkinSharp=0 27 | dxSkinSilver=0 28 | dxSkinSpringTime=0 29 | dxSkinStardust=0 30 | dxSkinSummer2008=0 31 | dxSkinsDefaultPainters=0 32 | dxSkinValentine=0 33 | dxSkinXmas2008Blue=0 34 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/Server_Icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/SimpleSockets/Srv/Server_Icon.ico -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/ufrmMain.dfm: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'TCPServer' 5 | ClientHeight = 243 6 | ClientWidth = 527 7 | Color = clBtnFace 8 | Font.Charset = DEFAULT_CHARSET 9 | Font.Color = clWindowText 10 | Font.Height = -11 11 | Font.Name = 'Tahoma' 12 | Font.Style = [] 13 | OldCreateOrder = False 14 | OnCreate = FormCreate 15 | OnDestroy = FormDestroy 16 | PixelsPerInch = 96 17 | TextHeight = 13 18 | object memLog: TMemo 19 | AlignWithMargins = True 20 | Left = 5 21 | Top = 37 22 | Width = 517 23 | Height = 201 24 | Margins.Left = 5 25 | Margins.Top = 0 26 | Margins.Right = 5 27 | Margins.Bottom = 5 28 | Align = alClient 29 | ReadOnly = True 30 | ScrollBars = ssVertical 31 | TabOrder = 0 32 | end 33 | object pnlToolbar: TPanel 34 | Left = 0 35 | Top = 0 36 | Width = 527 37 | Height = 37 38 | Align = alTop 39 | BevelOuter = bvNone 40 | FullRepaint = False 41 | TabOrder = 1 42 | object btnActivate: TButton 43 | AlignWithMargins = True 44 | Left = 5 45 | Top = 5 46 | Width = 105 47 | Height = 27 48 | Margins.Left = 5 49 | Margins.Top = 5 50 | Margins.Right = 5 51 | Margins.Bottom = 5 52 | Align = alLeft 53 | Caption = 'Activate' 54 | TabOrder = 0 55 | OnClick = btnActivateClick 56 | end 57 | object pblPort: TPanel 58 | AlignWithMargins = True 59 | Left = 115 60 | Top = 3 61 | Width = 412 62 | Height = 31 63 | Margins.Left = 0 64 | Margins.Right = 0 65 | Align = alClient 66 | BevelOuter = bvNone 67 | FullRepaint = False 68 | TabOrder = 1 69 | ExplicitLeft = 110 70 | ExplicitWidth = 417 71 | object edtPort: TSpinEdit 72 | AlignWithMargins = True 73 | Left = 0 74 | Top = 5 75 | Width = 121 76 | Height = 22 77 | Margins.Left = 0 78 | Margins.Top = 5 79 | Margins.Right = 5 80 | Margins.Bottom = 5 81 | Align = alLeft 82 | MaxValue = 0 83 | MinValue = 0 84 | TabOrder = 0 85 | Value = 16233 86 | OnChange = edtPortChange 87 | ExplicitLeft = 291 88 | end 89 | object btnShutdownAllClients: TButton 90 | AlignWithMargins = True 91 | Left = 256 92 | Top = 5 93 | Width = 151 94 | Height = 21 95 | Margins.Left = 5 96 | Margins.Top = 5 97 | Margins.Right = 5 98 | Margins.Bottom = 5 99 | Align = alRight 100 | Caption = 'Shutdown all clients' 101 | TabOrder = 1 102 | OnClick = btnShutdownAllClientsClick 103 | end 104 | end 105 | end 106 | object TCPServer: TncTCPServer 107 | OnConnected = TCPServerConnected 108 | OnDisconnected = TCPServerDisconnected 109 | OnReadData = TCPServerReadData 110 | Left = 92 111 | Top = 52 112 | end 113 | end 114 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/Srv/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | {$IFDEF MSWINDOWS} 7 | WinApi.Windows, WinApi.Winsock2, 8 | {$ELSE} 9 | Posix.SysSocket, Posix.Unistd, 10 | {$ENDIF} 11 | System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Samples.Spin, 12 | System.Diagnostics, ncLines, ncSocketList, ncSockets; 13 | 14 | type 15 | TfrmMain = class(TForm) 16 | memLog: TMemo; 17 | TCPServer: TncTCPServer; 18 | pnlToolbar: TPanel; 19 | btnActivate: TButton; 20 | pblPort: TPanel; 21 | edtPort: TSpinEdit; 22 | btnShutdownAllClients: TButton; 23 | procedure FormCreate(Sender: TObject); 24 | procedure FormDestroy(Sender: TObject); 25 | procedure TCPServerConnected(Sender: TObject; aLine: TncLine); 26 | procedure TCPServerDisconnected(Sender: TObject; aLine: TncLine); 27 | procedure TCPServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); 28 | procedure btnActivateClick(Sender: TObject); 29 | procedure edtPortChange(Sender: TObject); 30 | procedure btnShutdownAllClientsClick(Sender: TObject); 31 | private 32 | public 33 | end; 34 | 35 | var 36 | frmMain: TfrmMain; 37 | 38 | implementation 39 | 40 | {$R *.dfm} 41 | 42 | procedure TfrmMain.FormCreate(Sender: TObject); 43 | begin 44 | try 45 | TCPServer.Active := True; 46 | memLog.Lines.Add('Server is active at port: ' + IntToStr(TCPServer.Port)); 47 | btnActivate.Caption := 'Deactivate'; 48 | except 49 | on e: Exception do 50 | memLog.Lines.Add('Server cannot activate. ' + e.Message); 51 | end; 52 | end; 53 | 54 | procedure TfrmMain.FormDestroy(Sender: TObject); 55 | begin 56 | TCPServer.Active := False; 57 | end; 58 | 59 | procedure TfrmMain.btnActivateClick(Sender: TObject); 60 | begin 61 | try 62 | TCPServer.Active := not TCPServer.Active; 63 | finally 64 | if TCPServer.Active then 65 | begin 66 | memLog.Lines.Add('Server is active at port: ' + IntToStr(TCPServer.Port)); 67 | btnActivate.Caption := 'Deactivate'; 68 | end 69 | else 70 | begin 71 | memLog.Lines.Add('Server was deactivated'); 72 | btnActivate.Caption := 'Activate'; 73 | end; 74 | end; 75 | end; 76 | 77 | procedure TfrmMain.edtPortChange(Sender: TObject); 78 | begin 79 | try 80 | TCPServer.Port := edtPort.Value; 81 | except 82 | // if it is active, it will not allow us to change the value, 83 | // revert the edtPort value to its original 84 | edtPort.Value := TCPServer.Port; 85 | raise; // Reraise the exception so as the user sees the error 86 | end; 87 | end; 88 | 89 | procedure TfrmMain.btnShutdownAllClientsClick(Sender: TObject); 90 | var 91 | SocketList: TSocketList; 92 | i: Integer; 93 | begin 94 | SocketList := TCPServer.Lines.LockList; 95 | try 96 | for i := 0 to SocketList.Count - 1 do 97 | TCPServer.ShutDownLine(SocketList.Lines[i]); 98 | finally 99 | TCPServer.Lines.UnlockList; 100 | end; 101 | end; 102 | 103 | 104 | procedure TfrmMain.TCPServerConnected(Sender: TObject; aLine: TncLine); 105 | begin 106 | TThread.Synchronize(nil, 107 | procedure 108 | begin 109 | memLog.Lines.Add('Connected: ' + aLine.PeerIP); 110 | end); 111 | 112 | TCPServer.Send(aLine, BytesOf('Hello mr. ' + IntToStr(aLine.Handle))); 113 | end; 114 | 115 | procedure TfrmMain.TCPServerDisconnected(Sender: TObject; aLine: TncLine); 116 | begin 117 | TThread.Synchronize(nil, 118 | procedure 119 | begin 120 | memLog.Lines.Add('Disconnected: ' + aLine.PeerIP); 121 | end); 122 | end; 123 | 124 | procedure TfrmMain.TCPServerReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); 125 | var 126 | BytesReceived: TBytes; 127 | begin 128 | BytesReceived := Copy(aBuf, 0, aBufCount); 129 | 130 | TThread.Queue(nil, 131 | procedure 132 | begin 133 | memLog.Lines.Add('Received: "' + StringOf(BytesReceived) + '" from: ' + aLine.PeerIP); 134 | end); 135 | 136 | // Send back the buffer received 137 | TCPServer.Send(aLine, BytesReceived); 138 | end; 139 | 140 | end. 141 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/ufrmMain.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | ActiveControl = edtDataToSend 5 | Caption = 'TCPClient' 6 | ClientHeight = 243 7 | ClientWidth = 527 8 | Color = clBtnFace 9 | Font.Charset = DEFAULT_CHARSET 10 | Font.Color = clWindowText 11 | Font.Height = -11 12 | Font.Name = 'Tahoma' 13 | Font.Style = [] 14 | OldCreateOrder = False 15 | Position = poScreenCenter 16 | OnDestroy = FormDestroy 17 | PixelsPerInch = 96 18 | TextHeight = 13 19 | object memLog: TMemo 20 | AlignWithMargins = True 21 | Left = 5 22 | Top = 37 23 | Width = 517 24 | Height = 169 25 | Margins.Left = 5 26 | Margins.Top = 0 27 | Margins.Right = 5 28 | Margins.Bottom = 5 29 | Align = alClient 30 | ReadOnly = True 31 | ScrollBars = ssVertical 32 | TabOrder = 1 33 | end 34 | object pnlToolbar: TPanel 35 | Left = 0 36 | Top = 0 37 | Width = 527 38 | Height = 37 39 | Align = alTop 40 | BevelOuter = bvNone 41 | FullRepaint = False 42 | TabOrder = 0 43 | object btnActivate: TButton 44 | AlignWithMargins = True 45 | Left = 5 46 | Top = 5 47 | Width = 105 48 | Height = 27 49 | Margins.Left = 5 50 | Margins.Top = 5 51 | Margins.Right = 0 52 | Margins.Bottom = 5 53 | Align = alLeft 54 | Caption = 'Activate' 55 | TabOrder = 0 56 | OnClick = btnActivateClick 57 | end 58 | object pnlAddress: TPanel 59 | AlignWithMargins = True 60 | Left = 110 61 | Top = 3 62 | Width = 417 63 | Height = 31 64 | Margins.Left = 0 65 | Margins.Right = 0 66 | Align = alClient 67 | BevelOuter = bvNone 68 | FullRepaint = False 69 | TabOrder = 1 70 | object edtHost: TEdit 71 | AlignWithMargins = True 72 | Left = 5 73 | Top = 5 74 | Width = 281 75 | Height = 21 76 | Margins.Left = 5 77 | Margins.Top = 5 78 | Margins.Right = 5 79 | Margins.Bottom = 5 80 | Align = alClient 81 | TabOrder = 0 82 | Text = 'LocalHost' 83 | TextHint = 'Enter host address' 84 | OnChange = edtHostChange 85 | end 86 | object edtPort: TSpinEdit 87 | AlignWithMargins = True 88 | Left = 291 89 | Top = 5 90 | Width = 121 91 | Height = 22 92 | Margins.Left = 0 93 | Margins.Top = 5 94 | Margins.Right = 5 95 | Margins.Bottom = 5 96 | Align = alRight 97 | MaxValue = 0 98 | MinValue = 0 99 | TabOrder = 1 100 | Value = 16233 101 | OnChange = edtPortChange 102 | end 103 | end 104 | end 105 | object Panel1: TPanel 106 | Left = 0 107 | Top = 211 108 | Width = 527 109 | Height = 32 110 | Margins.Left = 5 111 | Margins.Top = 0 112 | Margins.Right = 5 113 | Margins.Bottom = 5 114 | Align = alBottom 115 | BevelOuter = bvNone 116 | FullRepaint = False 117 | TabOrder = 2 118 | object btnSendData: TButton 119 | AlignWithMargins = True 120 | Left = 5 121 | Top = 0 122 | Width = 105 123 | Height = 27 124 | Margins.Left = 5 125 | Margins.Top = 0 126 | Margins.Right = 0 127 | Margins.Bottom = 5 128 | Align = alLeft 129 | Caption = 'Send' 130 | Default = True 131 | TabOrder = 0 132 | OnClick = btnSendDataClick 133 | end 134 | object Panel2: TPanel 135 | AlignWithMargins = True 136 | Left = 110 137 | Top = 3 138 | Width = 417 139 | Height = 26 140 | Margins.Left = 0 141 | Margins.Right = 0 142 | Align = alClient 143 | BevelOuter = bvNone 144 | FullRepaint = False 145 | TabOrder = 1 146 | object edtDataToSend: TEdit 147 | AlignWithMargins = True 148 | Left = 5 149 | Top = 0 150 | Width = 407 151 | Height = 21 152 | Margins.Left = 5 153 | Margins.Top = 0 154 | Margins.Right = 5 155 | Margins.Bottom = 5 156 | Align = alClient 157 | TabOrder = 0 158 | Text = 'This is some text data' 159 | TextHint = 'Enter data to send here' 160 | OnEnter = edtDataToSendEnter 161 | OnExit = edtDataToSendExit 162 | end 163 | end 164 | end 165 | object TCPClient: TncTCPClient 166 | Host = 'localhost' 167 | OnConnected = TCPClientConnected 168 | OnDisconnected = TCPClientDisconnected 169 | OnReadData = TCPClientReadData 170 | OnReconnected = TCPClientReconnected 171 | Left = 92 172 | Top = 52 173 | end 174 | end 175 | -------------------------------------------------------------------------------- /Demos/SimpleSockets/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | {$IFDEF MSWINDOWS} 7 | WinApi.Windows, WinApi.Winsock2, 8 | {$ELSE} 9 | Posix.SysSocket, Posix.Unistd, 10 | {$ENDIF} 11 | System.Classes, System.SysUtils, Vcl.Forms, Vcl.Controls, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Samples.Spin, 12 | System.Diagnostics, ncLines, ncSockets; 13 | 14 | type 15 | TForm1 = class(TForm) 16 | memLog: TMemo; 17 | TCPClient: TncTCPClient; 18 | pnlToolbar: TPanel; 19 | btnActivate: TButton; 20 | pnlAddress: TPanel; 21 | edtHost: TEdit; 22 | edtPort: TSpinEdit; 23 | Panel1: TPanel; 24 | btnSendData: TButton; 25 | Panel2: TPanel; 26 | edtDataToSend: TEdit; 27 | procedure btnActivateClick(Sender: TObject); 28 | procedure FormDestroy(Sender: TObject); 29 | procedure TCPClientConnected(Sender: TObject; aLine: TncLine); 30 | procedure TCPClientDisconnected(Sender: TObject; aLine: TncLine); 31 | procedure TCPClientReconnected(Sender: TObject; aLine: TncLine); 32 | procedure TCPClientReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); 33 | procedure edtHostChange(Sender: TObject); 34 | procedure edtPortChange(Sender: TObject); 35 | procedure btnSendDataClick(Sender: TObject); 36 | procedure edtDataToSendEnter(Sender: TObject); 37 | procedure edtDataToSendExit(Sender: TObject); 38 | private 39 | public 40 | end; 41 | 42 | var 43 | Form1: TForm1; 44 | 45 | implementation 46 | 47 | {$R *.dfm} 48 | 49 | procedure TForm1.FormDestroy(Sender: TObject); 50 | begin 51 | TCPClient.Active := False; 52 | end; 53 | 54 | procedure TForm1.edtHostChange(Sender: TObject); 55 | begin 56 | try 57 | TCPClient.Host := edtHost.Text; 58 | except 59 | edtHost.OnChange := nil; 60 | try 61 | edtHost.Text := TCPClient.Host; 62 | finally 63 | edtHost.OnChange := edtHostChange; 64 | end; 65 | raise; 66 | end; 67 | end; 68 | 69 | procedure TForm1.edtPortChange(Sender: TObject); 70 | begin 71 | try 72 | TCPClient.Port := edtPort.Value; 73 | except 74 | edtPort.OnChange := nil; 75 | try 76 | edtPort.Value := TCPClient.Port; 77 | finally 78 | edtPort.OnChange := edtPortChange; 79 | end; 80 | raise; 81 | end; 82 | end; 83 | 84 | procedure TForm1.btnActivateClick(Sender: TObject); 85 | begin 86 | TCPClient.Active := not TCPClient.Active; 87 | end; 88 | 89 | procedure TForm1.edtDataToSendEnter(Sender: TObject); 90 | begin 91 | btnSendData.Default := True; 92 | end; 93 | 94 | procedure TForm1.edtDataToSendExit(Sender: TObject); 95 | begin 96 | btnSendData.Default := False; 97 | end; 98 | 99 | procedure TForm1.TCPClientConnected(Sender: TObject; aLine: TncLine); 100 | begin 101 | TThread.Synchronize(nil, 102 | procedure 103 | begin 104 | memLog.Lines.Add('Connected'); 105 | btnActivate.Caption := 'Deactivate'; 106 | end); 107 | end; 108 | 109 | procedure TForm1.TCPClientDisconnected(Sender: TObject; aLine: TncLine); 110 | begin 111 | TThread.Synchronize(nil, 112 | procedure 113 | begin 114 | memLog.Lines.Add('Disconnected'); 115 | btnActivate.Caption := 'Activate'; 116 | end); 117 | end; 118 | 119 | procedure TForm1.TCPClientReconnected(Sender: TObject; aLine: TncLine); 120 | begin 121 | TThread.Synchronize(nil, 122 | procedure 123 | begin 124 | memLog.Lines.Add('Reconnected'); 125 | end); 126 | end; 127 | 128 | procedure TForm1.TCPClientReadData(Sender: TObject; aLine: TncLine; const aBuf: TArray; aBufCount: Integer); 129 | var 130 | BytesReceived: TBytes; 131 | begin 132 | BytesReceived := Copy(aBuf, 0, aBufCount); 133 | 134 | TThread.Synchronize(nil, 135 | procedure 136 | begin 137 | memLog.Lines.Add('Received: ' + StringOf(BytesReceived)); 138 | end); 139 | end; 140 | 141 | procedure TForm1.btnSendDataClick(Sender: TObject); 142 | begin 143 | TCPClient.Send(edtDataToSend.Text); 144 | end; 145 | 146 | 147 | end. 148 | -------------------------------------------------------------------------------- /Demos/VideoChat/Client/AndroidManifest.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | 9 | 10 | <%uses-permission%> 11 | 12 | 21 | 22 | <%provider%> 23 | <%application-meta-data%> 24 | <%services%> 25 | 27 | 31 | 32 | 34 | 35 | 36 | 37 | 38 | 39 | <%activity%> 40 | <%receivers%> 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /Demos/VideoChat/Client/VideoChatClient.dpr: -------------------------------------------------------------------------------- 1 | program VideoChatClient; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | FMX.Types, 7 | ufrmMain in 'ufrmMain.pas' {frmMain}, 8 | CommonCommands in '..\Server\CommonCommands.pas'; 9 | 10 | {$R *.res} 11 | 12 | begin 13 | {$IFDEF DEBUG} 14 | ReportMemoryLeaksOnShutdown := True; 15 | {$ENDIF} 16 | Application.Initialize; 17 | Application.CreateForm(TfrmMain, frmMain); 18 | Application.Run; 19 | end. 20 | -------------------------------------------------------------------------------- /Demos/VideoChat/Client/VideoChatClient.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 5 | 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 6 | 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 7 | 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 8 | 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 9 | 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 10 | 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 11 | 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 12 | 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas 13 | 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 14 | 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 15 | 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 16 | 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 17 | 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 18 | 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 19 | 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 20 | 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 21 | 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 22 | 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 23 | 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 24 | 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 25 | 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 26 | 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 27 | 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 28 | 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 29 | 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 30 | 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 31 | 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 32 | 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 33 | 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 34 | 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 35 | 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 36 | 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 37 | 2020/08/12 00:19:14.000.567,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 38 | 2020/08/12 09:24:02.000.042,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 39 | 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 40 | 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 41 | 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 42 | 2020/08/12 10:06:25.000.279,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\Unit1.pas 43 | 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 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /Demos/VideoChat/Client/VideoChatClient.identcache: -------------------------------------------------------------------------------- 1 | `C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\ufrmMain.pasfC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pasgC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Client\VideoChatClient.dpr -------------------------------------------------------------------------------- /Demos/VideoChat/Client/VideoChatClient.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/VideoChat/Client/VideoChatClient.res -------------------------------------------------------------------------------- /Demos/VideoChat/Client/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, 8 | FMX.ListView.Types, FMX.ListView.Appearances, FMX.ListView.Adapters.Base, 9 | FMX.Layouts, ncSources, FMX.Edit, FMX.StdCtrls, FMX.ListView, 10 | FMX.Controls.Presentation, FMX.Objects, FMX.ScrollBox, FMX.Memo, FMX.MultiView, 11 | FMX.ListBox, CommonCommands, FMX.Media; 12 | 13 | type 14 | TfrmMain = class(TForm) 15 | ToolBar: TToolBar; 16 | btnConnect: TButton; 17 | edtUsername: TEdit; 18 | ltContent: TLayout; 19 | Client: TncClientSource; 20 | ltCameras: TGridPanelLayout; 21 | ltSendText: TLayout; 22 | imgUserVideo: TImage; 23 | imgPeerUserVideo: TImage; 24 | edtTextToSend: TEdit; 25 | btnSendText: TButton; 26 | ltMessages: TLayout; 27 | memMessages: TMemo; 28 | Splitter: TSplitter; 29 | btnMasterView: TButton; 30 | MultiView: TMultiView; 31 | lbUsers: TListBox; 32 | CameraComponent: TCameraComponent; 33 | procedure edtUsernameEnter(Sender: TObject); 34 | procedure edtUsernameExit(Sender: TObject); 35 | procedure edtTextToSendEnter(Sender: TObject); 36 | procedure edtTextToSendExit(Sender: TObject); 37 | procedure btnConnectClick(Sender: TObject); 38 | procedure ClientConnected(Sender: TObject; aLine: TncLine); 39 | procedure ClientDisconnected(Sender: TObject; aLine: TncLine); 40 | function ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 41 | const aSenderComponent, aReceiverComponent: string): TArray; 42 | procedure btnSendTextClick(Sender: TObject); 43 | procedure CameraComponentSampleBufferReady(Sender: TObject; const ATime: TMediaTime); 44 | procedure FormCreate(Sender: TObject); 45 | procedure FormDestroy(Sender: TObject); 46 | procedure FormPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); 47 | private 48 | ConnectErrorMsg: string; 49 | public 50 | end; 51 | 52 | var 53 | frmMain: TfrmMain; 54 | 55 | implementation 56 | 57 | {$R *.fmx} 58 | 59 | procedure TfrmMain.FormCreate(Sender: TObject); 60 | begin 61 | // 62 | end; 63 | 64 | procedure TfrmMain.FormDestroy(Sender: TObject); 65 | begin 66 | Client.Active := False; 67 | end; 68 | 69 | procedure TfrmMain.FormPaint(Sender: TObject; Canvas: TCanvas; 70 | const ARect: TRectF); 71 | begin 72 | // We set the camera on when the form has fully loaded, as in some phones, 73 | // we may not get the permission to use the camera. In such a case, if we 74 | // had enabled the camera at creation time, the application would terminate... 75 | OnPaint := nil; 76 | CameraComponent.Active := True; 77 | end; 78 | 79 | procedure TfrmMain.ClientConnected(Sender: TObject; aLine: TncLine); 80 | begin 81 | TThread.Synchronize(nil, 82 | procedure 83 | begin 84 | btnConnect.Text := 'Disconnect'; 85 | if edtUsername.Text = '' then 86 | edtUsername.Text := 'Anonymous'; // Although Eponymous 87 | edtUsername.Enabled := False; 88 | end); 89 | 90 | try 91 | Client.ExecCommand(cmdCntUserLogin, BytesOf(edtUsername.Text), True); 92 | except 93 | on e: exception do 94 | begin 95 | // We do not want to show exceptions here, as this might be a reconnect 96 | // attempt, we will show the exception only when the user presses the button 97 | // in btnConnectClick 98 | ConnectErrorMsg := e.Message; 99 | Client.Active := False; 100 | end; 101 | end; 102 | end; 103 | 104 | procedure TfrmMain.ClientDisconnected(Sender: TObject; aLine: TncLine); 105 | begin 106 | TThread.Synchronize(nil, 107 | procedure 108 | begin 109 | btnConnect.Text := 'Connect'; 110 | edtUsername.Enabled := True; 111 | lbUsers.Clear; 112 | end); 113 | end; 114 | 115 | procedure TfrmMain.btnConnectClick(Sender: TObject); 116 | begin 117 | if Client.Active then 118 | begin 119 | Client.Active := False; 120 | end 121 | else 122 | begin 123 | Client.Active := True; 124 | if not Client.Active then 125 | raise Exception.Create(ConnectErrorMsg); 126 | end; 127 | end; 128 | 129 | function TfrmMain.ClientHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 130 | const aSenderComponent, aReceiverComponent: string): TArray; 131 | begin 132 | SetLength(Result, 0); 133 | 134 | TThread.Synchronize(nil, 135 | 136 | procedure 137 | var 138 | i: Integer; 139 | Username: string; 140 | BytesStream: TBytesStream; 141 | lbIndex: Integer; 142 | PrevUser: string; 143 | begin 144 | // This is called from the server to update information 145 | case aCmd of 146 | cmdSrvUpdateLoggedInUsers: 147 | begin 148 | // Save the user we are on 149 | lbUsers.BeginUpdate; 150 | try 151 | if lbUsers.ItemIndex <> -1 then 152 | PrevUser := lbUsers.Items.Strings[lbUsers.ItemIndex] 153 | else 154 | PrevUser := ''; 155 | 156 | lbUsers.Items.CommaText := StringOf(aData); 157 | 158 | if PrevUser <> '' then 159 | lbUsers.ItemIndex := lbUsers.Items.IndexOf(PrevUser); 160 | finally 161 | lbUsers.EndUpdate; 162 | end; 163 | end; 164 | cmdSrvUpdateImage: 165 | begin 166 | // Extract the #13#10 from the aData 167 | for i := 0 to High(aData) - 1 do 168 | if (aData[i] = 13) and (aData[i + 1] = 10) then 169 | begin 170 | Username := StringOf(Copy(aData, 0, i)); 171 | 172 | BytesStream := TBytesStream.Create(Copy(aData, i + 2)); 173 | try 174 | lbIndex := lbUsers.Items.IndexOf(Username); 175 | lbUsers.ItemByIndex(lbIndex).ItemData.Bitmap.LoadFromStream(BytesStream); 176 | lbUsers.ItemByIndex(lbIndex).StyleLookup := 'listboxitemleftdetail'; 177 | 178 | if lbUsers.ItemIndex = lbIndex then 179 | imgPeerUserVideo.Bitmap.LoadFromStream(BytesStream); 180 | finally 181 | BytesStream.Free; 182 | end; 183 | 184 | Break; 185 | end; 186 | end; 187 | cmdSrvGetText: 188 | begin 189 | memMessages.Lines.Add(StringOf(aData)); 190 | memMessages.ScrollBy(0, 100); 191 | end; 192 | end; 193 | end); 194 | end; 195 | 196 | procedure TfrmMain.CameraComponentSampleBufferReady(Sender: TObject; const ATime: TMediaTime); 197 | var 198 | BytesStream: TBytesStream; 199 | begin 200 | // We got a new image from the camera 201 | // Assign it first to our own imgUserVideo component 202 | CameraComponent.SampleBufferToBitmap(imgUserVideo.Bitmap, True); 203 | 204 | // This try is because the CameraComponent OnSampleBufferReady cannot cope 205 | // with thrown exceptions 206 | try 207 | if Client.Active then 208 | begin 209 | // If we are logged in, send the picture to the server 210 | // (SaveToStream will save it as png format) 211 | BytesStream := TBytesStream.Create; 212 | try 213 | imgUserVideo.Bitmap.SaveToStream(BytesStream); 214 | Client.ExecCommand(cmdCntCameraImage, BytesStream.Bytes, False); 215 | finally 216 | BytesStream.Free; 217 | end; 218 | end; 219 | except 220 | end; 221 | end; 222 | 223 | procedure TfrmMain.btnSendTextClick(Sender: TObject); 224 | begin 225 | Client.ExecCommand(cmdCntGetText, BytesOf(edtUsername.Text + ': ' + edtTextToSend.Text), False); 226 | edtTextToSend.Text := ''; 227 | end; 228 | 229 | procedure TfrmMain.edtUsernameEnter(Sender: TObject); 230 | begin 231 | btnConnect.Default := True; 232 | end; 233 | 234 | procedure TfrmMain.edtUsernameExit(Sender: TObject); 235 | begin 236 | btnConnect.Default := False; 237 | end; 238 | 239 | procedure TfrmMain.edtTextToSendEnter(Sender: TObject); 240 | begin 241 | btnSendText.Default := True; 242 | end; 243 | 244 | procedure TfrmMain.edtTextToSendExit(Sender: TObject); 245 | begin 246 | btnSendText.Default := False; 247 | end; 248 | 249 | end. 250 | -------------------------------------------------------------------------------- /Demos/VideoChat/Server/AndroidManifest.template.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 8 | 9 | 10 | <%uses-permission%> 11 | 12 | 21 | 22 | <%provider%> 23 | <%application-meta-data%> 24 | <%services%> 25 | 27 | 31 | 32 | 34 | 35 | 36 | 37 | 38 | 39 | <%activity%> 40 | <%receivers%> 41 | 42 | 43 | 44 | -------------------------------------------------------------------------------- /Demos/VideoChat/Server/CommonCommands.pas: -------------------------------------------------------------------------------- 1 | unit CommonCommands; 2 | 3 | interface 4 | 5 | const 6 | cmdCntUserLogin = 0; 7 | cmdSrvUpdateLoggedInUsers = 1; 8 | cmdCntCameraImage = 2; 9 | cmdSrvUpdateImage = 3; 10 | cmdCntGetText = 4; 11 | cmdSrvGetText = 5; 12 | 13 | implementation 14 | 15 | end. 16 | -------------------------------------------------------------------------------- /Demos/VideoChat/Server/VideoChatServer.dpr: -------------------------------------------------------------------------------- 1 | program VideoChatServer; 2 | 3 | uses 4 | System.StartUpCopy, 5 | FMX.Forms, 6 | ufrmMain in 'ufrmMain.pas' {frmMain}, 7 | CommonCommands in 'CommonCommands.pas'; 8 | 9 | {$R *.res} 10 | 11 | begin 12 | {$IFDEF DEBUG} 13 | ReportMemoryLeaksOnShutdown := True; 14 | {$ENDIF} 15 | Application.Initialize; 16 | Application.CreateForm(TfrmMain, frmMain); 17 | Application.Run; 18 | end. 19 | -------------------------------------------------------------------------------- /Demos/VideoChat/Server/VideoChatServer.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 2018/09/21 12:49:51.000.179,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 5 | 2018/09/24 13:18:27.000.279,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 6 | 2018/10/10 13:56:06.000.238,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 7 | 2018/10/16 10:56:54.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 8 | 2018/10/16 11:40:09.000.191,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 9 | 2018/11/04 15:48:45.000.203,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 10 | 2018/11/04 16:17:18.000.148,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 11 | 2018/11/04 16:17:48.000.272,=C:\Users\Programmer\Documents\Development\Projects\Unit1.pas 12 | 2018/11/23 20:02:18.000.772,=C:\Users\Programmer\Documents\Development\Projects\Unit2.pas 13 | 2019/02/27 18:05:16.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 14 | 2019/02/27 18:06:31.000.995,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 15 | 2019/02/27 18:12:19.000.197,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 16 | 2019/03/05 12:15:54.000.434,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 17 | 2019/03/05 13:06:38.000.677,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 18 | 2019/03/11 18:09:12.000.176,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 19 | 2019/03/25 16:12:14.000.258,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 20 | 2019/05/29 14:49:59.000.196,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 21 | 2019/05/31 18:08:29.000.138,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 22 | 2019/08/21 21:29:49.000.507,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 23 | 2019/09/18 13:39:12.000.759,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 24 | 2019/11/09 19:07:03.000.902,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 25 | 2019/12/15 14:13:57.000.985,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 26 | 2020/04/13 08:49:52.000.721,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 27 | 2020/04/14 04:39:08.000.542,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 28 | 2020/04/15 03:31:58.000.910,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 29 | 2020/07/02 09:58:25.000.183,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 30 | 2020/07/02 20:01:51.000.926,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 31 | 2020/07/05 15:55:38.000.562,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 32 | 2020/07/08 18:03:33.000.205,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 33 | 2020/07/16 00:09:13.000.392,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 34 | 2020/08/07 10:38:54.000.477,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 35 | 2020/08/08 10:30:32.000.363,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 36 | 2020/08/10 13:26:25.000.247,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 37 | 2020/08/12 00:19:14.000.567,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 38 | 2020/08/12 09:20:35.000.938,=C:\Users\Programmer\Documents\Development\Projects\Unit3.pas 39 | 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 40 | 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 41 | 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 42 | 2020/08/12 10:07:55.000.801,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pas 43 | 44 | 45 | 46 | 47 | 48 | -------------------------------------------------------------------------------- /Demos/VideoChat/Server/VideoChatServer.identcache: -------------------------------------------------------------------------------- 1 | `C:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\ufrmMain.pasfC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\CommonCommands.pasgC:\Users\Programmer\Documents\Development\Components\NetCom7\Demos\VideoChat\Server\VideoChatServer.dpr -------------------------------------------------------------------------------- /Demos/VideoChat/Server/VideoChatServer.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Demos/VideoChat/Server/VideoChatServer.res -------------------------------------------------------------------------------- /Demos/VideoChat/Server/ufrmMain.fmx: -------------------------------------------------------------------------------- 1 | object frmMain: TfrmMain 2 | Left = 0 3 | Top = 0 4 | Caption = 'NetCom Video Chat Server' 5 | ClientHeight = 480 6 | ClientWidth = 640 7 | FormFactor.Width = 320 8 | FormFactor.Height = 480 9 | FormFactor.Devices = [Desktop] 10 | OnCreate = FormCreate 11 | OnDestroy = FormDestroy 12 | DesignerMasterStyle = 0 13 | object memLog: TMemo 14 | Touch.InteractiveGestures = [Pan, LongTap, DoubleTap] 15 | DataDetectorTypes = [] 16 | Align = Client 17 | Size.Width = 640.000000000000000000 18 | Size.Height = 480.000000000000000000 19 | Size.PlatformDefault = False 20 | TabOrder = 1 21 | Viewport.Width = 636.000000000000000000 22 | Viewport.Height = 476.000000000000000000 23 | end 24 | object Server: TncServerSource 25 | Port = 17244 26 | CommandProcessorThreadsPerCPU = 2 27 | CommandProcessorThreadsGrowUpto = 20 28 | ExecCommandTimeout = 2000 29 | EncryptionKey = 'SetEncryptionKey' 30 | OnConnected = ServerConnected 31 | OnDisconnected = ServerDisconnected 32 | OnHandleCommand = ServerHandleCommand 33 | Left = 40 34 | Top = 40 35 | end 36 | end 37 | -------------------------------------------------------------------------------- /Demos/VideoChat/Server/ufrmMain.pas: -------------------------------------------------------------------------------- 1 | unit ufrmMain; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, 7 | FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, 8 | FMX.Controls.Presentation, FMX.ScrollBox, FMX.Memo, 9 | System.SyncObjs, ncSocketList, ncSources, CommonCommands; 10 | 11 | type 12 | TConnectedUserData = class 13 | Line: TncLine; 14 | Image: TBitmap; 15 | end; 16 | 17 | TfrmMain = class(TForm) 18 | Server: TncServerSource; 19 | memLog: TMemo; 20 | procedure FormCreate(Sender: TObject); 21 | procedure FormDestroy(Sender: TObject); 22 | function ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 23 | const aSenderComponent, aReceiverComponent: string): TArray; 24 | procedure ServerDisconnected(Sender: TObject; aLine: TncLine); 25 | procedure ServerConnected(Sender: TObject; aLine: TncLine); 26 | private 27 | ConnectedUsersLock: TCriticalSection; 28 | ConnectedUsers: TStringList; 29 | procedure InformClientsOfLogins(aDontSendToLine: TncLine = nil); 30 | public 31 | end; 32 | 33 | var 34 | frmMain: TfrmMain; 35 | 36 | implementation 37 | 38 | {$R *.fmx} 39 | 40 | procedure TfrmMain.FormCreate(Sender: TObject); 41 | begin 42 | ConnectedUsersLock := TCriticalSection.Create; 43 | 44 | ConnectedUsers := TStringList.Create; 45 | ConnectedUsers.Sorted := True; 46 | ConnectedUsers.Duplicates := dupError; 47 | ConnectedUsers.CaseSensitive := False; 48 | 49 | try 50 | Server.Active := True; 51 | memLog.Lines.Add('Server started! Do not close this window'); 52 | except 53 | on e: Exception do 54 | memLog.Lines.Add('Cannot start server: ' + e.Message); 55 | end; 56 | end; 57 | 58 | procedure TfrmMain.FormDestroy(Sender: TObject); 59 | begin 60 | Server.Active := False; 61 | ConnectedUsers.Free; 62 | ConnectedUsersLock.Free; 63 | end; 64 | 65 | procedure TfrmMain.ServerConnected(Sender: TObject; aLine: TncLine); 66 | begin 67 | TThread.Synchronize(nil, 68 | procedure 69 | begin 70 | memLog.Lines.Add(aLine.PeerIP + ' Client connected'); 71 | memLog.ScrollBy(0, 100); 72 | end); 73 | end; 74 | 75 | procedure TfrmMain.ServerDisconnected(Sender: TObject; aLine: TncLine); 76 | var 77 | i: Integer; 78 | UserData: TConnectedUserData; 79 | begin 80 | TThread.Synchronize(nil, 81 | procedure 82 | begin 83 | memLog.Lines.Add(aLine.PeerIP + ' Client disconnected'); 84 | memLog.ScrollBy(0, 100); 85 | end); 86 | 87 | // Check Connected Users list to delete the entry 88 | ConnectedUsersLock.Acquire; 89 | try 90 | for i := 0 to ConnectedUsers.Count - 1 do 91 | begin 92 | UserData := TConnectedUserData(ConnectedUsers.Objects[i]); 93 | if UserData.Line = aLine then 94 | begin 95 | UserData.Image.Free; 96 | UserData.Free; 97 | ConnectedUsers.Delete(i); 98 | Break; 99 | end; 100 | end; 101 | finally 102 | ConnectedUsersLock.Release; 103 | end; 104 | 105 | InformClientsOfLogins(aLine); 106 | end; 107 | 108 | // DontSendTo parameter is used by disconnect, so that we don't send the 109 | // disconnected line the message 110 | procedure TfrmMain.InformClientsOfLogins(aDontSendToLine: TncLine = nil); 111 | var 112 | SocketList: TSocketList; 113 | i: Integer; 114 | begin 115 | // Now inform all clients to update their user lists 116 | ConnectedUsersLock.Acquire; 117 | try 118 | SocketList := Server.Lines.LockList; 119 | try 120 | for i := 0 to SocketList.Count - 1 do 121 | if SocketList.Lines[i] <> aDontSendToLine then 122 | Server.ExecCommand(SocketList.Lines[i], cmdSrvUpdateLoggedInUsers, BytesOf(ConnectedUsers.CommaText), False); 123 | finally 124 | Server.Lines.UnlockList; 125 | end; 126 | finally 127 | ConnectedUsersLock.Release; 128 | end; 129 | end; 130 | 131 | function TfrmMain.ServerHandleCommand(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TArray; aRequiresResult: Boolean; 132 | const aSenderComponent, aReceiverComponent: string): TArray; 133 | var 134 | UserData: TConnectedUserData; 135 | i, j: Integer; 136 | BytesStream: TBytesStream; 137 | DataToSend: TBytes; 138 | SocketList: TSocketList; 139 | begin 140 | SetLength(Result, 0); 141 | 142 | case aCmd of 143 | cmdCntUserLogin: 144 | begin 145 | // When the user logs in, he/she sends a name which is held in aData 146 | ConnectedUsersLock.Acquire; 147 | try 148 | // If a username already exists, the ConnectedUsers will raise an exception 149 | // as it has Duplicates set to dupError 150 | // This exception will travel back to the client. Since we want a custom 151 | // message, we trap the exception and change its message 152 | UserData := TConnectedUserData.Create; 153 | UserData.Line := aLine; 154 | UserData.Image := TBitmap.Create; 155 | try 156 | ConnectedUsers.AddObject(StringOf(aData), UserData); 157 | except 158 | UserData.Image.Free; 159 | UserData.Free; 160 | raise Exception.Create('Cannot login with this name, another user has already taken it'); 161 | end; 162 | finally 163 | ConnectedUsersLock.Release; 164 | end; 165 | 166 | // Inform all connected clients of the new data 167 | InformClientsOfLogins; 168 | end; 169 | cmdCntCameraImage: 170 | begin 171 | // The client is sending us a video image, update our list 172 | ConnectedUsersLock.Acquire; 173 | try 174 | for i := 0 to ConnectedUsers.Count - 1 do 175 | begin 176 | UserData := TConnectedUserData(ConnectedUsers.Objects[i]); 177 | if UserData.Line = aLine then 178 | begin 179 | BytesStream := TBytesStream.Create(aData); 180 | try 181 | UserData.Image.LoadFromStream(BytesStream); 182 | finally 183 | BytesStream.Free; 184 | end; 185 | 186 | // Send the image to everyone 187 | DataToSend := BytesOf(ConnectedUsers.Strings[i]) + BytesOf(#13#10) + aData; 188 | SocketList := Server.Lines.LockList; 189 | try 190 | for j := 0 to SocketList.Count - 1 do 191 | Server.ExecCommand(SocketList.Lines[j], cmdSrvUpdateImage, DataToSend, False); 192 | finally 193 | Server.Lines.UnlockList; 194 | end; 195 | 196 | Break; 197 | end; 198 | end; 199 | finally 200 | ConnectedUsersLock.Release; 201 | end; 202 | end; 203 | cmdCntGetText: 204 | begin 205 | // Send the text to all users 206 | SocketList := Server.Lines.LockList; 207 | try 208 | for j := 0 to SocketList.Count - 1 do 209 | Server.ExecCommand(SocketList.Lines[j], cmdSrvGetText, aData, False); 210 | finally 211 | Server.Lines.UnlockList; 212 | end; 213 | end; 214 | end; 215 | end; 216 | 217 | end. 218 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Bill Anastasios Demos 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NetCom7.dpk: -------------------------------------------------------------------------------- 1 | package NetCom7; 2 | 3 | {$R *.res} 4 | {$R 'Source\NetComRegister.dcr'} 5 | {$R *.dres} 6 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 7 | {$ALIGN 8} 8 | {$ASSERTIONS OFF} 9 | {$BOOLEVAL OFF} 10 | {$DEBUGINFO OFF} 11 | {$EXTENDEDSYNTAX ON} 12 | {$IMPORTEDDATA ON} 13 | {$IOCHECKS ON} 14 | {$LOCALSYMBOLS OFF} 15 | {$LONGSTRINGS ON} 16 | {$OPENSTRINGS ON} 17 | {$OPTIMIZATION ON} 18 | {$OVERFLOWCHECKS OFF} 19 | {$RANGECHECKS OFF} 20 | {$REFERENCEINFO OFF} 21 | {$SAFEDIVIDE OFF} 22 | {$STACKFRAMES OFF} 23 | {$TYPEDADDRESS OFF} 24 | {$VARSTRINGCHECKS OFF} 25 | {$WRITEABLECONST OFF} 26 | {$MINENUMSIZE 1} 27 | {$IMAGEBASE $400000} 28 | {$DEFINE RELEASE} 29 | {$ENDIF IMPLICITBUILDING} 30 | {$DESCRIPTION 'NetCom7 Network Communications Suite'} 31 | {$IMPLICITBUILD ON} 32 | 33 | requires 34 | rtl, 35 | DesignIDE, 36 | dbrtl, 37 | adortl; 38 | 39 | contains 40 | NetComRegister in 'Source\NetComRegister.pas', 41 | ncThreads in 'Source\ncThreads.pas', 42 | ncLines in 'Source\ncLines.pas', 43 | ncSocketList in 'Source\ncSocketList.pas', 44 | ncSockets in 'Source\ncSockets.pas', 45 | ncCommandPacking in 'Source\ncCommandPacking.pas', 46 | ncCommandHandlers in 'Source\ncCommandHandlers.pas', 47 | ncSources in 'Source\ncSources.pas', 48 | ncSerializeADO in 'Source\ncSerializeADO.pas', 49 | ncDBSrv in 'Source\ncDBSrv.pas', 50 | ncDBCnt in 'Source\ncDBCnt.pas', 51 | ncDBCommands in 'Source\ncDBCommands.pas', 52 | ncCompression in 'Source\ncCompression.pas', 53 | ncEncryption in 'Source\ncEncryption.pas', 54 | ncEncBlockciphers in 'Source\Encryption\ncEncBlockciphers.pas', 55 | ncEncBlowfish in 'Source\Encryption\ncEncBlowfish.pas', 56 | ncEncCast128 in 'Source\Encryption\ncEncCast128.pas', 57 | ncEncCast256 in 'Source\Encryption\ncEncCast256.pas', 58 | ncEncCrypt2 in 'Source\Encryption\ncEncCrypt2.pas', 59 | ncEncDes in 'Source\Encryption\ncEncDes.pas', 60 | ncEncHaval in 'Source\Encryption\ncEncHaval.pas', 61 | ncEncIce in 'Source\Encryption\ncEncIce.pas', 62 | ncEncIdea in 'Source\Encryption\ncEncIdea.pas', 63 | ncEncMars in 'Source\Encryption\ncEncMars.pas', 64 | ncEncMd4 in 'Source\Encryption\ncEncMd4.pas', 65 | ncEncMd5 in 'Source\Encryption\ncEncMd5.pas', 66 | ncEncMisty1 in 'Source\Encryption\ncEncMisty1.pas', 67 | ncEncRc2 in 'Source\Encryption\ncEncRc2.pas', 68 | ncEncRc4 in 'Source\Encryption\ncEncRc4.pas', 69 | ncEncRc5 in 'Source\Encryption\ncEncRc5.pas', 70 | ncEncRc6 in 'Source\Encryption\ncEncRc6.pas', 71 | ncEncRijndael in 'Source\Encryption\ncEncRijndael.pas', 72 | ncEncRipemd128 in 'Source\Encryption\ncEncRipemd128.pas', 73 | ncEncRipemd160 in 'Source\Encryption\ncEncRipemd160.pas', 74 | ncEncSerpent in 'Source\Encryption\ncEncSerpent.pas', 75 | ncEncSha1 in 'Source\Encryption\ncEncSha1.pas', 76 | ncEncSha256 in 'Source\Encryption\ncEncSha256.pas', 77 | ncEncSha512 in 'Source\Encryption\ncEncSha512.pas', 78 | ncEncTea in 'Source\Encryption\ncEncTea.pas', 79 | ncEncTiger in 'Source\Encryption\ncEncTiger.pas', 80 | ncEncTwofish in 'Source\Encryption\ncEncTwofish.pas', 81 | ncPendingCommandsList in 'Source\ncPendingCommandsList.pas'; 82 | 83 | end. 84 | 85 | -------------------------------------------------------------------------------- /NetCom7.dproj.local: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | 5 | 6 | 7 | 2020/08/08 06:05:23.000.402,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSocketList.pas 8 | 2020/08/08 06:14:41.000.027,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Unit1.pas 9 | 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 10 | 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 11 | 2020/08/10 13:33:07.000.316,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png 12 | 2020/08/10 13:45:09.000.739,C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png= 13 | 2020/08/10 13:45:27.000.192,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png 14 | 2020/08/10 13:48:53.000.848,C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png= 15 | 2020/08/10 13:50:07.000.192,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncIcon.bmp 16 | 2020/08/10 14:10:53.000.681,=C:\Users\Programmer\Documents\Development\Components\NetCom7\PaletteIcons\TncIcon.bmp 17 | 2020/08/11 19:21:43.000.342,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncPendingCommandsList.pas 18 | 19 | 20 | -------------------------------------------------------------------------------- /NetCom7.dres: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/NetCom7.dres -------------------------------------------------------------------------------- /NetCom7.identcache: -------------------------------------------------------------------------------- 1 | *8D:\Components\NetCom7\Source\Encryption\ncEncCast256.pas.D:\Components\NetCom7\Source\ncCompression.pas4D:\Components\NetCom7\Source\Encryption\ncEncIce.pas7D:\Components\NetCom7\Source\Encryption\ncEncSha512.pas:D:\Components\NetCom7\Source\Encryption\ncEncRipemd160.pas4D:\Components\NetCom7\Source\Encryption\ncEncTea.pas=D:\Components\NetCom7\Source\Encryption\ncEncBlockciphers.pas4D:\Components\NetCom7\Source\Encryption\ncEncRc6.pas7D:\Components\NetCom7\Source\Encryption\ncEncSha256.pas4D:\Components\NetCom7\Source\Encryption\ncEncRc2.pas4D:\Components\NetCom7\Source\Encryption\ncEncMd4.pas(D:\Components\NetCom7\Source\ncDBSrv.pas9D:\Components\NetCom7\Source\Encryption\ncEncRijndael.pas4D:\Components\NetCom7\Source\Encryption\ncEncDes.pas8D:\Components\NetCom7\Source\Encryption\ncEncTwofish.pas6D:\Components\NetCom7\Source\Encryption\ncEncTiger.pas*D:\Components\NetCom7\Source\ncThreads.pas8D:\Components\NetCom7\Source\Encryption\ncEncSerpent.pas7D:\Components\NetCom7\Source\Encryption\ncEncMisty1.pas*D:\Components\NetCom7\Source\ncSockets.pas:D:\Components\NetCom7\Source\Encryption\ncEncRipemd128.pas1D:\Components\NetCom7\Source\ncCommandPacking.pas9D:\Components\NetCom7\Source\Encryption\ncEncBlowfish.pas5D:\Components\NetCom7\Source\Encryption\ncEncMars.pas6D:\Components\NetCom7\Source\Encryption\ncEncHaval.pas-D:\Components\NetCom7\Source\ncDBCommands.pas4D:\Components\NetCom7\Source\Encryption\ncEncRc5.pas4D:\Components\NetCom7\Source\Encryption\ncEncRc4.pas*D:\Components\NetCom7\Source\ncSources.pas5D:\Components\NetCom7\Source\Encryption\ncEncSha1.pas-D:\Components\NetCom7\Source\ncEncryption.pas/D:\Components\NetCom7\Source\NetComRegister.pas-D:\Components\NetCom7\Source\ncSocketList.pas5D:\Components\NetCom7\Source\Encryption\ncEncIdea.pas/D:\Components\NetCom7\Source\ncSerializeADO.pas6D:\Components\NetCom7\Source\ncPendingCommandsList.pas8D:\Components\NetCom7\Source\Encryption\ncEncCast128.pas7D:\Components\NetCom7\Source\Encryption\ncEncCrypt2.pas2D:\Components\NetCom7\Source\ncCommandHandlers.pas(D:\Components\NetCom7\Source\ncDBCnt.pas4D:\Components\NetCom7\Source\Encryption\ncEncMd5.pas(D:\Components\NetCom7\Source\ncLines.pas -------------------------------------------------------------------------------- /NetCom7.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/NetCom7.res -------------------------------------------------------------------------------- /NetCom7.skincfg: -------------------------------------------------------------------------------- 1 | [ExpressSkins] 2 | Default=1 3 | ShowNotifications=0 4 | Enabled=1 5 | dxSkinBlack=0 6 | dxSkinBlue=0 7 | dxSkinCaramel=0 8 | dxSkinCoffee=0 9 | dxSkinDarkRoom=0 10 | dxSkinDarkSide=0 11 | dxSkinFoggy=0 12 | dxSkinGlassOceans=0 13 | dxSkiniMaginary=0 14 | dxSkinLilian=0 15 | dxSkinLiquidSky=0 16 | dxSkinLondonLiquidSky=0 17 | dxSkinMcSkin=0 18 | dxSkinMoneyTwins=0 19 | dxSkinOffice2007Black=0 20 | dxSkinOffice2007Blue=0 21 | dxSkinOffice2007Green=0 22 | dxSkinOffice2007Pink=0 23 | dxSkinOffice2007Silver=0 24 | dxSkinPumpkin=0 25 | dxSkinSeven=0 26 | dxSkinSharp=0 27 | dxSkinSilver=0 28 | dxSkinSpringTime=0 29 | dxSkinStardust=0 30 | dxSkinSummer2008=0 31 | dxSkinsDefaultPainters=0 32 | dxSkinValentine=0 33 | dxSkinXmas2008Blue=0 34 | dxSkinBlueprint=0 35 | dxSkinDevExpressDarkStyle=1 36 | dxSkinDevExpressStyle=1 37 | dxSkinHighContrast=0 38 | dxSkinOffice2010Black=1 39 | dxSkinOffice2010Blue=0 40 | dxSkinOffice2010Silver=1 41 | dxSkinOffice2013White=0 42 | dxSkinSevenClassic=0 43 | dxSkinSharpPlus=0 44 | dxSkinTheAsphaltWorld=0 45 | dxSkinVS2010=0 46 | dxSkinWhiteprint=0 47 | -------------------------------------------------------------------------------- /NetCom7.stat: -------------------------------------------------------------------------------- 1 | [Stats] 2 | EditorSecs=1563 3 | DesignerSecs=1 4 | InspectorSecs=1 5 | CompileSecs=16371 6 | OtherSecs=111 7 | StartTime=16/1/2018 01:31:50 8 | RealKeys=0 9 | EffectiveKeys=0 10 | DebugSecs=1 11 | -------------------------------------------------------------------------------- /NetCom7Resource.rc: -------------------------------------------------------------------------------- 1 | TNCICON BITMAP "PaletteIcons\\TncIcon.bmp" 2 | -------------------------------------------------------------------------------- /PaletteIcons/TncIcon.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/PaletteIcons/TncIcon.bmp -------------------------------------------------------------------------------- /PaletteIcons/TncIcon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/PaletteIcons/TncIcon.png -------------------------------------------------------------------------------- /Source/Encryption/ncEncRc5.pas: -------------------------------------------------------------------------------- 1 | {$R-} 2 | {$Q-} 3 | unit ncEncRc5; 4 | 5 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 6 | // 7 | // NetCom7 Package 8 | // 13 Dec 2010, 23/3/2024 9 | // 10 | // Written by Demos Bill 11 | // VasDemos@yahoo.co.uk 12 | // 13 | // This portion of NetCom adapts DCPCrypt into the library, 14 | // so that is does not depend on any DCP package the programmer may have installed. 15 | // The reason is because if there is an error in any encryption/decryption class, 16 | // That error should be maintained the same for any compilation of this library, 17 | // that is for any client using it. 18 | // To adapt DCPCrypt, a few changes had to be made: 19 | // 1. cosmetic changes (underscores were removed) 20 | // 2. performance changes 21 | // - const parameters when applicable 22 | // - inlined functions when necessary 23 | // 3. bug fixes: 24 | // - all ciphers do pointer walking arithmetic under only win32 25 | // For example, in DCPblowfish.pas, line 209, 210, you would find: 26 | // xL:= Pdword(@InData)^; 27 | // xR:= Pdword(longword(@InData)+4)^; 28 | // That would treat, wrongly, the address of @InData as a 32 bit unsigned int, 29 | // so all this type of pointer arithmetic has been replaced with the proper: 30 | // xL:= Pdword(@InData)^; 31 | // xR:= Pdword(NativeUInt(@InData)+4)^; 32 | // - All Pdword and dword references have been replaced with their appropriate 33 | // intrinsic types. 34 | // 35 | // Bellow is tribute to David Barton for supplying such a gem to the software community: 36 | // 37 | { ****************************************************************************** } 38 | { * Copyright (c) 1999-2002 David Barton * } 39 | { * Permission is hereby granted, free of charge, to any person obtaining a * } 40 | { * copy of this software and associated documentation files (the "Software"), * } 41 | { * to deal in the Software without restriction, including without limitation * } 42 | { * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } 43 | { * and/or sell copies of the Software, and to permit persons to whom the * } 44 | { * Software is furnished to do so, subject to the following conditions: * } 45 | { * * } 46 | { * The above copyright notice and this permission notice shall be included in * } 47 | { * all copies or substantial portions of the Software. * } 48 | { * * } 49 | { * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } 50 | { * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } 51 | { * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } 52 | { * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } 53 | { * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } 54 | { * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } 55 | { * DEALINGS IN THE SOFTWARE. * } 56 | { ****************************************************************************** } 57 | // 58 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 59 | 60 | // To disable as much of RTTI as possible (Delphi 2009/2010), 61 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 62 | {$IF CompilerVersion >= 21.0} 63 | {$WEAKLINKRTTI ON} 64 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 65 | {$ENDIF} 66 | 67 | interface 68 | 69 | uses 70 | System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; 71 | 72 | const 73 | NUMROUNDS = 12; { number of rounds must be between 12-16 } 74 | 75 | type 76 | TncEnc_rc5 = class(TncEnc_blockcipher64) 77 | protected 78 | KeyData: array [0 .. ((NUMROUNDS * 2) + 1)] of UInt32; 79 | procedure InitKey(const Key; Size: longword); override; 80 | public 81 | class function GetAlgorithm: string; override; 82 | class function GetMaxKeySize: Integer; override; 83 | class function SelfTest: Boolean; override; 84 | procedure Burn; override; 85 | procedure EncryptECB(const InData; var OutData); override; 86 | procedure DecryptECB(const InData; var OutData); override; 87 | end; 88 | 89 | { ****************************************************************************** } 90 | { ****************************************************************************** } 91 | implementation 92 | 93 | uses ncEncryption; 94 | 95 | const 96 | sBox: array [0 .. 33] of UInt32 = ($B7E15163, $5618CB1C, $F45044D5, $9287BE8E, $30BF3847, $CEF6B200, $6D2E2BB9, $0B65A572, $A99D1F2B, $47D498E4, $E60C129D, $84438C56, $227B060F, $C0B27FC8, $5EE9F981, $FD21733A, $9B58ECF3, $399066AC, $D7C7E065, $75FF5A1E, $1436D3D7, $B26E4D90, $50A5C749, $EEDD4102, $8D14BABB, 97 | $2B4C3474, $C983AE2D, $67BB27E6, $05F2A19F, $A42A1B58, $42619511, $E0990ECA, $7ED08883, $1D08023C); 98 | 99 | function LRot32(const a, b: UInt32): UInt32; inline; 100 | begin 101 | Result := (a shl b) or (a shr (32 - b)); 102 | end; 103 | 104 | function RRot32(const a, b: UInt32): UInt32; inline; 105 | begin 106 | Result := (a shr b) or (a shl (32 - b)); 107 | end; 108 | 109 | class function TncEnc_rc5.GetAlgorithm: string; 110 | begin 111 | Result := 'RC5'; 112 | end; 113 | 114 | class function TncEnc_rc5.GetMaxKeySize: Integer; 115 | begin 116 | Result := 2048; 117 | end; 118 | 119 | class function TncEnc_rc5.SelfTest: Boolean; 120 | const 121 | Key1: array [0 .. 15] of byte = ($DC, $49, $DB, $13, $75, $A5, $58, $4F, $64, $85, $B4, $13, $B5, $F1, $2B, $AF); 122 | Plain1: array [0 .. 1] of UInt32 = ($B7B3422F, $92FC6903); 123 | Cipher1: array [0 .. 1] of UInt32 = ($B278C165, $CC97D184); 124 | Key2: array [0 .. 15] of byte = ($52, $69, $F1, $49, $D4, $1B, $A0, $15, $24, $97, $57, $4D, $7F, $15, $31, $25); 125 | Plain2: array [0 .. 1] of UInt32 = ($B278C165, $CC97D184); 126 | Cipher2: array [0 .. 1] of UInt32 = ($15E444EB, $249831DA); 127 | var 128 | Cipher: TncEnc_rc5; 129 | Data: array [0 .. 1] of UInt32; 130 | begin 131 | Cipher := TncEnc_rc5.Create(nil); 132 | Cipher.Init(Key1, Sizeof(Key1) * 8, nil); 133 | Cipher.EncryptECB(Plain1, Data); 134 | Result := Boolean(CompareMem(@Data, @Cipher1, Sizeof(Data))); 135 | Cipher.DecryptECB(Data, Data); 136 | Result := Result and Boolean(CompareMem(@Data, @Plain1, Sizeof(Data))); 137 | Cipher.Burn; 138 | Cipher.Init(Key2, Sizeof(Key2) * 8, nil); 139 | Cipher.EncryptECB(Plain2, Data); 140 | Result := Result and Boolean(CompareMem(@Data, @Cipher2, Sizeof(Data))); 141 | Cipher.DecryptECB(Data, Data); 142 | Result := Result and Boolean(CompareMem(@Data, @Plain2, Sizeof(Data))); 143 | Cipher.Burn; 144 | Cipher.Free; 145 | end; 146 | 147 | procedure TncEnc_rc5.InitKey(const Key; Size: longword); 148 | var 149 | xKeyD: array [0 .. 63] of UInt32; 150 | i, j, k, xKeyLen: longword; 151 | a, b: UInt32; 152 | begin 153 | FillChar(xKeyD, Sizeof(xKeyD), 0); 154 | Size := Size div 8; 155 | Move(Key, xKeyD, Size); 156 | xKeyLen := Size div 4; 157 | if (Size mod 4) <> 0 then 158 | Inc(xKeyLen); 159 | Move(sBox, KeyData, (NUMROUNDS + 1) * 8); 160 | i := 0; 161 | j := 0; 162 | a := 0; 163 | b := 0; 164 | if xKeyLen > ((NUMROUNDS + 1) * 2) then 165 | k := xKeyLen * 3 166 | else 167 | k := (NUMROUNDS + 1) * 6; 168 | for k := k downto 1 do 169 | begin 170 | a := LRot32(KeyData[i] + a + b, 3); 171 | KeyData[i] := a; 172 | b := LRot32(xKeyD[j] + a + b, a + b); 173 | xKeyD[j] := b; 174 | i := (i + 1) mod ((NUMROUNDS + 1) * 2); 175 | j := (j + 1) mod xKeyLen; 176 | end; 177 | FillChar(xKeyD, Sizeof(xKeyD), 0); 178 | end; 179 | 180 | procedure TncEnc_rc5.Burn; 181 | begin 182 | FillChar(KeyData, Sizeof(KeyData), $FF); 183 | inherited Burn; 184 | end; 185 | 186 | procedure TncEnc_rc5.EncryptECB(const InData; var OutData); 187 | var 188 | a, b: UInt32; 189 | i: longword; 190 | begin 191 | if not FInitialized then 192 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 193 | a := PUInt32(@InData)^ + KeyData[0]; 194 | b := PUInt32(NativeUInt(@InData) + 4)^ + KeyData[1]; 195 | for i := 1 to NUMROUNDS do 196 | begin 197 | a := a xor b; 198 | a := LRot32(a, b) + KeyData[2 * i]; 199 | b := b xor a; 200 | b := LRot32(b, a) + KeyData[(2 * i) + 1]; 201 | end; 202 | PUInt32(@OutData)^ := a; 203 | PUInt32(NativeUInt(@OutData) + 4)^ := b; 204 | end; 205 | 206 | procedure TncEnc_rc5.DecryptECB(const InData; var OutData); 207 | var 208 | a, b: UInt32; 209 | i: longword; 210 | begin 211 | if not FInitialized then 212 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 213 | a := PUInt32(@InData)^; 214 | b := PUInt32(NativeUInt(@InData) + 4)^; 215 | for i := NUMROUNDS downto 1 do 216 | begin 217 | b := RRot32(b - KeyData[(2 * i) + 1], a); 218 | b := b xor a; 219 | a := RRot32(a - KeyData[2 * i], b); 220 | a := a xor b; 221 | end; 222 | PUInt32(@OutData)^ := a - KeyData[0]; 223 | PUInt32(NativeUInt(@OutData) + 4)^ := b - KeyData[1]; 224 | end; 225 | 226 | end. 227 | -------------------------------------------------------------------------------- /Source/Encryption/ncEncTea.pas: -------------------------------------------------------------------------------- 1 | {$R-} 2 | {$Q-} 3 | unit ncEncTea; 4 | 5 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 6 | // 7 | // NetCom7 Package 8 | // 13 Dec 2010, 23/3/2024 9 | // 10 | // Written by Demos Bill 11 | // VasDemos@yahoo.co.uk 12 | // 13 | // This portion of NetCom adapts DCPCrypt into the library, 14 | // so that is does not depend on any DCP package the programmer may have installed. 15 | // The reason is because if there is an error in any encryption/decryption class, 16 | // That error should be maintained the same for any compilation of this library, 17 | // that is for any client using it. 18 | // To adapt DCPCrypt, a few changes had to be made: 19 | // 1. cosmetic changes (underscores were removed) 20 | // 2. performance changes 21 | // - const parameters when applicable 22 | // - inlined functions when necessary 23 | // 3. bug fixes: 24 | // - all ciphers do pointer walking arithmetic under only win32 25 | // For example, in DCPblowfish.pas, line 209, 210, you would find: 26 | // xL:= Pdword(@InData)^; 27 | // xR:= Pdword(longword(@InData)+4)^; 28 | // That would treat, wrongly, the address of @InData as a 32 bit unsigned int, 29 | // so all this type of pointer arithmetic has been replaced with the proper: 30 | // xL:= Pdword(@InData)^; 31 | // xR:= Pdword(NativeUInt(@InData)+4)^; 32 | // - All Pdword and dword references have been replaced with their appropriate 33 | // intrinsic types. 34 | // 35 | // Bellow is tribute to David Barton for supplying such a gem to the software community: 36 | // 37 | { ****************************************************************************** } 38 | { * Copyright (c) 1999-2002 David Barton * } 39 | { * Permission is hereby granted, free of charge, to any person obtaining a * } 40 | { * copy of this software and associated documentation files (the "Software"), * } 41 | { * to deal in the Software without restriction, including without limitation * } 42 | { * the rights to use, copy, modify, merge, publish, distribute, sublicense, * } 43 | { * and/or sell copies of the Software, and to permit persons to whom the * } 44 | { * Software is furnished to do so, subject to the following conditions: * } 45 | { * * } 46 | { * The above copyright notice and this permission notice shall be included in * } 47 | { * all copies or substantial portions of the Software. * } 48 | { * * } 49 | { * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR * } 50 | { * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, * } 51 | { * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL * } 52 | { * THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER * } 53 | { * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING * } 54 | { * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * } 55 | { * DEALINGS IN THE SOFTWARE. * } 56 | { ****************************************************************************** } 57 | // 58 | // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 59 | 60 | // To disable as much of RTTI as possible (Delphi 2009/2010), 61 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 62 | {$IF CompilerVersion >= 21.0} 63 | {$WEAKLINKRTTI ON} 64 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 65 | {$ENDIF} 66 | 67 | interface 68 | 69 | uses 70 | System.Classes, System.Sysutils, ncEnccrypt2, ncEncblockciphers; 71 | 72 | type 73 | TncEnc_tea = class(TncEnc_blockcipher64) 74 | protected 75 | KeyData: array [0 .. 3] of UInt32; 76 | procedure InitKey(const Key; Size: longword); override; 77 | public 78 | class function GetAlgorithm: string; override; 79 | class function GetMaxKeySize: Integer; override; 80 | class function SelfTest: Boolean; override; 81 | procedure Burn; override; 82 | procedure EncryptECB(const InData; var OutData); override; 83 | procedure DecryptECB(const InData; var OutData); override; 84 | end; 85 | 86 | { ****************************************************************************** } 87 | { ****************************************************************************** } 88 | implementation 89 | 90 | uses ncEncryption; 91 | 92 | const 93 | Delta = $9E3779B9; 94 | Rounds = 32; 95 | 96 | function SwapDword(const a: UInt32): UInt32; inline; 97 | begin 98 | Result := ((a and $FF) shl 24) or ((a and $FF00) shl 8) or ((a and $FF0000) shr 8) or ((a and $FF000000) shr 24); 99 | end; 100 | 101 | class function TncEnc_tea.GetAlgorithm: string; 102 | begin 103 | Result := 'Tea'; 104 | end; 105 | 106 | class function TncEnc_tea.GetMaxKeySize: Integer; 107 | begin 108 | Result := 128; 109 | end; 110 | 111 | class function TncEnc_tea.SelfTest: Boolean; 112 | const 113 | Key: array [0 .. 3] of UInt32 = ($12345678, $9ABCDEF0, $0FEDCBA9, $87654321); 114 | PT: array [0 .. 1] of UInt32 = ($12345678, $9ABCDEF0); 115 | var 116 | Data: array [0 .. 1] of UInt32; 117 | Cipher: TncEnc_tea; 118 | begin 119 | Cipher := TncEnc_tea.Create(nil); 120 | Cipher.Init(Key, Sizeof(Key) * 8, nil); 121 | Cipher.EncryptECB(PT, Data); 122 | Result := not CompareMem(@Data, @PT, Sizeof(PT)); 123 | Cipher.DecryptECB(Data, Data); 124 | Result := Result and CompareMem(@Data, @PT, Sizeof(PT)); 125 | Cipher.Burn; 126 | Cipher.Free; 127 | end; 128 | 129 | procedure TncEnc_tea.InitKey(const Key; Size: longword); 130 | begin 131 | FillChar(KeyData, Sizeof(KeyData), 0); 132 | Move(Key, KeyData, Size div 8); 133 | KeyData[0] := SwapDword(KeyData[0]); 134 | KeyData[1] := SwapDword(KeyData[1]); 135 | KeyData[2] := SwapDword(KeyData[2]); 136 | KeyData[3] := SwapDword(KeyData[3]); 137 | end; 138 | 139 | procedure TncEnc_tea.Burn; 140 | begin 141 | FillChar(KeyData, Sizeof(KeyData), 0); 142 | inherited Burn; 143 | end; 144 | 145 | procedure TncEnc_tea.EncryptECB(const InData; var OutData); 146 | var 147 | a, b, c, d, x, y, n, sum: UInt32; 148 | begin 149 | if not FInitialized then 150 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 151 | 152 | x := SwapDword(PUInt32(@InData)^); 153 | y := SwapDword(PUInt32(NativeUInt(@InData) + 4)^); 154 | sum := 0; 155 | a := KeyData[0]; 156 | b := KeyData[1]; 157 | c := KeyData[2]; 158 | d := KeyData[3]; 159 | for n := 1 to Rounds do 160 | begin 161 | Inc(sum, Delta); 162 | Inc(x, (y shl 4) + (a xor y) + (sum xor (y shr 5)) + b); 163 | Inc(y, (x shl 4) + (c xor x) + (sum xor (x shr 5)) + d); 164 | end; 165 | PUInt32(@OutData)^ := SwapDword(x); 166 | PUInt32(NativeUInt(@OutData) + 4)^ := SwapDword(y); 167 | end; 168 | 169 | procedure TncEnc_tea.DecryptECB(const InData; var OutData); 170 | var 171 | a, b, c, d, x, y, n, sum: UInt32; 172 | begin 173 | if not FInitialized then 174 | raise EEncBlockcipherException.Create(rsCipherNotInitialised); 175 | 176 | x := SwapDword(PUInt32(@InData)^); 177 | y := SwapDword(PUInt32(NativeUInt(@InData) + 4)^); 178 | sum := Delta shl 5; 179 | a := KeyData[0]; 180 | b := KeyData[1]; 181 | c := KeyData[2]; 182 | d := KeyData[3]; 183 | for n := 1 to Rounds do 184 | begin 185 | Dec(y, (x shl 4) + (c xor x) + (sum xor (x shr 5)) + d); 186 | Dec(x, (y shl 4) + (a xor y) + (sum xor (y shr 5)) + b); 187 | Dec(sum, Delta); 188 | end; 189 | PUInt32(@OutData)^ := SwapDword(x); 190 | PUInt32(NativeUInt(@OutData) + 4)^ := SwapDword(y); 191 | end; 192 | 193 | end. 194 | -------------------------------------------------------------------------------- /Source/NetComRegister.dcr: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Source/NetComRegister.dcr -------------------------------------------------------------------------------- /Source/NetComRegister.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/DelphiBuilder/NetCom7/29c6ef3fe43ac0c82e7880f84bc363b0e2065ec1/Source/NetComRegister.pas -------------------------------------------------------------------------------- /Source/ncCommandHandlers.pas: -------------------------------------------------------------------------------- 1 | unit ncCommandHandlers; 2 | 3 | // To disable as much of RTTI as possible (Delphi 2009/2010), 4 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 5 | {$IF CompilerVersion >= 21.0} 6 | {$WEAKLINKRTTI ON} 7 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 8 | {$ENDIF} 9 | 10 | interface 11 | 12 | uses 13 | System.Classes, System.SysUtils, System.SyncObjs, System.Rtti, ncSources; 14 | 15 | type 16 | TncCustomCommandHandler = class(TComponent, IncCommandHandler) 17 | private 18 | FSource: TncSourceBase; 19 | FPeerCommandHandler: string; 20 | FOnConnected: TncOnSourceConnectDisconnect; 21 | FOnDisconnected: TncOnSourceConnectDisconnect; 22 | FOnHandleCommand: TncOnSourceHandleCommand; 23 | FOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; 24 | procedure SetSource(const Value: TncSourceBase); 25 | function GetPeerCommandHandler: string; 26 | procedure SetPeerCommandHandler(const Value: string); 27 | function GetOnConnected: TncOnSourceConnectDisconnect; 28 | procedure SetOnConnected(const Value: TncOnSourceConnectDisconnect); 29 | function GetOnDisconnected: TncOnSourceConnectDisconnect; 30 | procedure SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); 31 | function GetOnHandleCommand: TncOnSourceHandleCommand; 32 | procedure SetOnHandleCommand(const Value: TncOnSourceHandleCommand); 33 | function GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; 34 | procedure SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); 35 | protected 36 | procedure Notification(AComponent: TComponent; Operation: TOperation); override; 37 | function GetComponentName: string; 38 | 39 | property Source: TncSourceBase read FSource write SetSource; 40 | property PeerCommandHandler: string read GetPeerCommandHandler write SetPeerCommandHandler; 41 | property OnConnected: TncOnSourceConnectDisconnect read GetOnConnected write SetOnConnected; 42 | property OnDisconnected: TncOnSourceConnectDisconnect read GetOnDisconnected write SetOnDisconnected; 43 | property OnHandleCommand: TncOnSourceHandleCommand read GetOnHandleCommand write SetOnHandleCommand; 44 | property OnAsyncExecCommandResult: TncOnAsyncExecCommandResult read GetOnAsyncExecCommandResult write SetOnAsyncExecCommandResult; 45 | public 46 | constructor Create(AOwner: TComponent); override; 47 | destructor Destroy; override; 48 | 49 | function ExecCommand(aLine: TncSourceLine; const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; 50 | aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''): TBytes; 51 | published 52 | end; 53 | 54 | TncCommandHandler = class(TncCustomCommandHandler) 55 | published 56 | property Source; 57 | property PeerCommandHandler; 58 | 59 | property OnConnected; 60 | property OnDisconnected; 61 | property OnHandleCommand; 62 | end; 63 | 64 | implementation 65 | 66 | { TncCustomCommandHandler } 67 | 68 | constructor TncCustomCommandHandler.Create(AOwner: TComponent); 69 | begin 70 | inherited Create(AOwner); 71 | FSource := nil; 72 | FOnConnected := nil; 73 | FOnDisconnected := nil; 74 | FOnHandleCommand := nil; 75 | FOnAsyncExecCommandResult := nil; 76 | end; 77 | 78 | destructor TncCustomCommandHandler.Destroy; 79 | begin 80 | Source := nil; 81 | inherited Destroy; 82 | end; 83 | 84 | procedure TncCustomCommandHandler.Notification(AComponent: TComponent; Operation: TOperation); 85 | begin 86 | inherited Notification(AComponent, Operation); 87 | 88 | if Operation = opRemove then 89 | if AComponent = FSource then 90 | SetSource(nil); 91 | 92 | if not(csLoading in ComponentState) then 93 | begin 94 | if Operation = opInsert then 95 | if not Assigned(FSource) then 96 | if AComponent is TncSourceBase then 97 | SetSource(TncSourceBase(AComponent)); 98 | end; 99 | end; 100 | 101 | function TncCustomCommandHandler.ExecCommand(aLine: TncSourceLine; const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; 102 | aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''): TBytes; 103 | begin 104 | if not Assigned(Source) then 105 | raise Exception.Create('Cannot execute with no source object'); 106 | 107 | // If no override, we use the component's command handler (the property) 108 | if aPeerComponentHandler = '' then 109 | Result := Source.ExecCommand(aLine, aCmd, aData, aRequiresResult, aAsyncExecute, PeerCommandHandler) 110 | else 111 | Result := Source.ExecCommand(aLine, aCmd, aData, aRequiresResult, aAsyncExecute, aPeerComponentHandler); 112 | end; 113 | 114 | procedure TncCustomCommandHandler.SetSource(const Value: TncSourceBase); 115 | begin 116 | if FSource <> Value then 117 | begin 118 | if Assigned(FSource) then 119 | FSource.RemoveCommandHandler(Self); 120 | 121 | FSource := Value; 122 | 123 | if Assigned(FSource) then 124 | FSource.AddCommandHandler(Self); 125 | end; 126 | end; 127 | 128 | function TncCustomCommandHandler.GetPeerCommandHandler: string; 129 | begin 130 | Result := FPeerCommandHandler; 131 | end; 132 | 133 | procedure TncCustomCommandHandler.SetPeerCommandHandler(const Value: string); 134 | begin 135 | FPeerCommandHandler := Value; 136 | end; 137 | 138 | function TncCustomCommandHandler.GetComponentName: string; 139 | begin 140 | Result := Name; 141 | end; 142 | 143 | function TncCustomCommandHandler.GetOnConnected: TncOnSourceConnectDisconnect; 144 | begin 145 | Result := FOnConnected; 146 | end; 147 | 148 | procedure TncCustomCommandHandler.SetOnConnected(const Value: TncOnSourceConnectDisconnect); 149 | begin 150 | FOnConnected := Value; 151 | end; 152 | 153 | function TncCustomCommandHandler.GetOnDisconnected: TncOnSourceConnectDisconnect; 154 | begin 155 | Result := FOnDisconnected; 156 | end; 157 | 158 | procedure TncCustomCommandHandler.SetOnDisconnected(const Value: TncOnSourceConnectDisconnect); 159 | begin 160 | FOnDisconnected := Value; 161 | end; 162 | 163 | function TncCustomCommandHandler.GetOnHandleCommand: TncOnSourceHandleCommand; 164 | begin 165 | Result := FOnHandleCommand; 166 | end; 167 | 168 | procedure TncCustomCommandHandler.SetOnHandleCommand(const Value: TncOnSourceHandleCommand); 169 | begin 170 | FOnHandleCommand := Value; 171 | end; 172 | 173 | function TncCustomCommandHandler.GetOnAsyncExecCommandResult: TncOnAsyncExecCommandResult; 174 | begin 175 | Result := FOnAsyncExecCommandResult; 176 | end; 177 | 178 | procedure TncCustomCommandHandler.SetOnAsyncExecCommandResult(const Value: TncOnAsyncExecCommandResult); 179 | begin 180 | FOnAsyncExecCommandResult := Value; 181 | end; 182 | 183 | end. 184 | -------------------------------------------------------------------------------- /Source/ncCommandPacking.pas: -------------------------------------------------------------------------------- 1 | unit ncCommandPacking; 2 | 3 | /// //////////////////////////////////////////////////////////////////////////// 4 | // 5 | // TSocketList 6 | // 7 | // This unit declares a TncCommand which is used by ncSources to pass 8 | // information from peer to peer. 9 | // The TncCommand can be packed and unnpacked into and from a TBytes array 10 | // 11 | // This unit has been optimised to perform at maximum speed by checking the 12 | // assembly the compiler generates. 13 | // 14 | // Written by Demos Bill 15 | // 7/8/2020 16 | // - Optimised code by checking assembly. The performance of executing 100000 17 | // times a command with data: 'Hello from Client', and compression on, was 18 | // before optimisation: 57532 msec 19 | // after optimisation: 19383 msec 20 | // performance gain: 2,97 times faster. 21 | // With compression off we can execute 100000 command executions 22 | // in 5438 msec 23 | // This performance testing was made before ncSources were re-engineered. 24 | // Please check ncSources to see what the new performance is after 25 | // latest re-engineering. 26 | // - Initial Creation: Ported code from ncSources 27 | // 28 | /// //////////////////////////////////////////////////////////////////////////// 29 | 30 | interface 31 | 32 | uses SysUtils; 33 | 34 | type 35 | ENetComImproperMessageEncoding = class(Exception); 36 | 37 | TncCommandType = (ctInitiator, ctResponse); 38 | PncCommandType = ^TncCommandType; 39 | 40 | TncCommandUniqueID = UInt32; 41 | PncCommandUniqueID = ^TncCommandUniqueID; 42 | 43 | TncCommandCmd = UInt32; 44 | PncCommandCmd = ^TncCommandCmd; 45 | 46 | TncCommand = record 47 | public 48 | CommandType: TncCommandType; 49 | UniqueID: TncCommandUniqueID; 50 | Cmd: TncCommandCmd; 51 | Data: TBytes; 52 | RequiresResult: Boolean; 53 | AsyncExecute: Boolean; 54 | ResultIsErrorString: Boolean; 55 | SourceComponentHandler: string; 56 | PeerComponentHandler: string; 57 | 58 | procedure FromBytes(const aBytes: TBytes); 59 | function ToBytes: TBytes; 60 | end; 61 | 62 | resourcestring 63 | ENetComImproperMessageEncodingMessage = 'Improper message encoding'; 64 | 65 | implementation 66 | 67 | // ///////////////////////////////////////////////////////////////////////////// 68 | { TncCommand } 69 | // ///////////////////////////////////////////////////////////////////////////// 70 | 71 | procedure TncCommand.FromBytes(const aBytes: TBytes); 72 | type 73 | PBool = ^Boolean; 74 | PInt32 = ^Int32; 75 | PUInt64 = ^UInt64; 76 | 77 | const 78 | SigLen = SizeOf(Byte); 79 | BytesLen = SizeOf(UInt64); 80 | 81 | CommandTypeLen = SizeOf(TncCommandType); 82 | UniqueIDLen = SizeOf(TncCommandUniqueID); 83 | CmdLen = SizeOf(TncCommandCmd); 84 | AsyncExecuteLen = SizeOf(Boolean); 85 | RequiresResultLen = SizeOf(Boolean); 86 | ResultIsErrorStringLen = SizeOf(Boolean); 87 | 88 | var 89 | AddrPtr: PByte; 90 | DataBytesLen, SourceComponentBytesLen, PeerComponentBytesLen: UInt64; 91 | StrBytes: TBytes; 92 | 93 | begin 94 | // Point to beginning of aBytes 95 | AddrPtr := @aBytes[0]; 96 | 97 | // Read command type 98 | CommandType := PncCommandType(AddrPtr)^; 99 | inc(AddrPtr, CommandTypeLen); 100 | // Read UniqueID 101 | UniqueID := PncCommandUniqueID(AddrPtr)^; 102 | inc(AddrPtr, UniqueIDLen); 103 | // Read Cmd 104 | Cmd := PncCommandCmd(AddrPtr)^; 105 | inc(AddrPtr, CmdLen); 106 | // Read AsyncExecute 107 | AsyncExecute := PBool(AddrPtr)^; 108 | inc(AddrPtr, AsyncExecuteLen); 109 | // Read RequiresResult 110 | RequiresResult := PBool(AddrPtr)^; 111 | inc(AddrPtr, RequiresResultLen); 112 | // Read ResultIsErrorString 113 | ResultIsErrorString := PBool(AddrPtr)^; 114 | inc(AddrPtr, ResultIsErrorStringLen); 115 | 116 | // Read Signature 117 | if PByte(AddrPtr)^ <> $AA then // 10101010 bin 118 | raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); 119 | inc(AddrPtr, SigLen); 120 | // Read DataLen 121 | DataBytesLen := PUInt64(AddrPtr)^; 122 | inc(AddrPtr, BytesLen); 123 | 124 | // Read Signature 125 | if PByte(AddrPtr)^ <> $AA then // 10101010 bin 126 | raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); 127 | inc(AddrPtr, SigLen); 128 | // Read SourceComponentHandlerBytesLen 129 | SourceComponentBytesLen := PUInt64(AddrPtr)^; 130 | inc(AddrPtr, BytesLen); 131 | 132 | // Read Signature 133 | if PByte(AddrPtr)^ <> $AA then // 10101010 bin 134 | raise ENetComImproperMessageEncoding.Create(ENetComImproperMessageEncodingMessage); 135 | inc(AddrPtr, SigLen); 136 | // Read PeerComponentHandlerBytesLen 137 | PeerComponentBytesLen := PUInt64(AddrPtr)^; 138 | inc(AddrPtr, BytesLen); 139 | 140 | // Read Data 141 | if DataBytesLen > 0 then 142 | begin 143 | SetLength(Data, DataBytesLen); 144 | move(AddrPtr^, Data[0], DataBytesLen); 145 | inc(AddrPtr, DataBytesLen); 146 | end; 147 | // Read SourceComponentHandlerBytes 148 | if SourceComponentBytesLen > 0 then 149 | begin 150 | SetLength(StrBytes, SourceComponentBytesLen); 151 | move(AddrPtr^, StrBytes[0], SourceComponentBytesLen); 152 | SourceComponentHandler := StringOf(StrBytes); 153 | inc(AddrPtr, SourceComponentBytesLen); 154 | end; 155 | // Read PeerComponentHandlerBytes 156 | if PeerComponentBytesLen > 0 then 157 | begin 158 | SetLength(StrBytes, PeerComponentBytesLen); 159 | move(AddrPtr^, StrBytes[0], PeerComponentBytesLen); 160 | PeerComponentHandler := StringOf(StrBytes); 161 | end; 162 | end; 163 | 164 | function TncCommand.ToBytes: TBytes; 165 | type 166 | PBool = ^Boolean; 167 | PInt32 = ^Int32; 168 | PUInt64 = ^UInt64; 169 | 170 | const 171 | SigLen = SizeOf(Byte); 172 | BytesLen = SizeOf(UInt64); 173 | 174 | CommandTypeLen = SizeOf(TncCommandType); 175 | UniqueIDLen = SizeOf(TncCommandUniqueID); 176 | CmdLen = SizeOf(TncCommandCmd); 177 | AsyncExecuteLen = SizeOf(Boolean); 178 | RequiresResultLen = SizeOf(Boolean); 179 | ResultIsErrorStringLen = SizeOf(Boolean); 180 | 181 | StaticBufferLen = 182 | 183 | UInt64(CommandTypeLen + UniqueIDLen + CmdLen + AsyncExecuteLen + RequiresResultLen + ResultIsErrorStringLen + 184 | 185 | SigLen + BytesLen + SigLen + BytesLen + SigLen + BytesLen); 186 | 187 | var 188 | AddrPtr: PByte; 189 | DataBytesLen, SourceComponentBytesLen, PeerComponentBytesLen: UInt64; 190 | SourceComponentHandlerBytes, PeerComponentHandlerBytes: TBytes; 191 | 192 | begin 193 | SourceComponentHandlerBytes := BytesOf(SourceComponentHandler); 194 | PeerComponentHandlerBytes := BytesOf(PeerComponentHandler); 195 | 196 | DataBytesLen := Length(Data); 197 | SourceComponentBytesLen := Length(SourceComponentHandlerBytes); 198 | PeerComponentBytesLen := Length(PeerComponentHandlerBytes); 199 | 200 | SetLength(Result, StaticBufferLen + DataBytesLen + SourceComponentBytesLen + PeerComponentBytesLen); 201 | 202 | // Point to beginning of result buffer 203 | AddrPtr := @Result[0]; 204 | 205 | // Write command type 206 | PncCommandType(AddrPtr)^ := CommandType; 207 | inc(AddrPtr, CommandTypeLen); 208 | // Write UniqueID 209 | PncCommandUniqueID(AddrPtr)^ := UniqueID; 210 | inc(AddrPtr, UniqueIDLen); 211 | // Write Cmd 212 | PncCommandCmd(AddrPtr)^ := Cmd; 213 | inc(AddrPtr, CmdLen); 214 | // Write AnyncExecute 215 | PBool(AddrPtr)^ := AsyncExecute; 216 | inc(AddrPtr, AsyncExecuteLen); 217 | // Write RequiresResult 218 | PBool(AddrPtr)^ := RequiresResult; 219 | inc(AddrPtr, RequiresResultLen); 220 | // Write ResultIsErrorString 221 | PBool(AddrPtr)^ := ResultIsErrorString; 222 | inc(AddrPtr, ResultIsErrorStringLen); 223 | 224 | // Write Signature 225 | PByte(AddrPtr)^ := $AA; // 10101010 bin 226 | inc(AddrPtr, SigLen); 227 | // Write DataLen 228 | PUInt64(AddrPtr)^ := DataBytesLen; 229 | inc(AddrPtr, BytesLen); 230 | 231 | // Write Signature 232 | PByte(AddrPtr)^ := $AA; // 10101010 bin 233 | inc(AddrPtr, SigLen); 234 | // Write SourceComponentHandlerBytesLen 235 | PUInt64(AddrPtr)^ := SourceComponentBytesLen; 236 | inc(AddrPtr, BytesLen); 237 | 238 | // Write Signature 239 | PByte(AddrPtr)^ := $AA; // 10101010 bin 240 | inc(AddrPtr, SigLen); 241 | // Write PeerComponentHandlerBytesLen 242 | PUInt64(AddrPtr)^ := PeerComponentBytesLen; 243 | inc(AddrPtr, BytesLen); 244 | 245 | // Write Data 246 | if DataBytesLen > 0 then 247 | begin 248 | move(Data[0], AddrPtr^, DataBytesLen); 249 | inc(AddrPtr, DataBytesLen); 250 | end; 251 | // Write SourceComponentHandlerBytes 252 | if SourceComponentBytesLen > 0 then 253 | begin 254 | move(SourceComponentHandlerBytes[0], AddrPtr^, SourceComponentBytesLen); 255 | inc(AddrPtr, SourceComponentBytesLen); 256 | end; 257 | // Write PeerComponentHandlerBytes 258 | if PeerComponentBytesLen > 0 then 259 | move(PeerComponentHandlerBytes[0], AddrPtr^, PeerComponentBytesLen); 260 | end; 261 | 262 | end. 263 | -------------------------------------------------------------------------------- /Source/ncCompression.pas: -------------------------------------------------------------------------------- 1 | unit ncCompression; 2 | 3 | // To disable as much of RTTI as possible (Delphi 2009/2010), 4 | // Note: There is a bug if $RTTI is used before the "unit ;" section of a unit, hence the position 5 | {$IF CompilerVersion >= 21.0} 6 | {$WEAKLINKRTTI ON} 7 | {$RTTI EXPLICIT METHODS([]) PROPERTIES([]) FIELDS([])} 8 | {$ENDIF} 9 | 10 | interface 11 | 12 | uses System.ZLib, System.Classes, System.SysUtils; 13 | 14 | type 15 | TncCompressionLevel = TZCompressionLevel; 16 | 17 | function CompressBytes(const aBytes: TBytes; aCompressionLevel: TncCompressionLevel = zcDefault): TBytes; 18 | function DecompressBytes(const aBytes: TBytes): TBytes; 19 | 20 | implementation 21 | 22 | function CompressBytes(const aBytes: TBytes; aCompressionLevel: TncCompressionLevel = zcDefault): TBytes; 23 | begin 24 | if Length(aBytes) > 0 then 25 | ZCompress(aBytes, Result, aCompressionLevel) 26 | else 27 | SetLength(Result, 0); 28 | end; 29 | 30 | function DecompressBytes(const aBytes: TBytes): TBytes; 31 | begin 32 | if Length(aBytes) > 0 then 33 | ZDecompress(aBytes, Result, Length(aBytes) * 128) 34 | else 35 | SetLength(Result, 0); 36 | end; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Source/ncDBCommands.pas: -------------------------------------------------------------------------------- 1 | unit ncDBCommands; 2 | 3 | interface 4 | 5 | uses Classes, SysUtils, DB, ADODB, ADOInt, ncCommandPacking, ncSources, ncSerializeADO; 6 | 7 | const 8 | ncDBOpenDataset = 0; // uses TDBDatasetData as param 9 | ncDBCloseDataset = 1; // uses no params 10 | ncDBUpdateDataset = 2; // uses TDBUpdateDatasetData as param 11 | ncDBExecDataset = 3; // uses TDBDatasetData as param 12 | 13 | type 14 | TDBDatasetData = class 15 | public 16 | SQL: string; 17 | Parameters: TBytes; 18 | 19 | constructor Create; 20 | destructor Destroy; override; 21 | 22 | function FromBytes(aBytes: TBytes): Integer; virtual; 23 | function ToBytes: TBytes; virtual; 24 | end; 25 | 26 | TDBUpdateDatasetData = class(TDBDatasetData) 27 | public 28 | RecordUpdates: _Recordset; 29 | 30 | constructor Create; 31 | destructor Destroy; override; 32 | 33 | function FromBytes(aBytes: TBytes): Integer; override; 34 | function ToBytes: TBytes; override; 35 | end; 36 | 37 | implementation 38 | 39 | { TDBOpenDatasetData } 40 | 41 | constructor TDBDatasetData.Create; 42 | begin 43 | inherited Create; 44 | SetLength(Parameters, 0); 45 | end; 46 | 47 | destructor TDBDatasetData.Destroy; 48 | begin 49 | inherited; 50 | end; 51 | 52 | function TDBDatasetData.FromBytes(aBytes: TBytes): Integer; 53 | begin 54 | Result := 0; 55 | 56 | SQL := ReadString(aBytes, Result); 57 | Parameters := ReadBytes(aBytes, Result); 58 | end; 59 | 60 | function TDBDatasetData.ToBytes: TBytes; 61 | var 62 | BufLen: Integer; 63 | begin 64 | // This is intended for the use of WriteMessageEmbeddedBufferLen 65 | SetLength(Result, 0); 66 | BufLen := 0; 67 | 68 | WriteString(SQL, Result, BufLen); 69 | WriteBytes(Parameters, Result, BufLen); 70 | end; 71 | 72 | { TDBUpdateDatasetData } 73 | 74 | constructor TDBUpdateDatasetData.Create; 75 | begin 76 | inherited Create; 77 | RecordUpdates := nil; 78 | end; 79 | 80 | destructor TDBUpdateDatasetData.Destroy; 81 | begin 82 | if Assigned(RecordUpdates) then 83 | RecordUpdates := nil; 84 | 85 | inherited; 86 | end; 87 | 88 | function TDBUpdateDatasetData.FromBytes(aBytes: TBytes): Integer; 89 | begin 90 | Result := inherited FromBytes(aBytes); 91 | 92 | RecordUpdates := BytesToRecordset(ReadBytes(aBytes, Result)); 93 | end; 94 | 95 | function TDBUpdateDatasetData.ToBytes: TBytes; 96 | var 97 | BufLen: Integer; 98 | begin 99 | Result := inherited ToBytes; 100 | BufLen := Length(Result); 101 | 102 | WriteBytes(RecordsetToBytes(RecordUpdates, pfADTG), Result, BufLen); 103 | end; 104 | 105 | end. 106 | -------------------------------------------------------------------------------- /Source/ncPendingCommandsList.pas: -------------------------------------------------------------------------------- 1 | unit ncPendingCommandsList; 2 | 3 | /// //////////////////////////////////////////////////////////////////////////// 4 | // 5 | // TPendingCommandsList 6 | // Written by Demos Bill, Tue 11/08/2020 7 | // 8 | // PendingCommandsList, the equivalent of TStringList 9 | // but for the type of TncCommandUniqueID 10 | // 11 | /// //////////////////////////////////////////////////////////////////////////// 12 | 13 | interface 14 | 15 | uses System.Classes, System.SysUtils, System.RTLConsts, System.SyncObjs, ncCommandPacking; 16 | 17 | type 18 | TPendingCommandItem = record 19 | FUniqueID: TncCommandUniqueID; 20 | FReceivedResultEvent: TLightweightEvent; 21 | FResult: TncCommand; 22 | end; 23 | 24 | PPendingCommandItem = ^TPendingCommandItem; 25 | 26 | TPendingCommandItemsList = array of TPendingCommandItem; 27 | PPendingCommandItemsList = ^TPendingCommandItemsList; 28 | 29 | TPendingCommandsList = class(TPersistent) 30 | private 31 | FList: TPendingCommandItemsList; 32 | FCount: Integer; 33 | FCapacity: Integer; 34 | function GetUniqueIDs(Index: Integer): TncCommandUniqueID; register; 35 | function GetReceivedResultEvents(Index: Integer): TLightweightEvent; register; 36 | procedure PutReceivedResultEvents(Index: Integer; aReceivedResultEvent: TLightweightEvent); 37 | function GetResults(Index: Integer): TncCommand; 38 | procedure PutResults(Index: Integer; const aResult: TncCommand); 39 | procedure SetCapacity(aNewCapacity: Integer); 40 | protected 41 | procedure Insert(aIndex: Integer; const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent); 42 | procedure Grow; 43 | public 44 | destructor Destroy; override; 45 | 46 | function Add(const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent): Integer; 47 | procedure Clear; 48 | procedure Delete(aIndex: Integer); register; 49 | function Find(const aUniqueID: TncCommandUniqueID; var aIndex: Integer): Boolean; register; 50 | function IndexOf(const aUniqueID: TncCommandUniqueID): Integer; register; 51 | 52 | property Count: Integer read FCount; 53 | property UniqueIDs[index: Integer]: TncCommandUniqueID read GetUniqueIDs; default; 54 | property ReceivedResultEvents[index: Integer]: TLightweightEvent read GetReceivedResultEvents write PutReceivedResultEvents; 55 | property Results[index: Integer]: TncCommand read GetResults write PutResults; 56 | end; 57 | 58 | implementation 59 | 60 | resourcestring 61 | SDuplicateUniqueID = 'Command unique ID list does not allow duplicates'; 62 | 63 | { TPendingCommandList } 64 | 65 | destructor TPendingCommandsList.Destroy; 66 | begin 67 | inherited Destroy; 68 | FCount := 0; 69 | SetCapacity(0); 70 | end; 71 | 72 | function TPendingCommandsList.Add(const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent): Integer; 73 | begin 74 | if Find(aUniqueID, Result) then 75 | raise Exception.Create(SDuplicateUniqueID); 76 | Insert(Result, aUniqueID, aReceivedResultEvent); 77 | end; 78 | 79 | procedure TPendingCommandsList.Clear; 80 | begin 81 | if FCount <> 0 then 82 | begin 83 | FCount := 0; 84 | SetCapacity(0); 85 | end; 86 | end; 87 | 88 | procedure TPendingCommandsList.Delete(aIndex: Integer); 89 | begin 90 | if (aIndex < 0) or (aIndex >= FCount) then 91 | raise Exception.Create(Format(SListIndexError, [aIndex])); 92 | 93 | Dec(FCount); 94 | if aIndex < FCount then 95 | System.Move(FList[aIndex + 1], FList[aIndex], (FCount - aIndex) * SizeOf(TPendingCommandItem)); 96 | end; 97 | 98 | // Binary Searching 99 | 100 | function TPendingCommandsList.Find(const aUniqueID: TncCommandUniqueID; var aIndex: Integer): Boolean; 101 | var 102 | Low, High, Mid: Integer; 103 | begin 104 | Result := False; 105 | Low := 0; 106 | High := FCount - 1; 107 | while Low <= High do 108 | begin 109 | Mid := (Low + High) shr 1; 110 | if aUniqueID > FList[Mid].FUniqueID then 111 | Low := Mid + 1 112 | else 113 | begin 114 | High := Mid - 1; 115 | if aUniqueID = FList[Mid].FUniqueID then 116 | begin 117 | Result := True; 118 | Low := Mid; 119 | end; 120 | end; 121 | end; 122 | aIndex := Low; 123 | end; 124 | 125 | procedure TPendingCommandsList.Grow; 126 | var 127 | Delta: Integer; 128 | begin 129 | if FCapacity > 64 then 130 | Delta := FCapacity div 4 131 | else if FCapacity > 8 then 132 | Delta := 16 133 | else 134 | Delta := 4; 135 | SetCapacity(FCapacity + Delta); 136 | end; 137 | 138 | function TPendingCommandsList.IndexOf(const aUniqueID: TncCommandUniqueID): Integer; 139 | begin 140 | if not Find(aUniqueID, Result) then 141 | Result := -1; 142 | end; 143 | 144 | procedure TPendingCommandsList.Insert(aIndex: Integer; const aUniqueID: TncCommandUniqueID; aReceivedResultEvent: TLightweightEvent); 145 | begin 146 | if FCount = FCapacity then 147 | Grow; 148 | if aIndex < FCount then 149 | System.Move(FList[aIndex], FList[aIndex + 1], (FCount - aIndex) * SizeOf(TPendingCommandItem)); 150 | with FList[aIndex] do 151 | begin 152 | FUniqueID := aUniqueID; 153 | FReceivedResultEvent := aReceivedResultEvent; 154 | end; 155 | Inc(FCount); 156 | end; 157 | 158 | function TPendingCommandsList.GetUniqueIDs(Index: Integer): TncCommandUniqueID; 159 | begin 160 | if (index < 0) or (index >= FCount) then 161 | raise Exception.Create(Format(SListIndexError, [index])); 162 | Result := FList[index].FUniqueID; 163 | end; 164 | 165 | function TPendingCommandsList.GetReceivedResultEvents(Index: Integer): TLightweightEvent; 166 | begin 167 | if (index < 0) or (index >= FCount) then 168 | raise Exception.Create(Format(SListIndexError, [index])); 169 | Result := FList[index].FReceivedResultEvent; 170 | end; 171 | 172 | procedure TPendingCommandsList.PutReceivedResultEvents(Index: Integer; aReceivedResultEvent: TLightweightEvent); 173 | begin 174 | if (index < 0) or (index >= FCount) then 175 | raise Exception.Create(Format(SListIndexError, [index])); 176 | FList[index].FReceivedResultEvent := aReceivedResultEvent; 177 | end; 178 | 179 | function TPendingCommandsList.GetResults(Index: Integer): TncCommand; 180 | begin 181 | if (index < 0) or (index >= FCount) then 182 | raise Exception.Create(Format(SListIndexError, [index])); 183 | Result := FList[index].FResult; 184 | end; 185 | 186 | procedure TPendingCommandsList.PutResults(Index: Integer; const aResult: TncCommand); 187 | begin 188 | if (index < 0) or (index >= FCount) then 189 | raise Exception.Create(Format(SListIndexError, [index])); 190 | FList[index].FResult := aResult; 191 | end; 192 | 193 | procedure TPendingCommandsList.SetCapacity(aNewCapacity: Integer); 194 | begin 195 | if aNewCapacity < FCount then 196 | raise Exception.Create(Format(SListCapacityError, [aNewCapacity])); 197 | if aNewCapacity <> FCapacity then 198 | begin 199 | SetLength(FList, aNewCapacity); 200 | FCapacity := aNewCapacity; 201 | end; 202 | end; 203 | 204 | end. 205 | -------------------------------------------------------------------------------- /Source/ncSerializeValue.pas: -------------------------------------------------------------------------------- 1 | unit ncSerializeValue; 2 | 3 | interface 4 | 5 | uses Rtti; 6 | 7 | implementation 8 | var 9 | RttiContext: TRttiContext; 10 | 11 | { Value ToBytes: 12 | if Data.IsEmpty then 13 | WriteString('nil') 14 | else 15 | begin 16 | // Write Data (TncValue) string name 17 | 18 | WriteString(RttiContext.GetType(Data.TypeInfo).QualifiedName); 19 | 20 | // Append Data (TncValue) contents 21 | Len := Length(Result); 22 | SetLength(Result, Len + Data.DataSize); 23 | Data.ExtractRawData(@Result[Len]); 24 | end; 25 | 26 | Value FromBytes: 27 | // Read Data (TncValue) string name 28 | TypeName := ReadString; 29 | 30 | // Read Data (TncValue) contents 31 | if TypeName = 'nil' then 32 | Data := nil 33 | else 34 | TValue.Make(@aBytes[Ofs], RttiContext.FindType(TypeName).Handle, Data); 35 | 36 | } 37 | 38 | initialization 39 | 40 | RttiContext := TRttiContext.Create; 41 | 42 | finalization 43 | 44 | RttiContext.Free; 45 | 46 | end. 47 | -------------------------------------------------------------------------------- /Source/ncSocketList.pas: -------------------------------------------------------------------------------- 1 | unit ncSocketList; 2 | 3 | /// //////////////////////////////////////////////////////////////////////////// 4 | // 5 | // TSocketList 6 | // Written by Demos Bill, Tue 21/10/2004 7 | // 8 | // SocketList, the equivalent of TStringList 9 | // but for the type of TSocket handles 10 | // 11 | /// //////////////////////////////////////////////////////////////////////////// 12 | 13 | interface 14 | 15 | uses System.Classes, System.SysUtils, System.RTLConsts, ncLines; 16 | 17 | type 18 | TSocketItem = record 19 | FSocketHandle: TSocketHandle; 20 | FLine: TncLine; 21 | end; 22 | 23 | PSocketItem = ^TSocketItem; 24 | 25 | TSocketItemList = array of TSocketItem; 26 | PSocketItemList = ^TSocketItemList; 27 | 28 | TSocketList = class(TPersistent) 29 | private 30 | FList: TSocketItemList; 31 | FCount: Integer; 32 | FCapacity: Integer; 33 | function GetSocketHandles(Index: Integer): TSocketHandle; register; 34 | function GetLines(Index: Integer): TncLine; register; 35 | procedure PutLines(Index: Integer; aLine: TncLine); 36 | procedure SetCapacity(aNewCapacity: Integer); 37 | protected 38 | procedure AssignTo(Dest: TPersistent); override; 39 | procedure Insert(aIndex: Integer; const aSocketHandle: TSocketHandle; aLine: TncLine); 40 | procedure Grow; 41 | public 42 | destructor Destroy; override; 43 | 44 | function Add(const aSocketHandle: TSocketHandle; aLine: TncLine): Integer; 45 | procedure Clear; 46 | procedure Delete(aIndex: Integer); register; 47 | function Find(const aSocketHandle: TSocketHandle; var aIndex: Integer): Boolean; register; 48 | function IndexOf(const aSocketHandle: TSocketHandle): Integer; register; 49 | 50 | property Count: Integer read FCount; 51 | property SocketHandles[index: Integer]: TSocketHandle read GetSocketHandles; default; 52 | property Lines[index: Integer]: TncLine read GetLines write PutLines; 53 | end; 54 | 55 | implementation 56 | 57 | resourcestring 58 | SDuplicateSocketHandle = 'Socket handle list does not allow duplicates'; 59 | 60 | { TSocketList } 61 | 62 | destructor TSocketList.Destroy; 63 | begin 64 | inherited Destroy; 65 | FCount := 0; 66 | SetCapacity(0); 67 | end; 68 | 69 | procedure TSocketList.AssignTo(Dest: TPersistent); 70 | var 71 | DestList: TSocketList; 72 | begin 73 | if Dest is TSocketList then 74 | begin 75 | DestList := TSocketList(Dest); 76 | DestList.FCapacity := FCapacity; 77 | DestList.FCount := FCount; 78 | DestList.FList := Copy(FList); 79 | end 80 | else 81 | raise EConvertError.CreateResFmt(@SAssignError, [ClassName, Dest.ClassName]); 82 | end; 83 | 84 | function TSocketList.Add(const aSocketHandle: TSocketHandle; aLine: TncLine): Integer; 85 | begin 86 | if Find(aSocketHandle, Result) then 87 | raise Exception.Create(SDuplicateSocketHandle); 88 | Insert(Result, aSocketHandle, aLine); 89 | end; 90 | 91 | procedure TSocketList.Clear; 92 | begin 93 | if FCount <> 0 then 94 | begin 95 | FCount := 0; 96 | SetCapacity(0); 97 | end; 98 | end; 99 | 100 | procedure TSocketList.Delete(aIndex: Integer); 101 | begin 102 | if (aIndex < 0) or (aIndex >= FCount) then 103 | raise Exception.Create(Format(SListIndexError, [aIndex])); 104 | 105 | Dec(FCount); 106 | if aIndex < FCount then 107 | System.Move(FList[aIndex + 1], FList[aIndex], (FCount - aIndex) * SizeOf(TSocketItem)); 108 | end; 109 | 110 | // Binary Searching 111 | 112 | function TSocketList.Find(const aSocketHandle: TSocketHandle; var aIndex: Integer): Boolean; 113 | var 114 | Low, High, Mid: Integer; 115 | begin 116 | Result := False; 117 | Low := 0; 118 | High := FCount - 1; 119 | while Low <= High do 120 | begin 121 | Mid := (Low + High) shr 1; 122 | if aSocketHandle > FList[Mid].FSocketHandle then 123 | Low := Mid + 1 124 | else 125 | begin 126 | High := Mid - 1; 127 | if aSocketHandle = FList[Mid].FSocketHandle then 128 | begin 129 | Result := True; 130 | Low := Mid; 131 | end; 132 | end; 133 | end; 134 | aIndex := Low; 135 | end; 136 | 137 | procedure TSocketList.Grow; 138 | var 139 | Delta: Integer; 140 | begin 141 | if FCapacity > 64 then 142 | Delta := FCapacity div 4 143 | else if FCapacity > 8 then 144 | Delta := 16 145 | else 146 | Delta := 4; 147 | SetCapacity(FCapacity + Delta); 148 | end; 149 | 150 | function TSocketList.IndexOf(const aSocketHandle: TSocketHandle): Integer; 151 | begin 152 | if not Find(aSocketHandle, Result) then 153 | Result := -1; 154 | end; 155 | 156 | procedure TSocketList.Insert(aIndex: Integer; const aSocketHandle: TSocketHandle; aLine: TncLine); 157 | begin 158 | if FCount = FCapacity then 159 | Grow; 160 | if aIndex < FCount then 161 | System.Move(FList[aIndex], FList[aIndex + 1], (FCount - aIndex) * SizeOf(TSocketItem)); 162 | with FList[aIndex] do 163 | begin 164 | FSocketHandle := aSocketHandle; 165 | FLine := aLine; 166 | end; 167 | Inc(FCount); 168 | end; 169 | 170 | function TSocketList.GetSocketHandles(Index: Integer): TSocketHandle; 171 | begin 172 | if (index < 0) or (index >= FCount) then 173 | raise Exception.Create(Format(SListIndexError, [index])); 174 | Result := FList[index].FSocketHandle; 175 | end; 176 | 177 | function TSocketList.GetLines(Index: Integer): TncLine; 178 | begin 179 | if (index < 0) or (index >= FCount) then 180 | raise Exception.Create(Format(SListIndexError, [index])); 181 | Result := FList[index].FLine; 182 | end; 183 | 184 | procedure TSocketList.PutLines(Index: Integer; aLine: TncLine); 185 | begin 186 | if (index < 0) or (index >= FCount) then 187 | raise Exception.Create(Format(SListIndexError, [index])); 188 | FList[index].FLine := aLine; 189 | end; 190 | 191 | procedure TSocketList.SetCapacity(aNewCapacity: Integer); 192 | begin 193 | if aNewCapacity < FCount then 194 | raise Exception.Create(Format(SListCapacityError, [aNewCapacity])); 195 | if aNewCapacity <> FCapacity then 196 | begin 197 | SetLength(FList, aNewCapacity); 198 | FCapacity := aNewCapacity; 199 | end; 200 | end; 201 | 202 | end. 203 | --------------------------------------------------------------------------------