delphi一个用socket封装udptcp通信的例子

unit UnitTCPUDP; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,WinSock, ExtCtrls, ComCtrls,inifiles,StrUtils; const WM_SOCK = WM_USER + 82; 自定义 windows 消息 /在 tcp 服务器方式下,WM_SOCK 为监听消息 / WM_SOCK+1 到 WM_SOCK+MAX_ACCEPT 为与连接客户端进行通讯时的消息 MAX_ACCEPT=100; FD_SET= MAX_ACCEPT; type TFormTCPUDP = class(TForm) BtnSend: TButton; MemoReceive: TMemo; EditSend: TEdit; Label2: TLabel; Label3: TLabel; Bevel2: TBevel; STOpCode: TStaticText; STIndex: TStaticText; STCommand: TStaticText; GroupBox1: TGroupBox; GroupBox2: TGroupBox; GroupBox3: TGroupBox; RBTCP: TRadioButton; RBUDP: TRadioButton; Panel1: TPanel; RBClient: TRadioButton; RBServer: TRadioButton; GroupBox4: TGroupBox; BtnConnect: TButton; BtnClose: TButton; Bevel1: TBevel; StatusBar1: TStatusBar; PanelDest: TPanel; Label4: TLabel; EditRemoteHost: TEdit; Label5: TLabel; EditRemotePort: TEdit; Label6: TLabel; CmbSendTo: TComboBox; Label7: TLabel; PanelLocal: TPanel; ChkBind: TCheckBox; EditHostPort: TEdit; Label1: TLabel; procedure BtnSendClick(Sender: TObject); procedure BtnConnectClick(Sender: TObject); procedure RBTCPClick(Sender: TObject); procedure RBUDPClick(Sender: TObject); procedure BtnCloseClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure RBClientClick(Sender: TObject); procedure RBServerClick(Sender: TObject); procedure ChkBindClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure EditHostPortChange(Sender: TObject); procedure EditRemoteHostChange(Sender: TObject); procedure EditRemotePortChange(Sender: TObject); procedure FormActivate(Sender: TObject); procedure CmbSendToKeyPress(Sender: TObject; var Key: Char); 消息接送 private Private declarations FirstFlag:Boolean; INIPath:String; procedure ReadData(var Message: TMessage); function ReadTCPUDPIni():boolean; /读取配置信息 procedure WriteIniStr(FileName:String;section:string;Ident:string;StringValue:string);/写系统信息 procedure WriteIniBool(FileName:String;section:string;Ident:string;BoolValue:Boolean);/写系统信息 protected Protected declarations other fields and methods procedure wndproc(var message:Tmessage);override; public Public declarations end; const DATA_LENGTH =120; /数据长度 type TUDPaction = packed record opcode:byte; /操作码 index:word; /序列号 Command:byte; /命令字 data:array0(DATA_LENGTH-1) of char; /数据 end; var FormTCPUDP: TFormTCPUDP; AcceptSock:Array0MAX_ACCEPT OF Tsocket; FSockAccept : Array0MAX_ACCEPT OF TSockAddrIn; AcceptSockFlag: Array0MAX_ACCEPT OF boolean; AcceptNum:integer=0; FSockLocal : TSockAddrIn; PackageID:integer=0; /包序号 BindFlag:Boolean=true; TcpFlag:Boolean=false; ServerFlag:Boolean=false; function WinSockInital(Handle: HWnd):bool; Procedure WinSockClose(); implementation $R *.dfm 始化 SOCKET function WinSockInital(Handle: HWnd):bool; var TempWSAData: TWSAData; i:integer; begin result := false; 1 初始化 SOCKET if WSAStartup(2, TempWSAData)=1 then /2 表示启用 winsock2 exit; 若是用 UDP 通信，则用 if TcpFlag then AcceptSock0:=Socket(AF_INET,SOCK_STREAM,0) else AcceptSock0:=Socket(AF_INET,SOCK_DGRAM,0); if AcceptSock0=SOCKET_ERROR then exit; if (BindFlag and not tcpflag) or (Serverflag and tcpflag) then if bind(AcceptSock0,FSockLocal,sizeof(FSockLocal)0 then /等待连接队列的最大长度为 1 begin WinSockClose(); exit; end; end else if connect(AcceptSock0,FSockAccept0,sizeof(FSockAccept0)0 then begin i:=strtoint(MidStr(CmbSendTo.Text,8,i-8); sendto(AcceptSocki, SEND_PACKAGE,sizeof(SEND_PACKAGE), 0, FSockAccepti, sizeof(FSockAcc epti); end else Application.MessageBox(您没有选择发送方,错误提示,MB_OK); end; / sendto(AcceptSock0, NbtstatPacket,50, 0, FSockAccept0, sizeof(FSockAccept0); end; procedure TFormTCPUDP.BtnConnectClick(Sender: TObject); var s:String; i:integer; begin s:=正在建立连接; StatusBar1.Panels0.Text:=s; Application.ProcessMessages; FSockLocal.sin_family:=AF_INET; FSockLocal.sin_port:=htons(strtoint(EditHostport.Text); FSockAccept0.sin_family:=AF_INET; FSockAccept0.sin_port:=htons(strtoint(EditRemoteport.Text); FSockAccept0.SIn_Addr.S_addr := inet_addr(PChar(EditRemoteHost.Text);/inet_addr(pchar(IP); if WinSockInital(FormTCPUDP.Handle) then begin BtnConnect.Enabled:=false; BtnClose.Enabled:=true; BtnSend.Enabled:=true; s:=连接成功！; if ChkBind.Checked then s:=s+, -绑定端口; if RBTcp.Checked then begin s:=s+,-TCP 方式; if RBServer.Checked then s:=s+,-服务端 else s:=s+,-客户端; end else s:=s+,-UDP 方式; if tcpflag and Serverflag then begin AcceptNum:=0; CmbSendto.Clear; StatusBar1.Panels2.Text:=共有：+inttostr(AcceptNum)+个连接; end; end else begin for i:=0 to StatusBar1.Panels.count-1 do StatusBar1.Panelsi.Text:=; s:=创建套接字失败!; end; StatusBar1.Panels0.Text:=s; end; procedure TFormTCPUDP.wndproc(var Message: TMessage); begin if (Message.Msg=WM_SOCK) and (Message.Msg 0 then begin StatusBar1.Panels0.Text:=收到来自 ip 地址:+inet_ntoa(FSockAcceptIndex.sin_addr)+ 端口: +inttostr(ntohs(FSockAcceptIndex.sin_port)+的数据; StOpCode.Caption:= format(%.2d,Receive_PACKAGE.opCode); StIndex.Caption:= format(%d,Receive_PACKAGE.Index); StCommand.Caption:= format(%.2d,Receive_PACKAGE.Command); MemoReceive.Lines.Add(StrPas(Receive_PACKAGE.data) end; end else if Event=FD_ACCEPT then begin for i:=1 to MAX_ACCEPT DO if not AcceptSockFlagi then begin flen:=Sizeof(FSockAccepti); AcceptSocki:=accept(AcceptSock0,FSockAccepti,flen); WSAAsyncSelect(AcceptSocki, Handle , WM_SOCK+i, FD_READ or FD_CLOSE); AcceptSockFlagi:=true; AcceptNum:=AcceptNum+1; CmbSendto.Items.Add(套接口:+inttostr(i)+ 地址:+inet_ntoa(FSockAccepti.sin_addr)+ 端 口:+inttostr(ntohs(FSockAccepti.sin_port); break; end; StatusBar1.Panels2.Text:=共有：+inttostr(AcceptNum)+个连接; end else if Event=FD_CLOSE then begin WSAAsyncSelect(AcceptSockindex, FormTCPUDP.Handle, 0, 0); if index0 then begin for i:=0 to CmbSendto.Items.Count-1 do if CmbSendto.Items.Stringsi= 套接口:+inttostr(index)+ 地址: +inet_ntoa(FSockAcceptindex.sin_addr)+ 端口:+inttostr(ntohs(FSockAcceptindex.sin_port) then begin CmbSendto.Items.Delete(i); break; end; CloseSocket(AcceptSockindex); AcceptSockFlagindex:=false; AcceptNum:=AcceptNum-1; StatusBar1.Panels2.Text:=共有：+inttostr(AcceptNum)+个连接; end; end; end; procedure TFormTCPUDP.RBTCPClick(Sender: TObject); begin writeiniBool(INIPath+TCPUDP.ini,Setting,TCPStatus,true); RBServer.Enabled:=true; RBClient.Enabled:=true; if RBServer.Checked then begin PanelDest.Visible:=false; CmbSendto.Enabled:=true; end else begin PanelDest.Visible:=true; PanelLocal.Visible:=false; end; ChkBind.Enabled:=false; TcpFlag:=true; end; procedure TFormTCPUDP.RBUDPClick(Sender: TObject); begin writeiniBool(INIPath+TCPUDP.ini,Setting,TCPStatus,false); RBServer.Enabled:=false; RBClient.Enabled:=false; PanelDest.Visible:=true; TcpFlag:=false; ChkBind.Enabled:=true; CmbSendto.Enabled:=false; PanelLocal.Visible:=true; end; procedure TFormTCPUDP.BtnCloseClick(Sender: TObject); var i:integer; begin WinSockClose(); BtnConnect.Enabled:=true; BtnClose.Enabled:=false; BtnSend.Enabled:=false; CmbSendto.Clear; for i:=0 to StatusBar1.Panels.count-1 do StatusBar1.Panelsi.Text:=; Statusbar1.Panels0.Text:=已关闭套接字！ ; end; procedure TFormTCPUDP.FormClose(Sender: TObject; var Action: TCloseAction); begin if BtnClose.Enabled then WinSockClose(); end; procedure TFormTCPUDP.RBClientClick(Sender: TObject); begin writeiniBool(INIPath+TCPUDP.ini,Setting,ServerStatus,false); ServerFlag:=false; PanelDest.Visible:=true; CmbSendto.Enabled:=false; if Tcpflag then PanelLocal.Visible:=false else PanelLocal.Visible:=true; end; procedure TFormTCPUDP.RBServerClick(Sender: TObject); begin writeiniBool(INIPath+TCPUDP.ini,Setting,ServerStatus,true); ServerFlag:=true; if Tcpflag then begin PanelDest.Visible:=false; CmbSendto.Enabled:=true; ChkBind.Enabled:=false; ChkBind.Checked:=true; end else ChkBind.Enabled:=true; PanelLocal.Visible:=true; end; procedure TFormTCPUDP.ChkBindClick(Sender: TObject); begin writeiniBool(INIPath+TCPUDP.ini,Setting,BindStatus,ChkBind.Checked);