unit uBase.MessageCommunication; interface uses classes, Windows, Messages, SysUtils, Contnrs, IdUDPServer, IdUDPClient, IdAntiFreeze, IdSocketHandle; const MaxBufferSize = 1024 * 4; ComponentBufferSize = 1024 * 4; Msg_UpLine = WM_USER + 101; Msg_DownLine = WM_USER + 102; Msg_ClaimFile = WM_USER + 103; Msg_ReceiveFile = WM_USER + 104; Msg_ExecMessage = WM_USER + 105; type TMessageType = (mtSend, ms_accept); TMessageState = (ms_start, ms_sending, ms_end); TArrayBuffer = array [0..MaxBufferSize - 1] of Byte; TStreamBuffer = array [0..ComponentBufferSize - 1] of Byte; TBaseManage = class; //IP选项 TIPOptions = class(TPersistent) private FIP: string; FID: string; FPort: Integer; public //procedure Assign(Source: TPersistent); override; published property IP: string read FIP write FIP; property ID: string read FID write FID; property Port: Integer read FPort write FPort; end; //属性 TProperties = class(TPersistent) private FReceiveOptions: TIPOptions; FSendOptions: TIPOptions; public //procedure Assign(Source: TPersistent); override; published property ReceiveOptions: TIPOptions read FReceiveOptions write FReceiveOptions; property SendOptions: TIPOptions read FSendOptions write FSendOptions; end; {------------------------------------------------------------------------------} //消息基类 TBaseMessage = class(TComponent) private FMessageType: TMessageType; //发送,接收 FMessageState: TMessageState; //发送状态:初始,正在发送,发送结束 FSize: Integer; //发送数据大小 FProperties: TProperties; //消息属性 FOwnerManager: TBaseManage; //自定义持久化方法 procedure ReadBuffer(Stream: TStream); procedure WriteBuffer(Stream: TStream); procedure ReadSize(Reader: TReader); procedure WriteSize(Writer: TWriter); procedure ReadMsType(Reader: TReader); procedure WriteMsType(Writer: TWriter); procedure ReadMsState(Reader: TReader); procedure WriteMsState(Writer: TWriter); protected FBuffer: TArrayBuffer; // 发送数据 procedure DefineProperties(Filer: TFiler); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Exec; virtual; abstract; property Size: Integer read FSize write FSize; property MsType: TMessageType read FMessageType write FMessageType; property MsState: TMessageState read FMessageState write FMessageState; property OwnerManager: TBaseManage read FOwnerManager write FOwnerManager; property Buffer: TArrayBuffer read FBuffer write FBuffer; published property Properties: TProperties read FProperties write FProperties; end; TcmType = (ctUpdateOrgStructFile, ctUpLine, ctDownLine, ctLeaveLine, ctClaimFile, ctReceiveFile, ctCancelFile); //命令消息 TCommandMessage = class(TBaseMessage) private FCommandType: TCmType; FMemo: string; function GetCommandType: TCmType; procedure SetCommandType(value: TCmType); public procedure Exec; override; property CommandType: TCmType read GetCommandType write SetCommandType; published property Memo: string read FMemo write FMemo; end; //文本消息 TTextMessage = class(TBaseMessage) private FSumSize: Integer; //文本大小 //获取文本 function GetText: string; procedure SetText(value: string); //设置文本 public procedure Exec; override; property Text: string read GetText; published property SumSize: Integer read FSumSize write FSumSize; end; TFileFlg = (fgNode, fgOrgStruct); //文件消息 TFileMessage = class(TBaseMessage) private FFileName: string; FNewFileName: string; FFlg: TFileFlg; FSize: Integer; public procedure Exec; override; published property FileName: string read FFileName write FFileName; property NewFileName: string read FNewFileName write FNewFileName; property Flg: TFileFlg read FFlg write FFlg; property FileSize: Integer read FSize write FSize; end; TIPState = (psUPLine, psDownLine, psLeaveLine); //IP消息 TIPOptionMessage = class(TBaseMessage) private FIPOptions: TIPOptions; FIPState: TIPState; published property IPOpertions: TIPOptions read FIPOptions write FIPOptions; property IPState: TIPState read FIPState write FIPState; end; TDBOrgStruct = class(TComponent) public constructor create(AOwner: TComponent); end; TOrgStructManage = (bbb); //MsgType = (Msg_UpLine, Msg_DownLine, Msg_ClaimFile, Msg_ReceiveFile, Msg_ExecMessage); TOnUpdateEvent = procedure (a: string) of object; TOnTextMessageEvent = procedure (a: string) of object; TOnLineState = procedure (a: string) of object; TOnSendFile = procedure (a: string) of object; {-----------------------------------------------------------------------------} //消息管理类 TBaseManage = class(TComponent) private FWindHandle: THandle; FMessageUDPServer: TIdUDPServer; //接收消息 FSendUDPClient: TIdUDPClient; // FIdAntiFreeze: TIdAntiFreeze; FOrgStruct: TDBOrgStruct; //组织结构数据表 FOrgStructManage: TOrgStructManage; //组织结构数据管理 FOnUpdateState: TOnUpdateEvent; //消息更新 FUserList: TObjectList; FOnTextMessage: TOnTextMessageEvent; //文本消息事件 FOnLineState: TOnLineState; //在线状态事件 FFileList: TObjectList; FOnSendFile: TOnSendFile; //文件发送事件 //发送基类消息 procedure SendMessage(vHost: string; vPort: Integer; vMessage: TBaseMessage); //上线 procedure UpLine(vCm: TCommandMessage); //下线 procedure DownLine(vCm: TCommandMessage); //请求发送文件 procedure ClaimFile(vCm: TCommandMessage); //确认接收文件 procedure ReceiveFile(vCm: TCommandMessage); //执行消息 procedure ExecMessage(vBm: TBaseMessage); protected procedure WndProc(var Message: TMessage); procedure MessageUDPServerUDPRead(Sender: TObject; AData: TStream; ABiding: TIdSocketHandle); virtual; procedure AddFileList(vOldFileName, vNewFilePath: string); // 添加到发送文件列表 procedure DeleteFileList(vOldFileName: string); function FindFileList(vOldFileName: string): string; property MessageUDPServer: TIdUDPServer read FMessageUDPServer; property FileList: TObjectList read FFileList; public constructor create(AOwner: TComponent); override; destructor Destroy; override; procedure SendText(vHost: string; vPort: Integer; vText: string); procedure SendCommand(vHost: string; vPort: Integer; vCommand: TCmType; vMsType: TMessageType; vFlg: TFileFlg=fgNode; vMemo: string=''); procedure SendFile(vHost: string; vPort: Integer; vFileName: string; vNewFileName: string; vMsType: TMessageType; vFlg: TFileFlg); procedure AddUser(vID, vIP: string; vPort: Integer); procedure DeleteUser(vIP: string); procedure BoardCastIPOption(vIPOption: TIPOptions; vIPState: TIPState); property UserList: TObjectList read FUserList; property OrgStructManage: TOrgStructManage read FOrgStructManage write FOrgStructManage; property OrgStruct: TDBOrgStruct read FOrgStruct; property OnUpdateState: TOnUpdateEvent read FOnUpdateState write FOnUpdateState; property OnTextMessage: TOnTextMessageEvent read FOnTextMessage write FOnTextMessage; property OnLineState: TOnLineState read FOnLineState write FOnLineState; property OnSendFile: TOnSendFile read FOnSendFile write FOnSendFile; property Handle: THandle read FWindHandle; end; //文件发送线程 TFileSendThread = class(TThread) private FOwnerManage: TBaseManage; FHost: string; FPort: Integer; FFileName: string; FNewFileName: string; FMsType: TMessageType; FFlg: TFileFlg; protected procedure Execute; override; public procedure SendFile(vOwnerManage: TBaseManage; vHost: string; vPort: Integer; vFileName: string; vNewFileName: string; vMsType: TMessageType; vFlg: TFileFlg); end; {------------------------------------------------------------------------------} //基本通讯类 //服务端 TServerManage = class(TBaseManage) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; //客户端 TClientManage = class(TBaseManage) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; implementation { TBaseMessage } constructor TBaseMessage.Create(AOwner: TComponent); begin inherited; FProperties := TProperties.Create; ZeroMemory(@FBuffer, MaxBufferSize); end; procedure TBaseMessage.DefineProperties(Filer: TFiler); begin inherited; Filer.DefineProperty('Size', ReadSize, WriteSize, True); Filer.DefineBinaryProperty('Buffer', ReadBuffer, WriteBuffer, FSize>0); Filer.DefineProperty('MsType', ReadMsType, WriteMsType, True); Filer.DefineProperty('MsState', ReadState, WriteState, True); end; destructor TBaseMessage.Destroy; begin FProperties.Free; inherited; end; procedure TBaseMessage.ReadBuffer(Stream: TStream); begin Stream.Read(FBuffer, FSize); end; procedure TBaseMessage.ReadMsState(Reader: TReader); begin FMessageState := TMessageState(Reader.ReadInteger); end; procedure TBaseMessage.ReadMsType(Reader: TReader); begin FMessageType := TMessageType(Reader.ReadInteger); end; procedure TBaseMessage.ReadSize(Reader: TReader); begin FSize := Reader.ReadInteger; end; procedure TBaseMessage.WriteBuffer(Stream: TStream); begin Stream.Write(FBuffer, FSize); end; procedure TBaseMessage.WriteMsState(Writer: TWriter); begin Writer.WriteInteger(Integer(FMessageState)); end; procedure TBaseMessage.WriteMsType(Writer: TWriter); begin Writer.WriteInteger(Integer(FMessageType)); end; procedure TBaseMessage.WriteSize(Writer: TWriter); begin Writer.WriteInteger(FSize); end; { TCommandMessage } procedure TCommandMessage.Exec; begin inherited; case CommandType of ctUpdateOrgStructFile: begin if MsType = mtSend then //请求命令 begin //OwnerManager.SendFile(Properties.SendOptions.IP, Properties.SendOptions.Port, //App_Path + Path_OrgStruct, '', mtReceive, fg_OrgStruct); //OwnerManager.SendCommand(Properties.SendOptions.IP, Properties.SendOptions.Port, // ctUpdateOrgStructFile, mtReceive ); end else //执行命令 begin end; end; ctUpLine: //上线 begin Windows.SendMessage(OwnerManager.Handle, Msg_UpLine, Integer(self), 0); end; ctDownLine: //下线 begin Windows.SendMessage(OwnerManager.Handle, Msg_DownLine, Integer(self), 0); end; ctLeaveLine: //离线 begin end; ctClaimFile: //请求发送文件 begin Windows.SendMessage(OwnerManager.Handle, Msg_ClaimFile, Integer(self), 0); end; ctCancelFile: //取消发送文件 begin //Windows.SendMessage(OwnerManager.Handle, Msg_UpLine, Integer(self), 0); end; end; end; function TCommandMessage.GetCommandType: TCmType; var MemoryStream: TMemoryStream; begin MemoryStream := TMemoryStream.Create; MemoryStream.Write(FBuffer, Size); MemoryStream.Position := 0; MemoryStream.Read(Result, Size); MemoryStream.Free; end; procedure TCommandMessage.SetCommandType(value: TCmType); var MemoryStream: TMemoryStream; begin FCommandType := value; Size := SizeOf(Integer); MemoryStream := TMemoryStream.Create; MemoryStream.Write(value, Size); MemoryStream.Position := 0; MemoryStream.Read(FBuffer, Size); MemoryStream.Free; end; { TTextMessage } procedure TTextMessage.Exec; begin inherited; //if Assigned(OwnerManager.OnTextMessage) then // OwnerManager.OnTextMessage(Self); Free; end; function TTextMessage.GetText: string; begin SetLength(Result, Size); CopyMemory(Pchar(Result), @FBuffer, Size); end; procedure TTextMessage.SetText(value: string); begin ZeroMemory(@FBuffer, Size); Size := Length(value); CopyMemory(@FBuffer, Pchar(value), Size); end; { TFileMessage } procedure TFileMessage.Exec; //读取组织结构文件 procedure ReadOrgStructFile; var FileStream: TFileStream; begin { if FileSize = 0 then begin if FileExists(AppPath + Path_OrgStruct) then DeleteFile(AppPath + Path_OrgStruct); Exit; end; // end if FileSize FileStream := TFileStream.Create(AppPath + Path_OrgStruct, fmCreate or fmOpenReadWrite); FileStream.Seek(0, SoEnd); FileStream.Write(FBuffer, Size) FileStream.Free; } end; //读取发送文件 procedure ReadFileName; var FileStream: TFileStream; begin if Size = 0 then if FileExists(NewFileName) then DeleteFile(NewFileName); if not FileExists(NewFileName) then FileStream := TFileStream.Create(NewFileName, fmCreate or fmOpenReadWrite) else FileStream := TFileStream.Create(NewFileName, fmOpenReadWrite); FileStream.Seek(0, SoEnd); FileStream.Write(FBuffer, Size); FileStream.Free; end; begin inherited; case Flg of fgNode: ReadFileName; fgOrgStruct: ReadOrgStructFile; end; Free; end; { TBaseManage } procedure TBaseManage.AddFileList(vOldFileName, vNewFilePath: string); begin end; procedure TBaseManage.AddUser(vID, vIP: string; vPort: Integer); begin end; procedure TBaseManage.BoardCastIPOption(vIPOption: TIPOptions; vIPState: TIPState); procedure BoardCastUpLine; //上线通知 var i: Integer; IPOptionMessage: TIPOptionMessage; IP: string; Port: Integer; begin for i:= 0 to UserList.Count - 1 do begin if TIPOptions(UserList[i]).IP <> vIPOption.IP then begin IP := TIPOptions(UserList[i]).IP; Port := TIPOptions(UserList[i]).Port; IPOptionMessage := TIPOptionMessage.Create(nil); IPOptionMessage.IPOpertions.Assign(vIPOption); IPOptionMessage.IPState := vIPState; SendMessage(IP, Port, IPOptionMessage); IPOptionMessage.Free; IPOptionMessage := TIPOptionMessage.Create(nil); IPOptionMessage.IPOpertions.Assign(TIPOptions(UserList[i])); IPOptionMessage.IPState := vIPState; SendMessage(vIPOption.IP, vIPOption.Port, IPOptionMessage); IPOptionMessage.Free; end; // end if TIPOptions end; // end for end; begin end; procedure TBaseManage.ClaimFile(vCm: TCommandMessage); begin end; constructor TBaseManage.create(AOwner: TComponent); begin inherited; //消息句柄创建 FWindHandle := AllocateHWnd(WndProc); //接收数据的UDP FMessageUDPServer := TIdUDPServer.Create(self); FMessageUDPServer.ThreadedEvent := True; FMessageUDPServer.OnUDPRead := MessageUDPServerUDPRead; FMessageUDPServer.BufferSize := ComponentBufferSize; //发送数据的UDP FSendUDPClient := TIdUDPClient.Create(self); FSendUDPClient.BufferSize := ComponentBufferSize; FSendUDPClient.ReceiveTimeout := 5000; FIdAntiFreeze := TIdAntiFreeze.Create(self); FIdAntiFreeze.Active := True; //数据操作类 FOrgStruct := TDBOrgStruct.create(self); //在线用户列表 FUserList := TObjectList.Create; //文件发送列表 FFileList := TObjectList.Create; end; procedure TBaseManage.DeleteFileList(vOldFileName: string); begin end; procedure TBaseManage.DeleteUser(vIP: string); begin end; destructor TBaseManage.Destroy; begin inherited; end; procedure TBaseManage.DownLine(vCm: TCommandMessage); begin end; procedure TBaseManage.ExecMessage(vBm: TBaseMessage); begin end; function TBaseManage.FindFileList(vOldFileName: string): string; begin end; //所有消息处理 procedure TBaseManage.MessageUDPServerUDPRead(Sender: TObject; AData: TStream; ABiding: TIdSocketHandle); var MessageObject: TBaseMessage; Str: string; begin AData.Position := 0; MessageObject := TBaseMessage.Create(nil); MessageObject := TBaseMessage(AData.ReadComponent(nil)); MessageObject.OwnerManager := self; MessageObject.Properties.SendOptions.IP := ABiding.PeerIP; MessageObject.Properties.SendOptions.Port := ABiding.PeerPort;//ClientPort; Str := 'OK'; ABiding.SendTo(ABiding.PeerIP, ABiding.PeerPort, Str[1], Length(Str)); Windows.SendMessage(FWindHandle, Msg_ExecMessage, Integer(MessageObject), 0) end; procedure TBaseManage.ReceiveFile(vCm: TCommandMessage); begin end; procedure TBaseManage.SendCommand(vHost: string; vPort: Integer; vCommand: TCmType; vMsType: TMessageType; vFlg: TFileFlg=fgNode; vMemo: string=''); var CommandMessage: TCommandMessage; begin CommandMessage := TCommandMessage.Create(nil); CommandMessage.CommandType := vCommand; CommandMessage.MsType := vMsType; CommandMessage.Memo := vMemo; SendMessage(vHost, vPort, CommandMessage); CommandMessage.Free; end; procedure TBaseManage.SendFile(vHost: string; vPort: Integer; vFileName, vNewFileName: string; vMsType: TMessageType; vFlg: TFileFlg); var CommandMessage: TCommandMessage; FileSendThread: TFileSendThread; begin CommandMessage := TCommandMessage.Create(nil); CommandMessage.MsType := vMsType; FileSendThread := TFileSendThread.Create(True); FileSendThread.SendFile(self, vHost, vPort, vFileName, vNewFileName, vMsType, vFlg); FileSendThread.Resume; end; procedure TBaseManage.SendMessage(vHost: string; vPort: Integer; vMessage: TBaseMessage); var MemoryStream: TMemoryStream; BF: TStreamBuffer; ResStr: string; begin vMessage.Properties.ReceiveOptions.IP := vHost; vMessage.Properties.ReceiveOptions.Port := vPort; //if (self is TClientManage) and (TClientManage(Self).CurNodeObject.ID <> nil) then // vMessage.Properties.SendOptions.ID := IntToStr(TClientManage(Self).CurNodeObject.ID); MemoryStream := TMemoryStream.Create; MemoryStream.WriteComponent(vMessage); MemoryStream.Position := 0; ZeroMemory(@BF, MemoryStream.Size); MemoryStream.Read(BF, MemoryStream.Size); FSendUDPClient.SendBuffer(vHost, vPort, BF, MemoryStream.Size); ResStr := ''; ResStr := FSendUDPClient.ReceiveString(); MemoryStream.Free; end; procedure TBaseManage.SendText(vHost: string; vPort: Integer; vText: string); var TextMessage: TTextMessage; MemoryStream: TMemoryStream; Step: Integer; Buffer: Pointer; begin MemoryStream := TMemoryStream.Create; //将文本写入流 MemoryStream.Write(vText[1], Length(vText)); MemoryStream.Position := 0; while MemoryStream.Position < MemoryStream.Size do begin if MemoryStream.Position + MaxBufferSize <= MemoryStream.Size then Step := MaxBufferSize else Step := MemoryStream.Size - MemoryStream.Position; TextMessage := TTextMessage.Create(nil); if Step + MemoryStream.Position = MemoryStream.Size then TextMessage.SumSize := MemoryStream.Size; Buffer := @TextMessage.FBuffer; ZeroMemory(Buffer, MaxBufferSize); MemoryStream.Read(Buffer^, Step); TextMessage.Size := Step; self.SendMessage(vHost, vPort, TextMessage); TextMessage.Free; end; MemoryStream.Free; end; procedure TBaseManage.UpLine(vCm: TCommandMessage); begin end; procedure TBaseManage.WndProc(var Message: TMessage); begin inherited; with message do begin case Msg of Msg_UpLine: UpLine(TCommandMessage(WParam)); Msg_DownLine: DownLine(TCommandMessage(WParam)); Msg_ClaimFile: ClaimFile(TCommandMessage(WParam)); Msg_ReceiveFile: ReceiveFile(TCommandMessage(WParam)); Msg_ExecMessage: ExecMessage(TCommandMessage(WParam)); else Result := DefWindowProc(FWindHandle, Msg, WParam, LParam); end; end; end; { TDBOrgStruct } constructor TDBOrgStruct.create(AOwner: TComponent); begin end; { TFileSendThread } procedure TFileSendThread.Execute; var FileMessage: TFileMessage; FileStream: TFileStream; Step: Integer; Buffer: TArrayBuffer; begin inherited; if not FileExists(FFileName) then Exit; FileStream := TFileStream.Create(FFileName, fmOpenRead); while FileStream.Position < FileStream.Size do begin Step := 0; FileMessage := TFileMessage.Create(nil); FileMessage.FileName := FNewFileName; FileMessage.Flg := FFlg; FileMessage.FileSize := FileStream.Position; FileMessage.MsType := FMsType; if FileStream.Position + MaxBufferSize <= FileStream.Size then Inc(Step, MaxBufferSize) else Inc(Step, FileStream.Size - FileStream.Position); ZeroMemory(@Buffer, MaxBufferSize); FileStream.Read(Buffer, Step); FileMessage.Size := Step; CopyMemory(@FileMessage.Buffer, @Buffer, Step); FOwnerManage.SendMessage(FHost, FPort, FileMessage); FileMessage.Free; end; FileStream.Free; Free; end; procedure TFileSendThread.SendFile(vOwnerManage: TBaseManage; vHost: string; vPort: Integer; vFileName, vNewFileName: string; vMsType: TMessageType; vFlg: TFileFlg); begin FOwnerManage := vOwnerManage; FHost := vHost; FPort := vPort; FFileName := vFileName; FNewFileName := vNewFileName; FMsType := vMsType; FFlg := vFlg; end; { TServerManage } constructor TServerManage.Create(AOwner: TComponent); begin inherited; MessageUDPServer.DefaultPort := 8818; //ServerPort; MessageUDPServer.Active := True; end; destructor TServerManage.Destroy; begin inherited; end; { TClientManage } constructor TClientManage.Create(AOwner: TComponent); begin inherited; //MessageUDPServer.DefaultPort := 8818; //FSendUDPClient.Host := '192.168.110.8'; //FSendUDPClient.Port := 8818; MessageUDPServer.Active := True; end; destructor TClientManage.Destroy; begin inherited; end; end.