msgclient.pas

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

{******************************************************************************}
{                                                                              }
{ Client components                                                            }
{                                                                              }
{******************************************************************************}

unit MsgClient;

interface

{$I MsgVer.inc}
{$WARNINGS OFF}
{$HINTS OFF}


uses Db, SysUtils, Classes,
{$IFDEF MSWINDOWS}
     Windows,
     Dialogs,
{$ENDIF}
{$IFDEF LINUX}
     Libc,
     QDialogs,
{$ENDIF}
{$IFDEF TRIAL_VERSION}
 {$IFDEF MSWINDOWS}
     Registry, MsgDECUtil, MsgCipher,
 {$ENDIF}
{$ENDIF}

//  MsgCommunicator units

     MsgCrypto,
     MsgCompression,
     MsgDatabase,
     MsgTypes,
     MsgExcept,
 {$IFDEF DEBUG_LOG}
     MsgDebug,
 {$ENDIF}
     MsgMemory,
     MsgConnection,
     MsgComMain,
     MsgComBase,
     MsgConst;


type

  TMsgCompressionAlgorithm = (caNone,caZLIB,caBZIP,caPPM);

  TMsgClientSession = class;


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


  TMsgClientNetworkSettingsEditor = class (TMsgNetworkSettingsEditor)
   private
    FConnectRetryCount:        Integer;
    FConnectDelay:             Integer;
    FStartReceiveTimeOut:      Integer;
    FReceiveTimeOut:           Integer;
    FReceiveSleep:             Integer;
    FMinSendTimeOut:           Integer;
    FSendTimeOut:              Integer;
    FWaitForSendSleep:         Integer;
    FResendDelay:              Integer;
    FRequestDelay:             Integer;
    FWaitForTimeOut:           Integer;
    FThreadsTerminateDelay:    Integer;
   public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure CopySettingsToConnectParams(var ConnectParams: TMsgConnectParams); override;
   published
    property ConnectRetryCount:        Integer read FConnectRetryCount write FConnectRetryCount;
    property ConnectDelay:             Integer read FConnectDelay write FConnectDelay;
    property StartReceiveTimeOut:      Integer read FStartReceiveTimeOut write FStartReceiveTimeOut;
    property ReceiveTimeOut:           Integer read FReceiveTimeOut write FReceiveTimeOut;
    property ReceiveSleep:             Integer read FReceiveSleep write FReceiveSleep;
    property MinSendTimeOut:           Integer read FMinSendTimeOut write FMinSendTimeOut;
    property SendTimeOut:              Integer read FSendTimeOut write FSendTimeOut;
    property WaitForSendSleep:         Integer read FWaitForSendSleep write FWaitForSendSleep;
    property ResendDelay:              Integer read FResendDelay write FResendDelay;
    property RequestDelay:             Integer read FRequestDelay write FRequestDelay;
    property WaitForTimeOut:           Integer read FWaitForTimeOut write FWaitForTimeOut;
    property ThreadsTerminateDelay:    Integer read FThreadsTerminateDelay write FThreadsTerminateDelay;
  end; // TMsgClientNetworkSettingsEditor



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

  TMsgClientConnectParamsEditor = class (TMsgConnectionParamsEditor)
   private
    FRemoteHost:                    String;
    FRemotePort:                    Cardinal;
    FCompressionAlgorithm:          TMsgCompressionAlgorithm;
    FCompressionMode:               Byte;
    FServerID:                      Cardinal;
    FNetworkSettings:               TMsgClientNetworkSettingsEditor;
   public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetConnectParams: TMsgConnectParams; override;
   published
    property RemoteHost: String read FRemoteHost write FRemoteHost;
    property RemotePort: Cardinal read FRemotePort write FRemotePort;
    property CompressionAlgorithm: TMsgCompressionAlgorithm
              read FCompressionAlgorithm write FCompressionAlgorithm;
    property CompressionMode: Byte read FCompressionMode write FCompressionMode;
    property ServerID: Cardinal read FServerID write FServerID;
    property NetworkSettings: TMsgClientNetworkSettingsEditor read FNetworkSettings write FNetworkSettings;
  end;



////////////////////////////////////////////////////////////////////////////////
//
// TMsgClient
//
////////////////////////////////////////////////////////////////////////////////

 TMsgClient = class (TMsgComponent)
  private
    FDatabase:                TMsgDatabase;
    FTempTable:               TMsgTempTable;
    FUserID:                  Cardinal;
    FPassword:                String;
    FActive:                  Boolean;
    FAllowDirectly:           Boolean;
    FConnected:               Boolean;
    FConnectedDirectly:       Boolean;
    FContacts:                TMsgContactInfoArray;
    FSessions:                TThreadList;
    FBeforeActive:            TNotifyEvent;
    FAfterActive:             TNotifyEvent;
    FAfterConnect:            TNotifyEvent;
    FAfterDisconnect:         TNotifyEvent;
    FAfterLogon:              TNotifyEvent;
    FAfterLogoff:             TNotifyEvent;
    FBeforeLogon:             TNotifyEvent;
    FBeforeLogoff:            TNotifyEvent;
    FBeforeConnect:           TNotifyEvent;
    FBeforeDisconnect:        TNotifyEvent;
    FOnServerShutdown:        TNotifyEvent;
    FKeepConnection:          Boolean;
    FConnectionParams:        TMsgClientConnectParamsEditor;
    FOnUserOnLine:            TMsgOnUserOnLine;
    FOnUserOffLine:           TMsgOnUserOffLine;
//    FOnDisconnectUser:        TMsgOnDisconnectUser;
    FStoreMessageHistory:     Boolean;
    FOnReceiveTextMessage:    TMsgOnReceiveTextMessage;
    FOnReceiveBinaryMessage:  TMsgOnReceiveBinaryMessage;
    FOnReceiveStreamMessage:  TMsgOnReceiveStreamMessage;
    FOnReceiveCommand:        TMsgOnReceiveCommand;
    FLogged:                  Boolean;
  protected
    function PrepareToSendMessage(
                                  var ToID, ToUserID: Cardinal;
                                  var Directly: Boolean;
                                  var ClientSession: TMsgClientSession
                                  ): Integer;
    function NeedToResendMessage(
                                  ToID, ToUserID: Cardinal;
                                  Directly: Boolean;
                                  Error: Integer
                                  ): Boolean;
    procedure SetLogged(value: Boolean);
    function SessionsCount: Integer;
    procedure CheckConnected;
    procedure CheckDisconnected;
    // db connected?
    function GetConnected: Boolean;
    // keeps connection
    procedure SetKeepConnection(Value: Boolean);
    // connect / disconnect
    procedure SetActive(value: boolean);
    procedure SetConnected(value: boolean);
    function GetContact(Index: Integer): TMsgContactInfo;
    function GetContactCount: Integer;
    procedure ChangeUserStatus(const UserID: Cardinal; const Status: TMsgUserStatus);
    // for commands
    function FindSessionWithUser(UserID: Cardinal): TMsgClientSession;
    function FindSession(ToUserID: Cardinal; var Directly: Boolean): TMsgClientSession;
    // sends notification
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetUserID(Value: Cardinal);
    function CreateDirectSession(UserID: Cardinal; Host: String; Port: Integer): TMsgClientSession;
  public
    FDefaultSession:          TMsgClientSession;
    FDefaultServerSession:    TMsgClientSession;
//    property DefaultSession: TMsgClientSession read FDefaultServerSession write FDefaultServerSession;
  public
    // constructor
    constructor Create(AOwner: TComponent); override;
    // destructor
    destructor Destroy; override;
(*****************************************************************************)
(*  COMMANDS                                                                 *)
(*****************************************************************************)
    // connect this client to server
    procedure Connect;
    // connect this client to another client directly
    procedure ConnectDirectly(UserID: Cardinal; Host: String = ''; Port: Integer = 0);
    // disconnect this client from server
    procedure Disconnect;
    // disconnect this client from all servers
    procedure DisconnectAll;
    // server disconnected client session
    procedure OnDisconnect(Session: TMsgClientSession);
     // Login on the server
    function Logon: Integer;
    // Logoff
    function Logoff: 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;
    // return MSG_COMMAND_OK and UserInfo if user exists, otherwise return error code
    function GetUserInfo(UserID: Cardinal; var UserInfo: TMsgUserInfo): Integer;
    // register new user at server
    function RegisterNewUser(var UserInfo: TMsgUserInfo; Password: String = ''): Integer;
    // change user details
    function UpdateUserInfo(var UserInfo: TMsgUserInfo; ChangePassword: Boolean; Password: String = ''): Integer;
    // add user to Contacts list of this client
    function AddUserToContacts(
                               UserID:            Cardinal;
                               ContactNameSource: TMsgContactNameSource = mcnsUserName;
                               ContactCustomName: String = ''
                              ): Integer;
    // update user in Contacts list of this client
    function UpdateUserInContacts(
                               UserID:            Cardinal;
                               ContactNameSource: TMsgContactNameSource = mcnsUserName;
                               ContactCustomName: String = ''
                              ): Integer;
    // remove user from Contacts list of this client
    function RemoveUserFromContacts(UserID: Cardinal): Integer;
    // get list of Contacts of this client
    function GetContacts: Integer;
    // return error code and fill Users if no error
    function FindUsers(
                    var Users:                    TMsgUserInfoArray;
                    var UserNameComparison:       TMsgTextComparison;
                    var FirstNameComparison:      TMsgTextComparison;
                    var LastNameComparison:       TMsgTextComparison;
                    var OrganizationComparison:   TMsgTextComparison;
                    var DepartmentComparison:     TMsgTextComparison;
                    var ApplicationComparison:    TMsgTextComparison;
                    var HostComparison:           TMsgTextComparison;
                    var PortComparison:           TMsgIntegerComparison;
                    Status:                       TMsgUserStatus = msgNone;
                    UserID:                       Cardinal = MSG_INVALID_USER_ID;
                    UserName:                     String = '';
                    FirstName:                    String = '';
                    LastName:                     String = '';
                    Organization:                 String = '';
                    Department:                   String = '';
                    Host:                         String = '';
                    Application:                  String = '';
                    SearchCondition:              String = ''; // SQL WHERE clause without word WHERE
                    // ORDER BY columns without ORDER BY words
                    // example: SenderID DESC, SendingDate ASC
                    SortBy:                       TMsgUserInfoArraySortBy = msgusbNone;
                    Ascending:                    Boolean = True;
                    OrderByClause:                String = ''
                       ): Integer;
    // return error code and fill ResultDataset if no error
    function FindMessages(
                         out ResultDataset:                 TDataset;
                         // if true - search in local history, otherwise - in server History
                         UseLocalHistory:                   Boolean;
                         var MessageTextComparison:         TMsgTextComparison;
                         var MessageUnicodeTextComparison:  TMsgTextComparison;
                         var SendingDate:                   TMsgDateComparison;
                         var DeliveryDate:                  TMsgDateComparison;
                         SearchDelivered:                   Boolean;
                         Delivered:                         Boolean = True;
                         MessageText:         String = ''; // text of the message
                         MessageUnicodeText:  WideString = ''; // unicode text of the message
                         SenderID:            Cardinal = MSG_INVALID_USER_ID;
                         RecipientID:         Cardinal = MSG_INVALID_USER_ID;
                         MessageType:         TMsgMessageType = aamtNone;
                         MessageDataSize:     Integer = -1; // size of MessageData
                         OrderBySendingDate:  Boolean = False;
                         // ORDER BY columns without ORDER BY statement
                         // example: SenderID DESC, SendingDate ASC
                         OrderByClause:       String = '';
                         Command:             Cardinal = 0 // no condition on command field if TMsgMessageType = aamtNone
                         ): Integer;
(*****************************************************************************)
    // receive custom message from server and call defined event
    procedure ReceiveMessage(Session: TMsgClientSession; Buffer: PChar; Size: Integer);
    // send message
    function SendMessage(ToUserID: Cardinal; const Text: String;
                                        Directly: Boolean = True): Integer; overload;
    function SendMessage(ToUserID: Cardinal; Buffer: PChar; Size: Integer;
                                        Directly: Boolean = True): Integer; overload;
    function SendMessage(ToUserID: Cardinal; Stream: TStream;
                                        Directly: Boolean = True): Integer; overload;
    // send command
    function SendCommand(
                                Command: Cardinal;
                                Buffer: PChar;
                                Size: Integer
                                       ): Integer;
//    property KeepConnection: Boolean read FKeepConnection write SetKeepConnection default True;
  public
    property Contacts[Index: Integer]: TMsgContactInfo read GetContact;
    property ContactCount: Integer read GetContactCount;
  published
    property UserID: Cardinal read FUserID write SetUserID;
    property StoreMessageHistory: Boolean read FStoreMessageHistory write FStoreMessageHistory;
    property Password: String read FPassword write FPassword;
    property Active: Boolean read FActive write SetActive default False;
    property AllowDirectly: Boolean read FAllowDirectly write FAllowDirectly default True;
    property Connected: Boolean read GetConnected write SetConnected default False;
    property ConnectedDirectly: Boolean read FConnectedDirectly;
    property Logged: Boolean read FLogged write SetLogged;
    property ConnectionParams: TMsgClientConnectParamsEditor read FConnectionParams write FConnectionParams;
    property Database: TMsgDatabase read FDatabase write FDatabase;
    property TempTable: TMsgTempTable read FTempTable write FTempTable;

    property OnUserOnLine: TMsgOnUserOnLine read FOnUserOnLine write FOnUserOnLine;
    property OnUserOffLine: TMsgOnUserOffLine read FOnUserOffLine write FOnUserOffLine;

    property OnReceiveTextMessage: TMsgOnReceiveTextMessage read FOnReceiveTextMessage write FOnReceiveTextMessage;
    property OnReceiveBinaryMessage: TMsgOnReceiveBinaryMessage read FOnReceiveBinaryMessage write FOnReceiveBinaryMessage;
    property OnReceiveStreamMessage: TMsgOnReceiveStreamMessage read FOnReceiveStreamMessage write FOnReceiveStreamMessage;