msgclient.pas

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

    property OnReceiveCommand: TMsgOnReceiveCommand read FOnReceiveCommand write FOnReceiveCommand;

    property AfterConnect: TNotifyEvent read FAfterConnect write FAfterConnect;
    property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;
    property AfterDisconnect: TNotifyEvent read FAfterDisconnect write FAfterDisconnect;
    property BeforeDisconnect: TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;
    property AfterLogon: TNotifyEvent read FAfterLogon write FAfterLogon;
    property BeforeLogon: TNotifyEvent read FBeforeLogon write FBeforeLogon;
    property AfterLogoff: TNotifyEvent read FAfterLogoff write FAfterLogoff;
    property BeforeLogoff: TNotifyEvent read FBeforeLogoff write FBeforeLogoff;
    property OnServerShutdown: TNotifyEvent read FOnServerShutdown write FOnServerShutdown;
    property AfterActive: TNotifyEvent read FAfterActive write FAfterActive;
    property BeforeActive: TNotifyEvent read FBeforeActive write FBeforeActive;
 end; // TMsgClient


////////////////////////////////////////////////////////////////////////////////
//
// TMsgClientSession
//
////////////////////////////////////////////////////////////////////////////////

  TMsgOnClientUserOnLine = procedure (UserID: String) of object;
  TMsgOnClientUserOffLine = procedure (UserID: String) of object;

  TMsgOnClientDisconnectUser = procedure of object;

  TMsgOnClientReceiveMessage = procedure (Session: TMsgClientSession; Buffer: PChar; Size: Integer) of object;
// For future extensions
//  TMsgOnClientReceiveCommand = procedure (Buffer: PChar; Size: Integer) of object;

  TMsgClientSession = class (TMsgNetworkSession)
   public
    FClient:                    TMsgClient;
   private
    FDirect:                    Boolean;
    FRemoteUser:                TMsgUserInfo;
    FOnReceiveMessage:          TMsgOnClientReceiveMessage;
// For future extensions
//    FOnReceiveCommand:          TMsgOnClientReceiveCommand;
(*
    FOnUserOnLine:              TMsgOnClientUserOnLine;
    FOnUserOffLine:             TMsgOnClientUserOffLine;
*)
//    FOnDisconnectUser:          TMsgOnClientDisconnectUser;
    FAfterConnect:            TNotifyEvent;
    FAfterDisconnect:         TNotifyEvent;
    FBeforeConnect:           TNotifyEvent;
    FBeforeDisconnect:        TNotifyEvent;
    FOnServerShutdown:        TNotifyEvent;
   protected
    procedure SetConnected(value: boolean); override;
    procedure SetLogged(value: boolean); override;
    function GetMyUserID: Cardinal;
   public
    // constructor
    constructor Create(AOwner: TComponent);
    // destructor
    destructor Destroy; override;
    // call OnError event handler
    procedure DoOnError(ErrorCode: Integer; NativeError: Integer = -1; ErrorMessage: String = ''); override;
    procedure DoCloseSessionOnNetworkError; override;
(*****************************************************************************)
(*  COMMANDS to send                                                         *)
(*****************************************************************************)
    // connect this client to server
    procedure Connect;
    // connect this client to another one directly
    procedure ConnectDirectly;
    // disconnect this client from server
    procedure Disconnect;
    // Login on the server
    function Logon: Integer;
    // Logoff
    function Logoff: Integer;
    // return MSG_COMMAND_OK and UserInfo if user exists, otherwise return error code
    function GetUserInfo(UserID: Cardinal; var UserInfo: TMsgUserInfo): Integer;
    // get list of Contacts of this client from server
    function GetContacts(var Contacts: TMsgContactInfoArray): Integer;
    // determine if user is already registered at server
    function IsUserExisting(UserID: Cardinal): Integer;
    // determine if user is on-line now
    function IsUserOnLine(UserID: Cardinal): Integer;
    // register new user at server
    function RegisterNewUser(var UserInfo: TMsgUserInfo; Password: ShortString = ''): Integer;
    // update user details
    function UpdateUserInfo(var UserInfo: TMsgUserInfo; ChangePassword: Boolean; Password: ShortString = ''): Integer;
    // add user to Contacts list of this client
    function AddUserToContacts(
                               UserID:            Cardinal;
                               var UserInfo:      TMsgUserInfo;
                               ContactNameSource: TMsgContactNameSource;
                               ContactCustomName: ShortString
                              ): Integer;
    // update user in Contacts list of this client
    function UpdateUserInContacts(
                               UserID:            Cardinal;
                               ContactNameSource: TMsgContactNameSource;
                               ContactCustomName: ShortString
                              ): Integer;
    // remove user from Contacts list of this client
    function RemoveUserFromContacts(UserID: Cardinal): Integer;
    function FindUsers(
                        var Users: TMsgUserInfoArray;
                        Stream:    TMsgMemoryStream
                       ): Integer;
    function FindMessages(
                        Stream:   TMsgMemoryStream;
                        out       ResultDataset: TDataset
                       ): Integer;
    function SendCommand(
                                Command: TMsgMessageType;
                                Buffer: PChar;
                                Size: Integer
                                        ): Integer;
(*****************************************************************************)
(*  COMMANDS to execute                                                      *)
(*****************************************************************************)
   protected
    function OnLineUser(UserID: Cardinal): Boolean;
    function OffLineUser(UserID: Cardinal): Boolean;
   public
    // connect user to this client
    function ConnectUser(UserID: Cardinal; Host: String; Port: Integer):
                                                   TMsgComBaseSession; override;
    function ConnectedUser(UserID: Cardinal; Host: String; Port: Integer): Boolean; override;
    // disconnect user from this client
    function DisconnectUser(UserID: Cardinal): Boolean;
    // send buffer with command in it via established connection using connection manager
    procedure SendBuffer(Buffer: PChar; BufferSize: Integer; Code: Integer = MsgNewRequest); override;
    // receive command
    procedure ReceiveData(var Buffer: PChar; var BufferSize: Integer); override;
(*****************************************************************************)
//    function ConnectedUserMake(UserID: Cardinal; Host: String; Port: Integer): Boolean;
    procedure ChangeStatus(UserID: Cardinal; NewStatus: TMsgUserStatus);
//   public
//    procedure OnDisconnect; override;
   protected
    // send custom message
    procedure SendMessage(Buffer: PChar; BufferSize: Integer);
   public
    // receive custom message
    procedure ReceiveMessage(Buffer: PChar; BufferSize: Integer); override;
    procedure OnDisconnect; override;
   public
    property Direct: Boolean read FDirect write FDirect; // Received from Sessons
    property RemoteUser: TMsgUserInfo read FRemoteUser write FRemoteUser; // Received from Sessons
   public
    property Client: TMsgClient read FClient;
    property OnReceiveMessage: TMsgOnClientReceiveMessage read FOnReceiveMessage write FOnReceiveMessage;
// For future extensions
//    property OnReceiveCommand: TMsgOnClientReceiveCommand read FOnReceiveCommand write FOnReceiveCommand;
//    property OnDisconnectUser: TMsgOnClientDisconnectUser read FOnDisconnectUser write FOnDisconnectUser;
(*
    property OnUserOnLine: TMsgOnClientUserOnLine read FOnUserOnLine write FOnUserOnLine;
    property OnUserOffLine: TMsgOnClientUserOffLine read FOnUserOffLine write FOnUserOffLine;
*)
    property AfterConnect: TNotifyEvent read FAfterConnect write FAfterConnect;
    property BeforeConnect: TNotifyEvent read FBeforeConnect write FBeforeConnect;
    property AfterDisconnect: TNotifyEvent read FAfterDisconnect write FAfterDisconnect;
    property BeforeDisconnect: TNotifyEvent read FBeforeDisconnect write FBeforeDisconnect;
    property OnServerShutdown: TNotifyEvent read FOnServerShutdown write FOnServerShutdown;
  end; // TMsgClientSession



////////////////////////////////////////////////////////////////////////////////
//
// TMsgShowMessageThread
//
////////////////////////////////////////////////////////////////////////////////
  TMsgShowMessageThread = class(TThread)
  private
    FText:            String;
  protected
    procedure Execute; override;
  public
    constructor Create(str: String);
    destructor Destroy; override;
  public
  end; // TMsgShowMessageThread



var ClientConnectionManager: TMsgClientConnectionManager;

implementation

uses
  Math
 {$IFDEF TRIAL_VERSION}
  , MsgCommunicator
 {$ENDIF}
  ;

var
  FCSect:                TRTLCriticalSection;
  Initialized:           Boolean;
  IsDesignMode:          Boolean;



////////////////////////////////////////////////////////////////////////////////
//
// TMsgClientNetworkSettingsEditor
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// Create
//------------------------------------------------------------------------------
constructor TMsgClientNetworkSettingsEditor.Create;
begin
  inherited Create;
  FConnectRetryCount := MsgConnectRetryCount;
  FConnectDelay := MsgConnectDelay;
  FStartReceiveTimeOut := MsgStartReceiveTimeOut;
  FReceiveTimeOut := MsgReceiveTimeOut;
  FReceiveSleep := MsgReceiveSleep;
  FMinSendTimeOut := MsgMinSendTimeOut;
  FSendTimeOut := MsgSendTimeOut;
  FWaitForSendSleep := MsgWaitForSendSleep;
  FResendDelay := MsgResendDelay;
  FRequestDelay := MsgRequestDelay;
  FWaitForTimeOut := MsgWaitForTimeOut;
  FThreadsTerminateDelay := MsgThreadsTerminateDelay;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgClientNetworkSettingsEditor.Destroy;
begin
  inherited Destroy;
end; // Destroy


//------------------------------------------------------------------------------
// Assign
//------------------------------------------------------------------------------
procedure TMsgClientNetworkSettingsEditor.Assign(Source: TPersistent);
begin
  if (Source <> nil) then
   if (Source is TMsgClientNetworkSettingsEditor) then
    begin
      inherited Assign(Source);
      FConnectRetryCount := TMsgClientNetworkSettingsEditor(Source).ConnectRetryCount;
      FConnectDelay := TMsgClientNetworkSettingsEditor(Source).ConnectDelay;
      FStartReceiveTimeOut := TMsgClientNetworkSettingsEditor(Source).StartReceiveTimeOut;
      FReceiveTimeOut := TMsgClientNetworkSettingsEditor(Source).ReceiveTimeOut;
      FReceiveSleep := TMsgClientNetworkSettingsEditor(Source).ReceiveSleep;
      FMinSendTimeOut := TMsgClientNetworkSettingsEditor(Source).MinSendTimeOut;
      FSendTimeOut := TMsgClientNetworkSettingsEditor(Source).SendTimeOut;
      FWaitForSendSleep := TMsgClientNetworkSettingsEditor(Source).WaitForSendSleep;
      FResendDelay := TMsgClientNetworkSettingsEditor(Source).ResendDelay;
      FRequestDelay := TMsgClientNetworkSettingsEditor(Source).RequestDelay;
      FWaitForTimeOut := TMsgClientNetworkSettingsEditor(Source).WaitForTimeOut;
      FThreadsTerminateDelay := TMsgClientNetworkSettingsEditor(Source).ThreadsTerminateDelay;
    end;
end; // Assign


//------------------------------------------------------------------------------
// Copy ClientNetwork settings to ConnectParams
//------------------------------------------------------------------------------
procedure TMsgClientNetworkSettingsEditor.CopySettingsToConnectParams(var ConnectParams: TMsgConnectParams);
begin
  inherited CopySettingsToConnectParams(ConnectParams);
  ConnectParams.ConnectRetryCount := FConnectRetryCount;
  ConnectParams.ConnectDelay := FConnectDelay;
  ConnectParams.StartReceiveTimeOut := FStartReceiveTimeOut;
  ConnectParams.ReceiveTimeOut := FReceiveTimeOut;
  ConnectParams.ReceiveSleep := FReceiveSleep;
  ConnectParams.MinSendTimeOut := FMinSendTimeOut;
  ConnectParams.SendTimeOut := FSendTimeOut;
  ConnectParams.WaitForSendSleep := FWaitForSendSleep;
  ConnectParams.ResendDelay := FResendDelay;
  ConnectParams.RequestDelay := FRequestDelay;
  ConnectParams.WaitForTimeOut := FWaitForTimeOut;
  ConnectParams.ThreadsTerminateDelay := FThreadsTerminateDelay;
end; // CopySettingsToConnectParams



////////////////////////////////////////////////////////////////////////////////
//
// TMsgClientConnectParamsEditor
//
////////////////////////////////////////////////////////////////////////////////


//------------------------------------------------------------------------------
// constructor
//------------------------------------------------------------------------------
constructor TMsgClientConnectParamsEditor.Create;
begin
  inherited;
  LocalPort := MsgDefaultClientPort;
  FServerID := MsgDefaultServerID;
  FRemoteHost := MsgDefaultHost;
  FRemotePort := MsgDefaultServerPort;
  FCompressionAlgorithm := caNone;
  FCompressionMode := 1;
  FNetworkSettings := TMsgClientNetworkSettingsEditor.Create;
end;//Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgClientConnectParamsEditor.Destroy;
begin
  FNetworkSettings.Free;
  inherited;
end; // Destroy


//------------------------------------------------------------------------------
// Assign
//------------------------------------------------------------------------------
procedure TMsgClientConnectParamsEditor.Assign(Source: TPersistent);
begin
  if (Source <> nil) then
   if (Source is TMsgConnectionParamsEditor) then
    begin
     inherited Assign(Source);
     FServerID := TMsgClientConnectParamsEditor(Source).ServerID;
     FRemoteHost := TMsgClientConnectParamsEditor(Source).RemoteHost;
     FRemotePort := TMsgClientConnectParamsEditor(Source).RemotePort;
     FCompressionAlgorithm := TMsgClientConnectParamsEditor(Source).CompressionAlgorithm;
     FCompressionMode := TMsgClientConnectParamsEditor(Source).CompressionMode;
     FNetworkSettings.Assign(TMsgClientConnectParamsEditor(Source).NetworkSettings);
    end;
end; // Assign


//------------------------------------------------------------------------------
// return ConnectParams
//------------------------------------------------------------------------------