[delphi] socket封装UDP/TCP通信的例子

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: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;
  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
       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
          &
nbsp;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[i] then
    begin
      CloseSocket(AcceptSock[i]);
      AcceptSockFlag[i]:=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;
    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[i]:=s[i+1];
  PackageID:=PackageID+1;
  if not (Tcpflag and Serverflag) then
    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[i], SEND_PACKAGE,sizeof(SEND_PACKAGE), 0, FSockAccept[i], sizeof(FSockAccept[i]));
    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[i].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 : TUDPacti
on;  //数据发送
   flen,len,i,index: integer;
   Event: word;
begin
  Index:=(Message.Msg-WM_SOCK);
  flen:=sizeof(FSockAccept&#91;Index&#93;);
  Event := WSAGetSelectEvent(Message.LParam);
  if Event = FD_READ then
  begin
    len := recvfrom(AcceptSock&#91;Index&#93;, Receive_PACKAGE, sizeof(Receive_PACKAGE), 0, FSockAccept&#91;Index&#93;, 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[i] then
         begin
           flen:=Sizeof(FSockAccept[i]);
           AcceptSock[i]:=accept(AcceptSock[0],@FSockAccept[i],@flen);
           WSAAsyncSelect(AcceptSock[i], Handle , WM_SOCK+i, FD_READ or FD_CLOSE);
           AcceptSockFlag[i]:=true;
           AcceptNum:=AcceptNum+1;
           CmbSendto.Items.Add('套接口:'+inttostr(i)+'   地址:'+inet_ntoa(FSockAccept[i].sin_addr)+'   端口:'+inttostr(ntohs(FSockAccept[i].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[i]= '套接口:'+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[i].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[i]:=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.