msgclient.pas

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

   FConnectedDirectly := False;
   if Assigned(AfterDisconnect) then
    AfterDisconnect(Self);
  end;
end; // DisconnectAll


//------------------------------------------------------------------------------
// Logon
//------------------------------------------------------------------------------
function TMsgClient.Logon: Integer;
begin
  Result := MSG_Error_Logon_NotConnected;
  if (not Connected) then
   Exit;
  Result := FDefaultServerSession.Logon;
  if Logged then
    if (GetContacts <> MSG_COMMAND_OK) then
      SetLength(FContacts,0);
end; // Logon


//------------------------------------------------------------------------------
// Logoff
//------------------------------------------------------------------------------
function TMsgClient.Logoff: Integer;
begin
  Result := FDefaultServerSession.Logoff;
end; // Logoff


//------------------------------------------------------------------------------
// FindSessionWithUser
//------------------------------------------------------------------------------
function TMsgClient.FindSessionWithUser(UserID: Cardinal): TMsgClientSession;
var
  Sessions:         TList;
  Session:          TMsgClientSession;
  i:                Integer;
begin
  Result := nil;
  Sessions:=FSessions.LockList;
  try
   for i:=Sessions.Count-1 downto 0 do
    begin
     Session := Sessions.Items[i];
     if Session.Direct then
       if Session.RemoteUser.UserID = UserID then
        begin
         Result := Session;
         Exit;
        end;
    end;
  finally
   FSessions.UnlockList;
  end;
end; // FindSessionWithUser


//------------------------------------------------------------------------------
// FindSession
//------------------------------------------------------------------------------
function TMsgClient.FindSession(ToUserID: Cardinal; var Directly: Boolean): TMsgClientSession;
var
  i:                Integer;
  Contacts:         TList;
  IsOnLine:         Boolean;
  UserInfo:         TMsgUserInfo;
begin
  Result := nil;
  if Directly then
   begin
    if ConnectedDirectly then
      IsOnLine := True
    else
     begin
      // is user on-line now?
      IsOnLine := False;
      i := GetUserInfo(ToUserID,UserInfo);
      if (i = MSG_COMMAND_OK) then
       if (UserInfo.Status <> msgOffLine) then
        IsOnline := True;
      if (FDefaultServerSession = nil) then
       begin
        Result := FindSessionWithUser(ToUserID);
        if Result <> nil then
          IsOnLine := True;
       end;
     end;
    if not IsOnLine then // off-line
      Directly := False
    else // on-line
     begin
      Result := FindSessionWithUser(ToUserID);
      // is it connected directly?
      try
       if Result = nil then
        begin
         ConnectDirectly(ToUserID);
         Result := FindSessionWithUser(ToUserID);
        end;
       if Result <> nil then
         Result.Connected := True;
      except
       Directly := False;
       if Result <> nil then
        begin
         Result.Free;
         Result := nil;
        end;
      end;
      if Result = nil then
        Directly := False
      else
       if not Result.Connected then
        begin
         Directly := False;
         Result.Free;
         Result := nil;
        end;
     end;
   end;
  if not Directly then
   begin
    Result := TMsgClientSession(FDefaultServerSession);
    if (Result = nil) then
      raise EMsgException.Create(11251,ErrorLClientIsNotConnected);
    if not Result.Connected then
      EMsgException.Create(40042, ErrorRNotConnected);
   end;
end; // FindSession


//------------------------------------------------------------------------------
// sends notification
//------------------------------------------------------------------------------
procedure TMsgClient.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent,Operation);
{
  if (Operation = opRemove) and (AComponent = FSession) and
     (FSession <> MsgDefaultSession) then
    begin
      Disconnect;
      SessionName := '';
    end;
}
end;// Notification


//------------------------------------------------------------------------------
// SessionsCount
//------------------------------------------------------------------------------
function TMsgClient.SessionsCount: Integer;
var
  Sessions:         TList;
begin
  Sessions:=FSessions.LockList;
  try
   Result := Sessions.Count;
  finally
   FSessions.UnLockList;
  end;
end; // SessionsCount


//------------------------------------------------------------------------------
// keep connection
//------------------------------------------------------------------------------
procedure TMsgClient.SetKeepConnection(Value: Boolean);
begin
  if FKeepConnection <> Value then
   begin
    FKeepConnection := Value;
    if not Value and (SessionsCount = 0) then
      Disconnect;
  end;
end;// SetKeepConnection


//------------------------------------------------------------------------------
// CheckConnected
//------------------------------------------------------------------------------
procedure TMsgClient.CheckConnected;
begin
  if (Connected) then
    EMsgException.Create(40043, ErrorRConnected);
end;// CheckConnected


//------------------------------------------------------------------------------
// CheckDisconnected
//------------------------------------------------------------------------------
procedure TMsgClient.CheckDisconnected;
begin
  if (not Connected) then
    EMsgException.Create(40042, ErrorRNotConnected);
end;// CheckDisconnected


//------------------------------------------------------------------------------
// connect / disconnect
//------------------------------------------------------------------------------
procedure TMsgClient.SetActive(value: boolean);
var
  bCatchException:  Boolean;
  ErrorActivate,Error: String;
  ErrorDeactivate:     String;
begin
  if Value = FActive then
    Exit;
  bCatchException := False;
  ErrorActivate := ErrorLClientCannotActivate;
  ErrorDeactivate := ErrorLClientCannotDeactivate;
{$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 Assigned(BeforeActive) then
    BeforeActive(Self);
  try
    if Value then
     begin
      if (FDefaultSession = nil) then
       begin
        FDefaultSession := TMsgClientSession.Create(Self);
        FSessions.Add(FDefaultSession);
       end;
      FDefaultSession.Direct := True;
  //    TMsgClientSession(FDefaultSession).OnReceiveMessage := ReceiveMessage; // allow sending message to non-connected client - security hole!!!
      FDefaultSession.FUserID := FUserID;
      FDefaultSession.ConnectParams := ConnectionParams.ConnectParams;
      ClientConnectionManager.Connect(FDefaultSession, true);
      FDefaultSession.FConnected := True;
      if (FDatabase <> nil) then
       Database.OpenOrCreateDatabase(True);
      FActive := True;
     end
    else
     begin
      FActive := False;
      if (FDefaultSession <> nil) then
       begin
        // free default session
        FDefaultSession.FConnected := False;
        FSessions.Remove(FDefaultSession);
        ClientConnectionManager.Disconnect(FDefaultSession, true);
        FDefaultSession.Free;
        FDefaultSession := nil;
       end;
      if (not Connected) then
       if (FDatabase <> nil) then
        FDatabase.CloseDatabase;
     end;
  finally
   if Assigned(AfterActive) then
    AfterActive(Self);
  end;
 except
   on e: EMsgException do
    begin
     if (Value) then
      begin
       Error := ErrorActivate+' '+e.Message;
       DoOnError(MSG_Error_ClientCannotActivate,e.NativeError,Error);
      end
     else
      begin
       Error := ErrorDeactivate+' '+e.Message;
       DoOnError(MSG_Error_ClientCannotDeactivate,e.NativeError,Error);
      end;
     if (csDesigning in ComponentState) then
      MessageDlg(Error,mtError,[mbOK],0)
     else
      if (not bCatchException) then
       raise;
    end
   else
    begin
     if (Value) then
      begin
       Error := ErrorActivate;
       DoOnError(MSG_Error_ClientCannotActivate,-1,Error);
      end
     else
      begin
       Error := ErrorDeactivate;
       DoOnError(MSG_Error_ClientCannotDeactivate,-1,Error);
      end;
     if (csDesigning in ComponentState) then
      MessageDlg(Error,mtError,[mbOK],0)
     else
      if (not bCatchException) then
       raise;
    end;
 end;
end;//SetActive


//------------------------------------------------------------------------------
// db connected?
//------------------------------------------------------------------------------
function TMsgClient.GetConnected: Boolean;
begin
  Result := FConnected; //(FDefaultServerSession <> nil);
end;// GetConnected


//------------------------------------------------------------------------------
// connect / disconnect
//------------------------------------------------------------------------------
procedure TMsgClient.SetConnected(value: boolean);
begin
  if Value = FConnected then
    Exit;
  if Value then
    Connect
  else
    Disconnect;
end;//SetConnected


//------------------------------------------------------------------------------
// Logged on/off
//------------------------------------------------------------------------------
procedure TMsgClient.SetLogged(value: Boolean);
begin
  if Value = FLogged then
    Exit;
  if Value then
    Logon
  else
    Logoff;
end; // SetLogged

//------------------------------------------------------------------------------
// return contacts
//------------------------------------------------------------------------------