msgnetwork.pas

Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl

unit MsgNetwork;

interface

{$I MsgVer.inc}

uses
  Classes, SysUtils,
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
{$IFDEF LINUX}
  Libc,
{$ENDIF}

// MsgCommunicator units

{$IFDEF DEBUG_LOG}
  MsgDebug,
{$ENDIF}
  MsgConst,
  MsgExcept,
  MsgMemory;

const
  MAX_PORT = 2147483646;

  PF_INET         =  2;
  SOCK_DGRAM      =  2;
  SOCKET_ERROR    = -1;
  AF_INET         =  2;
  IPPROTO_UDP     = 17;             { user datagram protocol }
  INADDR_NONE     = -1;

  FD_SETSIZE      =  1; // default value = 64;

type

  TSocket = Integer;

  SunB = packed record
    s_b1, s_b2, s_b3, s_b4: Byte;
  end;

  SunW = packed record
    s_w1, s_w2: Word;
  end;

  PInAddr = ^TInAddr;
  TMsgin_addr = record
    case integer of
      0: (S_un_b: SunB);
      1: (S_un_w: SunW);
      2: (S_addr: LongInt);
  end;
  TInAddr = TMsgin_addr;

  TMsgsockaddr_in = record
    case Integer of
      0: (sin_family: Word;
          sin_port:   Word;
          sin_addr:   TInAddr;
          sin_zero:   array[0..7] of Char);
      1: (sa_family:  Word;
          sa_data:    array[0..13] of Char)
  end;
  TSockAddr = TMsgsockaddr_in;

  PHostEnt = ^THostEnt;
  TMsghostent = record
    h_name: PChar;
    h_aliases: ^PChar;
    h_addrtype: Smallint;
    h_length: Smallint;
    case Byte of
      0: (h_addr_list: ^PChar);
      1: (h_addr: ^PChar)
  end;
  THostEnt = TMsghostent;

  PFDSet = ^TFDSet;
  TFDSet = record
    fd_count: Integer;
    fd_array: array[0..FD_SETSIZE-1] of TSocket;
  end;

  PTimeVal = ^TTimeVal;
  TMsgtimeval = record
    tv_sec: Longint;
    tv_usec: Longint;
  end;
  TTimeVal = TMsgtimeval;

const
  WSADESCRIPTION_LEN     =   256;
  WSASYS_STATUS_LEN      =   128;
type
  TWSAData = record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..WSADESCRIPTION_LEN] of Char;
    szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;

{$IFDEF LINUX}

(*$HPPEMIT '#include <sys/socket.h>'*)

{$ENDIF}


// Forward Declarations

  TMsgListenerThread = class;

////////////////////////////////////////////////////////////////////////////////
//
// TMsgapiNetwork
//
////////////////////////////////////////////////////////////////////////////////

  TMsgDataReceivedNotifyEvent = procedure(
                             Buffer:    PChar;
                             Count:     Integer;
                             FromHost:  String;
                             FromPort:  Integer
                                          ) of object;

  TMsgDisconnectNotifyEvent = procedure(
                             FromHost:  String;
                             FromPort:  Integer;
                             Recv:      Boolean = False
                                          ) of object;

  TMsgapiNetwork = class (TObject)
   private
    FOnDataReceived:      TMsgDataReceivedNotifyEvent;
    FOnDisconnect:        TMsgDisconnectNotifyEvent;
    FSocket:              Integer;
    FPacketSize:          Integer;
    FLocalHost:           String;
    FLocalPort:           Integer;
    FRemoteHost:          String;
    FRemotePort:          Integer;
    FListener:            TMsgListenerThread;
    FActive:              Boolean;
    FDisconnected:        Boolean;
    procedure SetActive(Value: Boolean);
    procedure SetRemoteHost(Host: String);
    function GetRemoteHost: String;
    procedure SetRemotePort(Port: Integer);
    function GetRemotePort: Integer;
    procedure SetLocalHost(Host: String);
    function GetLocalHost: String;
    procedure SetLocalPort(Port: Integer);
    function GetLocalPort: Integer;
    procedure StartListening;
    procedure StopListening;
    procedure Open;
    procedure Close;
   public
//   protected
    property OnDataReceived: TMsgDataReceivedNotifyEvent
                                    read FOnDataReceived write FOnDataReceived;
    property OnDisconnect: TMsgDisconnectNotifyEvent
                                    read FOnDisconnect write FOnDisconnect;
   public
    constructor Create;
    destructor Destroy; override;
    procedure SendBuffer(
                            Buffer:     PChar;
                            Count:      Integer
                         );
   public
    property Active: Boolean read FActive write SetActive;
    property RemoteHost: String read GetRemoteHost write SetRemoteHost;
    property RemotePort: Integer read GetRemotePort write SetRemotePort;
    property LocalHost: String read GetLocalHost write SetLocalHost;
    property LocalPort: Integer read GetLocalPort write SetLocalPort;
  end; // TMsgapiNetwork


  TMsgListenerThread = class(TThread)
  private
    FapiNetwork:  TMsgapiNetwork;
  protected
    procedure Execute; override;
  public
    constructor Create(apiNetwork: TMsgapiNetwork);
    destructor Destroy; override;
  end;// TMsgListenerThread


  TMsgOnDisconnectThread = class(TThread)
  private
    FapiNetwork:    TMsgapiNetwork;
    FRecv:          Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create(
                        apiNetwork:     TMsgapiNetwork;
                        Recv:           Boolean = False
                      );
    destructor Destroy; override;
  end;// TMsgOnDisconnectThread



// Procedures

function SocketError: Integer;
function LookupHostAddr(const hn: string): string;

{$IFDEF MSWINDOWS}
const
  winsocket = 'wsock32.dll';
  kernel32  = 'kernel32.dll';

function socket(af, Struct, protocol: Integer): TSocket; stdcall;
function bind(s: TSocket; var addr: TSockAddr; namelen: Integer): Integer; stdcall;
function sendto(s: TSocket; var Buf; len, flags: Integer;
                  var addrto: TSockAddr; tolen: Integer): Integer; stdcall;
function recvfrom(s: TSocket; var Buf; len, flags: Integer;
                  var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
                  timeout: PTimeVal): Longint; stdcall;
function inet_addr(cp: PChar): Longint; stdcall; {PInAddr;}  { TInAddr }
function gethostbyname(name: PChar): PHostEnt; stdcall;
function htons(hostshort: Word): Word; stdcall;
function ntohs(netshort: Word): Word; stdcall;
function closesocket(s: TSocket): Integer; stdcall;
function WSAStartup(wVersionRequired: Word; var WSData: TWSAData): Integer; stdcall;
function WSACleanup: Integer; stdcall;
function WSAGetLastError: Integer; stdcall;
function TerminateThread(hThread: THandle; dwExitCode: Longword): Boolean; stdcall;
{$ENDIF}

var
  FNetworkThreads:     TThreadList;

implementation


////////////////////////////////////////////////////////////////////////////////
//
// TMsgapiNetwork
//
////////////////////////////////////////////////////////////////////////////////

//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgapiNetwork.Create;
begin
  inherited Create;
  FActive := False;
  FDisconnected := False;
  FPacketSize := MsgDefaultPacketSize;
  FLocalHost := '';
  FLocalPort := MsgDefaultClientPort;
  FRemoteHost := MsgDefaultHost;
  FRemotePort := MsgDefaultServerPort;
  FListener := nil;
  StartListening;
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgapiNetwork.Create>  Socket #'+IntToStr(Integer(FSocket)));
{$ENDIF}
end;// Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgapiNetwork.Destroy;
begin
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgapiNetwork.Destroy>  Socket #'+IntToStr(Integer(FSocket)));
{$ENDIF}
  StopListening;
  FDisconnected := True;
  inherited Destroy;
{$IFDEF DEBUG_LOG_NETWORK_THREADS}
aaWriteToLog('TMsgapiNetwork.Destroy - FINISHED');
{$ENDIF}
end;// Destoy


//------------------------------------------------------------------------------
// SetRemoteHost
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.SetRemoteHost(Host: String);
begin
  FRemoteHost := Host;
end;


//------------------------------------------------------------------------------
// GetRemoteHost
//------------------------------------------------------------------------------
function TMsgapiNetwork.GetRemoteHost: String;
begin
  Result := FRemoteHost;
end;


//------------------------------------------------------------------------------
// SetRemotePort
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.SetRemotePort(Port: Integer);
begin
  FRemotePort := Port;
end;


//------------------------------------------------------------------------------
// GetRemotePort
//------------------------------------------------------------------------------
function TMsgapiNetwork.GetRemotePort: Integer;
begin
  Result := FRemotePort;
end;


//------------------------------------------------------------------------------
// GetLocalHost
//------------------------------------------------------------------------------
function TMsgapiNetwork.GetLocalHost: String;
begin
  Result := FLocalHost;
end;


//------------------------------------------------------------------------------
// GetLocalPort
//------------------------------------------------------------------------------
function TMsgapiNetwork.GetLocalPort: Integer;
begin
  Result := FLocalPort;
end;


//------------------------------------------------------------------------------
// SetLocalPort
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.SetLocalPort(Port: Integer);
begin
  if FLocalPort = Port then Exit;
  if FListener <> nil then
    StopListening; // you must close socket to change Local parameter
  FLocalPort := Port;
  StartListening;
end;


//------------------------------------------------------------------------------
// SetLocalHost
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.SetLocalHost(Host: String);
begin
  if FLocalHost = Host then Exit;
  if FListener <> nil then
    StopListening; // you must close socket to change Local parameter
  FLocalHost := Host;
  StartListening;
end;


//------------------------------------------------------------------------------
// SetActive
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.SetActive(Value: Boolean);
begin
  if Value = FActive then Exit; // you must close socket to change Local parameters
  if Value then
    Open
  else
    Close;
  FActive := Value;
end;// SetActive


//------------------------------------------------------------------------------
// StartListening
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.StartListening;
begin
  if FListener <> nil then
    raise EMsgException.Create(40028, ErrorRNetworkListenerStarted, [SocketError]);
  if Active = False then
    Open;
  FListener := TMsgListenerThread.Create(self);
end; // StartListening


//------------------------------------------------------------------------------
// StopListening
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.StopListening;
begin 
  if FListener = nil then
    raise EMsgException.Create(40029, ErrorRNetworkListenerNotStarted, [SocketError]); 
  FListener.Free;
  FListener := nil; 
  Close;
  FActive := False;
end; // StopListening
	
 
//------------------------------------------------------------------------------
// Open
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.Open; 
var
  RetCode:    Integer; 
  Addr:       TSockAddr; 
  Bound:      Boolean;
  i:          Integer; 
begin 
  // open socket 
  FSocket := socket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);
  if FSocket = SOCKET_ERROR then
    raise EMsgException.Create(40032, ErrorRCannotOpenSocket, ['socket', SocketError]);
  // set parameters 
  Addr.sin_family := AF_INET;
  Addr.sin_addr.s_addr := inet_addr(pchar(LookupHostAddr(FLocalHost))); 
  // binding 
  Bound := False; 
  for i:=FLocalPort to MAX_PORT do
   begin
    Addr.sin_port := htons(FLocalPort); 
    if bind(FSocket, Addr, sizeof(Addr)) = SOCKET_ERROR then 
      RetCode := SocketError
    else
     begin
      Bound := True;
      break; // bound
     end; 
    if RetCode = 10048 then // port is already in use 
      inc(FLocalPort)       // search for another port
    else
      raise EMsgException.Create(40032, ErrorRCannotOpenSocket, ['bind', RetCode]);
   end; // binding
  if not Bound then 
    raise EMsgException.Create(40032, ErrorRCannotOpenSocket, ['bind: cannot bound', RetCode]); 
end; // Open 
 
 
//------------------------------------------------------------------------------
// Close
//------------------------------------------------------------------------------
procedure TMsgapiNetwork.Close; 
var
  RetCode:    Integer;
begin 
{$IFDEF MSWINDOWS} 
  RetCode := closesocket(FSocket);
{$ENDIF} 
{$IFDEF LINUX}
  RetCode := Libc.__close(FSocket);
{$ENDIF}
  if RetCode = SOCKET_ERROR then