msgserver.pas

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

begin
  inherited Create;
  InitializeCriticalSection(FCSect);
  FServer := TMsgServer(aServer);
  FConnectParams := FServer.ConnectionParams.GetConnectParams;
  FLogged := False;
end; // Create


//------------------------------------------------------------------------------
// Destroy
//------------------------------------------------------------------------------
destructor TMsgServerSession.Destroy;
begin
  inherited Destroy;
  DeleteCriticalSection(FCSect);
end; // Destroy


//------------------------------------------------------------------------------
// call OnError event handler
//------------------------------------------------------------------------------
procedure TMsgServerSession.DoOnError(ErrorCode: Integer; NativeError: Integer = -1; ErrorMessage: String = '');
begin
{$IFDEF DEBUG_ONERROR}
aaWriteToLog('==================================================================');
aaWriteToLog('Error on server session!');
aaWriteToLog('------------------------------------------------------------------');
aaWriteToLog('SessionID='+IntToStr(Integer(self.SessionID)));
aaWriteToLog('ErrorCode='+IntToStr(Integer(ErrorCode)));
aaWriteToLog('NativeError='+IntToStr(Integer(NativeError)));
aaWriteToLog('ErrorMessage:"'+ErrorMessage+'"');
aaWriteToLog('GetTickCount = '+IntToStr(aaGetTickCount));
aaWriteToLog('==================================================================');
{$ENDIF}
  if (FServer <> nil) then
   FServer.DoOnError(ErrorCode,NativeError,ErrorMessage);
end; // DoOnError


//------------------------------------------------------------------------------
// Send command error occured - session must be destroyed
//------------------------------------------------------------------------------
procedure TMsgServerSession.DoCloseSessionOnNetworkError;
begin
 {$IFDEF DEBUG_LOG_COMMUNICATION}
 aaWriteToLog('Server DoCloseSessionOnNetworkError starting, SessionID = '+IntToStr(FSessionID));
 {$ENDIF}
  FServer.FConnectionManager.TerminateSession(self);
 {$IFDEF DEBUG_LOG_COMMUNICATION}
 aaWriteToLog('Server DoCloseSessionOnNetworkError finish, SessionID = '+IntToStr(FSessionID));
 {$ENDIF}
end; // DoCloseSessionOnNetworkError


//------------------------------------------------------------------------------
// ConnectUser
//------------------------------------------------------------------------------
function TMsgServerSession.ConnectUser: Boolean;
begin
 try
  if (not Connected) then
   begin
    Result := FServer.ConnectSession(Self);
    if (Result) then
     FConnected := True;
   end
  else
   Result := True;
 except
  Result := False;
 end;
end; // ConnectUser


//------------------------------------------------------------------------------
// ConnectUser
//------------------------------------------------------------------------------
procedure TMsgServerSession.DisconnectUser;
begin
  FConnected := False;
  FServer.DisconnectSession(Self);
end; // DisconnectUser



//------------------------------------------------------------------------------
// execute received command
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteReceivedCommand(var Buffer: PChar; BufferSize: Integer);
var
  ms:             TMsgMemoryStream;
  CommandHeader:  TMsgCommandHeader;
begin
{$IFDEF DEBUG_LOG_COMMUNICATION}
aaWriteToLog(#13#10+'vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv');
aaWriteToLog('S> ServerSession is starting to execute a received command...');
aaWriteToLog('S> SessionID = '+IntToStr(SessionID)+', ServerID = '+IntToStr(FServer.ServerID)+#13#10+
             'S> Client UserID = '+IntToStr(Integer(FUserID))+#13#10+
             'S> Client Host = '+ConnectParams.RemoteHost+#13#10+
             'S> Client Port = '+IntToStr(ConnectParams.RemotePort)+#13#10
             );
aaWriteBufferToLog(Buffer,BufferSize);
aaWriteToLog('S> Execute Start Time = '+aaGetCurrentTimeAsString);
try
{$ENDIF}
  if (Buffer <> nil) and (BufferSize >= SizeOf(CommandHeader)) then
   begin
    ms := TMsgMemoryStream.Create(Buffer,BufferSize);
    try
      try
       Move(Buffer^,CommandHeader,SizeOf(CommandHeader));
{$IFDEF DEBUG_LOG_COMMUNICATION}
aaWriteToLog('S> CommandCode = '+IntToStr(CommandHeader.CommandCode));
{$ENDIF}
       CommandHeader.NativeError := 0;
       ms.Position := SizeOf(CommandHeader);
       if (not Logged)
       or (FUserID = MSG_INVALID_USER_ID) // guest
       then
         if (CommandHeader.CommandCode <> MsgLogon) then
           if (CommandHeader.CommandCode <> MsgRegisterNewUser) then
             if (CommandHeader.CommandCode <> MsgFindUsers) then
               if (CommandHeader.CommandCode <> MsgIsUserExisting) then
                 Exit;
       case CommandHeader.CommandCode of
        MsgGetUserInfo:            ExecuteGetUserInfo(CommandHeader,ms);
        MsgGetUserID:              ExecuteGetUserID(CommandHeader,ms);
        MsgGetContacts:            ExecuteGetContacts(CommandHeader,ms);
        MsgIsUserExisting:         ExecuteIsUserExisting(CommandHeader,ms);
        MsgIsUserOnline:           ExecuteIsUserOnline(CommandHeader,ms);
        MsgRegisterNewUser:        ExecuteRegisterNewUser(CommandHeader,ms);
        MsgUpdateUserInfo:         ExecuteUpdateUserInfo(CommandHeader,ms);
        MsgAddUserToContacts:      ExecuteAddUserToContacts(CommandHeader,ms);
        MsgUpdateUserInContacts:   ExecuteUpdateUserInContacts(CommandHeader,ms);
        MsgRemoveUserFromContacts: ExecuteRemoveUserFromContacts(CommandHeader,ms);
        MsgFindUsers:              ExecuteFindUsers(CommandHeader,ms);
        MsgFindMessages:           ExecuteFindMessages(CommandHeader,ms);
        MsgLogon:                  ExecuteLogon(CommandHeader,ms);
        MsgLogoff:                 ExecuteLogoff(CommandHeader,ms);
       end;
      except
       // ignore invalid buffer
       on e: EMsgException do
        FServer.DoOnError(CommandHeader.CommandResult,e.NativeError,e.Message);
       on e: Exception do
        FServer.DoOnError(CommandHeader.CommandResult,-1,e.Message)
       else
        FServer.DoOnError(CommandHeader.CommandResult);
      end;
    finally
      ms.Free;
    end;
   end
  else
   if (Buffer <> nil) then
     MemoryManager.FreeAndNilMem(Buffer);
{$IFDEF DEBUG_LOG_COMMUNICATION}
finally
 aaWriteToLog('S> Execute End Time = '+aaGetCurrentTimeAsString);
 aaWriteToLog('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^'+#13#10);
end;
{$ENDIF}
end; // ExecuteReceivedCommand


//------------------------------------------------------------------------------
// SetLogged
//------------------------------------------------------------------------------
procedure TMsgServerSession.SetLogged(value: boolean);
begin
  if Logged = value then
    Exit;
  FLogged := value;
  if Logged then
    FServer.OnLineUser(Self)
  else
    FServer.OffLineUser(Self);
end;// SetLogged


//------------------------------------------------------------------------------
// SetConnected
//------------------------------------------------------------------------------
procedure TMsgServerSession.SetConnected(value: boolean);
begin
  FConnected := value;
end;// SetConnected


//------------------------------------------------------------------------------
// ExecuteLogon
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteLogon(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var UserID:   Cardinal;
    Password: String;
    Buffer:   PChar;
begin
 CommandHeader.CommandResult := MSG_Error_Logon_InvalidParams;
 try
   LoadDataFromStream(UserID,SizeOf(UserID),Stream,40086);
   LoadStringFromStream(Password,Stream,40087);
   CommandHeader.CommandResult := MSG_Error_Logon_InternalServerError;
 except
   on e: EMsgException do
    FServer.DoOnError(CommandHeader.CommandResult,e.NativeError,e.Message);
   on e: Exception do
    FServer.DoOnError(CommandHeader.CommandResult,-1,e.Message)
   else
    FServer.DoOnError(CommandHeader.CommandResult);
 end;
 Stream.Size := 0;
 Stream.Position := 0;
 if (CommandHeader.CommandResult = MSG_Error_Logon_InternalServerError) then
  begin
   try
    if not (FServer.IsUserExisting(UserID)) then
     begin
      CommandHeader.CommandResult := MSG_Error_Logon_UserDoesNotExist;
      FUserID := MSG_INVALID_USER_ID;
     end
    else
    if (FServer.FConnectedUsers.ItemCount > MsgMaxSingleUserConnections) then
      CommandHeader.CommandResult := MSG_Error_Logon_MaxConnectionsExceeded
    else
      if (FServer.IsUserLogged(UserID)) then
        CommandHeader.CommandResult := MSG_Error_Logon_UserAlreadyLogged
      else
        if not (FServer.IsPasswordValid(UserID,Password)) then
         begin
          CommandHeader.CommandResult := MSG_Error_Logon_InvalidPassword;
          Logged := False;
         end
        else
         begin
          CommandHeader.CommandResult := MSG_COMMAND_OK;
          Logged := True;
          Connected := True;
         end;
   except
     on e: EMsgException do
      FServer.DoOnError(CommandHeader.CommandResult,e.NativeError,e.Message);
     on e: Exception do
      FServer.DoOnError(CommandHeader.CommandResult,-1,e.Message)
     else
      FServer.DoOnError(CommandHeader.CommandResult);
   end;
  end;
 SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,40090);
 Buffer := Stream.Buffer;
 SendBuffer(Buffer,Stream.Size);
end; // ExecuteLogon


//------------------------------------------------------------------------------
// ExecuteLogoff
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteLogoff(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var UserID:   Cardinal;
    Password: String;
    Buffer:   PChar;
begin
 CommandHeader.CommandResult := MSG_Error_Logoff_InvalidParams;
 try
   LoadDataFromStream(UserID,SizeOf(UserID),Stream,40088);
   LoadStringFromStream(Password,Stream,40089);
   CommandHeader.CommandResult := MSG_Error_Logoff_InternalServerError;
 except
   on e: EMsgException do
    FServer.DoOnError(CommandHeader.CommandResult,e.NativeError,e.Message);
   on e: Exception do
    FServer.DoOnError(CommandHeader.CommandResult,-1,e.Message)
   else
    FServer.DoOnError(CommandHeader.CommandResult);
 end;
 Stream.Size := 0;
 Stream.Position := 0;
 if (CommandHeader.CommandResult = MSG_Error_Logoff_InternalServerError) then
  begin
   try
    if not (FServer.IsUserExisting(UserID)) then
      CommandHeader.CommandResult := MSG_Error_Logoff_UserDoesNotExist
    else
      if not (FServer.IsUserLogged(UserID)) then
        CommandHeader.CommandResult := MSG_Error_Logoff_UserNotLogged
      else
        if not (FServer.IsPasswordValid(UserID,Password)) then
          CommandHeader.CommandResult := MSG_Error_Logoff_InvalidPassword
        else
         begin
          CommandHeader.CommandResult := MSG_COMMAND_OK;
          Logged := False;
         end;
   except
     on e: EMsgException do
      FServer.DoOnError(CommandHeader.CommandResult,e.NativeError,e.Message);
     on e: Exception do
      FServer.DoOnError(CommandHeader.CommandResult,-1,e.Message)
     else
      FServer.DoOnError(CommandHeader.CommandResult);
   end;
  end;
 SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,40091);