fastertcp.pas

faster tcp companents delphi

{*************************************************************}
{                     IMPORTANT NOTE:                         }
{ This software is provided 'as-is', without any express or   }
{ implied warranty. In no event will the author be held       }
{ liable for any damages arising from the use of this         }
{ software.                                                   }
{ Permission is granted to anyone to use this software for    }
{ any purpose, including commercial applications, and to      }
{ alter it and redistribute it freely, subject to the         }
{ following restrictions:                                     }
{ 1. The origin of this software must not be misrepresented,  }
{    you must not claim that you wrote the original software. }
{    If you use this software in a product, an acknowledgment }
{    in the product documentation would be appreciated but is }
{    not required.                                            }
{ 2. Altered source versions must be plainly marked as such,  }
{    and must not be misrepresented as being the original     }
{    software.                                                }
{ 3. This notice may not be removed or altered from any       }
{    source distribution.                                     }
{*************************************************************}

{                               VERSION : 1.05                               }
{                                                                            }
{ This unit have been created by Jyrki Kyll鰊en. This is my version of what  }
{ Winsock TCP/IP programming should be all about.                            }
{ See README for more notes.                                                 }

{$IFNDEF VER80}          {Delphi 1}
 {$IFNDEF VER90}         {Delphi 2}
  {$IFNDEF VER93}        {BCB 1}
   {$DEFINE D3}          {* Delphi 3 or higher}
   {$IFNDEF VER100}      {Delphi 3}
    {$IFNDEF VER110}     {BCB 3}
     {$DEFINE D4}        {* Delphi 4 or higher}
     {$IFNDEF VER120}    {Delphi 4}
      {$IFNDEF VER125}   {BCB 4}
       {$DEFINE D5}      {* Delphi 5 or higher}
       {$IFNDEF VER130}  {Delphi/BCB 5}
        {$ObjExportAll On}
        {$WARN SYMBOL_PLATFORM OFF}
        {$DEFINE D6}     {* Delphi 6 or higher}
        {$IFNDEF VER140}  {Delphi/BCB 6}
         {$DEFINE D7}
         {$IFNDEF VER150} {Delphi/BCB 7}
           { * delphi 8? * }
         {$ENDIF}
        {$ENDIF}
       {$ENDIF}
      {$ENDIF}
     {$ENDIF}
    {$ENDIF}
   {$ENDIF}
  {$ENDIF}
 {$ENDIF}
{$ENDIF}

{$IFDEF D7}
  {$WARN UNIT_DEPRECATED OFF}
  {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}

unit FasterTCP;
{$DEFINE DEBUGMODEON} 
{Can also use INT64_STREAMS}
{$H+}
interface

uses
  Windows, Messages, Classes, WinSock, PacketLists ;  { ### Now PacketLists are waiting for future use. }

const
  SYNCSELECT_ID = WM_USER + $0001;
  {Packet structure: Size(4 bytes)|Command(4 bytes)|data}
  OWN_ID = 1000;
  StreamSize_of_Size = {$IFDEF INT64_STREAMS} SizeOf(Int64) {$ELSE} SizeOf(LongInt){$ENDIF};

type
TPingStatus = (PingOK,WaitingPing);
TFasterHeader = record
  Size: LongInt;
  Command: LongInt;
 end;

  TFasterTCPServerClient = class; //defined here so that declaration of Events wont raise error about it

  TFasterTCPAcceptEvent =                procedure(Sender: TObject; Client: TFasterTCPServerClient; var Accept: Boolean) of object;
  TFasterTCPClientDataReceivedEvent =    procedure(Sender: TObject; DataSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF}; DataInfo: String) of object;
  TFasterTCPClientDataAvailEvent =       procedure(Sender: TObject; Data: TMemoryStream; DataSize: LongInt) of object;
  TFasterTCPClientIOEvent =              procedure(Sender: TObject; TheMessage: String) of object;
  TFasterTCPClientNewStreamComingEvent = procedure(Sender: TObject; StreamSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF}; DataInfo: String; Var Accept: Boolean) of object;
  TFasterTCPClientUnknownIDEvent =       procedure(Sender: TObject; Data: TMemoryStream; ID: LongInt) of object;
  TFasterTCPErrorEvent =                 procedure(Sender: TObject; Socket: TSocket; ErrorCode: LongInt; ErrorMsg: String) of object;
  TFasterTCPRegisterUserEvent =          procedure(Sender: TObject; Client: TFasterTCPServerClient; Var DontLetIn: Boolean; TheRoom,TheUserName : PChar) of object;
  TFasterTCPServerDataReceivedEvent =    procedure(Sender: TObject; Client: TFasterTCPServerClient; DataSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF}; DataInfo: String) of object;
  TFasterTCPServerDataAvailEvent =       procedure(Sender: TObject; Client: TFasterTCPServerClient; Data: TMemoryStream; DataSize: LongInt) of object;
  TFasterTCPServerEvent =                procedure(Sender: TObject; Client: TFasterTCPServerClient) of object;
  TFasterTCPServerIOEvent =              procedure(Sender: TObject; Client: TFasterTCPServerClient; TheMessage: String) of object;
  TFasterTCPServerNewStreamComingEvent = procedure(Sender: TObject; Client: TFasterTCPServerClient; StreamSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF}; DataInfo: String; Var Accept: Boolean) of object;
  TFasterTCPServerTimeOutEvent =         procedure(Sender: TObject; Client: TFasterTCPServerClient; Var ForceDisconnectClient: Boolean) of object;
  TFasterTCPServerUnknownIDEvent =       procedure(Sender: TObject; Client: TFasterTCPServerClient; Data: TMemoryStream; ID: LongInt) of object;

  TCustomFasterSocket = class(TComponent)
  private
    FAllowChangeHostAndPortOnConnection: Boolean;
    FHost: String;
    FPort: Word;
    FSocket: TSocket;

    FOnError: TFasterTCPErrorEvent;

    {$IFDEF DEBUGMODEON}
    FDebugInfo: TStringList;
    {$ENDIF}

    HostEnt: PHostEnt;
//    SelfClassType: LongInt;   {### Not needed in this version}
    SockAddrIn: TSockAddrIn;
    WindowHandle: hWnd;

    function    ReceiveFrom(Const Socket: TSocket; Buffer: PChar; BufLength: LongInt; ReceiveCompletely: Boolean): LongInt; // returns N of bytes read
    function    ReceiveStreamFrom(Const Socket: TSocket; Stream: TMemoryStream; DataSize: LongInt; ReceiveCompletely: Boolean): Boolean;
    function    SendBufferTo(Const Socket: TSocket; Buffer: Pointer; BufLength: LongInt): LongInt; // returns N of bytes sent
    function    SendStreamTo(Const Socket: TSocket; Client: TFasterTCPServerClient; Stream: TStream; Size: LongInt): LongInt; // returns N of bytes sent

    function    SendPacketTo(Socket: TSocket; Packet: TFasterPacket; AutoFreePointer: Boolean): LongInt;

    procedure   ProcessTCPSelect(var Msg: TMessage); message SYNCSELECT_ID;
    procedure   WndProc(var Message: TMessage); virtual;
  protected  
    // For internal use
    FConnections: TList;

    procedure   DoAccept; virtual; abstract;
    procedure   DoClose(Socket: TSocket); virtual; abstract;
    procedure   DoConnect; virtual; abstract;
    Procedure   ProcessCommands(Client: TFasterTCPServerClient; Data: TMemoryStream; Command: LongInt); virtual; abstract;
    procedure   SetHost(Value: String); virtual; abstract;
    procedure   SetPort(Value: Word); virtual; abstract;
    procedure   SocketError(Socket: TSocket; ErrorCode: LongInt); virtual;
  public
    constructor Create(aOwner: TComponent); override;
    destructor  Destroy; override;
    property    AllowChangeHostAndPortOnConnection: Boolean read FAllowChangeHostAndPortOnConnection write FAllowChangeHostAndPortOnConnection default False;
    property    Host: String read FHost write SetHost;
    property    OnError: TFasterTCPErrorEvent read FOnError write FOnError;
    property    Port: Word read FPort write SetPort default 0;
    property    Socket: TSocket read FSocket write FSocket;

    {$IFDEF DEBUGMODEON}
      property  DebugInfo: TStringList read FDebugInfo write FDebugInfo;
    {$ENDIF}
  end;

  { TFasterTCPServer }
  TFasterTCPServer = class(TCustomFasterSocket)
  private
    FAllowSameUserNames: Boolean;
    FListen: Boolean;
    //FSendPacketsImmediately: Boolean; { ### Not used for anything in this version }
    FOnAccept: TFasterTCPAcceptEvent;
    FOnClientAcceptStream: TFasterTCPServerEvent;
    FOnClientConnected: TFasterTCPServerEvent;
    FOnClientDenyStream: TFasterTCPServerEvent;
    FOnClientDisconnected: TFasterTCPServerEvent;
    FOnClientMessageCome: TFasterTCPServerIOEvent;
    FOnClientNeedMoreData: TFasterTCPServerEvent;
    FOnClientPacketCome: TFasterTCPServerDataAvailEvent;
    FOnClientPong: TFasterTCPServerEvent;
    FOnClientReceivedStream: TFasterTCPServerEvent;
    FOnClientStopReceivingStream: TFasterTCPServerEvent;
    FOnClientStopSendingStream: TFasterTCPServerEvent;
    FOnClientTimeOut: TFasterTCPServerTimeOutEvent;
    FOnNewStreamComing: TFasterTCPServerNewStreamComingEvent;
    FOnServerGetUserName :TFasterTCPRegisterUserEvent;
    FOnStreamReceived: TFasterTCPServerDataReceivedEvent;
    FOnUnknownPacketID: TFasterTCPServerUnknownIDEvent;

    function    GetLocalHostName: String;
    function    GetLocalIP: String;
    
    Procedure   SendCommand(Client: TFasterTCPServerClient; Command, CommandDataSize: LongInt; Data: TMemoryStream; Immediately: Boolean);
    //Procedure   SendWaitingPackets(Client: TFasterTCPServerClient); {### Not needed in this version.}

    procedure   SetNoneStr(Value: String); //Does nothing, but allows user to access the LocalHostName and -IP properties. User can't access read-only values on DesignMode.
  protected

    procedure   DoAccept; override;
    procedure   DoClose(Socket: TSocket); override;                                                      
    procedure   DoMessageCome(Client: TFasterTCPServerClient; Const ProcessedMessage: String);
    procedure   DoPacketCome(Client: TFasterTCPServerClient; Data: TMemoryStream; DataSize: LongInt); 
    Procedure   ProcessCommands(Client: TFasterTCPServerClient; Data: TMemoryStream; Command: LongInt); override;  
    procedure   SocketError(Socket: TSocket; ErrorCode: LongInt); override;
    procedure   SetListen(Value: Boolean); virtual;
    procedure   SetPort(Value: Word); override;
  public
    constructor Create(aOwner: TComponent); override;
    procedure   AskMoreData(Client: TFasterTCPServerClient);
    procedure   AskToReceiveStream(Client: TFasterTCPServerClient; Const DataSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF};
                                   Const DataInfo: String);
    procedure   Broadcast(Buffer: PChar; BufLength: LongInt);
    procedure   BroadcastStream(Stream: TStream; SendSize: LongInt);
    property    Clients: TList read FConnections;
    destructor  Destroy; override;
    procedure   DisconnectAClient(Client: TFasterTCPServerClient);
    procedure   DisconnectEveryone;
    procedure   KickOutAClient(Client: TFasterTCPServerClient);
    procedure   MakeRoomUserNameList(Const RoomName: String; var TheList: TStringList);
    procedure   MakeUserNameList(var TheList: TStringList);
    Function    Send(Client: TFasterTCPServerClient; Buffer: PChar; BufLength: LongInt): Longint;
    Function    SendCustomPacket(Client: TFasterTCPServerClient; ID, DataSize: LongInt; Data: TStream; AutoFreeData: Boolean): LongInt;
    Function    SendCustomPacketEx(Client: TFasterTCPServerClient; ID, DataSize: LongInt; Data: Pointer): LongInt;
    Procedure   SendStream(Client: TFasterTCPServerClient; Stream: TStream; Size: LongInt); 
    procedure   StopReceivingData(Client: TFasterTCPServerClient);
    procedure   StopSendingData(Client: TFasterTCPServerClient);
    procedure   UpdatePingStatuses;
  published
    property    AllowChangeHostAndPortOnConnection;
    property    AllowSameUserNames: Boolean read FAllowSameUserNames write FAllowSameUserNames;
    property    Listen: Boolean read FListen write SetListen stored False;
    property    LocalHostName: String read GetLocalHostName write SetNoneStr stored False;
    property    LocalIP: String read GetLocalIP write SetNoneStr stored False;
    property    Port;
    //property    SendPacketsImmediately: Boolean read FSendPacketsImmediately Write FSendPacketsImmediately;

    property    OnAccept: TFasterTCPAcceptEvent read FOnAccept write FOnAccept;
    property    OnClientAcceptStream: TFasterTCPServerEvent read FOnClientAcceptStream write FOnClientAcceptStream;
    property    OnClientConnected: TFasterTCPServerEvent read FOnClientConnected write FOnClientConnected;
    property    OnClientDenyStream: TFasterTCPServerEvent read FOnClientDenyStream write FOnClientDenyStream;
    property    OnClientDisconnected: TFasterTCPServerEvent read FOnClientDisconnected write FOnClientDisconnected;
    property    OnClientMessageCome: TFasterTCPServerIOEvent read FOnClientMessageCome write FOnClientMessageCome;
    property    OnClientNeedMoreData: TFasterTCPServerEvent read FOnClientNeedMoreData write FOnClientNeedMoreData;
    property    OnClientPacketCome: TFasterTCPServerDataAvailEvent read FOnClientPacketCome write FOnClientPacketCome;
    property    OnClientPong: TFasterTCPServerEvent read FOnClientPong write FOnClientPong;
    property    OnClientReceivedStream: TFasterTCPServerEvent read FOnClientReceivedStream write FOnClientReceivedStream;
    property    OnClientStopReceivingStream: TFasterTCPServerEvent read FOnClientStopReceivingStream write FOnClientStopReceivingStream;
    property    OnClientStopSendingStream: TFasterTCPServerEvent read FOnClientStopSendingStream write FOnClientStopSendingStream;
    property    OnClientTimeOut: TFasterTCPServerTimeOutEvent read FOnClientTimeOut Write FOnClientTimeOut;
    property    OnError;
    property    OnNewStreamComing: TFasterTCPServerNewStreamComingEvent read FOnNewStreamComing write FOnNewStreamComing;
    property    OnServerGetUserName: TFasterTCPRegisterUserEvent read FOnServerGetUserName write FOnServerGetUserName;
    property    OnStreamReceived: TFasterTCPServerDataReceivedEvent read FOnStreamReceived write FOnStreamReceived;
    property    OnUnknownPacketID: TFasterTCPServerUnknownIDEvent read FOnUnknownPacketID write FOnUnknownPacketID;
  end;

  {TFasterTCPServerClient}
  TFasterTCPServerClient = class(TCustomFasterSocket)
  private
    FConnected: Boolean;
    FExtraDataObject: TObject;
    FRoom: String;
    FStream_FullSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF};
    FStreamDataInfo: String;
    FUserName: String;
  protected
    //FPacketsWaiting: TFasterPacketList;
    FPingStatus: TPingStatus;     
    FStreamDataReceived: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF};  
    FTimeOuts:  LongInt;
    Procedure   ClearStreamProperties;
    procedure   SetConnected(Value: Boolean); virtual;
  public
    constructor Create(aOwner: TComponent); override;
    destructor  Destroy; override;
    property    Connected: Boolean read FConnected write SetConnected stored False;
    property    ExtraDataObject: TObject read FExtraDataObject Write FExtraDataObject;
    property    PingStatus: TPingStatus read FPingStatus Stored False;
    property    Room: String read FRoom write FRoom;
    property    StreamDataFullSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF} read FStream_FullSize Stored False;
    property    StreamDataInfo: String read FStreamDataInfo Stored False;
    property    StreamDataReceived: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF} read FStreamDataReceived Stored False;
    property    TimeOuts: LongInt read FTimeOuts;
    property    UserName: String read FUserName write FUserName;
  end;

  {Server uses Client's FStreamDataReceived to know how much data it has received from
   the client. On Client it means how much data the Client has received from the server.
   StreamDataFullSize means the size received from last AskToReceiveStream-call.
   AskToReceiveStream sets the StreamDataInfo, -Received, -Size and fires the
   OnNewStreamComing event, nothing more.}

  {TFasterTCPClient}
  TFasterTCPClient = class(TFasterTCPServerClient)
  private
    FAutoTryReconnect: Boolean;
    //FSendPacketsImmediately: Boolean;
    FOnConnected: TNotifyEvent;
    FOnDisconnected: TNotifyEvent;
    FOnMessageCome: TFasterTCPClientIOEvent;
    FOnNewStreamComing: TFasterTCPClientNewStreamComingEvent;
    FOnPacketCome: TFasterTCPClientDataAvailEvent;
    FOnServerAccept: TNotifyEvent;
    FOnServerAcceptStream: TNotifyEvent;
    FOnServerDenyStream: TNotifyEvent;
    FOnServerDisconnectAll: TNotifyEvent;
    FOnServerDisconnectYou: TNotifyEvent;
    FOnServerKickYouOut: TNotifyEvent;
    FOnServerNameInUse: TNotifyEvent;
    FOnServerNeedMoreData: TNotifyEvent;
    FOnServerNotLetIn: TNotifyEvent;
    FOnServerPong: TNotifyEvent;
    FOnServerReceivedStream: TNotifyEvent;
    FOnServerStopReceivingStream: TNotifyEvent;
    FOnServerStopSendingStream: TNotifyEvent;
    FOnStreamReceived: TFasterTCPClientDataReceivedEvent;
    FOnTimeOut: TNotifyEvent;
    FOnUnknownPacketID: TFasterTCPClientUnknownIDEvent;
    function    GetIP: LongInt;      
    Procedure   SendCommand(Command, CommandDataSize: LongInt; Data: TMemoryStream; Immediately: Boolean);
    //Procedure   SendWaitingPackets;
    procedure   SetIP(Value: LongInt);
  protected
//    procedure WndProc(var Message: TMessage); override;
    //property    PacketsWaiting: TFasterPacketList read FPacketsWaiting write FPacketsWaiting;

    procedure   DoClose(Socket: TSocket); override;
    procedure   DoConnect; override;
    procedure   DoMessageCome(ProcessedMessage: String);
    procedure   DoPacketCome(Data: TMemoryStream; DataSize: LongInt); 
    Procedure   ProcessCommands(Client: TFasterTCPServerClient; Data: TMemoryStream; Command: LongInt); override;
    procedure   SetConnected(Value: Boolean); override;
    procedure   SetHost(Value: String); override;
    procedure   SetPort(Value: Word); override;
    procedure   SocketError(Socket: TSocket; ErrorCode: LongInt); override;
  public
    property    IP: LongInt read GetIP write SetIP;
    procedure   AskMoreData;
    procedure   AskToReceiveStream(Const DataSize: {$IFDEF INT64_STREAMS} Int64 {$ELSE} LongInt {$ENDIF}; Const DataInfo: String);
    Function    Send(Buffer: PChar; BufLength: LongInt): LongInt;
    Function    SendCustomPacket(ID, DataSize: LongInt; Data: TStream; AutoFreeData: Boolean): LongInt;
    Function    SendCustomPacketEx(ID, DataSize: LongInt; Data: Pointer): LongInt;
    procedure   SendStream(Stream: TStream; Size: LongInt);
    procedure   StopReceivingData;
    procedure   StopSendingData;
    procedure   UpdatePingStatus;
  published
    property    AllowChangeHostAndPortOnConnection;
    property    AutoTryReconnect: Boolean read FAutoTryReconnect write FAutoTryReconnect default False;
    property    Connected;
    property    Host;
    property    Port;
    property    Room;            
    //property    SendPacketsImmediately: Boolean read FSendPacketsImmediately Write FSendPacketsImmediately;
    property    UserName;        

    property    OnConnected: TNotifyEvent read FOnConnected write FOnConnected;
    property    OnDisconnected: TNotifyEvent read FOnDisconnected write FOnDisconnected;
    property    OnError;
    property    OnMessageCome: TFasterTCPClientIOEvent read FOnMessageCome write FOnMessageCome;
    property    OnNewStreamComing: TFasterTCPClientNewStreamComingEvent read FOnNewStreamComing write FOnNewStreamComing;
    property    OnPacketCome: TFasterTCPClientDataAvailEvent read FOnPacketCome write FOnPacketCome;
    property    OnServerAccept: TNotifyEvent read FOnServerAccept write FOnServerAccept;
    property    OnServerAcceptStream: TNotifyEvent read FOnServerAcceptStream write FOnServerAcceptStream;