unit UnitTCPUDP;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,WinSock, ExtCtrls, ComCtrls,inifiles,StrUtils;const //WM_USER = $0400; 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:array[0..(DATA_LENGTH-1)] of char; //数据 end;var FormTCPUDP: TFormTCPUDP; AcceptSock:Array[0..MAX_ACCEPT] OF Tsocket; FSockAccept : Array[0..MAX_ACCEPT] OF TSockAddrIn; AcceptSockFlag: Array[0..MAX_ACCEPT] OF boolean; AcceptNum:integer=0; FSockLocal : TSockAddrIn; PackageID:integer=0; //包序号 BindFlag:Boolean=true; //绑定标志 TcpFlag:Boolean=false; //tcp方式标志 ServerFlag:Boolean=false; //服务器端标志 function WinSockInital(Handle: HWnd):bool; //WinSock初始化 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 AcceptSock[0]:=Socket(AF_INET,SOCK_STREAM,0) else AcceptSock[0]:=Socket(AF_INET,SOCK_DGRAM,0); if AcceptSock[0]=SOCKET_ERROR then exit; if (BindFlag and not tcpflag) or (Serverflag and tcpflag) then if bind(AcceptSock[0],FSockLocal,sizeof(FSockLocal))<>0 then begin WinSockClose(); exit; end; if Tcpflag then if Serverflag then begin if Listen(AcceptSock[0],1)<>0 then //等待连接队列的最大长度为1 begin WinSockClose(); exit; end; end else if connect(AcceptSock[0],FSockAccept[0],sizeof(FSockAccept[0]))<>0 then begin WinSockClose(); exit; end; {FD_READ 在读就绪的时候, 产生WM_SOCK 自定义消息号} if not TcpFlag then WSAAsyncSelect(AcceptSock[0], Handle , WM_SOCK, FD_READ) else if Serverflag then WSAAsyncSelect(AcceptSock[0], Handle , WM_SOCK, FD_READ or FD_ACCEPT or FD_CLOSE) else WSAAsyncSelect(AcceptSock[0], Handle , WM_SOCK, FD_READ or FD_CLOSE); Result:=true;end;{关闭SOCKET}Procedure WinSockClose();var i:integer;begin for i:=1 to MAX_ACCEPT DO if AcceptSockFlag then begin CloseSocket(AcceptSock); AcceptSockFlag:=false; end; CloseSocket(AcceptSock[0]); {closesocket函数用来关闭一个描述符为AcceptSock[0]套接字} WSACleanup;end;function TFormTCPUDP.ReadTCPUDPIni():boolean;var ti:TiniFile;begin ti:=TIniFile.Create(INIPath+'TCPUDP.ini'); EditHostPort.text:=ti.ReadString('Setting','LocalPort',''); ChkBind.Checked:=ti.ReadBool('Setting','BindStatus',false); EditRemotePort.text:=ti.ReadString('Setting','RemotePort',''); EditRemoteHost.text:=ti.ReadString('Setting','RemoteHost',''); RBTCP.Checked:=ti.ReadBool('Setting','TCPStatus',false); RBUDP.Checked:=not RBTCP.Checked; RBServer.Checked:=ti.ReadBool('Setting','ServerStatus',false); RBClient.Checked:=not RBServer.Checked;end;procedure TFormTCPUDP.WriteIniStr(FileName:String;Section:string;Ident:string;StringValue:string);var ti:TiniFile;begin ti:=TIniFile.Create(FileName); ti.writestring(section,Ident,StringValue); ti.Free;end;procedure TFormTCPUDP.WriteIniBool(FileName:String;Section:string;Ident:string;BoolValue:Boolean);var ti:TiniFile;begin ti:=TIniFile.Create(FileName); ti.writebool(section,Ident,BoolValue); ti.Free;end;procedure TFormTCPUDP.BtnSendClick(Sender: TObject);var SEND_PACKAGE : TUDPaction; //数据发送 i:integer; //j:integer; s:String;begin Fillchar(SEND_PACKAGE.data,Data_Length,chr(0)); SEND_PACKAGE.data[0]:='1'; SEND_PACKAGE.data[1]:='2'; SEND_PACKAGE.data[2]:='3'; SEND_PACKAGE.opcode:=2; SEND_PACKAGE.index:=PackageID; SEND_PACKAGE.Command:=3; s:=editsend.Text; for i:=0 to length(EditSend.Text)-1 do SEND_PACKAGE.data:=s[i+1]; PackageID:=PackageID+1; if not (Tcpflag and Serverflag) then //for j:=0 to AcceptSock sendto(AcceptSock[0], SEND_PACKAGE,sizeof(SEND_PACKAGE), 0, FSockAccept[0], sizeof(FSockAccept[0])) else if AcceptNum=0 then Application.MessageBox('没有一个客户端和您建立连接','信息提示',MB_OK) else begin i:=pos(' ',CmbSendto.Text); if i>0 then begin i:=strtoint(MidStr(CmbSendTo.Text,8,i-8)); sendto(AcceptSock, SEND_PACKAGE,sizeof(SEND_PACKAGE), 0, FSockAccept, sizeof(FSockAccept)); end else Application.MessageBox('您没有选择发送方','错误提示',MB_OK); end;// sendto(AcceptSock[0], NbtstatPacket,50, 0, FSockAccept[0], sizeof(FSockAccept[0]));end;procedure TFormTCPUDP.BtnConnectClick(Sender: TObject);var s:String; i:integer;begin s:='正在建立连接....'; StatusBar1.Panels[0].Text:=s; Application.ProcessMessages; FSockLocal.sin_family:=AF_INET; FSockLocal.sin_port:=htons(strtoint(EditHostport.Text)); FSockAccept[0].sin_family:=AF_INET; FSockAccept[0].sin_port:=htons(strtoint(EditRemoteport.Text)); FSockAccept[0].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.Panels[2].Text:='共有：'+inttostr(AcceptNum)+'个连接'; end; end else begin for i:=0 to StatusBar1.Panels.count-1 do StatusBar1.Panels.Text:=''; s:='创建套接字失败!!'; end; StatusBar1.Panels[0].Text:=s;end;procedure TFormTCPUDP.wndproc(var Message: TMessage);begin if (Message.Msg>=WM_SOCK) and (Message.Msg<=WM_SOCK+MAX_ACCEPT) then ReadData(Message) else inherited wndproc(message);end;procedure TFormTCPUDP.ReadData(var Message: TMessage);var Receive_PACKAGE : TUDPaction; //数据发送 flen,len,i,index: integer; Event: word;begin Index:=(Message.Msg-WM_SOCK); flen:=sizeof(FSockAccept[Index]); Event := WSAGetSelectEvent(Message.LParam); if Event = FD_READ then begin len := recvfrom(AcceptSock[Index], Receive_PACKAGE, sizeof(Receive_PACKAGE), 0, FSockAccept[Index], Flen); if len> 0 then begin StatusBar1.Panels[0].Text:='收到来自ip地址:'+inet_ntoa(FSockAccept[Index].sin_addr)+' 端口:'+inttostr(ntohs(FSockAccept[Index].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 AcceptSockFlag then begin flen:=Sizeof(FSockAccept); AcceptSock:=accept(AcceptSock[0],@FSockAccept,@flen); WSAAsyncSelect(AcceptSock, Handle , WM_SOCK+i, FD_READ or FD_CLOSE); AcceptSockFlag:=true; AcceptNum:=AcceptNum+1; CmbSendto.Items.Add('套接口:'+inttostr(i)+' 地址:'+inet_ntoa(FSockAccept.sin_addr)+' 端口:'+inttostr(ntohs(FSockAccept.sin_port))); break; end; StatusBar1.Panels[2].Text:='共有：'+inttostr(AcceptNum)+'个连接'; end else if Event=FD_CLOSE then begin WSAAsyncSelect(AcceptSock[index], FormTCPUDP.Handle, 0, 0); if index<>0 then begin for i:=0 to CmbSendto.Items.Count-1 do if CmbSendto.Items.Strings= '套接口:'+inttostr(index)+' 地址:'+inet_ntoa(FSockAccept[index].sin_addr)+' 端口:'+inttostr(ntohs(FSockAccept[index].sin_port)) then begin CmbSendto.Items.Delete(i); break; end; CloseSocket(AcceptSock[index]); AcceptSockFlag[index]:=false; AcceptNum:=AcceptNum-1; StatusBar1.Panels[2].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.Panels.Text:=''; Statusbar1.Panels[0].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); BindFlag:=ChkBind.Checked;end;procedure TFormTCPUDP.FormCreate(Sender: TObject);var i:integer;begin FirstFlag:=true; for i:=1 to MAX_ACCEPT do AcceptSockFlag:=false; INIPath:=extractFilePath(ParamStr(0));end;procedure TFormTCPUDP.EditHostPortChange(Sender: TObject);begin writeiniStr(INIPath+'TCPUDP.ini','Setting','LocalPort',EditHostPort.Text);end;procedure TFormTCPUDP.EditRemoteHostChange(Sender: TObject);begin writeiniStr(INIPath+'TCPUDP.ini','Setting','RemoteHost',EditRemoteHost.Text);end;procedure TFormTCPUDP.EditRemotePortChange(Sender: TObject);begin writeiniStr(INIPath+'TCPUDP.ini','Setting','RemotePort',EditRemotePort.Text);end;procedure TFormTCPUDP.FormActivate(Sender: TObject);begin if FirstFlag then begin FirstFlag:=false; ReadTCPUDPIni(); end;end;procedure TFormTCPUDP.CmbSendToKeyPress(Sender: TObject; var Key: Char);begin key:=chr(0);end;end.
