⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 msgserver.pas

📁 Delphi MsgCommunicator 2-10 component.I ve used, really good job. can be Server-Client message appl
💻 PAS
📖 第 1 页 / 共 5 页
字号:
 Buffer := Stream.Buffer;
 SendBuffer(Buffer,Stream.Size);
end; // ExecuteLogoff


//------------------------------------------------------------------------------
// get user info if user exists, otherwise return error code
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteGetUserInfo(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var UserID:   Cardinal;
    Buffer:   PChar;
    UserInfo: TMsgUserInfo;
begin
 CommandHeader.CommandResult := MSG_Error_GetUserInfo_InvalidParams;
 try
   LoadDataFromStream(UserID,SizeOf(UserID),Stream,11464);
   CommandHeader.CommandResult := MSG_COMMAND_OK;
 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_COMMAND_OK) then
  begin
   try
    CommandHeader.CommandResult := MSG_Error_GetUserInfo_UserDoesNotExist;
    UserInfo := FServer.GetUserInfo(UserID);
    if (UserInfo.UserID <> MSG_INVALID_USER_ID) then
     CommandHeader.CommandResult := MSG_COMMAND_OK;
   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;
   SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,11465);
   if (CommandHeader.CommandResult = MSG_COMMAND_OK) then
    FServer.SaveUserInfoToStream(UserInfo,Stream);
  end
 else
   SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,11466);
 Buffer := Stream.Buffer;
 SendBuffer(Buffer,Stream.Size);
end; // ExecuteGetUserInfo


//------------------------------------------------------------------------------
// get user info if user exists, otherwise return error code
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteGetUserID(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var
    Buffer:   PChar;
begin
  CommandHeader.CommandResult := MSG_COMMAND_OK;
  Stream.Size := 0;
  Stream.Position := 0;
  SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,11467);
  SaveDataToStream(FUserID,SizeOf(FUserID),Stream,11468);
  Buffer := Stream.Buffer;
  SendBuffer(Buffer,Stream.Size);
end; // ExecuteGetUserID


//------------------------------------------------------------------------------
// get contacts
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteGetContacts(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var
    Buffer:   PChar;
    Contacts: TMsgContactInfoArray;
begin
  CommandHeader.CommandResult := MSG_Error_GetContacts_Failed;
  try
   FServer.GetUserContacts(FUserID,Contacts);
   CommandHeader.CommandResult := MSG_COMMAND_OK;
  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;
  SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,11469);
  if (CommandHeader.CommandResult = MSG_COMMAND_OK) then
    FServer.SaveContactsToStream(Contacts,Stream);
  Buffer := Stream.Buffer;
  SendBuffer(Buffer,Stream.Size);
  FServer.SendStoredMessages(Self);
end; // ExecuteGetContacts


//------------------------------------------------------------------------------
// return true if user exists
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteIsUserExisting(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var UserID:   Cardinal;
    Buffer:   PChar;
begin
 CommandHeader.CommandResult := MSG_Error_IsUserExisting_InvalidParams;
 try
   LoadDataFromStream(UserID,SizeOf(UserID),Stream,11476);
   CommandHeader.CommandResult := MSG_COMMAND_OK;
 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_COMMAND_OK) then
  begin
   try
    if (FServer.IsUserExisting(UserID)) then
     CommandHeader.CommandResult := MSG_COMMAND_RESULT_TRUE
    else
     CommandHeader.CommandResult := MSG_COMMAND_RESULT_FALSE;
   except
    CommandHeader.CommandResult := MSG_Error_IsUserExisting_Failed;
   end;
  end;
 SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,11477);
 Buffer := Stream.Buffer;
 SendBuffer(Buffer,Stream.Size);
end; // ExecuteIsUserExisting


//------------------------------------------------------------------------------
// return true if user is connected to server
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteIsUserOnline(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var UserID:   Cardinal;
    Buffer:   PChar;
begin
 CommandHeader.CommandResult := MSG_Error_IsUserOnline_InvalidParams;
 try
   LoadDataFromStream(UserID,SizeOf(UserID),Stream,11478);
   CommandHeader.CommandResult := MSG_COMMAND_OK;
 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_COMMAND_OK) then
  begin
   try
    if (FServer.IsUserConnected(UserID)) then
     CommandHeader.CommandResult := MSG_COMMAND_RESULT_TRUE
    else
     CommandHeader.CommandResult := MSG_COMMAND_RESULT_FALSE;
   except
    CommandHeader.CommandResult := MSG_Error_IsUserOnline_Failed;
   end;
  end;
 SaveDataToStream(CommandHeader,SizeOf(CommandHeader),Stream,11479);
 Buffer := Stream.Buffer;
 SendBuffer(Buffer,Stream.Size);
end; // ExecuteIsUserOnline


//------------------------------------------------------------------------------
// try to register new user and send error code if failed
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteRegisterNewUser(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var
    Buffer:   PChar;
    UserInfo: TMsgUserInfo;
    Password: ShortString;
begin
 CommandHeader.CommandResult := MSG_Error_RegisterNewUser_InvalidParams;
 try
   FServer.LoadUserInfoFromStream(UserInfo,Stream);
   LoadShortStringFromStream(Password,Stream,11481);
   CommandHeader.CommandResult := MSG_COMMAND_OK;
 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_COMMAND_OK) then
  begin
   try
    CommandHeader.CommandResult := MSG_Error_RegisterNewUser_Failed;
    if (UserInfo.UserID = MSG_INVALID_USER_ID) then
     begin
      UserInfo.UserID := FServer.GetNewUserID;
      FServer.AddUser(UserInfo,Password);
      CommandHeader.CommandResult := MSG_COMMAND_OK;
     end
    else
     begin
      if (FServer.IsUserExisting(UserInfo.UserID)) then
        CommandHeader.CommandResult := MSG_Error_RegisterNewUser_UserAlreadyExists
      else
       begin
        FServer.AddUser(UserInfo,Password);
        CommandHeader.CommandResult := MSG_COMMAND_OK;
       end;
     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,11484);
 if (CommandHeader.CommandResult = MSG_COMMAND_OK) then
   if (FUserID = MSG_INVALID_USER_ID) then
    begin
     FUserID := UserInfo.UserID;
     SaveDataToStream(FUserID,SizeOf(FUserID),Stream,40093);
    end;
 Buffer := Stream.Buffer;
 SendBuffer(Buffer,Stream.Size);
end; // ExecuteRegisterNewUser


//------------------------------------------------------------------------------
// try to update user information and send error code if failed
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteUpdateUserInfo(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var
    Buffer:         PChar;
    UserInfo:       TMsgUserInfo;
    ChangePassword: Boolean;
    Password:       ShortString;
begin
 CommandHeader.CommandResult := MSG_Error_UpdateUserInfo_InvalidParams;
 try
   FServer.LoadUserInfoFromStream(UserInfo,Stream);
   LoadBooleanFromStream(ChangePassword,Stream,11486);
   LoadShortStringFromStream(Password,Stream,11487);
   UserInfo.UserID := FUserID;
   CommandHeader.CommandResult := MSG_COMMAND_OK;
 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_COMMAND_OK) then
  begin
   try
    CommandHeader.CommandResult := MSG_Error_UpdateUserInfo_Failed;
    if (not FServer.IsUserExisting(UserInfo.UserID)) then
      CommandHeader.CommandResult := MSG_Error_UpdateUserInfo_UserDoesNotExist
    else
     begin
      FServer.ChangeUserInfo(UserInfo,ChangePassword,Password);
      CommandHeader.CommandResult := MSG_COMMAND_OK;
     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,11488);
 Buffer := Stream.Buffer;
 SendBuffer(Buffer,Stream.Size);
end; // ExecuteUpdateUserInfo


//------------------------------------------------------------------------------
// add user to contacts
//------------------------------------------------------------------------------
procedure TMsgServerSession.ExecuteAddUserToContacts(var CommandHeader: TMsgCommandHeader; Stream: TMsgMemoryStream);
var UserID:             Cardinal;
    Buffer:             PChar;
    ContactCustomName:  ShortString;
    ContactNameSource:  TMsgContactNameSource;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -