diff --git a/NetCom7.dproj b/NetCom7.dproj index 597a81c..a10798b 100644 --- a/NetCom7.dproj +++ b/NetCom7.dproj @@ -2,7 +2,7 @@ {57C69AC0-7B5F-43DD-957C-8CC07D9D9092} NetCom7.dpk - 18.8 + 19.2 Release DCC32 None @@ -24,6 +24,16 @@ Base true + + true + Base + true + + + true + Base + true + true Base @@ -93,6 +103,7 @@ android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar rtl;dbrtl;$(DCC_UsePackage) CompanyName=Bill Demos;FileDescription=;FileVersion=7.2.0.522;InternalName=;LegalCopyright=Copyright © Bill Demos;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=7.2.0.522;Comments=;versionCode=522 + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=7;versionName=2.0.522;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey= @@ -104,6 +115,18 @@ android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar rtl;dbrtl;$(DCC_UsePackage);$(DCC_UsePackage) 7 + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + + + $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing bluetooth;NSBluetoothPeripheralUsageDescription=The reason for accessing bluetooth peripherals;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSMotionUsageDescription=The reason for accessing the accelerometer;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers + iPhoneAndiPad + Debug + $(MSBuildProjectName) + + + CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false;NSBluetoothAlwaysUsageDescription=The reason for accessing bluetooth;NSBluetoothPeripheralUsageDescription=The reason for accessing bluetooth peripherals;NSCalendarsUsageDescription=The reason for accessing the calendar data;NSRemindersUsageDescription=The reason for accessing the reminders;NSMotionUsageDescription=The reason for accessing the accelerometer;NSSpeechRecognitionUsageDescription=The reason for requesting to send user data to Apple's speech recognition servers + iPhoneAndiPad NetCom7_Icon.ico @@ -141,9 +164,12 @@ 1033 - CompanyName=;FileVersion=7.0.0.567;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) + CompanyName=;FileVersion=7.3.0.572;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName);FileDescription=$(MSBuildProjectName);ProductName=$(MSBuildProjectName) NetCom7 Network Communications Suite - 567 + 572 + 3 + false + true 0 @@ -263,9 +289,7 @@ 1.0.0.0 - - Microsoft Office 2000 Sample Automation Server Wrapper Components - + NetCom7.dpk @@ -273,6 +297,8 @@ True True + False + False True True @@ -434,6 +460,16 @@ 1 + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + res\drawable-ldpi @@ -664,6 +700,32 @@ 0 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + 1 @@ -763,6 +825,16 @@ 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + 1 @@ -774,6 +846,66 @@ 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + 1 @@ -873,6 +1005,16 @@ 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + 1 @@ -884,6 +1026,16 @@ 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + 1 @@ -928,6 +1080,86 @@ 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + 1 @@ -949,6 +1181,7 @@ + 1 diff --git a/NetCom7.dproj.local b/NetCom7.dproj.local deleted file mode 100644 index e85cdbf..0000000 --- a/NetCom7.dproj.local +++ /dev/null @@ -1,19 +0,0 @@ - - - - - - - 2020/08/08 06:05:23.000.402,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncSocketList.pas - 2020/08/08 06:14:41.000.027,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Unit1.pas - 2020/08/08 06:15:03.000.683,C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLine.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Unit1.pas - 2020/08/08 07:50:30.000.380,C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLine.pas=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncLines.pas - 2020/08/10 13:33:07.000.316,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png - 2020/08/10 13:45:09.000.739,C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png= - 2020/08/10 13:45:27.000.192,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png - 2020/08/10 13:48:53.000.848,C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncClientSource.png= - 2020/08/10 13:50:07.000.192,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Icons\TncIcon.bmp - 2020/08/10 14:10:53.000.681,=C:\Users\Programmer\Documents\Development\Components\NetCom7\PaletteIcons\TncIcon.bmp - 2020/08/11 19:21:43.000.342,=C:\Users\Programmer\Documents\Development\Components\NetCom7\Source\ncPendingCommandsList.pas - - diff --git a/NetCom7.identcache b/NetCom7.identcache deleted file mode 100644 index 683c7df..0000000 Binary files a/NetCom7.identcache and /dev/null differ diff --git a/NetCom7.res b/NetCom7.res index 1962c0e..2d02f33 100644 Binary files a/NetCom7.res and b/NetCom7.res differ diff --git a/README.md b/README.md index 3daf62b..f41cc71 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,12 @@ # NetCom7 The fastest communications possible. -This is version 7.2 of the NetCom package. In this version, the NetCom package is now multi-platform! +This is version 7.3, an unoffical version by Andreas Toth (andreas.toth[at]xtra[dot]co[dot]nz), of the NetCom package with added UDP and IPv6 support. In this version, the NetCom package is now multi-platform! You can compile your apps under all platforms in FireMonkey! -This set of components is the fastest possible implementation of socket communications, in any language; this is an extremely optimised code on TCP/IP sockets. Forget using a thread per connection: With this suite you can have as many concurrent connections to your server as you like. Threads are used per request and not per connection, and are maintained in a very fast thread pool class. +This set of components is the fastest possible implementation of socket communications, in any language; this is an extremely optimised code on TCP/IP and now UDP sockets. Forget using a thread per connection: With this suite you can have as many concurrent connections to your server as you like. Threads are used per request and not per connection, and are maintained in a very fast thread pool class. -The implementation begins with TncTCPServer and TncTCPClient which implements the basic socket communications. -You can use TncTCPClient and TncTCPServer if all you want is to implement standard (but very fast) socket comms. +The implementation begins with TncTCPServer or TncUDPServer and TncTCPClient or TncUDPClient which implements the basic socket communications. You can use TncTCPClient/TncUDPClient and TncTCPServer/TncUDPServer if all you want is to implement standard (but very fast) socket comms. On top of the TCP/IP sockets, a lightweight protocol is implemented to be able to pack and unpack buffers (simple TCP/IP is streaming and has no notion of a well defined buffer). The set of components implementing this functionality is TncServerSource and TncClientSource. Both of these components implement an ExecCommand (aCmd, aData) which triggers an OnHandleCommand event on the other side (a client can ExecCommand to a server, or a server can ExecCommand to any client). ExecCommand can be blocking or non-blocking (async) depending on how you set its aRequiresResult parameter. If you use the blocking behaviour, the component still handles incoming requests from its peer(s). For example, a ClientSource could be waiting on an ExecCommand to the server, but while waiting it can serve ExecCommand requests from the server! @@ -76,9 +75,15 @@ This set of components can also deal with garbage data thrown at them, they have The effort a programmer has to make to use these components is minimal compared to other frameworks. Please refer to the demos for a better understanding on how to use these components. -Written by Bill Anastasios Demos. +Written by Bill Anastasios Demos. +UDP and IPv6 support added Feb 14, 2022 by Andreas Toth (andreas.toth[at]xtra[dot]co[dot]nz). Special thanks to Daniel Mauric, Tommi Prami, Roland Bengtsson for the extensive testing and suggestions. Thank you so much! +WARNINGS + - Only tested under Windows 10 + - UDP broadcast not tested + - IPv6 support not tested + VasDemos[at]yahoo[dot]co[dot]uk -** Delphi RULES ** +** Delphi RULES ** \ No newline at end of file diff --git a/Source/NetComRegister.pas b/Source/NetComRegister.pas index d0a500b..2e7ca36 100644 --- a/Source/NetComRegister.pas +++ b/Source/NetComRegister.pas @@ -3,19 +3,29 @@ // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // // NetCom7 Package -// 13 Dec 2010, 12/8/2020 +// 13 Dec 2010, 12/8/2020, 14 Feb 2022 // // Written by Demos Bill // VasDemos@yahoo.co.uk // +// UDP and IPv6 support added 14 Feb 2022 by Andreas Toth - andreas.toth@xtra.co.nz +// // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////////// interface uses - WinApi.Windows, System.Classes, System.SysUtils, ToolsAPI, DesignIntf, DesignEditors, - - ncSockets, ncSources, ncCommandHandlers, ncDBSrv, ncDBCnt; + WinApi.Windows, + System.Classes, + System.SysUtils, + ToolsAPI, + DesignIntf, + DesignEditors, + ncSockets, + ncSources, + ncCommandHandlers, + ncDBSrv, + ncDBCnt; type TncTCPSocketDefaultEditor = class(TDefaultEditor) @@ -34,53 +44,64 @@ implementation procedure Register; begin - RegisterComponents('NetCom7', [TncTCPServer, TncTCPClient, TncServerSource, TncClientSource, TncCommandHandler, TncDBServer, TncDBDataset]); + RegisterComponents('NetCom7', [TncTCPServer, TncTCPClient, TncUDPServer, TncUDPClient, TncServerSource, TncClientSource, TncCommandHandler, TncDBServer, TncDBDataset]); RegisterComponentEditor(TncTCPServer, TncTCPSocketDefaultEditor); RegisterComponentEditor(TncTCPClient, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncUDPServer, TncTCPSocketDefaultEditor); + RegisterComponentEditor(TncUDPClient, TncTCPSocketDefaultEditor); RegisterComponentEditor(TncServerSource, TncSourceDefaultEditor); RegisterComponentEditor(TncClientSource, TncSourceDefaultEditor); UnlistPublishedProperty(TncDBDataset, 'Connection'); UnlistPublishedProperty(TncDBDataset, 'ConnectionString'); - // RegisterPropertyEditor(TypeInfo(string), TncDBDataset, 'ConnectionString', nil); + //RegisterPropertyEditor(TypeInfo(string), TncDBDataset, 'ConnectionString', nil); ForceDemandLoadState(dlDisable); end; function GetVersion(aMinor: Boolean = True; aRelease: Boolean = True; aBuild: Boolean = True): string; var - VerInfoSize: DWORD; + VerInfoSize: DWord; VerInfo: Pointer; - VerValueSize: DWORD; + VerValueSize: DWord; VerValue: PVSFixedFileInfo; - Dummy: DWORD; - strBuffer: array [0 .. MAX_PATH] of Char; + Dummy: DWord; + strBuffer: array[0..MAX_PATH] of Char; begin GetModuleFileName(hInstance, strBuffer, MAX_PATH); VerInfoSize := GetFileVersionInfoSize(strBuffer, Dummy); + if VerInfoSize <> 0 then begin GetMem(VerInfo, VerInfoSize); try GetFileVersionInfo(strBuffer, 0, VerInfoSize, VerInfo); VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize); - with VerValue^ do + + Result := IntToStr(VerValue^.dwFileVersionMS shr 16); // Major always there + + if aMinor then + begin + Result := Result + '.' + IntToStr(VerValue^.dwFileVersionMS and $FFFF); + end; + + if aRelease then + begin + Result := Result + '.' + IntToStr(VerValue^.dwFileVersionLS shr 16); + end; + + if aBuild then begin - Result := IntToStr(dwFileVersionMS shr 16); // Major always there - if aMinor then - Result := Result + '.' + IntToStr(dwFileVersionMS and $FFFF); - if aRelease then - Result := Result + '.' + IntToStr(dwFileVersionLS shr 16); - if aBuild then - Result := Result + '.' + IntToStr(dwFileVersionLS and $FFFF); + Result := Result + '.' + IntToStr(VerValue^.dwFileVersionLS and $FFFF); end; finally FreeMem(VerInfo, VerInfoSize); end; - end - else + end else + begin Result := '1.0.0.0'; + end; end; const @@ -94,9 +115,8 @@ function GetVersion(aMinor: Boolean = True; aRelease: Boolean = True; aBuild: Bo resourcestring resPackageName = 'NetCom7 Network Communications Framework'; resLicence = 'Full Edition for RAD Studio'; - resAboutCopyright = 'Copyright © 2020 Bill Demos (VasDemos@yahoo.co.uk)'; - resAboutDescription = - 'Netcom7 Communicatios Framework enables you to use communication components with the ease of use of the Delphi programming language. Create and handle client/server sockets, sources and DB elements with no single line of API calls.'; + resAboutCopyright = 'Copyright © 2021 Bill Demos (VasDemos@yahoo.co.uk)'; + resAboutDescription = 'Netcom7 Communicatios Framework enables you to use communication components with the ease of use of the Delphi programming language. Create and handle client/server TCP/UDP sockets, sources and DB elements with no single line of API calls.'; procedure RegisterSplashScreen; var @@ -116,8 +136,7 @@ procedure RegisterAboutBox; begin Supports(BorlandIDEServices, IOTAAboutBoxServices, AboutBoxServices); ProductImage := LoadBitmap(FindResourceHInstance(hInstance), ICON_ABOUT); - AboutBoxIndex := AboutBoxServices.AddPluginInfo(resPackageName + GetVersion, - resAboutCopyright + #13#10 + resAboutDescription, ProductImage, False, resLicence); + AboutBoxIndex := AboutBoxServices.AddPluginInfo(resPackageName + GetVersion, resAboutCopyright + #13#10 + resAboutDescription, ProductImage, False, resLicence); end; procedure UnregisterAboutBox; @@ -138,9 +157,10 @@ procedure TncTCPSocketDefaultEditor.EditProperty(const Prop: IProperty; var Cont begin Prop.Edit; Continue := False; - end - else + end else + begin inherited; + end; end; { TncCustomPeerSourceDefaultEditor } @@ -151,18 +171,17 @@ procedure TncSourceDefaultEditor.EditProperty(const Prop: IProperty; var Continu begin Prop.Edit; Continue := False; - end - else + end else + begin inherited; + end; end; initialization - -RegisterSplashScreen; -RegisterAboutBox; + RegisterSplashScreen; + RegisterAboutBox; finalization - -UnregisterAboutBox; + UnregisterAboutBox; end. diff --git a/Source/ncLines.pas b/Source/ncLines.pas index ce9d08f..c4f62c1 100644 --- a/Source/ncLines.pas +++ b/Source/ncLines.pas @@ -1,4 +1,4 @@ -// ///////////////////////////////////////////////////////////////////////////// +// //////////////////////////////////////////////////////////////////////////// // // NetCom7 Package // @@ -6,6 +6,9 @@ // socket, organised in an object which contains the handle of the socket, // and also makes sure it checks every API command for errors // +// 14 Feb 2022 by Andreas Toth - andreas.toth@xtra.co.nz +// - Added UDP and IPv6 support +// // 9/8/2020 // - Completed multiplatform support, now NetCom can be compiled in all // platforms @@ -30,10 +33,16 @@ interface uses {$IFDEF MSWINDOWS} - Winapi.Windows, Winapi.Winsock2, + Winapi.Windows, + Winapi.Winsock2, {$ELSE} - Posix.SysTypes, Posix.SysSelect, Posix.SysSocket, Posix.NetDB, Posix.SysTime, - Posix.Unistd, {Posix.ArpaInet,} + Posix.SysTypes, + Posix.SysSelect, + Posix.SysSocket, + Posix.NetDB, + Posix.SysTime, + Posix.Unistd, + //Posix.ArpaInet, {$ENDIF} System.SyncObjs, System.Math, @@ -41,8 +50,7 @@ interface System.Diagnostics; const - // Flag that indicates that the socket is intended for bind() + listen() when constructing it - AI_PASSIVE = 1; + AI_PASSIVE = 1; // Flag that indicates that the socket is intended for bind() + listen() when constructing it {$IFDEF MSWINDOWS} InvalidSocket = Winapi.Winsock2.INVALID_SOCKET; SocketError = SOCKET_ERROR; @@ -53,6 +61,36 @@ interface TCP_NODELAY = $0001; {$ENDIF} +type + TSocketType = + ( + stUDP, + stTCP + ); + +const + CSocketTypeNames: array[TSocketType] of string = + ( + 'UDP', + 'TCP' + ); + +type + TAddressType = + ( + afUnspecified, + afIPv4, + afIPv6 + ); + +const + CAddressTypeNames: array[TAddressType] of string = + ( + 'Unspecified', + 'IPv4', + 'IPv6' + ); + type {$IFDEF MSWINDOWS} TSocketHandle = Winapi.Winsock2.TSocket; @@ -63,9 +101,9 @@ interface EncLineException = class(Exception); - TncLine = class; // Forward declaration + TncLine = class; - TncLineOnConnectDisconnect = procedure(aLine: TncLine) of object; + TncLineOnConnectDisconnect = procedure(ALine: TncLine) of object; // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// // TncLine @@ -73,6 +111,8 @@ TncLine = class; // Forward declaration TncLine = class(TObject) private + FFamily: TAddressType; + FKind: TSocketType; FActive: Boolean; FLastSent: Int64; FLastReceived: Int64; @@ -83,28 +123,39 @@ TncLine = class(TObject) private PropertyLock: TCriticalSection; FHandle: TSocketHandle; + + function IsConnectionBased: Boolean; + procedure SetConnected; procedure SetDisconnected; + function GetLastReceived: Int64; function GetLastSent: Int64; - procedure SetLastReceived(const Value: Int64); - procedure SetLastSent(const Value: Int64); + + procedure SetLastReceived(const AValue: Int64); + procedure SetLastSent(const AValue: Int64); + protected + const DefaultFamily = afIPv4; + const DefaultKind = stTCP; protected + procedure SetKind(const AKind: TSocketType); + function CreateLineObject: TncLine; virtual; - procedure Check(aCmdRes: Integer); inline; + procedure Check(ACmdRes: Integer); inline; // API functions - procedure CreateClientHandle(const aHost: string; const aPort: Integer); - procedure CreateServerHandle(const aPort: Integer); + procedure CreateClientHandle(const AHost: string; const APort: Integer); + procedure CreateServerHandle(const APort: Integer; const AAddress: string = ''); procedure DestroyHandle; function AcceptLine: TncLine; inline; - function SendBuffer(const aBuf; aLen: Integer): Integer; inline; - function RecvBuffer(var aBuf; aLen: Integer): Integer; inline; + function SendBuffer(const ABuffer; ABufferSize: Integer): Integer; inline; + function RecvBuffer(var ABuffer; ABufferSize: Integer): Integer; inline; procedure EnableNoDelay; inline; procedure EnableKeepAlive; inline; + procedure EnableBroadcast; inline; procedure EnableReuseAddress; inline; property OnConnected: TncLineOnConnectDisconnect read FOnConnected write FOnConnected; @@ -113,6 +164,8 @@ TncLine = class(TObject) constructor Create; overload; virtual; destructor Destroy; override; + property Family: TAddressType read FFamily; + property Kind: TSocketType read FKind; property Handle: TSocketHandle read FHandle; property Active: Boolean read FActive; property LastSent: Int64 read GetLastSent write SetLastSent; @@ -121,71 +174,101 @@ TncLine = class(TObject) property DataObject: TObject read FDataObject write FDataObject; end; -function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): TSocketHandleArray; -function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): Boolean; inline; +function Readable(const ASocketHandleArray: TSocketHandleArray; const ATimeout: Cardinal): TSocketHandleArray; +function ReadableAnySocket(const ASocketHandleArray: TSocketHandleArray; const ATimeout: Cardinal): Boolean; inline; implementation +const + CRawAddressTypes: array[TAddressType] of Integer = + ( + AF_UNSPEC, + AF_INET, + AF_INET6 + ); + + CRawSocketTypes: array[TSocketType] of Integer = + ( + SOCK_DGRAM, // UDP datagram + SOCK_STREAM // TCP stream + ); + + CRawProtocolTypes: array[TSocketType] of Integer = + ( + IPPROTO_UDP, + IPPROTO_TCP + ); + // Readable checks to see if any socket handles have data // and if so, overwrites aReadFDS with the data -function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): TSocketHandleArray; +function Readable(const ASocketHandleArray: TSocketHandleArray; const ATimeout: Cardinal): TSocketHandleArray; {$IFDEF MSWINDOWS} var TimeoutValue: timeval; FDSetPtr: PFdSet; - SocketArrayLength, SocketArrayBytes: Integer; + SocketArrayLength: Integer; + SocketArrayBytes: Integer; begin - TimeoutValue.tv_sec := aTimeout div 1000; - TimeoutValue.tv_usec := (aTimeout mod 1000) * 1000; + TimeoutValue.tv_sec := ATimeout div 1000; + TimeoutValue.tv_usec := (ATimeout mod 1000) * 1000; - SocketArrayLength := Length(aSocketHandleArray); + SocketArrayLength := Length(ASocketHandleArray); SocketArrayBytes := SocketArrayLength * SizeOf(TSocketHandle); // + 32 is there in case of compiler record field aligning GetMem(FDSetPtr, SizeOf(FDSetPtr^.fd_count) + SocketArrayBytes + 32); try FDSetPtr^.fd_count := SocketArrayLength; - move(aSocketHandleArray[0], FDSetPtr^.fd_array[0], SocketArrayBytes); + Move(ASocketHandleArray[0], FDSetPtr^.fd_array[0], SocketArrayBytes); Select(0, FDSetPtr, nil, nil, @TimeoutValue); if FDSetPtr^.fd_count > 0 then begin SetLength(Result, FDSetPtr^.fd_count); - move(FDSetPtr^.fd_array[0], Result[0], FDSetPtr^.fd_count * SizeOf(TSocketHandle)); - end - else + Move(FDSetPtr^.fd_array[0], Result[0], FDSetPtr^.fd_count * SizeOf(TSocketHandle)); + end else + begin SetLength(Result, 0); // This is needed with newer compilers + end; finally FreeMem(FDSetPtr); end; end; {$ELSE} - var TimeoutValue: timeval; i: Integer; SocketHandle: TSocketHandle; FDSetPtr: Pfd_set; - FDArrayLen, FDNdx, ReadySockets, ResultNdx: Integer; + FDArrayLen: Integer; + FDNdx: Integer; + ReadySockets: Integer; + ResultNdx: Integer; begin - TimeoutValue.tv_sec := aTimeout div 1000; - TimeoutValue.tv_usec := (aTimeout mod 1000) * 1000; + TimeoutValue.tv_sec := ATimeout div 1000; + TimeoutValue.tv_usec := (ATimeout mod 1000) * 1000; // Find max socket handle SocketHandle := 0; - for i := 0 to High(aSocketHandleArray) do - if SocketHandle < aSocketHandleArray[i] then - SocketHandle := aSocketHandleArray[i]; + + for i := Low(ASocketHandleArray) to High(ASocketHandleArray) do + begin + if SocketHandle < ASocketHandleArray[i] then + begin + SocketHandle := ASocketHandleArray[i]; + end; + end; // NFDBITS is SizeOf(fd_mask) in bits (i.e. SizeOf(fd_mask) * 8)) FDArrayLen := SocketHandle div NFDBITS + 1; GetMem(FDSetPtr, FDArrayLen * SizeOf(fd_mask)); try FillChar(FDSetPtr^.fds_bits[0], FDArrayLen * SizeOf(fd_mask), 0); - for i := 0 to High(aSocketHandleArray) do + + for i := Low(ASocketHandleArray) to High(ASocketHandleArray) do begin - SocketHandle := aSocketHandleArray[i]; + SocketHandle := ASocketHandleArray[i]; FDNdx := SocketHandle div NFDBITS; FDSetPtr.fds_bits[FDNdx] := FDSetPtr.fds_bits[FDNdx] or (1 shl (SocketHandle mod NFDBITS)); end; @@ -195,34 +278,35 @@ function Readable(const aSocketHandleArray: TSocketHandleArray; const aTimeout: if ReadySockets > 0 then begin SetLength(Result, ReadySockets); - ResultNdx := 0; - for i := 0 to High(aSocketHandleArray) do + + for i := Low(ASocketHandleArray) to High(ASocketHandleArray) do begin - SocketHandle := aSocketHandleArray[i]; + SocketHandle := ASocketHandleArray[i]; FDNdx := SocketHandle div NFDBITS; + if FDSetPtr.fds_bits[FDNdx] and (1 shl (SocketHandle mod NFDBITS)) <> 0 then begin Result[ResultNdx] := SocketHandle; ResultNdx := ResultNdx + 1; end; end; - end - else + end else + begin SetLength(Result, 0); + end; finally FreeMem(FDSetPtr); end; end; {$ENDIF} -function ReadableAnySocket(const aSocketHandleArray: TSocketHandleArray; const aTimeout: Cardinal): Boolean; +function ReadableAnySocket(const ASocketHandleArray: TSocketHandleArray; const ATimeout: Cardinal): Boolean; begin - Result := Length(Readable(aSocketHandleArray, aTimeout)) > 0; + Result := Length(Readable(ASocketHandleArray, ATimeout)) > 0; end; {$IFDEF MSWINDOWS} - type PAddrInfoW = ^TAddrInfoW; PPAddrInfoW = ^PAddrInfoW; @@ -232,36 +316,40 @@ TAddrInfoW = record ai_family: Integer; ai_socktype: Integer; ai_protocol: Integer; - ai_addrlen: ULONG; // is NativeUInt + ai_addrlen: ULONG; // NativeUInt ai_canonname: PWideChar; ai_addr: PSOCKADDR; ai_next: PAddrInfoW; end; - TGetAddrInfoW = function(NodeName: PWideChar; ServiceName: PWideChar; Hints: PAddrInfoW; ppResult: PPAddrInfoW): Integer; stdcall; + TGetAddrInfoW = function(ANodeName: PWideChar; AServiceName: PWideChar; AHints: PAddrInfoW; AResult: PPAddrInfoW): Integer; stdcall; TFreeAddrInfoW = procedure(ai: PAddrInfoW); stdcall; var DllGetAddrInfo: TGetAddrInfoW = nil; DllFreeAddrInfo: TFreeAddrInfoW = nil; -procedure GetAddressInfo(NodeName: PWideChar; ServiceName: PWideChar; Hints: PAddrInfoW; ppResult: PPAddrInfoW); +procedure GetAddressInfo(ANodeName: PWideChar; AServiceName: PWideChar; AHints: PAddrInfoW; AResult: PPAddrInfoW); var iRes: Integer; begin - if LowerCase(string(NodeName)) = 'localhost' then - NodeName := '127.0.0.1'; + if LowerCase(string(ANodeName)) = 'localhost' then + begin + ANodeName := '127.0.0.1'; + end; + + iRes := DllGetAddrInfo(ANodeName, AServiceName, AHints, AResult); - iRes := DllGetAddrInfo(NodeName, ServiceName, Hints, ppResult); if iRes <> 0 then + begin raise EncLineException.Create(SysErrorMessage(iRes)); + end; end; procedure FreeAddressInfo(ai: PAddrInfoW); begin DllFreeAddrInfo(ai); end; - {$ENDIF} // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -274,6 +362,8 @@ constructor TncLine.Create; PropertyLock := TCriticalSection.Create; + FFamily := DefaultFamily; + FKind := DefaultKind; FHandle := InvalidSocket; FActive := False; @@ -289,9 +379,11 @@ constructor TncLine.Create; destructor TncLine.Destroy; begin if FActive then + begin DestroyHandle; + end; - PropertyLock.Free; + FreeAndNil(PropertyLock); inherited Destroy; end; @@ -299,45 +391,49 @@ destructor TncLine.Destroy; function TncLine.CreateLineObject: TncLine; begin Result := TncLine.Create; + Result.SetKind(Kind); end; /// ///////////////////////////////////////////////////////////////////////////// -procedure TncLine.Check(aCmdRes: Integer); +procedure TncLine.Check(ACmdRes: Integer); begin - if aCmdRes = SocketError then + if ACmdRes = SocketError then + begin {$IFDEF MSWINDOWS} raise EncLineException.Create(SysErrorMessage(WSAGetLastError)); {$ELSE} raise EncLineException.Create(SysErrorMessage(GetLastError)); {$ENDIF} + end; end; -procedure TncLine.CreateClientHandle(const aHost: string; const aPort: Integer); +procedure TncLine.CreateClientHandle(const AHost: string; const APort: Integer); var {$IFDEF MSWINDOWS} - Hints: TAddrInfoW; + AHints: TAddrInfoW; AddrResult: PAddrInfoW; {$ELSE} - Hints: addrinfo; + AHints: addrinfo; AddrResult: Paddrinfo; - AnsiHost, AnsiPort: RawByteString; + AnsiHost: RawByteString; + AnsiPort: RawByteString; {$ENDIF} begin try - FillChar(Hints, SizeOf(Hints), 0); - Hints.ai_family := AF_INET; - Hints.ai_socktype := SOCK_STREAM; - Hints.ai_protocol := IPPROTO_TCP; + FillChar(AHints, SizeOf(AHints), 0); + AHints.ai_family := CRawAddressTypes[FFamily]; + AHints.ai_socktype := CRawSocketTypes[FKind]; + AHints.ai_protocol := CRawProtocolTypes[FKind]; // Could just be set to 0 to use default protocol for the address family // Resolve the server address and port {$IFDEF MSWINDOWS} - GetAddressInfo(PChar(aHost), PChar(IntToStr(aPort)), @Hints, @AddrResult); + GetAddressInfo(PChar(AHost), PChar(IntToStr(APort)), @AHints, @AddrResult); {$ELSE} - AnsiHost := RawByteString(aHost); - AnsiPort := RawByteString(IntToStr(aPort)); + AnsiHost := RawByteString(AHost); + AnsiPort := RawByteString(IntToStr(APort)); - GetAddrInfo(MarshaledAString(AnsiHost), MarshaledAString(AnsiPort), Hints, AddrResult); + GetAddrInfo(MarshaledAString(AnsiHost), MarshaledAString(AnsiPort), AHints, AddrResult); {$ENDIF} try // Create a SOCKET for connecting to server @@ -358,7 +454,7 @@ procedure TncLine.CreateClientHandle(const aHost: string; const aPort: Integer); {$IFDEF MSWINDOWS} FreeAddressInfo(AddrResult); {$ELSE} - freeaddrinfo(AddrResult^); + FreeAddrInfo(AddrResult^); {$ENDIF} end; except @@ -367,29 +463,54 @@ procedure TncLine.CreateClientHandle(const aHost: string; const aPort: Integer); end; end; -procedure TncLine.CreateServerHandle(const aPort: Integer); +procedure TncLine.CreateServerHandle(const APort: Integer; const AAddress: string); var {$IFDEF MSWINDOWS} - Hints: TAddrInfoW; + AHints: TAddrInfoW; AddrResult: PAddrInfoW; {$ELSE} - Hints: addrinfo; + AHints: addrinfo; AddrResult: Paddrinfo; + AnsiAddress: RawByteString; AnsiPort: RawByteString; {$ENDIF} begin - FillChar(Hints, SizeOf(Hints), 0); - Hints.ai_family := AF_INET; - Hints.ai_socktype := SOCK_STREAM; - Hints.ai_protocol := IPPROTO_TCP; - Hints.ai_flags := AI_PASSIVE; // Inform GetAddrInfo to return a server socket + FillChar(AHints, SizeOf(AHints), 0); + AHints.ai_family := CRawAddressTypes[FFamily]; + AHints.ai_socktype := CRawSocketTypes[FKind]; + AHints.ai_protocol := CRawProtocolTypes[FKind]; // Could just be set to 0 to use default protocol for the address family + + if AAddress = '' then + begin + AHints.ai_flags := AI_PASSIVE; // Use default local address + end; // Resolve the server address and port {$IFDEF MSWINDOWS} - GetAddressInfo(nil, PChar(IntToStr(aPort)), @Hints, @AddrResult); + if AAddress = '' then + begin + GetAddressInfo(nil, PChar(IntToStr(APort)), @AHints, @AddrResult); + end else + begin + GetAddressInfo(PChar(AAddress), PChar(IntToStr(APort)), @AHints, @AddrResult); + end; +{$ELSE} + if AAddress = '' then + begin + AnsiAddress := nil; + AnsiPort := RawByteString(IntToStr(APort)); + GetAddrInfo(nil, MarshaledAString(AnsiPort), AHints, AddrResult); + end else + begin + AnsiAddress := RawByteString(AAddress); + AnsiPort := RawByteString(IntToStr(APort)); + + GetAddrInfo(MarshaledAString(AnsiAddress), MarshaledAString(AnsiPort), AHints, AddrResult); + end; +{$ENDIF} + +{$IFDEF MSWINDOWS} {$ELSE} - AnsiPort := RawByteString(IntToStr(aPort)); - GetAddrInfo(nil, MarshaledAString(AnsiPort), Hints, AddrResult); {$ENDIF} try // Create a server listener socket @@ -399,9 +520,14 @@ procedure TncLine.CreateServerHandle(const aPort: Integer); {$IFNDEF MSWINDOWS} EnableReuseAddress; {$ENDIF} - // Setup the TCP listening socket + // Setup the listening socket Check(Bind(FHandle, AddrResult^.ai_addr^, AddrResult^.ai_addrlen)); - Check(Listen(FHandle, SOMAXCONN)); + + if IsConnectionBased then + begin + Check(Listen(FHandle, SOMAXCONN)); + end; + SetConnected; except DestroyHandle; @@ -411,7 +537,7 @@ procedure TncLine.CreateServerHandle(const aPort: Integer); {$IFDEF MSWINDOWS} FreeAddressInfo(AddrResult); {$ELSE} - freeaddrinfo(AddrResult^); + FreeAddrInfo(AddrResult^); {$ENDIF} end; end; @@ -429,10 +555,13 @@ procedure TncLine.DestroyHandle; Posix.Unistd.__Close(FHandle); {$ENDIF} except + // Ignore end; + try SetDisconnected; except + // Ignore end; FHandle := InvalidSocket; @@ -447,29 +576,40 @@ function TncLine.AcceptLine: TncLine; AddrLen: socklen_t; {$ENDIF} begin + if IsConnectionBased then + begin {$IFDEF MSWINDOWS} - NewHandle := Accept(FHandle, nil, nil); + NewHandle := Accept(FHandle, nil, nil); {$ELSE} - NewHandle := Accept(FHandle, Addr, AddrLen); + NewHandle := Accept(FHandle, Addr, AddrLen); {$ENDIF} - if NewHandle = InvalidSocket then - Abort; // raise silent exception - Result := CreateLineObject; + if NewHandle = InvalidSocket then + begin + Abort; // Raise silent exception + end; - Result.FHandle := NewHandle; - Result.OnConnected := OnConnected; - Result.OnDisconnected := OnDisconnected; - Result.SetConnected; + Result := CreateLineObject; + + Result.FHandle := NewHandle; + Result.OnConnected := OnConnected; + Result.OnDisconnected := OnDisconnected; + Result.SetConnected; + end else + begin + Result := Self; // ??? + end; end; -function TncLine.SendBuffer(const aBuf; aLen: Integer): Integer; +function TncLine.SendBuffer(const ABuffer; ABufferSize: Integer): Integer; begin // Send all buffer in one go, the most optimal by far - Result := Send(FHandle, aBuf, aLen, 0); + Result := Send(FHandle, ABuffer, ABufferSize, 0); try if Result = SocketError then - Abort; // raise silent exception instead of Check + begin + Abort; // ==> Raise silent exception instead of Check + end; LastSent := TStopWatch.GetTimeStamp; except @@ -478,12 +618,14 @@ function TncLine.SendBuffer(const aBuf; aLen: Integer): Integer; end; end; -function TncLine.RecvBuffer(var aBuf; aLen: Integer): Integer; +function TncLine.RecvBuffer(var ABuffer; ABufferSize: Integer): Integer; begin - Result := recv(FHandle, aBuf, aLen, 0); + Result := recv(FHandle, ABuffer, ABufferSize, 0); try if (Result = SocketError) or (Result = 0) then - Abort; // raise silent exception instead of Check, something has disconnected + begin + Abort; // ==> Raise silent exception instead of Check, something has disconnected + end; LastReceived := TStopWatch.GetTimeStamp; except @@ -508,7 +650,7 @@ procedure TncLine.EnableKeepAlive; var optval: Integer; begin - optval := 1; // any non zero indicates true + optval := 1; // Non-zero indicates true {$IFDEF MSWINDOWS} Check(SetSockOpt(FHandle, SOL_SOCKET, SO_KEEPALIVE, PAnsiChar(@optval), SizeOf(optval))); {$ELSE} @@ -516,6 +658,18 @@ procedure TncLine.EnableKeepAlive; {$ENDIF} end; +procedure TncLine.EnableBroadcast; +var + optval: Integer; +begin + optval := 1; +{$IFDEF MSWINDOWS} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@optval), SizeOf(optval))); +{$ELSE} + Check(SetSockOpt(FHandle, SOL_SOCKET, SO_BROADCAST, optval, SizeOf(optval))); +{$ENDIF} +end; + procedure TncLine.EnableReuseAddress; var optval: Integer; @@ -528,6 +682,19 @@ procedure TncLine.EnableReuseAddress; {$ENDIF} end; +procedure TncLine.SetKind(const AKind: TSocketType); +begin + if FHandle = InvalidSocket then // TODO: Raise exception otherwise??? + begin + FKind := AKind; + end; +end; + +function TncLine.IsConnectionBased: Boolean; +begin + Result := FKind = stTCP; +end; + procedure TncLine.SetConnected; var Addr: sockaddr; @@ -545,26 +712,23 @@ procedure TncLine.SetConnected; LastReceived := LastSent; AddrSize := SizeOf(Addr); + if GetPeerName(FHandle, Addr, AddrSize) <> SocketError then begin // FPeerIP := IntToStr(Ord(addr.sin_addr.S_un_b.s_b1)) + '.' + IntToStr(Ord(addr.sin_addr.S_un_b.s_b2)) + '.' + IntToStr(Ord(addr.sin_addr.S_un_b.s_b3)) + // '.' + IntToStr(Ord(addr.sin_addr.S_un_b.s_b4)); - FPeerIP := - - IntToStr(Ord(Addr.sa_data[2])) + '.' + - - IntToStr(Ord(Addr.sa_data[3])) + '.' + - - IntToStr(Ord(Addr.sa_data[4])) + '.' + - - IntToStr(Ord(Addr.sa_data[5])); + FPeerIP := IntToStr(Ord(Addr.sa_data[2])) + '.' + + IntToStr(Ord(Addr.sa_data[3])) + '.' + + IntToStr(Ord(Addr.sa_data[4])) + '.' + + IntToStr(Ord(Addr.sa_data[5])); end; if Assigned(OnConnected) then - try - OnConnected(Self); - except - end; + try + OnConnected(Self); + except + // Ignore + end; end; end; @@ -575,10 +739,11 @@ procedure TncLine.SetDisconnected; FActive := False; if Assigned(FOnDisconnected) then - try - OnDisconnected(Self); - except - end; + try + OnDisconnected(Self); + except + // Ignore + end; end; end; @@ -592,11 +757,11 @@ function TncLine.GetLastReceived: Int64; end; end; -procedure TncLine.SetLastReceived(const Value: Int64); +procedure TncLine.SetLastReceived(const AValue: Int64); begin PropertyLock.Acquire; try - FLastReceived := Value; + FLastReceived := AValue; finally PropertyLock.Release; end; @@ -612,32 +777,33 @@ function TncLine.GetLastSent: Int64; end; end; -procedure TncLine.SetLastSent(const Value: Int64); +procedure TncLine.SetLastSent(const AValue: Int64); begin PropertyLock.Acquire; try - FLastSent := Value; + FLastSent := AValue; finally PropertyLock.Release; end; end; {$IFDEF MSWINDOWS} - var ExtDllHandle: THandle = 0; procedure AttachAddrInfo; - procedure SafeLoadFrom(aDll: string); + procedure SafeLoadFrom(const ADll: string); begin if not Assigned(DllGetAddrInfo) then begin - ExtDllHandle := SafeLoadLibrary(aDll); + ExtDllHandle := SafeLoadLibrary(ADll); + if ExtDllHandle <> 0 then begin DllGetAddrInfo := GetProcAddress(ExtDllHandle, 'GetAddrInfoW'); DllFreeAddrInfo := GetProcAddress(ExtDllHandle, 'FreeAddrInfoW'); + if not Assigned(DllGetAddrInfo) then begin FreeLibrary(ExtDllHandle); @@ -656,18 +822,16 @@ procedure AttachAddrInfo; WSAData: TWSAData; initialization - -WSAStartup(MakeWord(2, 2), WSAData); // Require WinSock 2 version - -AttachAddrInfo; + WSAStartup(MakeWord(2, 2), WSAData); // Require WinSock 2 version + AttachAddrInfo; finalization + if ExtDllHandle <> 0 then + begin + FreeLibrary(ExtDllHandle); + end; -if ExtDllHandle <> 0 then - FreeLibrary(ExtDllHandle); - -WSACleanup; - + WSACleanup; {$ENDIF} end. diff --git a/Source/ncSockets.pas b/Source/ncSockets.pas index bede6b9..f858e62 100644 --- a/Source/ncSockets.pas +++ b/Source/ncSockets.pas @@ -7,6 +7,9 @@ // This unit creates a TCP Server and TCP Client socket, along with their // threads dealing with reading from the socket // +// 14 Feb 2022 by Andreas Toth - andreas.toth@xtra.co.nz +// - Added UDP and IPv6 support +// // 9/8/2020 // - Added a ShutDownLine in the TCPServer component so as to allow to // shutdown a line even when within a read operation @@ -40,12 +43,21 @@ interface uses {$IFDEF MSWINDOWS} - Winapi.Windows, Winapi.Winsock2, + Winapi.Windows, + Winapi.Winsock2, {$ELSE} - Posix.SysSocket, Posix.Unistd, + Posix.SysSocket, + Posix.Unistd, {$ENDIF} - System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.Diagnostics, System.TimeSpan, - ncLines, ncSocketList, ncThreads; + System.Classes, + System.SysUtils, + System.SyncObjs, + System.Math, + System.Diagnostics, + System.TimeSpan, + ncLines, + ncSocketList, + ncThreads; const DefPort = 16233; @@ -57,19 +69,34 @@ interface DefUseReaderThread = True; DefNoDelay = False; DefKeepAlive = True; + DefBroadcast = False; resourcestring + ECannotSetFamilyWhileConnectionIsActiveStr = 'Cannot set Family property whilst the connection is active'; ECannotSetPortWhileConnectionIsActiveStr = 'Cannot set Port property whilst the connection is active'; ECannotSetHostWhileConnectionIsActiveStr = 'Cannot set Host property whilst the connection is active'; ECannotSetUseReaderThreadWhileActiveStr = 'Cannot set UseReaderThread property whilst the connection is active'; - ECannotReceiveIfUseReaderThreadStr = - 'Cannot receive data if UseReaderThread is set. Use OnReadData event handler to get the data or set UseReaderThread property to false'; + ECannotReceiveIfUseReaderThreadStr = 'Cannot receive data if UseReaderThread is set. Use OnReadData event handler to get the data or set UseReaderThread property to False'; type EPropertySetError = class(Exception); ENonActiveSocket = class(Exception); ECannotReceiveIfUseReaderThread = class(Exception); + // We bring in TncLine so that a form that uses our components does + // not have to reference ncLines unit to get the type + TncLine = ncLines.TncLine; + + // We make a descendant of TncLine so that we can access the API functions. + // These API functions are not made puclic in TncLine so that the user cannot + // mangle up the line. + // + // Note that this descendant must be declared in the interface section in + // order to be able to use it inline even though the purpose of it only + // serves the implementation section of this unit as using it from another + // unit will once again hide the protected API functions. + TncLineAccess = class(TncLine); + // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// // TThreadLineList // Thread safe object, used by the main components @@ -81,60 +108,85 @@ TThreadLineList = class FLock: TCriticalSection; FLockCount: Integer; protected - procedure Add(const Item: TncLine); inline; + procedure Add(const AItem: TncLine); inline; procedure Clear; inline; - procedure Remove(Item: TncLine); inline; + procedure Remove(AItem: TncLine); inline; + function LockListNoCopy: TSocketList; procedure UnlockListNoCopy; public constructor Create; destructor Destroy; override; + function LockList: TSocketList; procedure UnlockList; end; // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// - // Base object for all TCP Sockets - TncOnConnectDisconnect = procedure(Sender: TObject; aLine: TncLine) of object; - TncOnReadData = procedure(Sender: TObject; aLine: TncLine; const aBuf: TBytes; aBufCount: Integer) of object; - TncOnReconnected = procedure(Sender: TObject; aLine: TncLine) of object; + // Base object for all sockets + TncOnConnectDisconnect = procedure(Sender: TObject; ALine: TncLine) of object; + TncOnReadData = procedure(Sender: TObject; ALine: TncLine; const ABuffer: TBytes; ABufferSize: Integer) of object; + TncOnReconnected = procedure(Sender: TObject; ALine: TncLine) of object; + + TncCustomSocket = class; + TncCustomSocketClass = class of TncCustomSocket; - TncTCPBase = class(TComponent) + TncCustomSocket = class(TComponent) private FInitActive: Boolean; + FFamily: TAddressType; FPort: Integer; FEventsUseMainThread: Boolean; FNoDelay: Boolean; FKeepAlive: Boolean; + FBroadcast: Boolean; FOnConnected: TncOnConnectDisconnect; FOnDisconnected: TncOnConnectDisconnect; FOnReadData: TncOnReadData; + function GetActive: Boolean; virtual; abstract; - procedure SetActive(const Value: Boolean); + procedure SetActive(const AValue: Boolean); + + function GetFamily: TAddressType; + procedure SetFamily(const AValue: TAddressType); + function GetPort: Integer; - procedure SetPort(const Value: Integer); + procedure SetPort(const AValue: Integer); + function GetReaderThreadPriority: TncThreadPriority; - procedure SetReaderThreadPriority(const Value: TncThreadPriority); + procedure SetReaderThreadPriority(const AValue: TncThreadPriority); + function GetEventsUseMainThread: Boolean; - procedure SetEventsUseMainThread(const Value: Boolean); + procedure SetEventsUseMainThread(const AValue: Boolean); + protected function GetNoDelay: Boolean; - procedure SetNoDelay(const Value: Boolean); + procedure SetNoDelay(const AValue: Boolean); + function GetKeepAlive: Boolean; - procedure SetKeepAlive(const Value: Boolean); + procedure SetKeepAlive(const AValue: Boolean); + + function GetBroadcast: Boolean; + procedure SetBroadcast(const AValue: Boolean); private FUseReaderThread: Boolean; - procedure DoActivate(aActivate: Boolean); virtual; abstract; - procedure SetUseReaderThread(const Value: Boolean); + + procedure DoActivate(AActivate: Boolean); virtual; abstract; + procedure SetUseReaderThread(const AValue: Boolean); protected - PropertyLock, ShutDownLock: TCriticalSection; + PropertyLock: TCriticalSection; + ShutdownLock: TCriticalSection; ReadBuf: TBytes; + procedure Loaded; override; function CreateLineObject: TncLine; virtual; public LineProcessor: TncReadyThread; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; + property Family: TAddressType read GetFamily write SetFamily default TncLineAccess.DefaultFamily; + function Kind: TSocketType; virtual; abstract; property Active: Boolean read GetActive write SetActive default False; property Port: Integer read GetPort write SetPort default DefPort; property ReaderThreadPriority: TncThreadPriority read GetReaderThreadPriority write SetReaderThreadPriority default DefReaderThreadPriority; @@ -142,54 +194,98 @@ TncTCPBase = class(TComponent) property UseReaderThread: Boolean read FUseReaderThread write SetUseReaderThread default DefUseReaderThread; property NoDelay: Boolean read GetNoDelay write SetNoDelay default DefNoDelay; property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default DefKeepAlive; + property Broadcast: Boolean read GetBroadcast write SetBroadcast default DefBroadcast; property OnConnected: TncOnConnectDisconnect read FOnConnected write FOnConnected; property OnDisconnected: TncOnConnectDisconnect read FOnDisconnected write FOnDisconnected; property OnReadData: TncOnReadData read FOnReadData write FOnReadData; - published + + function IsConnectionBased: Boolean; end; // ///////////////////////////////////////////////////////////////////////////////////////////////////////////////// - // Client Socket + // Client socket TncClientProcessor = class; - TncCustomTCPClient = class(TncTCPBase) + TncCustomSocketClient = class; + TncCustomSocketClientClass = class of TncCustomSocketClient; + + TncCustomSocketClient = class(TncCustomSocket) private FHost: string; FReconnect: Boolean; FReconnectInterval: Cardinal; FOnReconnected: TncOnReconnected; + function GetActive: Boolean; override; - procedure SetHost(const Value: string); + + procedure SetHost(const AValue: string); function GetHost: string; + function GetReconnect: Boolean; - procedure SetReconnect(const Value: Boolean); + procedure SetReconnect(const AValue: Boolean); + function GetReconnectInterval: Cardinal; - procedure SetReconnectInterval(const Value: Cardinal); + procedure SetReconnectInterval(const AValue: Cardinal); protected WasConnected: Boolean; LastConnectAttempt: Int64; - procedure DoActivate(aActivate: Boolean); override; - procedure DataSocketConnected(aLine: TncLine); - procedure DataSocketDisconnected(aLine: TncLine); + + procedure DoActivate(AActivate: Boolean); override; + + procedure DataSocketConnected(ALine: TncLine); + procedure DataSocketDisconnected(ALine: TncLine); public ReadSocketHandles: TSocketHandleArray; Line: TncLine; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure Send(const aBuf; aBufSize: Integer); overload; inline; - procedure Send(const aBytes: TBytes); overload; inline; - procedure Send(const aStr: string); overload; inline; - function Receive(aTimeout: Cardinal = 2000): TBytes; inline; - function ReceiveRaw(var aBytes: TBytes): Integer; inline; + property Host: string read GetHost write SetHost; + + procedure Send(const ABuffer; ABufferSize: Integer); overload; inline; + procedure Send(const ABytes: TBytes); overload; inline; + procedure Send(const AString: string); overload; inline; + + function Receive(ATimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(var ABytes: TBytes): Integer; inline; + property Reconnect: Boolean read GetReconnect write SetReconnect default True; property ReconnectInterval: Cardinal read GetReconnectInterval write SetReconnectInterval default DefCntReconnectInterval; property OnReconnected: TncOnReconnected read FOnReconnected write FOnReconnected; end; + TncCustomUDPClient = class(TncCustomSocketClient) + public + constructor Create(AOwner: TComponent); override; + + function Kind: TSocketType; override; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default False; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default False; + end; + + TncUDPClient = class(TncCustomUDPClient) + published + property Active; + property Family; + property Port; + property Host; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property OnReadData; + end; + + TncCustomTCPClient = class(TncCustomSocketClient) + public + function Kind: TSocketType; override; + end; + TncTCPClient = class(TncCustomTCPClient) published property Active; + property Family; property Port; property Host; property ReaderThreadPriority; @@ -207,10 +303,12 @@ TncTCPClient = class(TncCustomTCPClient) TncClientProcessor = class(TncReadyThread) private - FClientSocket: TncCustomTCPClient; + FClientSocket: TncCustomSocketClient; public ReadySocketsChanged: Boolean; - constructor Create(aClientSocket: TncCustomTCPClient); + + constructor Create(aClientSocket: TncCustomSocketClient); + procedure SocketWasReconnected; procedure SocketProcess; inline; procedure ProcessEvent; override; @@ -220,32 +318,66 @@ TncClientProcessor = class(TncReadyThread) // Server Socket TncServerProcessor = class; - TncCustomTCPServer = class(TncTCPBase) + TncCustomSocketServer = class; + TncCustomSocketServerClass = class of TncCustomSocketServer; + + TncCustomSocketServer = class(TncCustomSocket) private function GetActive: Boolean; override; protected Listener: TncLine; - LinesToShutDown: array of TncLine; - procedure DataSocketConnected(aLine: TncLine); - procedure DataSocketDisconnected(aLine: TncLine); - procedure DoActivate(aActivate: Boolean); override; + LinesToShutdown: array of TncLine; + + procedure DataSocketConnected(ALine: TncLine); + procedure DataSocketDisconnected(ALine: TncLine); + procedure DoActivate(AActivate: Boolean); override; public ReadSocketHandles: TSocketHandleArray; Lines: TThreadLineList; + constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure ShutDownLine(aLine: TncLine); - procedure Send(aLine: TncLine; const aBuf; aBufSize: Integer); overload; inline; - procedure Send(aLine: TncLine; const aBytes: TBytes); overload; inline; - procedure Send(aLine: TncLine; const aStr: string); overload; inline; - function Receive(aLine: TncLine; aTimeout: Cardinal = 2000): TBytes; inline; - function ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; inline; + + procedure ShutdownLine(ALine: TncLine); + + procedure Send(ALine: TncLine; const ABuffer; ABufferSize: Integer); overload; inline; + procedure Send(ALine: TncLine; const ABytes: TBytes); overload; inline; + procedure Send(ALine: TncLine; const AString: string); overload; inline; + + function Receive(ALine: TncLine; ATimeout: Cardinal = 2000): TBytes; inline; + function ReceiveRaw(ALine: TncLine; var ABytes: TBytes): Integer; inline; end; - TncTCPServer = class(TncCustomTCPServer) + TncCustomUDPServer = class(TncCustomSocketServer) + public + constructor Create(AOwner: TComponent); override; + + function Kind: TSocketType; override; + property NoDelay: Boolean read GetNoDelay write SetNoDelay default False; + property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default False; + end; + + TncCustomTCPServer = class(TncCustomSocketServer) public + function Kind: TSocketType; override; + end; + + TncUDPServer = class(TncCustomUDPServer) + published + property Active; + property Family; + property Port; + property ReaderThreadPriority; + property EventsUseMainThread; + property UseReaderThread; + property Broadcast; + property OnReadData; + end; + + TncTCPServer = class(TncCustomTCPServer) published property Active; + property Family; property Port; property ReaderThreadPriority; property EventsUseMainThread; @@ -259,25 +391,19 @@ TncTCPServer = class(TncCustomTCPServer) TncServerProcessor = class(TncReadyThread) private - FServerSocket: TncCustomTCPServer; - procedure CheckLinesToShutDown; + FServerSocket: TncCustomSocketServer; + + procedure CheckLinesToShutdown; public ReadySockets: TSocketHandleArray; ReadySocketsChanged: Boolean; - constructor Create(aServerSocket: TncCustomTCPServer); + + constructor Create(AServerSocket: TncCustomSocketServer); + procedure SocketProcess; inline; procedure ProcessEvent; override; end; - // We bring in TncLine so that a form that uses our components does - // not have to reference ncLines unit to get the type - TncLine = ncLines.TncLine; - - // We make a descendant of TncLine so that we can access the API functions. - // These API functions are not made puclic in TncLine so that the user cannot - // mangle up the line - TncLineInternal = class(TncLine); - implementation // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// @@ -287,6 +413,7 @@ implementation constructor TThreadLineList.Create; begin inherited Create; + FLock := TCriticalSection.Create; FList := TSocketList.Create; FLockCount := 0; @@ -294,23 +421,32 @@ constructor TThreadLineList.Create; destructor TThreadLineList.Destroy; begin - LockListNoCopy; - try - FList.Free; + if Assigned(FLock) then + begin + LockListNoCopy; + try + FreeAndNil(FList); + + inherited Destroy; + finally + UnlockListNoCopy; + FreeAndNil(FLock); + end; + end else + begin + FreeAndNil(FList); + inherited Destroy; - finally - UnlockListNoCopy; - FLock.Free; end; end; -procedure TThreadLineList.Add(const Item: TncLine); +procedure TThreadLineList.Add(const AItem: TncLine); begin LockListNoCopy; try // FList has Duplicates to dupError, so we know if this is already in the // list it will not be accepted - FList.Add(Item.Handle, Item); + FList.Add(AItem.Handle, AItem); finally UnlockListNoCopy; end; @@ -326,11 +462,11 @@ procedure TThreadLineList.Clear; end; end; -procedure TThreadLineList.Remove(Item: TncLine); +procedure TThreadLineList.Remove(AItem: TncLine); begin LockListNoCopy; try - FList.Delete(FList.IndexOf(Item.Handle)); + FList.Delete(FList.IndexOf(AItem.Handle)); finally UnlockListNoCopy; end; @@ -356,8 +492,8 @@ function TThreadLineList.LockList: TSocketList; FListCopy := TSocketList.Create; FListCopy.Assign(FList); end; - Result := FListCopy; + Result := FListCopy; FLockCount := FLockCount + 1; finally FLock.Release; @@ -374,29 +510,33 @@ procedure TThreadLineList.UnlockList; FLockCount := FLockCount - 1; if FLockCount = 0 then - FListCopy.Free; + begin + FreeAndNil(FListCopy); + end; finally FLock.Release; end; end; // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -{ TncTCPBase } +{ TncCustomSocket } // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TncTCPBase.Create(AOwner: TComponent); +constructor TncCustomSocket.Create(AOwner: TComponent); begin inherited Create(AOwner); PropertyLock := TCriticalSection.Create; - ShutDownLock := TCriticalSection.Create; + ShutdownLock := TCriticalSection.Create; FInitActive := False; + FFamily := TncLineAccess.DefaultFamily; FPort := DefPort; FEventsUseMainThread := DefEventsUseMainThread; FUseReaderThread := DefUseReaderThread; FNoDelay := DefNoDelay; FKeepAlive := DefKeepAlive; + FBroadcast := DefBroadcast; FOnConnected := nil; FOnDisconnected := nil; FOnReadData := nil; @@ -404,40 +544,82 @@ constructor TncTCPBase.Create(AOwner: TComponent); SetLength(ReadBuf, DefReadBufferLen); end; -destructor TncTCPBase.Destroy; +destructor TncCustomSocket.Destroy; begin - ShutDownLock.Free; - PropertyLock.Free; + FreeAndNil(ShutdownLock); + FreeAndNil(PropertyLock); + inherited Destroy; end; -procedure TncTCPBase.Loaded; +procedure TncCustomSocket.Loaded; begin inherited Loaded; if FInitActive then + begin DoActivate(True); + end; +end; + +function TncCustomSocket.CreateLineObject: TncLine; +begin + Result := TncLineAccess.Create; + TncLineAccess(Result).SetKind(Kind); end; -function TncTCPBase.CreateLineObject: TncLine; +function TncCustomSocket.IsConnectionBased: Boolean; begin - Result := TncLineInternal.Create; + Result := Kind = stTCP; end; -procedure TncTCPBase.SetActive(const Value: Boolean); +procedure TncCustomSocket.SetActive(const AValue: Boolean); begin PropertyLock.Acquire; try - if not(csLoading in ComponentState) then - DoActivate(Value); + if not (csLoading in ComponentState) then + begin + DoActivate(AValue); + end; - FInitActive := GetActive; // we only care here for the loaded event + if not (csDestroying in ComponentState) then + begin + FInitActive := GetActive; // We only care here for the loaded event + end; finally PropertyLock.Release; end; end; -function TncTCPBase.GetPort: Integer; +function TncCustomSocket.GetFamily: TAddressType; +begin + PropertyLock.Acquire; + try + Result := FFamily; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomSocket.SetFamily(const AValue: TAddressType); +begin + if not (csLoading in ComponentState) then + begin + if Active then + begin + raise EPropertySetError.Create(ECannotSetFamilyWhileConnectionIsActiveStr); + end; + end; + + PropertyLock.Acquire; + try + FFamily := AValue; + finally + PropertyLock.Release; + end; +end; + +function TncCustomSocket.GetPort: Integer; begin PropertyLock.Acquire; try @@ -447,21 +629,25 @@ function TncTCPBase.GetPort: Integer; end; end; -procedure TncTCPBase.SetPort(const Value: Integer); +procedure TncCustomSocket.SetPort(const AValue: Integer); begin - if not(csLoading in ComponentState) then + if not (csLoading in ComponentState) then + begin if Active then + begin raise EPropertySetError.Create(ECannotSetPortWhileConnectionIsActiveStr); + end; + end; PropertyLock.Acquire; try - FPort := Value; + FPort := AValue; finally PropertyLock.Release; end; end; -function TncTCPBase.GetReaderThreadPriority: TncThreadPriority; +function TncCustomSocket.GetReaderThreadPriority: TncThreadPriority; begin PropertyLock.Acquire; try @@ -471,12 +657,12 @@ function TncTCPBase.GetReaderThreadPriority: TncThreadPriority; end; end; -procedure TncTCPBase.SetReaderThreadPriority(const Value: TncThreadPriority); +procedure TncCustomSocket.SetReaderThreadPriority(const AValue: TncThreadPriority); begin PropertyLock.Acquire; try try - LineProcessor.Priority := FromNcThreadPriority(Value); + LineProcessor.Priority := FromNcThreadPriority(AValue); except // Some android devices cannot handle changing priority end; @@ -485,7 +671,7 @@ procedure TncTCPBase.SetReaderThreadPriority(const Value: TncThreadPriority); end; end; -function TncTCPBase.GetEventsUseMainThread: Boolean; +function TncCustomSocket.GetEventsUseMainThread: Boolean; begin PropertyLock.Acquire; try @@ -495,31 +681,35 @@ function TncTCPBase.GetEventsUseMainThread: Boolean; end; end; -procedure TncTCPBase.SetEventsUseMainThread(const Value: Boolean); +procedure TncCustomSocket.SetEventsUseMainThread(const AValue: Boolean); begin PropertyLock.Acquire; try - FEventsUseMainThread := Value; + FEventsUseMainThread := AValue; finally PropertyLock.Release; end; end; -procedure TncTCPBase.SetUseReaderThread(const Value: Boolean); +procedure TncCustomSocket.SetUseReaderThread(const AValue: Boolean); begin - if not(csLoading in ComponentState) then + if not (csLoading in ComponentState) then + begin if Active then + begin raise EPropertySetError.Create(ECannotSetUseReaderThreadWhileActiveStr); + end; + end; PropertyLock.Acquire; try - FUseReaderThread := Value; + FUseReaderThread := AValue; finally PropertyLock.Release; end; end; -function TncTCPBase.GetNoDelay: Boolean; +function TncCustomSocket.GetNoDelay: Boolean; begin PropertyLock.Acquire; try @@ -529,17 +719,17 @@ function TncTCPBase.GetNoDelay: Boolean; end; end; -procedure TncTCPBase.SetNoDelay(const Value: Boolean); +procedure TncCustomSocket.SetNoDelay(const AValue: Boolean); begin PropertyLock.Acquire; try - FNoDelay := Value; + FNoDelay := AValue; finally PropertyLock.Release; end; end; -function TncTCPBase.GetKeepAlive: Boolean; +function TncCustomSocket.GetKeepAlive: Boolean; begin PropertyLock.Acquire; try @@ -549,21 +739,41 @@ function TncTCPBase.GetKeepAlive: Boolean; end; end; -procedure TncTCPBase.SetKeepAlive(const Value: Boolean); +procedure TncCustomSocket.SetKeepAlive(const AValue: Boolean); begin PropertyLock.Acquire; try - FKeepAlive := Value; + FKeepAlive := AValue; + finally + PropertyLock.Release; + end; +end; + +function TncCustomSocket.GetBroadcast: Boolean; +begin + PropertyLock.Acquire; + try + Result := FBroadcast; + finally + PropertyLock.Release; + end; +end; + +procedure TncCustomSocket.SetBroadcast(const AValue: Boolean); +begin + PropertyLock.Acquire; + try + FBroadcast := AValue; finally PropertyLock.Release; end; end; // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -{ TncCustomTCPClient } +{ TncCustomSocketClient } // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TncCustomTCPClient.Create(AOwner: TComponent); +constructor TncCustomSocketClient.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -576,8 +786,8 @@ constructor TncCustomTCPClient.Create(AOwner: TComponent); WasConnected := False; Line := CreateLineObject; - TncLineInternal(Line).OnConnected := DataSocketConnected; - TncLineInternal(Line).OnDisconnected := DataSocketDisconnected; + TncLineAccess(Line).OnConnected := DataSocketConnected; + TncLineAccess(Line).OnDisconnected := DataSocketDisconnected; LineProcessor := TncClientProcessor.Create(Self); try @@ -588,126 +798,154 @@ constructor TncCustomTCPClient.Create(AOwner: TComponent); LineProcessor.WaitForReady; end; -destructor TncCustomTCPClient.Destroy; +destructor TncCustomSocketClient.Destroy; begin - Active := False; + if Assigned(PropertyLock) then + begin + Active := False; // Active protected by PropertyLock + end; - LineProcessor.Terminate; - LineProcessor.WakeupEvent.SetEvent; - LineProcessor.WaitFor; - LineProcessor.Free; + if Assigned(LineProcessor) then + begin + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + + FreeAndNil(LineProcessor); + end; - Line.Free; + FreeAndNil(Line); inherited Destroy; end; -procedure TncCustomTCPClient.DoActivate(aActivate: Boolean); +procedure TncCustomSocketClient.DoActivate(AActivate: Boolean); begin - if aActivate = GetActive then - Exit; + if AActivate = GetActive then + begin + Exit; // ==> + end; - if aActivate then + if AActivate then begin - TncLineInternal(Line).CreateClientHandle(FHost, FPort); + TncLineAccess(Line).CreateClientHandle(FHost, FPort); // if there were no exceptions, and line is still not active, // that means the user has deactivated it in the OnConnect handler + if not Line.Active then + begin WasConnected := False; - end - else + end; + end else begin WasConnected := False; - TncLineInternal(Line).DestroyHandle; + TncLineAccess(Line).DestroyHandle; end; end; -procedure TncCustomTCPClient.DataSocketConnected(aLine: TncLine); +procedure TncCustomSocketClient.DataSocketConnected(ALine: TncLine); begin SetLength(ReadSocketHandles, 1); ReadSocketHandles[0] := Line.Handle; if NoDelay then - try - TncLineInternal(Line).EnableNoDelay; - except - end; + try + TncLineAccess(Line).EnableNoDelay; + except + // Ignore + end; if KeepAlive then - try - TncLineInternal(Line).EnableKeepAlive; - except - end; + try + TncLineAccess(Line).EnableKeepAlive; + except + // Ignore + end; + + if Broadcast then + try + TncLineAccess(Line).EnableBroadcast; + except + // Ignore + end; if Assigned(OnConnected) then - try - OnConnected(Self, aLine); - except - end; + try + OnConnected(Self, ALine); + except + // Ignore + end; LastConnectAttempt := TStopWatch.GetTimeStamp; WasConnected := True; if UseReaderThread then + begin LineProcessor.Run; // Will just set events, this does not wait + end; end; -procedure TncCustomTCPClient.DataSocketDisconnected(aLine: TncLine); +procedure TncCustomSocketClient.DataSocketDisconnected(ALine: TncLine); begin if Assigned(OnDisconnected) then - try - OnDisconnected(Self, aLine); - except - end; + try + OnDisconnected(Self, ALine); + except + // Ignore + end; end; -procedure TncCustomTCPClient.Send(const aBuf; aBufSize: Integer); +procedure TncCustomSocketClient.Send(const ABuffer; ABufferSize: Integer); begin Active := True; - TncLineInternal(Line).SendBuffer(aBuf, aBufSize); + TncLineAccess(Line).SendBuffer(ABuffer, ABufferSize); end; -procedure TncCustomTCPClient.Send(const aBytes: TBytes); +procedure TncCustomSocketClient.Send(const ABytes: TBytes); begin - if Length(aBytes) > 0 then - Send(aBytes[0], Length(aBytes)); + if Length(ABytes) > 0 then + begin + Send(ABytes[0], Length(ABytes)); + end; end; -procedure TncCustomTCPClient.Send(const aStr: string); +procedure TncCustomSocketClient.Send(const AString: string); begin - Send(BytesOf(aStr)); + Send(BytesOf(AString)); end; -function TncCustomTCPClient.Receive(aTimeout: Cardinal): TBytes; +function TncCustomSocketClient.Receive(ATimeout: Cardinal): TBytes; var BufRead: Integer; begin if UseReaderThread then + begin raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + end; Active := True; - if not ReadableAnySocket([Line.Handle], aTimeout) then + if not ReadableAnySocket([Line.Handle], ATimeout) then begin SetLength(Result, 0); - Exit; + Exit; // ==> end; - BufRead := TncLineInternal(Line).RecvBuffer(ReadBuf[0], Length(ReadBuf)); + BufRead := TncLineAccess(Line).RecvBuffer(ReadBuf[0], Length(ReadBuf)); Result := Copy(ReadBuf, 0, BufRead) end; -function TncCustomTCPClient.ReceiveRaw(var aBytes: TBytes): Integer; +function TncCustomSocketClient.ReceiveRaw(var ABytes: TBytes): Integer; begin - Result := TncLineInternal(Line).RecvBuffer(aBytes[0], Length(aBytes)); + Result := TncLineAccess(Line).RecvBuffer(ABytes[0], Length(ABytes)); end; -function TncCustomTCPClient.GetActive: Boolean; +function TncCustomSocketClient.GetActive: Boolean; begin - Result := Line.Active; + Result := Assigned(Line) and Line.Active; end; -function TncCustomTCPClient.GetHost: string; +function TncCustomSocketClient.GetHost: string; begin PropertyLock.Acquire; try @@ -717,21 +955,25 @@ function TncCustomTCPClient.GetHost: string; end; end; -procedure TncCustomTCPClient.SetHost(const Value: string); +procedure TncCustomSocketClient.SetHost(const AValue: string); begin - if not(csLoading in ComponentState) then + if not (csLoading in ComponentState) then + begin if Active then + begin raise EPropertySetError.Create(ECannotSetHostWhileConnectionIsActiveStr); + end; + end; PropertyLock.Acquire; try - FHost := Value; + FHost := AValue; finally PropertyLock.Release; end; end; -function TncCustomTCPClient.GetReconnect: Boolean; +function TncCustomSocketClient.GetReconnect: Boolean; begin PropertyLock.Acquire; try @@ -741,17 +983,17 @@ function TncCustomTCPClient.GetReconnect: Boolean; end; end; -procedure TncCustomTCPClient.SetReconnect(const Value: Boolean); +procedure TncCustomSocketClient.SetReconnect(const AValue: Boolean); begin PropertyLock.Acquire; try - FReconnect := Value; + FReconnect := AValue; finally PropertyLock.Release; end; end; -function TncCustomTCPClient.GetReconnectInterval: Cardinal; +function TncCustomSocketClient.GetReconnectInterval: Cardinal; begin PropertyLock.Acquire; try @@ -761,24 +1003,51 @@ function TncCustomTCPClient.GetReconnectInterval: Cardinal; end; end; -procedure TncCustomTCPClient.SetReconnectInterval(const Value: Cardinal); +procedure TncCustomSocketClient.SetReconnectInterval(const AValue: Cardinal); begin PropertyLock.Acquire; try - FReconnectInterval := Value; + FReconnectInterval := AValue; finally PropertyLock.Release; end; end; +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomUDPClient } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomUDPClient.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FNoDelay := False; + FKeepAlive := False; +end; + +function TncCustomUDPClient.Kind: TSocketType; +begin + Result := stUDP; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPClient } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +function TncCustomTCPClient.Kind: TSocketType; +begin + Result := stTCP; +end; + // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { TncClientProcessor } // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TncClientProcessor.Create(aClientSocket: TncCustomTCPClient); +constructor TncClientProcessor.Create(aClientSocket: TncCustomSocketClient); begin FClientSocket := aClientSocket; ReadySocketsChanged := False; + inherited Create; end; @@ -786,20 +1055,27 @@ procedure TncClientProcessor.SocketProcess; var BufRead: Integer; begin - BufRead := TncLineInternal(FClientSocket.Line).RecvBuffer(FClientSocket.ReadBuf[0], Length(FClientSocket.ReadBuf)); + BufRead := TncLineAccess(FClientSocket.Line).RecvBuffer(FClientSocket.ReadBuf[0], Length(FClientSocket.ReadBuf)); + if Assigned(FClientSocket.OnReadData) then - try - FClientSocket.OnReadData(FClientSocket, FClientSocket.Line, FClientSocket.ReadBuf, BufRead); - except - end; + try + FClientSocket.OnReadData(FClientSocket, FClientSocket.Line, FClientSocket.ReadBuf, BufRead); + except + // Ignore + end; end; procedure TncClientProcessor.SocketWasReconnected; begin if Assigned(FClientSocket.FOnReconnected) then + begin FClientSocket.FOnReconnected(FClientSocket, FClientSocket.Line); + end; + if Assigned(FClientSocket.FOnConnected) then + begin FClientSocket.FOnConnected(FClientSocket, FClientSocket.Line); + end; end; procedure TncClientProcessor.ProcessEvent; @@ -807,85 +1083,98 @@ procedure TncClientProcessor.ProcessEvent; PrevOnConnect: TncOnConnectDisconnect; WasReconnected: Boolean; begin - while (not Terminated) do // Repeat handling until terminated - try - if FClientSocket.Line.Active then // Repeat reading socket until disconnected + while not Terminated do // Repeat handling until terminated + try + if (not FClientSocket.IsConnectionBased) or FClientSocket.Line.Active then // Repeat reading socket until disconnected + begin + if ReadableAnySocket(FClientSocket.ReadSocketHandles, 250) then begin - if ReadableAnySocket(FClientSocket.ReadSocketHandles, 250) then + if ReadySocketsChanged then begin - if ReadySocketsChanged then - begin - ReadySocketsChanged := False; - Continue; - end; - if FClientSocket.EventsUseMainThread then - Synchronize(SocketProcess) // for synchronize - else - SocketProcess; + ReadySocketsChanged := False; + Continue; // ==> end; - end - else - // Is not Active, try reconnecting if was connected - begin - // Logic for reconnect mode - if FClientSocket.Reconnect and FClientSocket.WasConnected then + + if FClientSocket.EventsUseMainThread then begin - // A minimal sleep time of 30 msec is required in Android before - // reattempting to connect on a recently deactivated network connection. - // We have put it to 60 for safety - Sleep(60); - if Terminated then - Break; - if TStopWatch.GetTimeStamp - FClientSocket.LastConnectAttempt > FClientSocket.ReconnectInterval * TTimeSpan.TicksPerMillisecond then - begin - FClientSocket.LastConnectAttempt := TStopWatch.GetTimeStamp; + Synchronize(SocketProcess); + end else + begin + SocketProcess; + end; + end; + end else // Not Active, try reconnecting if connection-based and was connected + begin + if (not FClientSocket.IsConnectionBased) or (not (FClientSocket.Reconnect and FClientSocket.WasConnected)) then + begin + Exit; // ==> + end; + + // A minimal sleep time of 30 msec is required in Android before + // reattempting to connect on a recently deactivated network connection. + // We have put it to 60 for safety + Sleep(60); + + if Terminated then + begin + Break; // ==> + end; - WasReconnected := False; - FClientSocket.PropertyLock.Acquire; + if TStopWatch.GetTimeStamp - FClientSocket.LastConnectAttempt > FClientSocket.ReconnectInterval * TTimeSpan.TicksPerMillisecond then + begin + FClientSocket.LastConnectAttempt := TStopWatch.GetTimeStamp; + + WasReconnected := False; + FClientSocket.PropertyLock.Acquire; + + try + if not FClientSocket.Active then + begin + PrevOnConnect := FClientSocket.OnConnected; try - if not FClientSocket.Active then - begin - PrevOnConnect := FClientSocket.OnConnected; - try - // Disable firing the event in the wrong thread in case it gets connected - FClientSocket.OnConnected := nil; - FClientSocket.Active := True; - WasReconnected := True; - finally - FClientSocket.OnConnected := PrevOnConnect; - end; - end; + // Disable firing the event in the wrong thread in case it gets connected + FClientSocket.OnConnected := nil; + FClientSocket.Active := True; + WasReconnected := True; finally - FClientSocket.PropertyLock.Release; + FClientSocket.OnConnected := PrevOnConnect; end; - if WasReconnected then - if FClientSocket.EventsUseMainThread then - Synchronize(SocketWasReconnected) - else - SocketWasReconnected; end; - end - else - Exit; + finally + FClientSocket.PropertyLock.Release; + end; + + if WasReconnected then + begin + if FClientSocket.EventsUseMainThread then + begin + Synchronize(SocketWasReconnected); + end else + begin + SocketWasReconnected; + end; + end; end; - except - // Something was disconnected, continue processing end; + except + // Something was disconnected, continue processing + end; end; // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -{ TncCustomTCPServer } +{ TncCustomSocketServer } // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TncCustomTCPServer.Create(AOwner: TComponent); +constructor TncCustomSocketServer.Create(AOwner: TComponent); begin inherited Create(AOwner); Listener := CreateLineObject; - TncLineInternal(Listener).OnConnected := DataSocketConnected; - TncLineInternal(Listener).OnDisconnected := DataSocketDisconnected; + TncLineAccess(Listener).OnConnected := DataSocketConnected; + TncLineAccess(Listener).OnDisconnected := DataSocketDisconnected; Lines := TThreadLineList.Create; + LineProcessor := TncServerProcessor.Create(Self); try LineProcessor.Priority := FromNcThreadPriority(DefReaderThreadPriority); @@ -894,42 +1183,50 @@ constructor TncCustomTCPServer.Create(AOwner: TComponent); end; end; -destructor TncCustomTCPServer.Destroy; +destructor TncCustomSocketServer.Destroy; begin - // Will get Sockets.Lines disposed off - Active := False; + if IsConnectionBased and Assigned(PropertyLock) then + begin + // Disposes of Lines + Active := False; // Protected by PropertyLock + end; - LineProcessor.Terminate; - LineProcessor.WakeupEvent.SetEvent; - LineProcessor.WaitFor; - LineProcessor.Free; + if Assigned(LineProcessor) then + begin + LineProcessor.Terminate; + LineProcessor.WakeupEvent.SetEvent; + LineProcessor.WaitFor; + + FreeAndNil(LineProcessor); + end; - Lines.Free; - Listener.Free; + FreeAndNil(Lines); + FreeAndNil(Listener); inherited Destroy; end; -function TncCustomTCPServer.GetActive: Boolean; +function TncCustomSocketServer.GetActive: Boolean; begin - Result := Listener.Active; + Result := Assigned(Listener) and Listener.Active; end; -procedure TncCustomTCPServer.DoActivate(aActivate: Boolean); +procedure TncCustomSocketServer.DoActivate(AActivate: Boolean); var DataSockets: TSocketList; i: Integer; begin - if aActivate = GetActive then - Exit; + if AActivate = GetActive then + begin + Exit; // ==> + end; - if aActivate then + if AActivate then begin - TncLineInternal(Listener).CreateServerHandle(FPort); - end - else + TncLineAccess(Listener).CreateServerHandle(FPort); + end else begin - TncLineInternal(Listener).DestroyHandle; + TncLineAccess(Listener).DestroyHandle; // Delphi complains about the free that it does nothing except nil the variable // That is under the mostly forgettable and thankgoodness "gotten rid off" @@ -938,11 +1235,13 @@ procedure TncCustomTCPServer.DoActivate(aActivate: Boolean); DataSockets := Lines.LockListNoCopy; try for i := 0 to DataSockets.Count - 1 do - try - TncLineInternal(DataSockets.Lines[i]).DestroyHandle; - TncLineInternal(DataSockets.Lines[i]).Free; - except - end; + try + TncLineAccess(DataSockets.Lines[i]).DestroyHandle; + FreeAndNil(DataSockets.Lines[i]); + except + // Ignore + end; + DataSockets.Clear; finally Lines.UnlockListNoCopy; @@ -950,202 +1249,262 @@ procedure TncCustomTCPServer.DoActivate(aActivate: Boolean); end; end; -procedure TncCustomTCPServer.ShutDownLine(aLine: TncLine); +procedure TncCustomSocketServer.ShutdownLine(ALine: TncLine); var i: Integer; begin if UseReaderThread then begin - ShutDownLock.Acquire; + ShutdownLock.Acquire; try - for i := 0 to High(LinesToShutDown) do - if LinesToShutDown[i] = aLine then - Exit; + for i := Low(LinesToShutdown) to High(LinesToShutdown) do + begin + if LinesToShutdown[i] = ALine then + begin + Exit; // ==> + end; + end; - SetLength(LinesToShutDown, Length(LinesToShutDown) + 1); - LinesToShutDown[High(LinesToShutDown)] := aLine; + SetLength(LinesToShutdown, Length(LinesToShutdown) + 1); + LinesToShutdown[High(LinesToShutdown)] := ALine; finally - ShutDownLock.Release; + ShutdownLock.Release; end; - end - else + end else begin - Lines.Remove(aLine); - aLine.Free; + Lines.Remove(ALine); + FreeAndNil(ALine); end; end; -procedure TncCustomTCPServer.DataSocketConnected(aLine: TncLine); +procedure TncCustomSocketServer.DataSocketConnected(ALine: TncLine); begin - if aLine = Listener then + if ALine = Listener then begin SetLength(ReadSocketHandles, 1); ReadSocketHandles[0] := Listener.Handle; + if UseReaderThread then begin LineProcessor.WaitForReady; LineProcessor.Run; end; - end - else + end else begin SetLength(ReadSocketHandles, Length(ReadSocketHandles) + 1); - ReadSocketHandles[High(ReadSocketHandles)] := aLine.Handle; + ReadSocketHandles[High(ReadSocketHandles)] := ALine.Handle; if NoDelay then - try - TncLineInternal(aLine).EnableNoDelay; - except - end; + try + TncLineAccess(ALine).EnableNoDelay; + except + // Ignore + end; if KeepAlive then - try - TncLineInternal(aLine).EnableKeepAlive; - except - end; + try + TncLineAccess(ALine).EnableKeepAlive; + except + // Ignore + end; if Assigned(OnConnected) then - try - OnConnected(Self, aLine); - except - end; + try + OnConnected(Self, ALine); + except + // Ignore + end; end; end; -procedure TncCustomTCPServer.DataSocketDisconnected(aLine: TncLine); +procedure TncCustomSocketServer.DataSocketDisconnected(ALine: TncLine); var i: Integer; begin - if aLine = Listener then - SetLength(ReadSocketHandles, 0) - else + if ALine = Listener then + begin + SetLength(ReadSocketHandles, 0); + end else begin if Assigned(OnDisconnected) then - try - OnDisconnected(Self, aLine); - except - end; + try + OnDisconnected(Self, ALine); + except + // ==> + end; - for i := 0 to High(ReadSocketHandles) do - if ReadSocketHandles[i] = aLine.Handle then + for i := Low(ReadSocketHandles) to High(ReadSocketHandles) do + begin + if ReadSocketHandles[i] = ALine.Handle then begin ReadSocketHandles[i] := ReadSocketHandles[High(ReadSocketHandles)]; SetLength(ReadSocketHandles, Length(ReadSocketHandles) - 1); - Break; + + Exit; // ==> end; + end; end; end; -procedure TncCustomTCPServer.Send(aLine: TncLine; const aBuf; aBufSize: Integer); +procedure TncCustomSocketServer.Send(ALine: TncLine; const ABuffer; ABufferSize: Integer); begin - TncLineInternal(aLine).SendBuffer(aBuf, aBufSize); + TncLineAccess(ALine).SendBuffer(ABuffer, ABufferSize); end; -procedure TncCustomTCPServer.Send(aLine: TncLine; const aBytes: TBytes); +procedure TncCustomSocketServer.Send(ALine: TncLine; const ABytes: TBytes); begin - if Length(aBytes) > 0 then - Send(aLine, aBytes[0], Length(aBytes)); + if Length(ABytes) > 0 then + begin + Send(ALine, ABytes[0], Length(ABytes)); + end; end; -procedure TncCustomTCPServer.Send(aLine: TncLine; const aStr: string); +procedure TncCustomSocketServer.Send(ALine: TncLine; const AString: string); begin - Send(aLine, BytesOf(aStr)); + Send(ALine, BytesOf(AString)); end; -function TncCustomTCPServer.Receive(aLine: TncLine; aTimeout: Cardinal): TBytes; +function TncCustomSocketServer.Receive(ALine: TncLine; ATimeout: Cardinal): TBytes; var - i, BufRead, LineNdx: Integer; + i: Integer; + BufRead: Integer; + LineNdx: Integer; DataSockets: TSocketList; Line: TncLine; ReadySockets: TSocketHandleArray; begin if UseReaderThread then + begin raise ECannotReceiveIfUseReaderThread.Create(ECannotReceiveIfUseReaderThreadStr); + end; SetLength(Result, 0); - ReadySockets := Readable(ReadSocketHandles, aTimeout); + ReadySockets := Readable(ReadSocketHandles, ATimeout); - for i := 0 to High(ReadySockets) do - try - if ReadySockets[i] = Listener.Handle then - // New line is here, accept it and create a new TncLine object - Lines.Add(TncLineInternal(Listener).AcceptLine); - except + for i := Low(ReadySockets) to High(ReadySockets) do + try + if ReadySockets[i] = Listener.Handle then + begin + // New line is here, accept it and create a new TncLine object + Lines.Add(TncLineAccess(Listener).AcceptLine); end; + except + // ==> + end; DataSockets := Lines.LockListNoCopy; try - for i := 0 to High(ReadySockets) do + for i := Low(ReadySockets) to High(ReadySockets) do try - if aLine.Handle = ReadySockets[i] then + if ALine.Handle = ReadySockets[i] then begin LineNdx := DataSockets.IndexOf(ReadySockets[i]); + if LineNdx = -1 then - Continue; + begin + Continue; // ==> + end; + Line := DataSockets.Lines[LineNdx]; try if not Line.Active then - Abort; - BufRead := TncLineInternal(Line).RecvBuffer(ReadBuf[0], Length(ReadBuf)); + begin + Abort; // ==> + end; + + BufRead := TncLineAccess(Line).RecvBuffer(ReadBuf[0], Length(ReadBuf)); Result := Copy(ReadBuf, 0, BufRead); except // Line has disconnected, destroy the line DataSockets.Delete(LineNdx); - Line.Free; + FreeAndNil(Line); end; end; except + // ==> end; finally Lines.UnlockListNoCopy; end; end; -function TncCustomTCPServer.ReceiveRaw(aLine: TncLine; var aBytes: TBytes): Integer; +function TncCustomSocketServer.ReceiveRaw(ALine: TncLine; var ABytes: TBytes): Integer; +begin + Result := TncLineAccess(ALine).RecvBuffer(ABytes[0], Length(ABytes)); +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomUDPServer } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +constructor TncCustomUDPServer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + FNoDelay := False; + FKeepAlive := False; +end; + +function TncCustomUDPServer.Kind: TSocketType; begin - Result := TncLineInternal(aLine).RecvBuffer(aBytes[0], Length(aBytes)); + Result := stUDP; +end; + +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +{ TncCustomTCPServer } +// /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + +function TncCustomTCPServer.Kind: TSocketType; +begin + Result := stTCP; end; // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// { TncServerProcessor } // /////////////////////////////////////////////////////////////////////////////////////////////////////////////////// -constructor TncServerProcessor.Create(aServerSocket: TncCustomTCPServer); +constructor TncServerProcessor.Create(AServerSocket: TncCustomSocketServer); begin - FServerSocket := aServerSocket; + FServerSocket := AServerSocket; ReadySocketsChanged := False; + inherited Create; end; -procedure TncServerProcessor.CheckLinesToShutDown; +procedure TncServerProcessor.CheckLinesToShutdown; var i: Integer; begin // The list may be locked from custom code executed in the OnReadData handler // So we will not delete anything, or lock the list, until this lock is freed if FServerSocket.Lines.FLock.TryEnter then + try + FServerSocket.ShutdownLock.Acquire; try - FServerSocket.ShutDownLock.Acquire; + for i := Low(FServerSocket.LinesToShutdown) to High(FServerSocket.LinesToShutdown) do try - for i := 0 to High(FServerSocket.LinesToShutDown) do - try - FServerSocket.Lines.Remove(FServerSocket.LinesToShutDown[i]); - TncLineInternal(FServerSocket.LinesToShutDown[i]).DestroyHandle; - TncLineInternal(FServerSocket.LinesToShutDown[i]).Free; - except - end; - SetLength(FServerSocket.LinesToShutDown, 0); - finally - FServerSocket.ShutDownLock.Release; + FServerSocket.Lines.Remove(FServerSocket.LinesToShutdown[i]); + TncLineAccess(FServerSocket.LinesToShutdown[i]).DestroyHandle; + FreeAndNil(FServerSocket.LinesToShutdown[i]); + except + // ==> end; + + SetLength(FServerSocket.LinesToShutdown, 0); finally - FServerSocket.Lines.FLock.Leave; + FServerSocket.ShutdownLock.Release; end; + finally + FServerSocket.Lines.FLock.Leave; + end; end; procedure TncServerProcessor.SocketProcess; var - i, LineNdx, BufRead, ReadySocketsHigh: Integer; + i: Integer; + LineNdx: Integer; + BufRead: Integer; + ReadySocketsHigh: Integer; DataSockets: TSocketList; Line: TncLine; j: Integer; @@ -1153,7 +1512,8 @@ procedure TncServerProcessor.SocketProcess; ReadySocketsHigh := High(ReadySockets); // First accept new lines - i := 0; + i := Low(ReadySockets); + while i <= ReadySocketsHigh do begin try @@ -1163,86 +1523,109 @@ procedure TncServerProcessor.SocketProcess; if ReadySocketsChanged then begin ReadySocketsChanged := False; - Exit; + Exit; // ==> end; - FServerSocket.Lines.Add(TncLineInternal(FServerSocket.Listener).AcceptLine); + + FServerSocket.Lines.Add(TncLineAccess(FServerSocket.Listener).AcceptLine); Delete(ReadySockets, i, 1); ReadySocketsHigh := ReadySocketsHigh - 1; i := i - 1; end; except + // ==> end; + i := i + 1; end; if ReadySocketsChanged then begin ReadySocketsChanged := False; - Exit; + Exit; // ==> end; // Check for new data DataSockets := FServerSocket.Lines.FList; - for i := 0 to ReadySocketsHigh do - try - LineNdx := DataSockets.IndexOf(ReadySockets[i]); - if LineNdx = -1 then + + for i := Low(ReadySockets) to ReadySocketsHigh do + try + LineNdx := DataSockets.IndexOf(ReadySockets[i]); + + if LineNdx = -1 then + begin + for j := Low(FServerSocket.ReadSocketHandles) to High(FServerSocket.ReadSocketHandles) do begin - for j := 0 to High(FServerSocket.ReadSocketHandles) do - if FServerSocket.ReadSocketHandles[j] = ReadySockets[i] then - begin - FServerSocket.ReadSocketHandles[j] := FServerSocket.ReadSocketHandles[High(FServerSocket.ReadSocketHandles)]; - SetLength(FServerSocket.ReadSocketHandles, Length(FServerSocket.ReadSocketHandles) - 1); - Break; - end; - Continue; - end; - Line := DataSockets.Lines[LineNdx]; - try - if not Line.Active then - Abort; - if ReadySocketsChanged then + if FServerSocket.ReadSocketHandles[j] = ReadySockets[i] then begin - ReadySocketsChanged := False; - Exit; + FServerSocket.ReadSocketHandles[j] := FServerSocket.ReadSocketHandles[High(FServerSocket.ReadSocketHandles)]; + SetLength(FServerSocket.ReadSocketHandles, Length(FServerSocket.ReadSocketHandles) - 1); + + Break; // ==> end; - BufRead := TncLineInternal(Line).RecvBuffer(FServerSocket.ReadBuf[0], Length(FServerSocket.ReadBuf)); - if Assigned(FServerSocket.OnReadData) then - FServerSocket.OnReadData(FServerSocket, Line, FServerSocket.ReadBuf, BufRead); - except - // Line has disconnected, destroy the line - DataSockets.Delete(LineNdx); - Line.Free; + end; + + Continue; // ==> + end; + + Line := DataSockets.Lines[LineNdx]; + try + if not Line.Active then + begin + Abort; // ==> end; if ReadySocketsChanged then begin ReadySocketsChanged := False; - Exit; + Exit; // ==> + end; + + BufRead := TncLineAccess(Line).RecvBuffer(FServerSocket.ReadBuf[0], Length(FServerSocket.ReadBuf)); + + if Assigned(FServerSocket.OnReadData) then + begin + FServerSocket.OnReadData(FServerSocket, Line, FServerSocket.ReadBuf, BufRead); end; except + // Line has disconnected, destroy the line + DataSockets.Delete(LineNdx); + FreeAndNil(Line); end; + + if ReadySocketsChanged then + begin + ReadySocketsChanged := False; + Exit; // ==> + end; + except + // Ignore + end; end; procedure TncServerProcessor.ProcessEvent; begin if FServerSocket.EventsUseMainThread then + begin while FServerSocket.Listener.Active and (not Terminated) do - try - ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); - Synchronize(SocketProcess); - CheckLinesToShutDown; - except - end - else + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + Synchronize(SocketProcess); + CheckLinesToShutdown; + except + // Ignore + end; + end else + begin while FServerSocket.Listener.Active and (not Terminated) do - try - ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); - SocketProcess; - CheckLinesToShutDown; - except - end; + try + ReadySockets := Readable(FServerSocket.ReadSocketHandles, 500); + SocketProcess; + CheckLinesToShutdown; + except + // Ignore + end; + end; end; end. diff --git a/Source/ncSources.pas b/Source/ncSources.pas index e2973ad..dca8f78 100644 --- a/Source/ncSources.pas +++ b/Source/ncSources.pas @@ -25,6 +25,9 @@ // These components have built in encryption and compression, set by the // corresponding properties. // +// 14 Feb 2022 by Andreas Toth - andreas.toth@xtra.co.nz +// - Added UDP and IPv6 support +// // 12/8/2020 // - Complete re-engineering of the base component // @@ -46,16 +49,36 @@ interface uses {$IFDEF MSWINDOWS} - Winapi.Windows, Winapi.Winsock2, + Winapi.Windows, + Winapi.Winsock2, {$ELSE} - Posix.SysSocket, Posix.Unistd, + Posix.SysSocket, + Posix.Unistd, {$ENDIF} - System.Classes, System.SysUtils, System.SyncObjs, System.Math, System.ZLib, - System.Diagnostics, System.TimeSpan, System.RTLConsts, System.Types, - ncCommandPacking, ncLines, ncSocketList, ncThreads, ncSockets, ncPendingCommandsList, ncCompression, ncEncryption; + System.Classes, + System.SysUtils, + System.SyncObjs, + System.Math, + System.ZLib, + System.Diagnostics, + System.TimeSpan, + System.RTLConsts, + System.Types, + ncCommandPacking, + ncLines, + ncSocketList, + ncThreads, + ncSockets, + ncPendingCommandsList, + ncCompression, + ncEncryption; type - TncCommandDirection = (cdIncoming, cdOutgoing); + TncCommandDirection = + ( + cdIncoming, + cdOutgoing + ); ENetComInvalidCommandHandler = class(Exception); ENetComCommandExecutionTimeout = class(Exception); @@ -107,29 +130,10 @@ TncSourceLine = class(TncLine) constructor Create; overload; override; end; - TncOnSourceConnectDisconnect = procedure( - - Sender: TObject; aLine: TncLine) of object; - - TncOnSourceReconnected = procedure( - - Sender: TObject; aLine: TncLine) of object; - - TncOnSourceHandleCommand = function( - - Sender: TObject; aLine: TncLine; - - aCmd: Integer; const aData: TBytes; aRequiresResult: Boolean; - - const aSenderComponent, aReceiverComponent: string): TBytes of object; - - TncOnAsyncExecCommandResult = procedure( - - Sender: TObject; - - aLine: TncLine; aCmd: Integer; const aResult: TBytes; aResultIsError: Boolean; - - const aSenderComponent, aReceiverComponent: string) of object; + TncOnSourceConnectDisconnect = procedure(Sender: TObject; aLine: TncLine) of object; + TncOnSourceReconnected = procedure(Sender: TObject; aLine: TncLine) of object; + TncOnSourceHandleCommand = function(Sender: TObject; aLine: TncLine; aCmd: Integer; const aData: TBytes; aRequiresResult: Boolean; const aSenderComponent, aReceiverComponent: string): TBytes of object; + TncOnAsyncExecCommandResult = procedure(Sender: TObject; aLine: TncLine; aCmd: Integer; const aResult: TBytes; aResultIsError: Boolean; const aSenderComponent, aReceiverComponent: string) of object; IncCommandHandler = interface ['{22337701-9561-489A-8593-82EAA3B1B431}'] @@ -225,10 +229,12 @@ TncSourceBase = class(TComponent, IncCommandHandler) CommandHandlers: array of IncCommandHandler; UniqueSentID: TncCommandUniqueID; HandleCommandThreadPool: TncThreadPool; - Socket: TncTCPBase; + Socket: TncCustomSocket; ExecuteSerialiser: TCriticalSection; - LastConnectedLine, LastDisconnectedLine, LastReconnectedLine: TncLine; + LastConnectedLine: TncLine; + LastDisconnectedLine: TncLine; + LastReconnectedLine: TncLine; PendingCommandsList: TPendingCommandsList; @@ -247,13 +253,7 @@ TncSourceBase = class(TComponent, IncCommandHandler) constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function ExecCommand( - - aLine: TncLine; const aCmd: Integer; const aData: TBytes = nil; - - const aRequiresResult: Boolean = True; const aAsyncExecute: Boolean = False; - - const aPeerComponentHandler: string = ''; const aSourceComponentHandler: string = ''): TBytes; overload; virtual; + function ExecCommand(aLine: TncLine; const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; const aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''; const aSourceComponentHandler: string = ''): TBytes; overload; virtual; procedure AddCommandHandler(aHandler: TComponent); procedure RemoveCommandHandler(aHandler: TComponent); @@ -266,12 +266,10 @@ TncSourceBase = class(TComponent, IncCommandHandler) property KeepAlive: Boolean read GetKeepAlive write SetKeepAlive default True; // New properties for sources - property CommandProcessorThreadPriority: TncThreadPriority read GetCommandProcessorThreadPriority write SetCommandProcessorThreadPriority - default DefExecThreadPriority; + property CommandProcessorThreadPriority: TncThreadPriority read GetCommandProcessorThreadPriority write SetCommandProcessorThreadPriority default DefExecThreadPriority; property CommandProcessorThreads: Integer read GetCommandProcessorThreads write SetCommandProcessorThreads default DefExecThreads; property CommandProcessorThreadsPerCPU: Integer read GetCommandProcessorThreadsPerCPU write SetCommandProcessorThreadsPerCPU default DefExecThreadsPerCPU; - property CommandProcessorThreadsGrowUpto: Integer read GetCommandProcessorThreadsGrowUpto write SetCommandProcessorThreadsGrowUpto - default DefExecThreadsGrowUpto; + property CommandProcessorThreadsGrowUpto: Integer read GetCommandProcessorThreadsGrowUpto write SetCommandProcessorThreadsGrowUpto default DefExecThreadsGrowUpto; property ExecCommandTimeout: Cardinal read GetExecCommandTimeout write SetExecCommandTimeout default DefExecCommandTimeout; property EventsUseMainThread: Boolean read GetEventsUseMainThread write SetEventsUseMainThread default DefEventsUseMainThread; property Compression: TncCompressionLevel read GetCompression write SetCompression default DefCompression; @@ -296,6 +294,7 @@ THandleCommandThread = class(TncReadyThread) Line: TncSourceLine; Command: TncCommand; CommandHandler: IncCommandHandler; + procedure CallOnAsyncEvents; procedure CallOnHandleEvents; procedure ProcessEvent; override; @@ -320,13 +319,7 @@ TncClientSource = class(TncSourceBase) constructor Create(AOwner: TComponent); override; destructor Destroy; override; - function ExecCommand( - - const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; - - const aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''; - - const aSourceComponentHandler: string = ''): TBytes; overload; virtual; + function ExecCommand(const aCmd: Integer; const aData: TBytes = nil; const aRequiresResult: Boolean = True; const aAsyncExecute: Boolean = False; const aPeerComponentHandler: string = ''; const aSourceComponentHandler: string = ''): TBytes; overload; virtual; property Line: TncLine read GetLine; published diff --git a/Source/ncThreads.pas b/Source/ncThreads.pas index e733b5c..579f873 100644 --- a/Source/ncThreads.pas +++ b/Source/ncThreads.pas @@ -19,12 +19,24 @@ interface uses {$IFDEF MSWINDOWS} - WinApi.Windows, WinApi.ActiveX, + WinApi.Windows, + WinApi.ActiveX, {$ENDIF} - System.Classes, System.SyncObjs, System.SysUtils; + System.Classes, + System.SyncObjs, + System.SysUtils; type - TncThreadPriority = (ntpIdle, ntpLowest, ntpLower, ntpNormal, ntpHigher, ntpHighest, ntpTimeCritical); + TncThreadPriority = + ( + ntpIdle, + ntpLowest, + ntpLower, + ntpNormal, + ntpHigher, + ntpHighest, + ntpTimeCritical + ); // The thread waits for the wakeup event to start processing // after the its ready event is set. @@ -32,14 +44,18 @@ interface // again for the WakeUpEvent to be set. TncReadyThread = class(TThread) public - WakeupEvent, ReadyEvent: TEvent; + WakeupEvent: TEvent; + ReadyEvent: TEvent; + constructor Create; destructor Destroy; override; + procedure Execute; override; procedure ProcessEvent; virtual; abstract; function IsReady: Boolean; - function WaitForReady(aTimeOut: Cardinal = Infinite): TWaitResult; + function WaitForReady(ATimeOut: Cardinal = Infinite): TWaitResult; + procedure Run; end; @@ -55,33 +71,37 @@ TncReadyThreadClass = class of TncReadyThread; TncThreadPool = class private FGrowUpto: Integer; + function GetGrowUpto: Integer; - procedure SetGrowUpto(const Value: Integer); + procedure SetGrowUpto(const AValue: Integer); private ThreadClass: TncReadyThreadClass; - procedure ShutDown; + + procedure Shutdown; protected Threads: array of TncReadyThread; public Serialiser: TCriticalSection; - constructor Create(aWorkerThreadClass: TncReadyThreadClass); + + constructor Create(AWorkerThreadClass: TncReadyThreadClass); destructor Destroy; override; + function RequestReadyThread: TncReadyThread; - procedure RunRequestedThread(aRequestedThread: TncReadyThread); + procedure RunRequestedThread(ARequestedThread: TncReadyThread); - procedure SetExecThreads(aThreadCount: Integer; aThreadPriority: TncThreadPriority); - procedure SetThreadPriority(aPriority: TncThreadPriority); + procedure SetExecThreads(AThreadCount: Integer; AThreadPriority: TncThreadPriority); + procedure SetThreadPriority(APriority: TncThreadPriority); property GrowUpto: Integer read GetGrowUpto write SetGrowUpto; end; function GetNumberOfProcessors: Integer; inline; {$IFDEF MSWINDOWS} -function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): TThreadPriority; inline; -function ToNCThreadPriority(aThreadPriority: TThreadPriority): TncThreadPriority; inline; +function FromNCThreadPriority(AncThreadPriority: TncThreadPriority): TThreadPriority; inline; +function ToNCThreadPriority(AThreadPriority: TThreadPriority): TncThreadPriority; inline; {$ELSE} -function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): Integer; inline; -function ToNCThreadPriority(aThreadPriority: Integer): TncThreadPriority; inline; +function FromNCThreadPriority(AncThreadPriority: TncThreadPriority): Integer; inline; +function ToNCThreadPriority(AThreadPriority: Integer): TncThreadPriority; inline; {$ENDIF} implementation @@ -99,25 +119,31 @@ function GetNumberOfProcessors: Integer; Result := 0; try GetSystemInfo(lpSystemInfo); + for i := 0 to lpSystemInfo.dwNumberOfProcessors - 1 do + begin if lpSystemInfo.dwActiveProcessorMask or (1 shl i) <> 0 then + begin Result := Result + 1; + end; + end; finally if Result < 1 then + begin Result := 1; + end; end; end; {$ELSE} - begin Result := TThread.ProcessorCount; end; {$ENDIF} -{$IFDEF MSWINDOWS} -function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): TThreadPriority; +{$IFDEF MSWINDOWS} +function FromNCThreadPriority(AncThreadPriority: TncThreadPriority): TThreadPriority; begin - case ancThreadPriority of + case AncThreadPriority of ntpIdle: Result := tpIdle; ntpLowest: @@ -135,9 +161,9 @@ function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): TThreadPrio end; end; -function ToNCThreadPriority(aThreadPriority: TThreadPriority): TncThreadPriority; +function ToNCThreadPriority(AThreadPriority: TThreadPriority): TncThreadPriority; begin - case aThreadPriority of + case AThreadPriority of tpIdle: Result := ntpIdle; tpLowest: @@ -155,10 +181,9 @@ function ToNCThreadPriority(aThreadPriority: TThreadPriority): TncThreadPriority end; end; {$ELSE} - -function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): Integer; +function FromNCThreadPriority(AncThreadPriority: TncThreadPriority): Integer; begin - case ancThreadPriority of + case AncThreadPriority of ntpIdle: Result := 19; ntpLowest: @@ -176,9 +201,9 @@ function FromNCThreadPriority(ancThreadPriority: TncThreadPriority): Integer; end; end; -function ToNCThreadPriority(aThreadPriority: Integer): TncThreadPriority; +function ToNCThreadPriority(AThreadPriority: Integer): TncThreadPriority; begin - case aThreadPriority of + case AThreadPriority of 14 .. 19: Result := ntpIdle; 8 .. 13: @@ -196,6 +221,7 @@ function ToNCThreadPriority(aThreadPriority: Integer): TncThreadPriority; end; end; {$ENDIF} + // ***************************************************************************** { TncReadyThread } // ***************************************************************************** @@ -204,13 +230,15 @@ constructor TncReadyThread.Create; begin WakeupEvent := TEvent.Create; ReadyEvent := TEvent.Create; + inherited Create(False); end; destructor TncReadyThread.Destroy; begin - ReadyEvent.Free; - WakeupEvent.Free; + FreeAndNil(ReadyEvent); + FreeAndNil(WakeupEvent); + inherited Destroy; end; @@ -228,14 +256,22 @@ procedure TncReadyThread.Execute; WakeupEvent.ResetEvent; // Next loop will wait again if Terminated then - Break; // Exit main loop + begin + Break; // ==> Exit main loop + end; + try ProcessEvent; except + // Ignore end; + if Terminated then - Break; // Exit main loop + begin + Break; // ==> Exit main loop + end; end; // Exiting main loop terminates thread + ReadyEvent.SetEvent; finally {$IFDEF MSWINDOWS} @@ -249,9 +285,9 @@ function TncReadyThread.IsReady: Boolean; Result := ReadyEvent.WaitFor(0) = wrSignaled; end; -function TncReadyThread.WaitForReady(aTimeOut: Cardinal = Infinite): TWaitResult; +function TncReadyThread.WaitForReady(ATimeOut: Cardinal = Infinite): TWaitResult; begin - Result := ReadyEvent.WaitFor(aTimeOut); + Result := ReadyEvent.WaitFor(ATimeOut); end; procedure TncReadyThread.Run; @@ -264,18 +300,21 @@ procedure TncReadyThread.Run; { TncThreadPool } // ***************************************************************************** -constructor TncThreadPool.Create(aWorkerThreadClass: TncReadyThreadClass); +constructor TncThreadPool.Create(AWorkerThreadClass: TncReadyThreadClass); begin + inherited Create; + Serialiser := TCriticalSection.Create; - ThreadClass := aWorkerThreadClass; + ThreadClass := AWorkerThreadClass; FGrowUpto := 500; // can reach up to 500 threads by default end; destructor TncThreadPool.Destroy; begin - ShutDown; - Serialiser.Free; - inherited; + Shutdown; + FreeAndNil(Serialiser); + + inherited Destroy; end; function TncThreadPool.RequestReadyThread: TncReadyThread; @@ -284,20 +323,23 @@ function TncThreadPool.RequestReadyThread: TncReadyThread; begin // Keep repeating until a ready thread is found repeat - for i := 0 to High(Threads) do + for i := Low(Threads) to High(Threads) do begin if Threads[i].ReadyEvent.WaitFor(0) = wrSignaled then begin Threads[i].ReadyEvent.ResetEvent; Result := Threads[i]; - Exit; + + Exit; // ==> end; end; + // We will get here if no threads were ready - if (Length(Threads) < FGrowUpto) then + if Length(Threads) < FGrowUpto then begin // Create a new thread to handle commands i := Length(Threads); + SetLength(Threads, i + 1); // i now holds High(Threads) try Threads[i] := ThreadClass.Create; @@ -306,91 +348,103 @@ function TncThreadPool.RequestReadyThread: TncReadyThread; // Set length back to what it was, and continue waiting until // any other thread is ready SetLength(Threads, i); - Continue; + Continue; // ==> end; + Threads[i].Priority := Threads[0].Priority; + if Threads[i].ReadyEvent.WaitFor(1000) = wrSignaled then begin Threads[i].ReadyEvent.ResetEvent; Result := Threads[i]; - Exit; + + Exit; // ==> end; - end - else - TThread.Yield; // Was Sleep(1); + end else + begin + TThread.Yield; + end; until False; end; // Between requesting a ready thread and executing it, we normally fill in // the thread's data (would be a descendant that we need to fill known data to work with) -procedure TncThreadPool.RunRequestedThread(aRequestedThread: TncReadyThread); +procedure TncThreadPool.RunRequestedThread(ARequestedThread: TncReadyThread); begin - aRequestedThread.WakeupEvent.SetEvent; + ARequestedThread.WakeupEvent.SetEvent; end; -procedure TncThreadPool.SetExecThreads(aThreadCount: Integer; aThreadPriority: TncThreadPriority); +procedure TncThreadPool.SetExecThreads(AThreadCount: Integer; AThreadPriority: TncThreadPriority); var i: Integer; begin // Terminate any not needed threads - if aThreadCount < Length(Threads) then + if AThreadCount < Length(Threads) then begin - for i := aThreadCount to High(Threads) do - try - Threads[i].Terminate; - Threads[i].WakeupEvent.SetEvent; - except - end; - for i := aThreadCount to high(Threads) do - try - Threads[i].WaitFor; - Threads[i].Free; - except - end; + for i := AThreadCount to High(Threads) do + try + Threads[i].Terminate; + Threads[i].WakeupEvent.SetEvent; + except + // Ignore + end; + + for i := AThreadCount to High(Threads) do + try + Threads[i].WaitFor; + FreeAndNil(Threads[i]); + except + // Ignore + end; end; // Reallocate thread count - SetLength(Threads, aThreadCount); + SetLength(Threads, AThreadCount); - for i := 0 to high(Threads) do + for i := Low(Threads) to High(Threads) do + begin if Threads[i] = nil then begin Threads[i] := ThreadClass.Create; - Threads[i].Priority := FromNCThreadPriority(aThreadPriority); - end - else - Threads[i].Priority := FromNCThreadPriority(aThreadPriority); + Threads[i].Priority := FromNCThreadPriority(AThreadPriority); + end else + begin + Threads[i].Priority := FromNCThreadPriority(AThreadPriority); + end; + end; end; -procedure TncThreadPool.SetThreadPriority(aPriority: TncThreadPriority); +procedure TncThreadPool.SetThreadPriority(APriority: TncThreadPriority); var i: Integer; begin - for i := 0 to high(Threads) do - try - Threads[i].Priority := FromNCThreadPriority(aPriority); - except - // Sone android devices do not like this - end; + for i := Low(Threads) to High(Threads) do + try + Threads[i].Priority := FromNCThreadPriority(APriority); + except + // Sone android devices do not like this + end; end; -procedure TncThreadPool.ShutDown; +procedure TncThreadPool.Shutdown; var i: Integer; begin - for i := 0 to high(Threads) do - try - Threads[i].Terminate; - Threads[i].WakeupEvent.SetEvent; - except - end; + for i := Low(Threads) to High(Threads) do + try + Threads[i].Terminate; + Threads[i].WakeupEvent.SetEvent; + except + // Ignore + end; - for i := 0 to high(Threads) do - try - Threads[i].WaitFor; - Threads[i].Free; - except - end; + for i := Low(Threads) to High(Threads) do + try + Threads[i].WaitFor; + FreeAndNil(Threads[i]); + except + // Ignore + end; end; function TncThreadPool.GetGrowUpto: Integer; @@ -403,11 +457,11 @@ function TncThreadPool.GetGrowUpto: Integer; end; end; -procedure TncThreadPool.SetGrowUpto(const Value: Integer); +procedure TncThreadPool.SetGrowUpto(const AValue: Integer); begin Serialiser.Acquire; try - FGrowUpto := Value; + FGrowUpto := AValue; finally Serialiser.Release; end; diff --git a/Tests/ClientServerTest/ClientServerTest.dpr b/Tests/ClientServerTest/ClientServerTest.dpr new file mode 100644 index 0000000..6bb031e --- /dev/null +++ b/Tests/ClientServerTest/ClientServerTest.dpr @@ -0,0 +1,55 @@ +program ClientServerTest; + +uses + Vcl.Forms, + UClientServerTestForm in 'UClientServerTestForm.pas' {ClientServerTestForm}, + ncCommandHandlers in '..\..\Source\ncCommandHandlers.pas', + ncCommandPacking in '..\..\Source\ncCommandPacking.pas', + ncCompression in '..\..\Source\ncCompression.pas', + ncEncryption in '..\..\Source\ncEncryption.pas', + ncLines in '..\..\Source\ncLines.pas', + ncPendingCommandsList in '..\..\Source\ncPendingCommandsList.pas', + ncSerializeValue in '..\..\Source\ncSerializeValue.pas', + ncSocketList in '..\..\Source\ncSocketList.pas', + ncSockets in '..\..\Source\ncSockets.pas', + ncSources in '..\..\Source\ncSources.pas', + ncThreads in '..\..\Source\ncThreads.pas', + ncEncBlockciphers in '..\..\Source\Encryption\ncEncBlockciphers.pas', + ncEncBlowfish in '..\..\Source\Encryption\ncEncBlowfish.pas', + ncEncCast128 in '..\..\Source\Encryption\ncEncCast128.pas', + ncEncCast256 in '..\..\Source\Encryption\ncEncCast256.pas', + ncEncCrypt2 in '..\..\Source\Encryption\ncEncCrypt2.pas', + ncEncDes in '..\..\Source\Encryption\ncEncDes.pas', + ncEncHaval in '..\..\Source\Encryption\ncEncHaval.pas', + ncEncIce in '..\..\Source\Encryption\ncEncIce.pas', + ncEncIdea in '..\..\Source\Encryption\ncEncIdea.pas', + ncEncMars in '..\..\Source\Encryption\ncEncMars.pas', + ncEncMd4 in '..\..\Source\Encryption\ncEncMd4.pas', + ncEncMd5 in '..\..\Source\Encryption\ncEncMd5.pas', + ncEncMisty1 in '..\..\Source\Encryption\ncEncMisty1.pas', + ncEncRc2 in '..\..\Source\Encryption\ncEncRc2.pas', + ncEncRc4 in '..\..\Source\Encryption\ncEncRc4.pas', + ncEncRc5 in '..\..\Source\Encryption\ncEncRc5.pas', + ncEncRc6 in '..\..\Source\Encryption\ncEncRc6.pas', + ncEncRijndael in '..\..\Source\Encryption\ncEncRijndael.pas', + ncEncRipemd128 in '..\..\Source\Encryption\ncEncRipemd128.pas', + ncEncRipemd160 in '..\..\Source\Encryption\ncEncRipemd160.pas', + ncEncSerpent in '..\..\Source\Encryption\ncEncSerpent.pas', + ncEncSha1 in '..\..\Source\Encryption\ncEncSha1.pas', + ncEncSha256 in '..\..\Source\Encryption\ncEncSha256.pas', + ncEncSha512 in '..\..\Source\Encryption\ncEncSha512.pas', + ncEncTea in '..\..\Source\Encryption\ncEncTea.pas', + ncEncTiger in '..\..\Source\Encryption\ncEncTiger.pas', + ncEncTwofish in '..\..\Source\Encryption\ncEncTwofish.pas'; + +{$R *.res} + +var + ClientServerTestForm: TClientServerTestForm; + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TClientServerTestForm, ClientServerTestForm); + Application.Run; +end. diff --git a/Tests/ClientServerTest/UClientServerTestForm.dfm b/Tests/ClientServerTest/UClientServerTestForm.dfm new file mode 100644 index 0000000..f6e3707 --- /dev/null +++ b/Tests/ClientServerTest/UClientServerTestForm.dfm @@ -0,0 +1,148 @@ +object ClientServerTestForm: TClientServerTestForm + Left = 0 + Top = 0 + Caption = 'Client/Server Test' + ClientHeight = 352 + ClientWidth = 855 + Color = clBtnFace + Constraints.MinHeight = 389 + Constraints.MinWidth = 773 + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -11 + Font.Name = 'Tahoma' + Font.Style = [] + OldCreateOrder = False + Position = poScreenCenter + DesignSize = ( + 855 + 352) + PixelsPerInch = 96 + TextHeight = 13 + object pnlDivider1: TBevel + Left = 193 + Top = 8 + Width = 1 + Height = 25 + Shape = bsLeftLine + end + object pnlDivider2: TBevel + Left = 537 + Top = 8 + Width = 4 + Height = 25 + Shape = bsLeftLine + end + object pnlDivider3: TBevel + Left = 762 + Top = 8 + Width = 4 + Height = 25 + Shape = bsLeftLine + end + object pnlDivider0: TBevel + Left = 100 + Top = 8 + Width = 1 + Height = 25 + Shape = bsLeftLine + end + object edtLog: TMemo + Left = 8 + Top = 39 + Width = 839 + Height = 305 + Anchors = [akLeft, akTop, akRight, akBottom] + ScrollBars = ssBoth + TabOrder = 10 + end + object btnToggleServer: TButton + Left = 107 + Top = 8 + Width = 80 + Height = 25 + Caption = 'Toggle server' + TabOrder = 2 + OnClick = btnToggleServerClick + end + object btnAddClients: TButton + Left = 260 + Top = 8 + Width = 80 + Height = 25 + Caption = 'Add clients' + TabOrder = 4 + OnClick = btnAddClientsClick + end + object btnDeleteClients: TButton + Left = 344 + Top = 8 + Width = 80 + Height = 25 + Caption = 'Delete clients' + TabOrder = 5 + OnClick = btnDeleteClientsClick + end + object bntSendToClients: TButton + Left = 543 + Top = 8 + Width = 104 + Height = 25 + Caption = 'Send to clients' + TabOrder = 7 + OnClick = bntSendToClientsClick + end + object btnSendFromClients: TButton + Left = 652 + Top = 8 + Width = 104 + Height = 25 + Caption = 'Send from clients' + TabOrder = 8 + OnClick = btnSendFromClientsClick + end + object edtClientCount: TSpinEdit + Left = 201 + Top = 9 + Width = 54 + Height = 22 + MaxValue = 4096 + MinValue = 1 + TabOrder = 3 + Value = 1 + end + object btnDeleteAllClients: TButton + Left = 428 + Top = 8 + Width = 104 + Height = 25 + Caption = 'Delete all clients' + TabOrder = 6 + OnClick = btnDeleteClientsClick + end + object btnReset: TButton + Left = 768 + Top = 8 + Width = 80 + Height = 25 + Caption = 'Reset' + TabOrder = 9 + OnClick = btnResetClick + end + object edtSocketTypeTCP: TRadioButton + Left = 8 + Top = 11 + Width = 40 + Height = 17 + Caption = 'TCP' + TabOrder = 0 + end + object edtSocketTypeUDP: TRadioButton + Left = 54 + Top = 11 + Width = 40 + Height = 17 + Caption = 'UDP' + TabOrder = 1 + end +end diff --git a/Tests/ClientServerTest/UClientServerTestForm.pas b/Tests/ClientServerTest/UClientServerTestForm.pas new file mode 100644 index 0000000..0124b92 --- /dev/null +++ b/Tests/ClientServerTest/UClientServerTestForm.pas @@ -0,0 +1,763 @@ +unit UClientServerTestForm; + +interface + +// Written for Delphi 10.4.2 by Andreas Toth (andreas.toth@xtra.co.nz) + +// WARNING: Since, currently, there is no way of differentiating TCP clients +// from each other, the TCP version of this test is limited to all +// clients being created and destroyed by a single instance of this +// code, something that is assumed(!) to be done in LIFO order! + +// WARNING: Since UDP clients don't provide a reply server, nor communicate a +// reply port, there's no way for the server to message clients! + +// WARNING: Creating clients (UDP/TCP) without having first created the server +// will cause synchronisation issues (and possibly AVs) once the +// server has been created! + +// WARNING: Toggling the socket type during a session can result in undefined +// behaviour! + +// WARNING: Data message strings are not escaped so be careful if you intend to +// base code on this rather basic implementation. + +uses + Vcl.Forms, + Vcl.Controls, + Vcl.StdCtrls, + Vcl.ExtCtrls, + Vcl.Samples.Spin, + System.SysUtils, + System.Classes, + System.Generics.Collections, + ncSockets, + ncLines; + +type + TClientServerTestForm = class(TForm) + edtSocketTypeTCP: TRadioButton; + edtSocketTypeUDP: TRadioButton; + pnlDivider0: TBevel; + btnToggleServer: TButton; + pnlDivider1: TBevel; + edtClientCount: TSpinEdit; + btnAddClients: TButton; + btnDeleteClients: TButton; + btnDeleteAllClients: TButton; + pnlDivider2: TBevel; + bntSendToClients: TButton; + btnSendFromClients: TButton; + pnlDivider3: TBevel; + btnReset: TButton; + edtLog: TMemo; + + procedure btnToggleServerClick(Sender: TObject); + procedure btnAddClientsClick(Sender: TObject); + procedure btnDeleteClientsClick(Sender: TObject); + procedure bntSendToClientsClick(Sender: TObject); + procedure btnSendFromClientsClick(Sender: TObject); + procedure btnResetClick(Sender: TObject); + private // Server + const + CServer = 'Server'; + type + TServer = TncCustomSocketServer; + + TServerClient = class + Connection: TncLine; // TCP + Host: string; // UDP + Port: string; // UDP + ID: Integer; + end; + + TServerClientList = System.Generics.Collections.TObjectList; + private + FServer: TServer; + FServerClients: TServerClientList; + + procedure HandleTCPServerOnConnected(Sender: TObject; ALine: TncLine); + procedure HandleTCPServerOnDisconnected(Sender: TObject; ALine: TncLine); + + procedure SendDataMessageToClient(const AIndex: Integer; const AData: string); + + procedure HandleTCPServerOnReadData(Sender: TObject; ALine: TncLine; const ABuffer: TBytes; ABufferSize: Integer); + procedure HandleUDPServerOnReadData(Sender: TObject; ALine: TncLine; const ABuffer: TBytes; ABufferSize: Integer); + + function ServerName: string; + function ServerSide_ClientName(const AClient: TServerClient): string; + private // Client + const + CClient = 'Client'; + type + TClient = TncCustomSocketClient; + TClientList = System.Generics.Collections.TObjectList; + private + FClients: TClientList; + + procedure SendDataMessageToServer(const AID: Integer; const AData: string); + procedure HandleClientOnReadData(Sender: TObject; ALine: TncLine; const ABuffer: TBytes; ABufferSize: Integer); + + function ClientSide_ClientName(const AType: TSocketType; const AID: Integer): string; + private // Common + const + CNameDelimiter = '-'; + CUnexpectedDataMessageSuffix = ' <<< UNEXPECTED >>>'; + CUDPAddClient = 'AddClient'; + CUDPDeleteClient = 'DeleteClient'; + private + function CurrentSocketType: TSocketType; + + function FormatTypedName(const AType: TSocketType; const AName: string): string; + function UnknownClientName(const AType: TSocketType): string; + + function WrapDataMessage(const ABy: string; const AFor: string; const AData: string): AnsiString; + procedure UnwrapDataMessage(const ADataMessage: AnsiString; out AValid: Boolean; out ABy: string; out AFor: string; out AData: string); overload; + procedure UnwrapDataMessage(const ABuffer: TBytes; const ACount: Integer; out AValid: Boolean; out ABy: string; out AFor: string; out AData: string); overload; + + function IsValidDataMessageAddressing(const ASource: string; const ADestination: string; const ABy: string; const AFor: string): Boolean; + private // Log + procedure Log(const AMessage: string); + + procedure LogCreated(const AName: string); + procedure LogDestroyed(const AName: string); + function FormatLogDestroyed(const AName: string): string; + + function FormatLogDataMessage(const ADataMessage: AnsiString): string; + + procedure LogDataSent(const ASource: string; const ADestination: string; const AData: AnsiString); + procedure LogDataReceived(const ASource: string; const ADestination: string; const ABuffer: TBytes; const ACount: Integer; const ASuffix: string = ''); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + +implementation + +{$R *.dfm} + +uses + System.Types, + System.StrUtils, + System.Diagnostics, + Winapi.Windows, + Winapi.WinSock2, + ncSocketList; + +type + TncLineAccess = class(TncLine); + +{ TClientServerTestForm } + +constructor TClientServerTestForm.Create(AOwner: TComponent); +begin + inherited; + + FServer := nil; + FServerClients := nil; + + FClients := nil; + + case TncLineAccess.DefaultKind of + stTCP: edtSocketTypeTCP.Checked := True; + stUDP: edtSocketTypeUDP.Checked := True; + else + raise Exception.Create('Unhandled default socket type'); + end; +end; + +destructor TClientServerTestForm.Destroy; +begin + FreeAndNil(FClients); + + FreeAndNil(FServerClients); + FreeAndNil(FServer); + + inherited; +end; + +procedure TClientServerTestForm.Log(const AMessage: string); +begin + edtLog.Lines.Add(AMessage); +end; + +procedure TClientServerTestForm.LogCreated(const AName: string); +begin + Log(AName + ' created'); +end; + +procedure TClientServerTestForm.LogDestroyed(const AName: string); +begin + Log(FormatLogDestroyed(AName)); +end; + +function TClientServerTestForm.FormatLogDestroyed(const AName: string): string; +begin + Result := AName + ' destroyed'; +end; + +function TClientServerTestForm.FormatLogDataMessage(const ADataMessage: AnsiString): string; +begin + Result := '(Message = <' + string(ADataMessage) + '>)'; +end; + +procedure TClientServerTestForm.LogDataSent(const ASource: string; const ADestination: string; const AData: AnsiString); +begin + Log(ASource + ' sent data to ' + ADestination + ' ' + FormatLogDataMessage(AData)); +end; + +procedure TClientServerTestForm.LogDataReceived(const ASource: string; const ADestination: string; const ABuffer: TBytes; const ACount: Integer; const ASuffix: string); +begin + var LValid: Boolean; + var LBy: string; + var LFor: string; + begin + var LData: string; + UnwrapDataMessage(ABuffer, ACount, LValid, LBy, LFor, LData); + end; + + var LSuffix: string := ''; + + if not LValid then + begin + LSuffix := ' <<< CORRUPT >>>'; + end else + begin + LValid := IsValidDataMessageAddressing(ASource, ADestination, LBy, LFor); + + if not LValid then + begin + LSuffix := ' <<< INVALID >>>'; + end; + end; + + LSuffix := LSuffix + ASuffix; + + var LData: AnsiString; + SetLength(LData, ACount); + Move(Pointer(ABuffer)^, Pointer(LData)^, ACount); + Log(ADestination + ' received data from ' + ASource + ' ' + FormatLogDataMessage(LData) + LSuffix); +end; + +function TClientServerTestForm.ServerName: string; +begin + if Assigned(FServer) then + begin + Result := FormatTypedName(FServer.Kind, CServer); + end else + begin + Result := FormatTypedName(CurrentSocketType, CServer); + end; +end; + +function TClientServerTestForm.ServerSide_ClientName(const AClient: TServerClient): string; +begin + if Assigned(AClient) then + begin + var LKind: TSocketType; + + if Assigned(AClient.Connection) then + begin + LKind := AClient.Connection.Kind; + end else + begin + LKind := stUDP; + end; + + Result := ClientSide_ClientName(LKind, AClient.ID); + end else + begin + Result := UnknownClientName(CurrentSocketType); + end; +end; + +function TClientServerTestForm.ClientSide_ClientName(const AType: TSocketType; const AID: Integer): string; +begin + Result := FormatTypedName(AType, CClient + IntToStr(AID)); +end; + +function TClientServerTestForm.CurrentSocketType: TSocketType; +begin + if edtSocketTypeTCP.Checked then + begin + Result := stTCP; + end else if edtSocketTypeUDP.Checked then + begin + Result := stUDP; + end else + begin + raise Exception.Create('Unhandled socket type'); + end; +end; + +function TClientServerTestForm.FormatTypedName(const AType: TSocketType; const AName: string): string; +begin + Result := CSocketTypeNames[AType] + CNameDelimiter + AName; +end; + +function TClientServerTestForm.UnknownClientName(const AType: TSocketType): string; +begin + Result := FormatTypedName(AType, CClient + '?'); +end; + +function TClientServerTestForm.WrapDataMessage(const ABy: string; const AFor: string; const AData: string): AnsiString; +begin + Result := AnsiString('By = ' + ABy + '; For = ' + AFor + '; Data = ' + AData); +end; + +procedure TClientServerTestForm.UnwrapDataMessage(const ADataMessage: AnsiString; out AValid: Boolean; out ABy: string; out AFor: string; out AData: string); +const + CDelimiters = ' ;='; + CByIndex = 3; + CForIndex = 8; + CMessageIndex = 13; + CUnknownString = ''; + CUnknownInteger = -1; +begin + var LReferenceDataMessage: AnsiString := WrapDataMessage(ServerName, ClientSide_ClientName(CurrentSocketType, 0), '0'); // NOTE: Dummy names used + var LReferenceStrings: TStringDynArray := SplitString(string(LReferenceDataMessage), CDelimiters); + var LReferenceLength: Integer := Length(LReferenceStrings); + + var LStrings: TStringDynArray := SplitString(string(ADataMessage), CDelimiters); + var LLength: Integer := Length(LStrings); + + AValid := LLength = LReferenceLength; + + if CByIndex < LLength then + begin + ABy := LStrings[CByIndex]; + end else + begin + AValid := False; + ABy := CUnknownString; + end; + + if CForIndex < LLength then + begin + AFor := LStrings[CForIndex]; + end else + begin + AValid := False; + AFor := CUnknownString; + end; + + if CMessageIndex < LLength then + begin + AData := LStrings[CMessageIndex]; + end else + begin + AValid := False; + AFor := CUnknownString; + end; +end; + +procedure TClientServerTestForm.UnwrapDataMessage(const ABuffer: TBytes; const ACount: Integer; out AValid: Boolean; out ABy: string; out AFor: string; out AData: string); +begin + var LData: AnsiString; + SetLength(LData, ACount); + Move(Pointer(ABuffer)^, Pointer(LData)^, ACount); + + UnwrapDataMessage(LData, AValid, ABy, AFor, AData); +end; + +function TClientServerTestForm.IsValidDataMessageAddressing(const ASource: string; const ADestination: string; const ABy: string; const AFor: string): Boolean; +begin + Result := (ABy = ASource) and (AFor = ADestination); +end; + +procedure TClientServerTestForm.HandleTCPServerOnConnected(Sender: TObject; ALine: TncLine); +begin + if not Assigned(FServerClients) then + begin + FServerClients := TServerClientList.Create; + FServerClients.OwnsObjects := True; + end; + + var LClient := TServerClient.Create; + LClient.Connection := ALine; + LClient.ID := FServerClients.Count; + + FServerClients.Add(LClient); + + LogCreated(ServerName + ServerSide_ClientName(LClient)); +end; + +procedure TClientServerTestForm.HandleTCPServerOnDisconnected(Sender: TObject; ALine: TncLine); +begin + var LClient: TServerClient := FServerClients[FServerClients.Count - 1]; + var LMessage: string := FormatLogDestroyed(ServerName + ServerSide_ClientName(LClient)); + + Assert(LClient.Connection = ALine); + FServerClients.Delete(FServerClients.Count - 1); + + if FServerClients.Count = 0 then + begin + FreeAndNil(FServerClients); + end; + + Log(LMessage); +end; + +procedure TClientServerTestForm.SendDataMessageToClient(const AIndex: Integer; const AData: string); +begin + var LClient: TServerClient := FServerClients[AIndex]; + var LSource: string := ServerSide_ClientName(LClient); + var LDestination: string := ServerName; + var LDataMessage: AnsiString := WrapDataMessage(LSource, LDestination, AData); + + if Assigned(LClient.Connection) then + begin + FServer.Send(LClient.Connection, string(LDataMessage)); + end else + begin + Exit; // ==> TODO: FServer.Send(LClient.Host, LClient.Port, string(LDataMessage)); + end; + + LogDataSent(LSource, LDestination, LDataMessage); +end; + +procedure TClientServerTestForm.HandleTCPServerOnReadData(Sender: TObject; ALine: TncLine; const ABuffer: TBytes; ABufferSize: Integer); +begin + var LSource: string := UnknownClientName(ALine.Kind); + var LDestination: string := ServerName; + + FServer.Lines.LockList; + try + if Assigned(FServerClients) then + begin + for var LIndex: Integer := 0 to FServerClients.Count - 1 do + begin + var LClient: TServerClient := FServerClients[LIndex]; + + if LClient.Connection = ALine then + begin + LSource := ServerSide_ClientName(LClient); + LogDataReceived(LSource, LDestination, ABuffer, ABufferSize); + + Exit; // ==> + end; + end; + end; + + LogDataReceived(LSource, LDestination, ABuffer, ABufferSize, CUnexpectedDataMessageSuffix); + finally + FServer.Lines.UnlockList; + end; +end; + +procedure TClientServerTestForm.SendDataMessageToServer(const AID: Integer; const AData: string); +begin + var LClient := FClients[AID]; + var LSource: string := ClientSide_ClientName(LClient.Line.Kind, AID); + var LDestination: string := ServerName; + var LDataMessage: AnsiString := WrapDataMessage(LSource, LDestination, AData); + + LClient.Send(string(LDataMessage)); + LogDataSent(LSource, LDestination, LDataMessage); +end; + +procedure TClientServerTestForm.HandleUDPServerOnReadData(Sender: TObject; ALine: TncLine; const ABuffer: TBytes; ABufferSize: Integer); +begin + FServer.Lines.LockList; + try + var LSource: string := UnknownClientName(ALine.Kind);; + var LDestination: string := ServerName; + + var LValid: Boolean; + var LBy: string; + var LFor: string; + var LData: string; + UnwrapDataMessage(ABuffer, ABufferSize, LValid, LBy, LFor, LData); + + var LClient: TServerClient := nil; + + if Assigned(FServerClients) then + begin + for var LIndex: Integer := 0 to FServerClients.Count - 1 do + begin + LClient := FServerClients[LIndex]; + + if (LClient.Host = ALine.PeerIP) and (LClient.Port = LBy{LPort}) then + begin + Break; // ==> + end; + + LClient := nil; + end; + end; + + var LExpected: Boolean := False; + var LDeleteMessage: string := ''; + + if not Assigned(LClient) then + begin + if LData = CUDPAddClient then + begin + LExpected := True; + + if LValid then + begin + if not Assigned(FServerClients) then + begin + FServerClients := TServerClientList.Create; + FServerClients.OwnsObjects := True; + end; + + LClient := TServerClient.Create; + LClient.Connection := nil; + LClient.Host := ALine.PeerIP; + LClient.Port := LBy{LPort}; + LClient.ID := FServerClients.Count; + + FServerClients.Add(LClient); + + LogCreated(ServerName + ServerSide_ClientName(LClient)); + + LSource := ServerSide_ClientName(LClient); + LValid := LValid and IsValidDataMessageAddressing(LSource, LDestination, LBy, LFor); + + if not LValid then + begin + // Error!!! + end; + end; + end; + end else + begin + LSource := ServerSide_ClientName(LClient); + LValid := LValid and IsValidDataMessageAddressing(LSource, LDestination, LBy, LFor); + + if LData <> CUDPAddClient then + begin + LExpected := True; + + if LValid and (LData = CUDPDeleteClient) then + begin + LDeleteMessage := FormatLogDestroyed(ServerName + ServerSide_ClientName(LClient)); + FServerClients.Delete(FServerClients.Count - 1); + + if FServerClients.Count = 0 then + begin + FreeAndNil(FServerClients); + end; + end; + end; + end; + + var LSuffix: string := '';; + + if not LExpected then + begin + LSuffix := CUnexpectedDataMessageSuffix; + end; + + LogDataReceived(LSource, LDestination, ABuffer, ABufferSize, LSuffix); + + if LDeleteMessage <> '' then + begin + Log(LDeleteMessage); + end; + finally + FServer.Lines.UnlockList; + end; +end; + +procedure TClientServerTestForm.HandleClientOnReadData(Sender: TObject; ALine: TncLine; const ABuffer: TBytes; ABufferSize: Integer); +begin + var LSource: string := ServerName; + var LDestination: string := UnknownClientName(ALine.Kind); + + for var LIndex: Integer := 0 to FClients.Count - 1 do + begin + var LClient: TClient := FClients[LIndex]; + + if LClient = Sender then + begin + LDestination := ClientSide_ClientName(LClient.Line.Kind, LIndex); + LogDataReceived(LDestination, LSource, ABuffer, ABufferSize); + + Exit; // ==> + end; + end; + + LogDataReceived(LDestination, LSource, ABuffer, ABufferSize, CUnexpectedDataMessageSuffix); +end; + +procedure TClientServerTestForm.btnToggleServerClick(Sender: TObject); + + function SocketTypeToServerClass(const ASocketType: TSocketType): TncCustomSocketServerClass; + begin + case ASocketType of + stTCP: Result := TncTCPServer; + stUDP: Result := TncUDPServer; + else + Result := nil; + end; + end; + +begin + if not Assigned(FServer) then + begin + FServer := SocketTypeToServerClass(CurrentSocketType).Create(nil); + + case FServer.Kind of + stTCP: + begin + FServer.OnReadData := HandleTCPServerOnReadData; + FServer.OnConnected := HandleTCPServerOnConnected; + FServer.OnDisconnected := HandleTCPServerOnDisconnected; + end; + stUDP: + begin + FServer.OnReadData := HandleUDPServerOnReadData; + end; + else + // Do nothing + end; + + FServer.EventsUseMainThread := True; + FServer.Active := True; + + LogCreated(ServerName); + end else + begin + var LName: string := ServerName; + + FreeAndNil(FServer); + FreeAndNil(FServerClients); + + LogDestroyed(LName); + end; +end; + +procedure TClientServerTestForm.btnAddClientsClick(Sender: TObject); + + function SocketTypeToClientClass(const ASocketType: TSocketType): TncCustomSocketClientClass; + begin + case ASocketType of + stTCP: Result := TncTCPClient; + stUDP: Result := TncUDPClient; + else + Result := nil; + end; + end; + +begin + if not Assigned(FClients) then + begin + FClients := TClientList.Create; + FClients.OwnsObjects := True; + end; + + var LCount: Integer := edtClientCount.Value; + var LClass: TncCustomSocketClientClass := SocketTypeToClientClass(CurrentSocketType); + + for var LIndex: Integer := 0 to LCount - 1 do + begin + var LClient: TncCustomSocketClient := LClass.Create(nil); + LClient.OnReadData := HandleClientOnReadData; + LClient.EventsUseMainThread := True; + FClients.Add(LClient); + LClient.Active := True; + + var LID: Integer := FClients.Count - 1; + LogCreated(ClientSide_ClientName(LClient.Line.Kind, LID)); + + if not LClient.IsConnectionBased then + begin + SendDataMessageToServer(LID, CUDPAddClient); + end; + end; +end; + +procedure TClientServerTestForm.btnDeleteClientsClick(Sender: TObject); +begin + if not Assigned(FClients) then + begin + Exit; // ==> + end; + + var LCount: Integer; + + if Sender = btnDeleteClients then + begin + LCount := edtClientCount.Value; + end else + begin + Assert(Sender = btnDeleteAllClients); + LCount := FClients.Count; + end; + + for var LIndex: Integer := 0 to LCount - 1 do + begin + var LID: Integer := FClients.Count - 1; + var LClient := FClients[LID]; + + var LMessage: string := FormatLogDestroyed(ClientSide_ClientName(LClient.Kind, LID)); + + if not LClient.IsConnectionBased then + begin + SendDataMessageToServer(LID, CUDPDeleteClient); + end; + + FClients.Delete(LID); + + if FClients.Count = 0 then + begin + FreeAndNil(FClients); + end; + + Log(LMessage); + + if not Assigned(FClients) then + begin + Exit; // ==> + end; + end; +end; + +procedure TClientServerTestForm.bntSendToClientsClick(Sender: TObject); +begin + if not Assigned(FServer) then + begin + Exit; // ==> + end; + + FServer.Lines.LockList; + try + if Assigned(FServerClients) then + begin + for var LIndex: Integer := 0 to FServerClients.Count - 1 do + begin + SendDataMessageToClient(LIndex, IntToStr(LIndex)); + end; + end; + finally + FServer.Lines.UnlockList; + end; +end; + +procedure TClientServerTestForm.btnSendFromClientsClick(Sender: TObject); +begin + if not Assigned(FClients) then + begin + Exit; // ==> + end; + + for var LIndex: Integer := 0 to FClients.Count - 1 do + begin + SendDataMessageToServer(LIndex, IntToStr(LIndex)); + end; +end; + +procedure TClientServerTestForm.btnResetClick(Sender: TObject); +begin + FreeAndNil(FClients); + + FreeAndNil(FServerClients); + FreeAndNil(FServer); + + Log('Reset'); +end; + +end.