delphi利用Window API编写基于socket的tcp程序

客户机和服务器可用互相通讯。 直接贴出代码吧，没有优化，代码可能有些冗余，只是实现了互相发送字符串的功能。仅供参考。

服务器端：

unit untserver;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Winsock;

type
  clients = record
    soc :TSocket;
    add :sockaddr_in;
  end;
  pclients = ^clients;

  Tserver = class(TForm)
    edt1: TEdit;
    lbl1: TLabel;
    btn1: TButton;
    mmo1: TMemo;
    lbl2: TLabel;
    edt2: TEdit;
    btn2: TButton;
    btn3: TButton;
    edt3: TEdit;
    procedure btn1Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
  private
    { Private declarations }
  public
    s :TSocket;
    acThreadID :DWORD;
  end;

procedure ServerAccept(s :TSocket);stdcall;
procedure SocketWorkThread(ns :TSocket);stdcall;
const buflen=100;

var
  server: Tserver;
  clientslist :TList;

implementation

{$R *.dfm}

procedure Tserver.btn1Click(Sender: TObject);
var
 wsa :TWSAData;
 wsstatus :Integer;
 sa : sockaddr_in;
begin
  wsstatus := WSAStartup($0202,wsa);  
  if wsstatus <> 0 then
  begin
    ShowMessage('初始化socket出错！');
    Exit;
  end;

  s := Socket(AF_INET,SOCK_STREAM,0);
  if s < 0 then
  begin
    ShowMessage('创建socket出错！');
    WSACleanup;
    Exit;
  end;

  sa.sin_port := htons(StrToInt(edt1.Text));
  sa.sin_family := AF_INET;
  sa.sin_addr.S_addr := INADDR_ANY;
  wsstatus := bind(s,sa,SizeOf(sa));
  if wsstatus <> 0 then
  begin
    ShowMessage('绑定socket出错');
    WSACleanup;
    Exit;
  end;

  wsstatus := listen(s,5);
  if  wsstatus <> 0 then
  begin
    ShowMessage('监听出错！');
    WSACleanup;
    Exit;
  end;

  clientslist := TList.Create;
  CreateThread(nil,0,@ServerAccept,Pointer(s),0,acThreadID);
  btn1.Enabled := False;
end;

procedure ServerAccept(s :TSocket);stdcall;
var
  ra :sockaddr_in;
  ra_len :integer;
  recev :TSocket;
  ThreadID :DWORD;
  ip :string;
  newclient :pclients;
begin
  ra_len := SizeOf(ra);
  try
    while True do
    begin
     recev := accept(s,@ra,@ra_len);
     if recev = -1 then
     begin
       ExitThread(0);
     end;
     ip := IntToHex(recev,2)+'-'+ IntToStr(Ord(ra.sin_addr.S_un_b.s_b1))+'.'+
              IntToStr(Ord(ra.sin_addr.S_un_b.s_b2))+'.'+
              IntToStr(Ord(ra.sin_addr.S_un_b.s_b3))+'.'+
              IntToStr(Ord(ra.sin_addr.S_un_b.s_b4));
     server.mmo1.Lines.Add(ip);
     GetMem(newclient,SizeOf(clients));
     newclient.soc := recev;
     newclient.add := ra;
     clientslist.Add(newclient);
     CreateThread(nil,0,@SocketWorkThread,Pointer(recev),0,ThreadID);
    end;
  except
  end;
end;

procedure SocketWorkThread(ns :TSocket);stdcall;
var
   recvbuf :array[0..buflen -1] of Char;
   rtn,k :Integer;
   rs :string[buflen];
   error :string;
begin
  try
    while true do
    begin
     rtn := recv(ns,recvbuf,buflen,0);
     if rtn < 1 then
     begin
       for k := 0 to clientslist.Count -1 do
       begin
         if ns = pclients(clientslist.Items[k]).soc then
         begin
            clientslist.Delete(k);
            Break;
         end
         else
           Continue;
       end; 
       CLOSESOCKET(ns);
       error := IntToHex(ns,2)+'退出';
       server.mmo1.Lines.Add(error);
       ExitThread(0);
     end;
     rs := PChar(@recvbuf);
     server.mmo1.Lines.Add(rs);
    end;
  except
  end;
end;

end.

客户端：

unit untclient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,WinSock;

type
  Tclient = class(TForm)
    edt1: TEdit;
    edt2: TEdit;
    lbl1: TLabel;
    lbl2: TLabel;
    edt3: TEdit;
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    mmo1: TMemo;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
  private
    { Private declarations }
  public
      s :TSocket;
  end;

procedure Receive(server :TSocket);stdcall;
const buflen = 100;

var
  client: Tclient;

implementation

{$R *.dfm}

procedure Tclient.btn1Click(Sender: TObject);
var
  sa :TWSAData;
  wstates :Integer;
  ad :sockaddr_in;
  threadid :DWORD;
begin
   wstates := WSAStartup($0202,sa);
   if  wstates <> 0 then
   begin
     ShowMessage('socket初始化出错！');
     Exit;
   end;

   s := socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
   if s = INVALID_SOCKET then
   begin
     ShowMessage('建立socket出错！');
     WSACleanup;
     Exit;
   end;

   ad.sin_family := PF_INET;
   ad.sin_port := htons(StrToInt(edt2.Text));
   ad.sin_addr.S_addr := inet_addr(PChar(edt1.Text));
   wstates := connect(s,ad,SizeOf(ad));
   if wstates <> 0 then
   begin
     ShowMessage('连接错误');
     WSACleanup;
     Exit;
   end;
  btn1.Enabled := False;
  CreateThread(nil,0,@Receive,Pointer(s),0,threadid);
end;

procedure Tclient.btn2Click(Sender: TObject);
var
  sendbuf :array[0..buflen -1] of Char;
  sendLen :Integer;
  i :Integer;
begin
  if edt3.Text <> '' then
  begin
    for i := 0 to Length(edt3.Text) -1 do
      sendbuf[i] := (edt3.Text)[i+1];
    sendLen := send(s,sendbuf,buflen,0);
    if sendLen < 0 then
    begin
      ShowMessage('发送出错');
      WSACleanup;
      btn1.Enabled := False;
      Exit;
    end; 
  end;
end;

procedure Tclient.btn3Click(Sender: TObject);
begin
  try
    closesocket(s);
    WSACleanup;
  finally
    btn1.Enabled := True;
  end;
end;

procedure Receive(server :TSocket);stdcall;
var
  recbuf:array[0..buflen -1] of Char;
  rtn :Integer;
  rs :string;
begin
  while True do
  begin
    rtn := recv(server,recbuf,buflen,0);
    if rtn < 1 then
    begin
      closesocket(server);
      ExitThread(0);
    end;
      rs := pchar(@recbuf);
    client.mmo1.Lines.Add(rs);
  end;
end; 
end.