API编写WinSock通信示例

闲着没事，写一个socket的基本应用，针对初学者，老鸟们可以掠过。本示例采用Delphi2010编写。

本示例中，涉及到的缓冲，均采取1024长度，采用的select轮询，现在select轮询已经被认为是比较低级的方法了，微软也不推荐使用，这里就以它开头吧，有时间，大家可以研究其他用法，比如WSAAsyncSelect模型 ，WSAEventSelect模型 ，Overlapped I/O 事件通知模型 ，Overlapped I/O 完成例程模型 ，IOCP模型 。下面开始贴代码了：

 

服务端单元：SocketServer

unit SocketServer; interface uses Windows, Classes,SyncObjs ,WinSock ,SysUtils; type TGetDataEvent = procedure(const stream:TMemoryStream) of object; TClientConnected = procedure(const socket: TSocket) of object; TWorkThread = class; TServerItem = class; TSocketServer = class private FServerSocket : TSocket; //客户端连接列表 FClientSocketList : TStringList; FServerItem : TServerItem; //允许最大连接数 FMaxClientCount : Integer; //客户端连接数 FClientCount : Integer; //当前客户端的索引 FClientIndex : Integer; //调用方的Handle FCallHandle : HWND; //接收用的内存流 FRecStream : TMemoryStream; //接收缓冲区 FRecBuf : array of byte; FHost : AnsiString; FPort : Integer; FTimeVal: TTimeVal; //工作线程 FWorkThread : TWorkThread; //以下是自定义事件 FOnGetData : TGetDataEvent; FOnClientConnected : TClientConnected; //初始化套接字 function InitSocket:Boolean; //从某个客户端套接字中获取数据 procedure GetDataFromClient(socket:TSocket); //检查是否有新的客户端连接 procedure CheckNewSocket; procedure SetMaxClientCount(const Value:Integer); function GetMaxClientCount:Integer; function GetClientCount:Integer; function GetMaxClient: Integer; procedure SetMaxClient(const Value: Integer); protected procedure DoRevData(stream:TMemoryStream); procedure DoClientConnected(socket:TSocket); //取得某个套接字的IP地址 function GetItemIP(index:Integer):PAnsiChar; function GetItemActived(index:Integer):Boolean; procedure SetItemActived(index:Integer;const Value:Boolean); public //ACallHandle:调用者的句柄, CreateSuspended:线程是否挂起 constructor Create(ACallHandle:HWND;CreateSuspended: Boolean);overload; //启用监听 function ListenStart:Boolean; //执行线程 procedure ResumeThread; property Host : AnsiString read FHost write FHost; property Port : Integer read FPort write FPort; property MaxClientCount : Integer read GetMaxClientCount write SetMaxClientCount; property OnClientConnected : TClientConnected read FOnClientConnected write FOnClientConnected; property OnGetData : TGetDataEvent read FOnGetData write FOnGetData; property ClientSocketList : TStringList read FClientSocketList; property IP[index: Integer] : PAnsiChar read GetItemIP; property ItemActived[index: Integer] : Boolean read GetItemActived write SetItemActived; property ClientCount : Integer read GetClientCount write FClientCount; property ClientIndex : Integer read FClientIndex; end; TWorkThread = class(TThread) private //临界 FLock : TCriticalSection; FSocketServer : TSocketServer; procedure Execute;override; procedure ReciveFromClient; public constructor Create(ASocketServer:TSocketServer;CreateSuspended: Boolean);overload; end; TServerItem = class private FSocket : TSocket; FIP : PAnsiChar; FActived : Boolean; public property Socket : TSocket read FSocket write FSocket; property IP : PAnsiChar read FIP write FIP; property Actived : Boolean read FActived write FActived; end; implementation const BufLen = 1024; { TSocketServer } procedure TSocketServer.CheckNewSocket; var fd : TFDSet; addr: sockaddr_in; addrlen: Integer; val: Integer; rec : TSocket; item : TServerItem; begin WinSock.FD_ZERO(fd); WinSock.FD_SET(FServerSocket,fd); val := WinSock.select(FServerSocket,@fd,nil,nil,@FTimeVal); if val > 0 then begin addrlen := SizeOf(addr); //接收可用连接 rec := WinSock.accept(FServerSocket,@addr,@addrlen); if rec <> INVALID_SOCKET then begin item := TServerItem.Create; item.Socket := rec; item.IP := WinSock.inet_ntoa(addr.sin_addr); item.Actived := True; //发现有新连接，添加到列表 FClientSocketList.AddObject(IntToStr(rec),TObject(item)); FClientIndex := FClientSocketList.Count - 1; FClientCount := FClientSocketList.Count; //触发连接事件 DoClientConnected(rec); end; end; end; constructor TSocketServer.Create(ACallHandle: HWND; CreateSuspended: Boolean); begin FCallHandle := ACallHandle; FClientIndex := -1; SetLength(FRecBuf,BufLen); FPort := 80; InitSocket; FRecStream := TMemoryStream.Create; FClientSocketList := TStringList.Create; FWorkThread := TWorkThread.Create(Self,True); //设置等待时间 FTimeVal.tv_sec := 0; {单位:毫秒} FTimeVal.tv_usec := 10; {单位:秒} end; procedure TSocketServer.DoClientConnected(socket: TSocket); begin if Assigned(OnClientConnected) then begin OnClientConnected(socket); end; end; procedure TSocketServer.DoRevData(stream: TMemoryStream); begin if Assigned(OnGetData) then begin OnGetData(FRecStream); end; end; function TSocketServer.GetClientCount: Integer; begin Result := FClientSocketList.Count; end; procedure TSocketServer.GetDataFromClient(socket: TSocket); var fd : TFDSet; val,reclen,i : Integer; begin WinSock.FD_ZERO(fd); WinSock.FD_SET(socket,fd); val := WinSock.select(socket,@fd,nil,nil,@FTimeVal); if val > 0 then begin FClientIndex := FClientSocketList.IndexOf(IntToStr(socket)); FRecStream.Clear; //接收数据，reclen为接收到的数据长度 reclen := WinSock.recv(socket,FRecBuf,BufLen,0); if reclen = 0 then Exit; //写入到接收内存流中 FRecStream.Write(FRecBuf,reclen); //触发调用者的接收数据事件 DoRevData(FRecStream); end; end; function TSocketServer.GetItemActived(index: Integer): Boolean; begin Result := TServerItem(FClientSocketList.Objects[index]).Actived; end; function TSocketServer.GetItemIP(index: Integer): PAnsiChar; begin Result := TServerItem(FClientSocketList.Objects[index]).IP; end; function TSocketServer.GetMaxClient: Integer; begin Result := FMaxClientCount; end; function TSocketServer.GetMaxClientCount: Integer; begin end; function TSocketServer.InitSocket: Boolean; var WSA : TWSAData; begin Result := False; if WSAStartup($0101,WSA) <> 0 then begin Result := False; Exit; end else begin end; Result := True; end; function TSocketServer.ListenStart: Boolean; var addr : sockaddr_in; begin Result := False; FServerSocket := socket(PF_INET,Sock_Stream,IPPROTO_IP); if FServerSocket = INVALID_SOCKET then begin Result := False; Exit; end else begin end; addr.sin_family := PF_INET; addr.sin_port := htons(FPort); addr.sin_addr.S_addr := INADDR_ANY; if bind(FServerSocket,addr,SizeOf(addr)) = SOCKET_ERROR then begin Result := False; closesocket(FServerSocket); Exit; end else begin end; listen(FServerSocket,5); Result := True; end; procedure TSocketServer.ResumeThread; begin FWorkThread.Resume; end; procedure TSocketServer.SetItemActived(index: Integer; const Value: Boolean); begin TServerItem(FClientSocketList.Objects[index]).Actived := Value; end; procedure TSocketServer.SetMaxClient(const Value: Integer); begin FMaxClientCount := Value; end; procedure TSocketServer.SetMaxClientCount(const Value: Integer); begin end; { TWorkThread } constructor TWorkThread.Create(ASocketServer: TSocketServer; CreateSuspended: Boolean); begin FSocketServer := ASocketServer; FLock := TCriticalSection.Create; inherited Create(CreateSuspended); FreeOnTerminate := True; end; procedure TWorkThread.Execute; begin inherited; FLock.Enter; while not Terminated do begin ReciveFromClient; FSocketServer.CheckNewSocket; end; FLock.Leave; end; //采用select轮询方式，从客户端获取数据 procedure TWorkThread.ReciveFromClient; var i : Integer; begin for i := FSocketServer.ClientSocketList.Count - 1 downto 0 do begin //如果套接字 Actived := False，则从列表中删除 if not TServerItem(FSocketServer.ClientSocketList.Objects[i]).Actived then begin FSocketServer.ClientSocketList.Delete(i); FSocketServer.ClientCount := FSocketServer.ClientCount - 1; continue; end; FSocketServer.GetDataFromClient(TServerItem(FSocketServer.ClientSocketList.Objects[i]).Socket); end; end; end.

服务端窗体：ServerMain

unit ServerMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,WinSock,SocketServer; type TServerForm = class(TForm) Label2: TLabel; ed_Port: TEdit; ListBox1: TListBox; btn_Start: TButton; Label1: TLabel; procedure btn_StartClick(Sender: TObject); private { Private declarations } Server: TSocket; FStop: Boolean; FServerThread: TServerThread; FServerSocket : TSocketServer; procedure DoGetData(const stream:TMemoryStream); procedure DoClientConnected(const socket:TSocket); procedure DoClientDisConnected; public { Public declarations } end; var ServerForm: TServerForm; implementation {$R *.dfm} procedure TServerForm.btn_StartClick(Sender: TObject); begin FServerSocket := TSocketServer.Create(Self.Handle,False); FServerSocket.Port := StrToInt(ed_Port.Text); FServerSocket.OnGetData := Self.DoGetData; FServerSocket.OnClientConnected := Self.DoClientConnected; if FServerSocket.ListenStart then FServerSocket.ResumeThread; end; procedure TServerForm.DoClientConnected(const socket: TSocket); begin ListBox1.Items.Add('用户:'+FServerSocket.IP[FServerSocket.ClientSocketList.Count - 1]+'已连接！'); Label1.Caption := '客户端连接数：'+ IntToStr(FServerSocket.ClientCount); end; procedure TServerForm.DoClientDisConnected; begin ListBox1.Items.Add('用户:'+FServerSocket.IP[FServerSocket.ClientSocketList.Count - 1]+'已断开！'); Label1.Caption := '客户端连接数：'+ IntToStr(FServerSocket.ClientCount); end; procedure TServerForm.DoGetData(const stream: TMemoryStream); var i:integer; buffer : array [0..1023] of AnsiChar; s : AnsiString; begin FillChar(buffer,Length(buffer),0); stream.Position := 0; stream.Read(buffer,Length(buffer)); SetString(s,buffer,Length(buffer)); //Exit为退出标志 if Trim(s) = 'Exit' then begin if FServerSocket.ClientIndex = -1 then Exit; DoClientDisConnected; //将退出的套接字的活动状态设置为False FServerSocket.ItemActived[FServerSocket.ClientIndex] := False; Exit; end; ListBox1.Items.Add(s); end; end.

 

 

 

下面是客户端，客户端比较简单，只是实现了发送字符串。

 

客户端单元：SocketClient

unit SocketClient; interface uses Windows, Classes,SyncObjs ,WinSock ,SysUtils; type TSocketClient = class private //客户端套接字描述 FClientSocket : TSocket; //服务端地址 FHost : AnsiString; //端口 FPort : Integer; //初始化套接字 function InitSocket:Boolean; public constructor Create;overload; //连接服务端 function ConnectToServer:Boolean; //发送字符串 procedure SendData(s:AnsiString); property Host : AnsiString read FHost write FHost; property Port : Integer read FPort write FPort; end; implementation const BufLen = 1024; { TServerClient } function TSocketClient.ConnectToServer: Boolean; var addr : sockaddr_in; hostaddr : u_long; begin Result := False; FClientSocket := socket(PF_INET,Sock_Stream,IPPROTO_IP); if FClientSocket <> INVALID_SOCKET then begin addr.sin_family := PF_INET; addr.sin_port := htons(FPort); hostaddr := inet_addr(PAnsiChar(FHost)); if hostaddr = -1 then begin //ShowMessage('IP地址错误！'); Exit; end; addr.sin_addr.S_addr := hostaddr; if connect(FClientSocket,addr,SizeOf(addr)) <> 0 then begin //ShowMessage('连接服务器超时！'); Exit; end; end; Result := True; //Label3.Caption := '连接成功！'+IntToStr(Client); end; constructor TSocketClient.Create; begin InitSocket; end; function TSocketClient.InitSocket: Boolean; var WSA : TWSAData; begin Result := True; if WSAStartup($0101,WSA) <> 0 then begin Result := False; end; end; procedure TSocketClient.SendData(s:AnsiString); var buffer : array [0..1023] of byte; begin FillChar(buffer,Length(buffer),0); Move(s[1],buffer,Length(s)); WinSock.send(FClientSocket,buffer,Length(s),0); end; end.

客户端窗体：ClientMain

unit ClientMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,WinSock,SocketClient; type TClientForm = class(TForm) Label1: TLabel; Label2: TLabel; ed_Host: TEdit; ed_Port: TEdit; btn_Connect: TButton; Label3: TLabel; Button3: TButton; Edit3: TEdit; Button5: TButton; procedure FormCreate(Sender: TObject); procedure btn_ConnectClick(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button5Click(Sender: TObject); private { Private declarations } Client : TSocket; FServerClient : TSocketClient; public { Public declarations } end; var ClientForm: TClientForm; implementation {$R *.dfm} procedure TClientForm.btn_ConnectClick(Sender: TObject); begin FServerClient := TSocketClient.Create; FServerClient.Port := StrToIntDef(ed_Port.Text,80); FServerClient.Host := AnsiString(ed_Host.Text); if FServerClient.ConnectToServer then Label3.Caption := '连接服务端成功！'; end; procedure TClientForm.Button3Click(Sender: TObject); begin FServerClient.SendData(AnsiString(Edit3.Text)); end; procedure TClientForm.Button5Click(Sender: TObject); begin //发送退出标志 FServerClient.SendData('Exit'); //关闭套接字 WinSock.closesocket(Client); end; procedure TClientForm.FormCreate(Sender: TObject); var WSA : TWSAData; begin if WSAStartup($0101,WSA) <> 0 then begin ShowMessage('创建套接字失败！'); end; end; end.

 

 

源码下载：http://download.csdn.net/source/2662127