《socket通信应用实例》由会员分享，可在线阅读，更多相关《socket通信应用实例（27页珍藏版）》请在金锄头文库上搜索。
1、unit MainUnit;interfaceuses Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, DBGrids, ScktComp, ComCtrls, StdCtrls, ExtCtrls, ComFunUnit, IBDatabase, DB, IBCustomDataSet, IBQuery, IniFiles, Grids;const CMax = 50; /客户端最大连接数 CMsgStoreMax = 30;type client_record = record CHandle : Intege
2、r; /客户端套接字句柄 CSocket : TCustomWinSocket; /客户端套接字 CName : string; /客户端计算机名称 CAddress : string; /客户端计算机IP地址 CUsed : Boolean; /客户端联机标志 end; MsgBuf = record MsgSource : array0.32 of Char; MsgDest : array0.32 of Char; MsgType : Integer; MsgData : array0.2048 of Char; end; PMsg = MsgBuf; POINTTOINT = Inte
3、ger; TMessagIPS = record IPA : string; IPB : string; IPC : string; end; TNodeInfo = record LoadID : string; NodeID : string; end; TUsedIPInfo = (uipIPA, uipIPB, uipIPC); TSendState = (ssNotJob, ssSending, ssFinished); TMsgSocket = class(TClientSocket) private FIPS : TMessagIPS; FSendResult : Boolean
4、; /发送成功标志 FSendState : TSendState; /工作状态 FMsg : MsgBuf; /待发送的消息数据 FUIPFlg : TUsedIPInfo; protected procedure DoActivate(Value: Boolean); override; procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); override; procedure Event(Socket: TCustomWinSocket; SocketEve
5、nt: TSocketEvent); override; public constructor Create(AOwner: TComponent); override; procedure TSendMessage (IPS : TMessagIPS; Msg : MsgBuf); end; TMainForm = class(TForm) Panel1: TPanel; Label3: TLabel; btnInitLinkA: TButton; btnstopA: TButton; csckSend: TClientSocket; tmrSend: TTimer; tmrSaveYC:
6、TTimer; tmrUnPacked: TTimer; pgcFTU: TPageControl; tsFTU: TTabSheet; tsYX: TTabSheet; tsYC: TTabSheet; ibdtbsFTU: TIBDatabase; ibqryFTU: TIBQuery; dbgrd1: TDBGrid; ibqryYX: TIBQuery; ibqryYC: TIBQuery; dbgrd2: TDBGrid; dsMsgSend: TDataSource; dsProRun: TDataSource; dbgrd3: TDBGrid; ibtrnsctn1: TIBTr
7、ansaction; ibqryYXID: TIntegerField; ibqryYXFTUADDR: TIntegerField; ibqryYXYXADDR: TIntegerField; ibqryYXYXNAME: TIBStringField; ibqryYXLASTSTATE: TIntegerField; ibqryYXLASTTIME: TTimeField; ibqryYCID: TIntegerField; ibqryYCFTUADDR: TIntegerField; ibqryYCYCADDR: TIntegerField; ibqryYCYCNAME: TIBStri
8、ngField; ibqryYCYCVALUE: TFloatField; ibqryYCYCPARA: TFloatField; ibqryYCDATATIME: TTimeField; ibqryYCSAVETIME: TTimeField; ibqryYCYCBM: TIBStringField; ibqryFTUFTUID: TIntegerField; ibqryFTUFTUADDR: TIntegerField; ibqryFTUFTUNAME: TIBStringField; ibqryFTUFTUSTATE: TSmallintField; ibqryFTULASTTIME:
9、TTimeField; ibqryFTUDATATIME: TTimeField; ibqryYXONNAME: TIBStringField; ibqryYXOFFNAME: TIBStringField; edtPort: TEdit; mmoReceive: TMemo; mmoSend: TMemo; pnl1: TPanel; lbl1: TLabel; edtIP: TEdit; edtPort1: TEdit; lbl2: TLabel; btnStart: TButton; lbl3: TLabel; lbl4: TLabel; lbl5: TLabel; mmo1: TMem
10、o; lbl6: TLabel; btnSendTestMsg: TButton; lbl7: TLabel; btnWindowsMsg: TButton; lbl8: TLabel; edt1: TEdit; lbl9: TLabel; edt2: TEdit; lbl10: TLabel; edt3: TEdit; csckReceive: TServerSocket; btnInitLinkB: TButton; btnstopB: TButton; mmoTest: TMemo; pnl2: TPanel; ibqrytmp: TIBQuery; dsMsgRecv: TDataSo
11、urce; ibqryMsgRecv: TIBQuery; ibqryMsgSend: TIBQuery; lbl11: TLabel; dsDestPro: TDataSource; ibqryDestPro: TIBQuery; cbbProgramID: TComboBox; dsNode_ID: TDataSource; ibqryNode_ID: TIBQuery; ibqryMsgType: TIBQuery; dsMsgType: TDataSource; dsMsgData: TDataSource; ibqrySMsgData: TIBQuery; ibqryRMsgData
12、: TIBQuery; dsRMsgData: TDataSource; dsMsgSource: TDataSource; ibqryMsgSource: TIBQuery; qryUpdateMsgState: TIBQuery; ds1: TDataSource; ibqrySELE: TIBQuery; dsSELE: TDataSource; ibqryCIP: TIBQuery; dsIPC: TDataSource; cbbNodeName: TComboBox; cbbMsgType: TComboBox; ibqryProHWND: TIBQuery; dsProHWND:
13、TDataSource; edt4: TEdit; ibqryDelSData: TIBQuery; dsDelSData: TDataSource; ibqryProRun: TIBQuery; ibqrySSqlChos: TIBQuery; dsSSqlChos: TDataSource; ibqryNodeID: TIBQuery; dsNodeID: TDataSource; tmrtest: TTimer; qryInsertMessge: TIBQuery; qryUpDataMsgState: TIBQuery; procedure btnStopClick(Sender: TObject); procedure csckSendDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure csckSendError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var E
