msgclient.pas

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

function TMsgClientConnectParamsEditor.GetConnectParams: TMsgConnectParams;
begin
  Result := inherited GetConnectParams;
  Result.CompressionAlgorithm := Byte(FCompressionAlgorithm);
  Result.CompressionMode := FCompressionMode;
  Result.RemoteHost := FRemoteHost;
  Result.RemotePort := FRemotePort;
  Result.ServerID := FServerID;
  FNetworkSettings.CopySettingsToConnectParams(Result);
end; // GetConnectParams


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


//------------------------------------------------------------------------------
// constructor
//------------------------------------------------------------------------------
constructor TMsgClient.Create(AOwner: TComponent);
begin
  FStoreMessageHistory := True;
  FConnected := False;
  FLogged := False;
  FPassword := '';
  SetLength(FContacts,0);
  FConnectedDirectly := False;
  FActive := False;
  FAllowDirectly := True;
  FUserID := MSG_INVALID_USER_ID;
  FKeepConnection:=True;
  if (not IsDesignMode) then
   if (Aowner <> nil) then
    if (csDesigning in AOwner.ComponentState) then
     IsDesignMode := true;
// create ConnectionParams Editor
  FConnectionParams := TMsgClientConnectParamsEditor.Create;
// create Lists
  FSessions := TThreadList.Create;
  FDefaultSession := nil;
  FDefaultServerSession := nil;
  inherited;
end; // Create


//------------------------------------------------------------------------------
// destructor
//------------------------------------------------------------------------------
destructor TMsgClient.Destroy;
var
  Sessions:         TList;
  Session:          TMsgComBaseSession;
  i:                Integer;
begin
  if (Length(FPassword) > 0) then
   FillChar(FPassword[1],Length(Password),$FF);
  Active := False;
  DisconnectAll;
  Sessions:=FSessions.LockList;
  try
   for i:=Sessions.Count-1 downto 0 do
    begin
     Session := Sessions.Items[i];
     if Session <> nil then
       Session.Free;
    end;
  finally
   FSessions.UnLockList;
  end;
  FConnectionParams.Free;
  SetLength(FContacts,0);
  FSessions.Free;
  inherited;
end; // Destroy


//------------------------------------------------------------------------------
// SetUserID
//------------------------------------------------------------------------------
procedure TMsgClient.SetUserID(Value: Cardinal);
begin
  if (FUserID = Value) or (Active) or (Connected) or (Logged) then
    Exit;
  FUserID := Value;
end; // SetUserID


//------------------------------------------------------------------------------
// connect to server
//------------------------------------------------------------------------------
procedure TMsgClient.Connect;
var
  bCatchException:  Boolean;
begin
  bCatchException := False;
{$IFDEF D6H}
  // fix: to enable open forms with incorrect properties
  if (csDesigning in ComponentState)
     and (not (csFreeNotification in ComponentState)) then
    bCatchException := True;
{$ENDIF}
 try
  if (FDatabase <> nil) then
   Database.OpenOrCreateDatabase(True);
  if (FDefaultServerSession = nil) then
   begin
    // create default session
    FDefaultServerSession := TMsgClientSession.Create(Self);
    TMsgClientSession(FDefaultServerSession).OnReceiveMessage := ReceiveMessage;
    FSessions.Add(FDefaultServerSession);
   end;
  if (not (FDefaultServerSession.Connected)) then
   begin
    if Assigned(BeforeConnect) then
     BeforeConnect(Self);
     try
      FDefaultServerSession.Connect;
     finally
      FConnected := FDefaultServerSession.Connected;
      FUserID := FDefaultServerSession.FUserID;
      if Logged then
        GetContacts;
     end;
    if Assigned(AfterConnect) then
     AfterConnect(Self);
   end;
  if Connected then
   if AllowDirectly then
    if not Active then
      Active := True;
 except
   on e: Exception do
    if (csDesigning in ComponentState) then
      MessageDlg(e.Message,mtError,[mbOK],0)
    else
     if (not bCatchException) then
       raise;
 end;
end; // Connect


//------------------------------------------------------------------------------
// CreateDirectSession
//------------------------------------------------------------------------------
function TMsgClient.CreateDirectSession(UserID: Cardinal; Host: String; Port: Integer): TMsgClientSession;
var
    i:                Integer;
    UserInfo:         TMsgUserInfo;
begin
  Result := TMsgClientSession.Create(Self);
  try
    Result.Direct := True;
    Result.OnReceiveMessage := ReceiveMessage;
    FSessions.Add(Result);
    Result.FConnectParams.ServerID := UserID; //MSG_INVALID_USER_ID;
    if (Host = '')
    or (Port = 0)
    then
     begin
      if not Connected then
        raise EMsgException.Create(40068, ErrorRNoServerConnection, [UserID, Host, Port]);
      i := GetUserInfo(UserID,UserInfo);
      if (i = MSG_Error_GetUserInfo_UserDoesNotExist) then
        raise EMsgException.Create(11471, ErrorLUserDoesNotExist, [UserID]);
      if (i <> MSG_COMMAND_OK) then
        raise EMsgException.Create(11472, ErrorLCannotGetUserInfo, [UserID,i]);
      if (UserInfo.Status = msgOffLine) then
        raise EMsgException.Create(11473, ErrorRNoServerConnection, [UserID, Host, Port]);
      Result.FConnectParams.RemoteHost := UserInfo.Host;
      Result.FConnectParams.RemotePort := UserInfo.Port;
      UserInfo.Status := msgConnecting;
      Result.RemoteUser := UserInfo;
{
      Contacts := TList.Create;
      GetMyContactsList(Contacts);
      for i:=0 to Contacts.Count do
       begin
        pUserInfo := Contacts[i];
        if pUserInfo.UserID = UserID then
         begin
          if pUserInfo.Status = msgOffLine then
            raise EMsgException.Create(40068, ErrorRNoServerConnection, [UserID, Host, Port]);
          if (pUserInfo.Port=0)
          or (pUserInfo.Host='')
          then
           begin
            UserInfo := GetUserInfo(UserID,ErrorCode);
            pUserInfo.Host := UserInfo.Host;
            pUserInfo.Port := UserInfo.Port;
           end;
          Result.FConnectParams.RemoteHost := pUserInfo.Host;
          Result.FConnectParams.RemotePort := pUserInfo.Port;
          pUserInfo.Status := msgConnecting;
          Result.RemoteUser := pUserInfo^;
          break;
         end;
       end;
      Contacts.Free;
}
     end
    else
     begin
      Result.FConnectParams.RemoteHost := Host;
      Result.FConnectParams.RemotePort := Port;
      if Connected then
        GetUserInfo(UserID,UserInfo);
      UserInfo.UserID := UserID;
      UserInfo.Host := Host;
      UserInfo.Port := Port;
      UserInfo.Status := msgConnecting;
      Result.RemoteUser := UserInfo;
     end;
  except
    Result.Free;
    raise;
  end;
end;  // CreateDirectSession


//------------------------------------------------------------------------------
// connect to other client directly
//------------------------------------------------------------------------------
procedure TMsgClient.ConnectDirectly(UserID: Cardinal; Host: String = ''; Port: Integer = 0);
var
  Session:          TMsgClientSession;
  bCatchException:  Boolean;
  Error:            String;
begin
  bCatchException := False;
{$IFDEF D6H}
  // fix: to enable open forms with incorrect properties
  if (csDesigning in ComponentState)
     and (not (csFreeNotification in ComponentState)) then
    bCatchException := True;
{$ENDIF}
  Error := Format(ErrorLCannotConnectDirectly,[UserID,Host,Port]);
  if Active then
   begin
    try
     Session := FindSessionWithUser(UserID);
     if (Session = nil)
//  or (not Session.Direct)
     then
       Session := CreateDirectSession(UserID, Host, Port);
     Session.ConnectDirectly;
     if Session.Connected then
      begin
       Session.FRemoteUser.Status := msgConnected;
       FConnectedDirectly := True;
      end;
    except
     on e: EMsgException do
      begin
       DoOnError(MSG_Error_CannotConnectDirectly,e.NativeError,Error+' '+e.Message);
       if (csDesigning in ComponentState) then
        MessageDlg(Error,mtError,[mbOK],0)
       else
       if (not bCatchException) then
         raise;
     end
     else
      begin
       DoOnError(MSG_Error_CannotConnectDirectly,-1,Error);
       if (csDesigning in ComponentState) then
        MessageDlg(Error,mtError,[mbOK],0)
       else
       if (not bCatchException) then
         raise;
      end;
    end;
  end;
end; // ConnectDirectly


//------------------------------------------------------------------------------
// disconnect from server
//------------------------------------------------------------------------------
procedure TMsgClient.Disconnect;
begin
  if Connected then
   begin
    if Assigned(BeforeDisconnect) then
      BeforeDisconnect(Self);
    try
      ClientConnectionManager.Disconnect(FDefaultServerSession);
    except
    end;
    FDefaultServerSession.FConnected := False;
    FConnected := False;
    FDefaultServerSession.FLogged := False;
    FLogged := False;
    if Assigned(AfterDisconnect) then
      AfterDisconnect(Self);
   end;
end; // Disconnect


//------------------------------------------------------------------------------
// disconnect this client from all servers
//------------------------------------------------------------------------------
procedure TMsgClient.DisconnectAll;
var
  Sessions:         TList;
  Session:          TMsgClientSession;
  i:                Integer;
  Error:            String;
begin
  if Assigned(BeforeDisconnect) then
    BeforeDisconnect(Self);
  Sessions:=FSessions.LockList;
  try
   for i:=Sessions.Count-1 downto 0 do
    begin
     Session := Sessions.Items[i];
     if Session.Connected then
      begin
       try
        if (Session = FDefaultServerSession) then
         Error := Format(ErrorLClientCannotDisconnectSessionWithServer,[ConnectionParams.ServerID])
        else
         Error := Format(ErrorLClientCannotDisconnectSessionWithUser,[Session.UserID]);
        if Session <> FDefaultSession then // Do not stop active listener
         begin
          Session.FConnected := False;
          ClientConnectionManager.Disconnect(Session);
         end;
       except
         on e: EMsgException do
          DoOnError(MSG_Error_ClientCannotDisconnectSession,e.NativeError,Error+' '+e.Message);
         else
          DoOnError(MSG_Error_ClientCannotDisconnectSession,-1,Error);
       end;
      end;
    end;
  finally
   FSessions.UnLockList;
   FLogged := False;
   FConnected := False;