📄 msgcombase.pas
字号:
{******************************************************************************}
{ }
{ Base internal classes }
{ }
{******************************************************************************}
unit MsgComBase;
interface
{$I MsgVer.inc}
uses Classes,SysUtils,
// MsgCommunicator units
MsgCompression,
MsgCrypto,
MsgConst,
{$IFDEF DEBUG_LOG}
MsgDebug,
{$ENDIF}
MsgTypes;
const
MSG_INVALID_USER_ID = $FFFFFFFF; // 4294967295;
type
TMsgComponent = class;
TMsgUserStatus = (msgOffLine, msgOnLine, msgConnecting, msgConnected, msgNone);
TMsgUserInfo = packed record
UserID: Cardinal;
UserName: ShortString;
FirstName: ShortString;
LastName: ShortString;
Organization: ShortString;
Department: ShortString;
Status: TMsgUserStatus;
Host: ShortString;
Port: Integer;
Application: ShortString;
end;
PMsgUserInfo = ^TMsgUserInfo;
TMsgBaseUserInfo = packed record
UserInfo: TMsgUserInfo;
PasswordHeader: TMsgCryptoHeader;
end;
PMsgBaseUserInfo = ^TMsgBaseUserInfo;
TMsgContactInfo = packed record
UserInfo: TMsgUserInfo;
ContactNameSource: TMsgContactNameSource;
ContactCustomName: ShortString;
end; // TMsgContactInfo
PMsgContactInfo = ^TMsgContactInfo;
TMsgUserInfoArray = array of TMsgUserInfo;
TMsgContactInfoArray = array of TMsgContactInfo;
// sort fields
TMsgUserInfoArraySortBy = (msgusbNone,msgusbUserID,msgusbUserName,
msgusbFirstName,msgusbLastName,msgusbStatus,msgusbHost,msgusbPort,msgusbApplication);
// Client/Server events
TMsgOnUserOnLine = procedure (const UserID: Cardinal) of object;
TMsgOnUserOffLine = procedure (const UserID: Cardinal) of object;
// TMsgOnDisconnectUser = procedure of object;
TMsgOnReceiveTextMessage = procedure (const FromUserID: Cardinal; const SendingDate,DeliveryDate: TDateTime; const Text: String) of object;
TMsgOnReceiveBinaryMessage = procedure (const FromUserID: Cardinal; const SendingDate,DeliveryDate: TDateTime; Buffer: PAnsiChar; Size: Integer) of object;
TMsgOnReceiveStreamMessage = procedure (const FromUserID: Cardinal; const SendingDate,DeliveryDate: TDateTime; Stream: TStream) of object;
TMsgOnReceiveCommand = procedure (const FromID, Command: Cardinal; const SendingDate,DeliveryDate: TDateTime; Buffer: PAnsiChar; Size: Integer) of object;
TMsgOnSaveMessage = procedure (
const SenderID: Cardinal;
const RecipientID: Cardinal;
const MessageType: TMsgMessageType;
const SendingDate: TDateTime;
const DeliveryDate: TDateTime;
const MessageData: PChar;
const MessageDataSize: Integer;
var MessageText: String;
var MessageUnicodeText: WideString;
const Command: Cardinal
) of object;
TMsgOnError = procedure (
Sender: TComponent;
const ErrorCode: Integer;
const NativeError: Integer;
const ErrorMessage: String
) of object;
////////////////////////////////////////////////////////////////////////////////
//
// TMsgComponent
//
////////////////////////////////////////////////////////////////////////////////
TMsgComponent = class (TComponent)
protected
FOnSaveMessage: TMsgOnSaveMessage;
FOnError: TMsgOnError;
protected
procedure LoadBaseUserInfoFromStream(BaseUserInfo: PMsgBaseUserInfo; Stream: TStream);
procedure SaveBaseUserInfoToStream(BaseUserInfo: PMsgBaseUserInfo; Stream: TStream);
procedure LoadUserInfoFromStream(var UserInfo: TMsgUserInfo; Stream: TStream);
procedure SaveUserInfoToStream(var UserInfo: TMsgUserInfo; Stream: TStream);
procedure LoadContactInfoFromStream(var ContactInfo: TMsgContactInfo; Stream: TStream);
procedure SaveContactInfoToStream(var ContactInfo: TMsgContactInfo; Stream: TStream);
procedure LoadBaseContactInfoFromStream(var ContactInfo: TMsgContactInfo; Stream: TStream);
procedure SaveBaseContactInfoToStream(var ContactInfo: TMsgContactInfo; Stream: TStream);
procedure LoadContactsFromStream(var Contacts: TMsgContactInfoArray; Stream: TStream);
procedure SaveContactsToStream(var Contacts: TMsgContactInfoArray; Stream: TStream);
// save message to database and return MessageID
function SaveMessageToDatabase(
Database: TComponent;
SenderID: Cardinal;
RecipientID: Cardinal;
MessageType: TMsgMessageType;
SendingDate: TDateTime;
Delivered: Boolean;
DeliveryDate: TDateTime;
Stream: TMsgMemoryStream
): Integer;
procedure DoOnError(
const ErrorCode: Integer;
const NativeError: Integer = -1;
const ErrorMessage: String = ''
);
function GetCurrentVersion: String;
procedure SetCurrentVersion(value: String);
public
function GetContactDisplayName(const ContactInfo: TMsgContactInfo): String;
published
property CurrentVersion: String read GetCurrentVersion write SetCurrentVersion;
property OnSaveMessage: TMsgOnSaveMessage read FOnSaveMessage write FOnSaveMessage;
property OnError: TMsgOnError read FOnError write FOnError;
end; // TMsgComponent
////////////////////////////////////////////////////////////////////////////////
//
// TMsgComBaseSession
//
////////////////////////////////////////////////////////////////////////////////
TMsgComBaseSession = class (TObject)
private
FSessionID: TMsgSessionID;
protected
FConnected: Boolean;
public
FUserID: Cardinal;
FConnectParams: TMsgConnectParams;
protected
procedure SetConnected(value: boolean); virtual; abstract;
// send custom message
procedure SendMessage(Buffer: PChar; BufferSize: Integer); virtual; abstract;
public
// constructor
constructor Create;
// destructor
destructor Destroy; override;
procedure DoOnError(ErrorCode: Integer; NativeError: Integer = -1; ErrorMessage: String = ''); virtual; abstract;
procedure DoCloseSessionOnNetworkError; virtual; abstract;
procedure SaveCommandHeader(
Stream: TStream;
CommandCode: Integer;
CommandResult: Integer = 0;
NativeError: Integer = 0
);
function ConnectUser(UserID: Cardinal; Host: String; Port: Integer):
TMsgComBaseSession; virtual; abstract;
function ConnectedUser(UserID: Cardinal; Host: String; Port: Integer): Boolean;
virtual; abstract;
{
(*****************************************************************************)
(* COMMANDS *)
(*****************************************************************************)
// connect this client to server
procedure Connect; virtual; abstract;
// disconnect this client from server
procedure Disconnect; virtual; abstract;
// connect user to this client
function ConnectUser(UserID: Cardinal): Boolean; virtual; abstract;
// disconnect user from this client
function DisconnectUser(UserID: Cardinal): Boolean; virtual; abstract;
// determine if user exists at server
function GetUserInfo(UserID: Cardinal): TMsgBaseUserInfo; virtual; abstract;
// register new user at server
function RegisterNewUser(UserInfo: TMsgBaseUserInfo): Boolean; virtual; abstract;
// add user to Contacts list of this client
function AddUserToMyContacts(UserID: Cardinal): Boolean; virtual; abstract;
// remove user from Contacts list of this client
function RemoveUserFromMyContacts(UserID: Cardinal): Boolean; virtual; abstract;
// get list of Contacts of this client from server
procedure GetMyContactsList; virtual; abstract;
(*****************************************************************************)
}
// send buffer with command in it via established connection using connection manager
procedure SendBuffer(Buffer: PChar; BufferSize: Integer; Code: Integer); virtual; abstract;
// receive command
procedure ReceiveData(var Buffer: PChar; var BufferSize: Integer); virtual; abstract;
// receive custom message
procedure ReceiveMessage(Buffer: PChar; BufferSize: Integer); virtual; abstract;
procedure OnDisconnect; virtual; abstract;
public
property SessionID: TMsgSessionID read FSessionID write FSessionID;
property UserID: Cardinal read FUserID;
property Connected: Boolean read FConnected write SetConnected;
property ConnectParams: TMsgConnectParams read FConnectParams write FConnectParams;
end; // TMsgComBaseSession
////////////////////////////////////////////////////////////////////////////////
//
// TMsgNetworkSession
//
////////////////////////////////////////////////////////////////////////////////
TMsgNetworkSession = class(TMsgComBaseSession)
protected
FLogged: Boolean;
procedure SetLogged(value: boolean); virtual; abstract;
public
// constructor
constructor Create;
// destructor
destructor Destroy; override;
public
property Logged: Boolean read FLogged write SetLogged;
end; // TMsgNetworkSession
implementation
uses MsgDatabase, MsgClient;
////////////////////////////////////////////////////////////////////////////////
//
// TMsgComponent
//
////////////////////////////////////////////////////////////////////////////////
//------------------------------------------------------------------------------
// load user info + password header
//------------------------------------------------------------------------------
procedure TMsgComponent.LoadBaseUserInfoFromStream(BaseUserInfo: PMsgBaseUserInfo; Stream: TStream);
begin
LoadUserInfoFromStream(BaseUserInfo^.UserInfo,Stream);
LoadDataFromStream(BaseUserInfo^.PasswordHeader,SizeOf(BaseUserInfo^.PasswordHeader),Stream,11457);
end; // LoadBaseUserInfoFromStream
//------------------------------------------------------------------------------
// save user info + password header
//------------------------------------------------------------------------------
procedure TMsgComponent.SaveBaseUserInfoToStream(BaseUserInfo: PMsgBaseUserInfo; Stream: TStream);
begin
SaveUserInfoToStream(BaseUserInfo^.UserInfo,Stream);
SaveDataToStream(BaseUserInfo^.PasswordHeader,SizeOf(BaseUserInfo^.PasswordHeader),Stream,11456);
end; // SaveBaseUserInfoToStream
//------------------------------------------------------------------------------
// user info
//------------------------------------------------------------------------------
procedure TMsgComponent.LoadUserInfoFromStream(var UserInfo: TMsgUserInfo; Stream: TStream);
begin
LoadDataFromStream(UserInfo.UserID,SizeOf(UserInfo.UserID),Stream,11436);
LoadShortStringFromStream(UserInfo.UserName,Stream,11437);
LoadShortStringFromStream(UserInfo.FirstName,Stream,11438);
LoadShortStringFromStream(UserInfo.LastName,Stream,11439);
LoadShortStringFromStream(UserInfo.Organization,Stream,11440);
LoadShortStringFromStream(UserInfo.Department,Stream,11441);
LoadDataFromStream(UserInfo.Status,SizeOf(UserInfo.Status),Stream,11442);
LoadShortStringFromStream(UserInfo.Host,Stream,11443);
LoadDataFromStream(UserInfo.Port,SizeOf(UserInfo.Port),Stream,11444);
LoadShortStringFromStream(UserInfo.Application,Stream,11445);
end; // LoadUserInfoFromStream
//------------------------------------------------------------------------------
// user info
//------------------------------------------------------------------------------
procedure TMsgComponent.SaveUserInfoToStream(var UserInfo: TMsgUserInfo; Stream: TStream);
begin
SaveDataToStream(UserInfo.UserID,SizeOf(UserInfo.UserID),Stream,11446);
SaveShortStringToStream(UserInfo.UserName,Stream,11447);
SaveShortStringToStream(UserInfo.FirstName,Stream,11448);
SaveShortStringToStream(UserInfo.LastName,Stream,11449);
SaveShortStringToStream(UserInfo.Organization,Stream,11450);
SaveShortStringToStream(UserInfo.Department,Stream,11451);
SaveDataToStream(UserInfo.Status,SizeOf(UserInfo.Status),Stream,11452);
SaveShortStringToStream(UserInfo.Host,Stream,11453);
SaveDataToStream(UserInfo.Port,SizeOf(UserInfo.Port),Stream,11454);
SaveShortStringToStream(UserInfo.Application,Stream,11455);
end; // SaveUserInfoToStream
//------------------------------------------------------------------------------
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -