delphi socket 编程 使用多线程

http://blog.csdn.net/lailai186/article/details/8788710?utm_source=tuicool

TClientSocket和TServerSocket的数据通知使用了Windwos下的消息通知机制，造成它们只适合针对窗口的WinForm程序，因为可以得到窗口的Handle句柄，用来postmessage或者sendmessage，但对于Dll这样的不存在窗口的工程就不适应了，我做了测试：

在DLL工程中引入TClientSocket，设置HostIP,HostPort后，Active后开始send数据，然后Active设置false关闭连接，但服务端没有收到数据，server端的ClientReadr事件不能被调用。

所以考虑一下还是用Windows的API来实现标准的Socket连接，结果通讯可以得到数据了。一下是实现代码，贴出来希望对做D7Socket的DLL需求的哥们有个帮助。

Server端代码：

{*************************************************
**uSocketFasca
@note:winsock 服务程序封装类

}

unit uSocketFasca;

interface

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

//定义socket传输的数据结构
type
  PPACKDATA=^TPACKDATA;
  TPACKDATA=record
    cmd:string[];
    data:string[];
    id:LongInt;
  end;

//定义服务数据获取线程
  TServerThread=class(TThread)
  private
     FSocket:Integer;
     g_preId:Integer;
  protected
     procedure Execute; override;
     procedure DecvDataLoop;
  public
     constructor Create(SockHd:Integer);
 end;

 //定义server启动线程
 TInvokerThread=class(TThread)
 private
   m_serversocket:Integer;
   m_clientsocket:Integer;
   m_serveraddr:sockaddr_in;
   Client_Addr: TSockAddr;
   ClientLen: Integer;
   FHostIp:string;
   FHostPort:Integer;
 protected
   procedure Execute;override;
    //初始化并启动服务
   procedure InitAndStartServerSocket;
   //释放WInSOck
   procedure WSACleanup();
   procedure InitLogger();
 public
   constructor Create(HostIp:string;HostPort:Integer);
 end;

 var
    FLogger:TLogger;

 implementation

 {TInvokerThread}
 procedure TInvokerThread.InitLogger();
 begin
      FLogger:=TLogger.GetLoggerInstance('uSocketFasca');
 end;

 //初始化并启动服务socket
 procedure TInvokerThread.InitAndStartServerSocket;
 var
   XL_WSADATA:TWSAData;
   Ret:Integer;
   threadFunc:TServerThread;
   tm : Longint;
 begin
   //init winsock 2.0 libaray
  Ret:=WSAStartup(MakeWord(,),XL_WSADATA);
  if (<>Ret) then
  begin
    FLogger.Send('WSASetUp error!');
    Exit;
  end;
  //create socket
  m_serversocket:=socket(PF_INET,SOCK_STREAM,);
  if INVALID_SOCKET = m_serversocket then
  begin
    FLogger.Send('Create socket error!');
     Exit;
  end;
  tm:=;//非锁定模式 ;TM:=0锁定模式
  ioctlsocket(m_serversocket,FIONBIO,tm);
  //bind socket
  m_serveraddr.sin_family:=PF_INET ;
  m_serveraddr.sin_port:=htons(FHostPort);
  m_serveraddr.sin_addr.S_addr:=INADDR_ANY;
  Ret:=bind(m_serversocket,m_serveraddr,SizeOf(m_serveraddr));
  if Ret=SOCKET_ERROR then
  begin
     FLogger.Send('socket bind error!');
     Exit;
  end;
  //linsten
  Ret:=listen(m_serversocket,);
   if Ret=SOCKET_ERROR then
  begin
     FLogger.Send('listen socket error!');
     Exit;
  end;
    m_clientsocket:=INVALID_SOCKET;
    while(True) do
    begin
       if terminated then
       begin
         threadFunc.Terminate;
         exit;
       end;
       //阻塞模式
       FillChar(Client_Addr,Sizeof(Client_Addr),);
       ClientLen := Sizeof(Client_Addr);
       m_clientsocket:=accept(m_serversocket,@Client_Addr,@ClientLen) ;
       if m_clientsocket <> INVALID_SOCKET then
       begin
        threadFunc:=TServerThread.Create(m_clientsocket);
       end;
        Application.ProcessMessages;
    end;
  Application.ProcessMessages;
 end;

  procedure TInvokerThread.WSACleanup();
  begin
     closesocket(m_serversocket);
  end;

  constructor TInvokerThread.Create(HostIp: string; HostPort: Integer);
  begin
      inherited Create(False);
      FHostIp:=HostIp;
      FHostPort:=HostPort;
      FreeOnTerminate:=True;
      InitLogger;
  end;

  procedure TInvokerThread.Execute;
  begin
    inherited;
     Synchronize(InitAndStartServerSocket);
    if Terminated then Exit;
  end;

{ TServerThread }

constructor TServerThread.Create(SockHd: Integer);
begin
  inherited Create(False);
  FSocket:=SockHd;
  FreeOnTerminate:=True;
  g_preId:=-;
end;

procedure TServerThread.DecvDataLoop;
var
    Buff:TPACKDATA;
    SendBuf:string[];
    RET: Integer;
    FdSet : TFDSet;
    TimeVal : TTimeVal;
begin

  while(true) do
  begin
       if terminated then exit;
       //非阻塞模式
       FD_ZERO(FdSet);
       FD_SET(FSocket,FdSet);
       TimeVal.tv_sec:=;
       TimeVal.tv_usec:=;
       if (select(,@FdSet,nil,nil,@TimeVal)>) and (not terminated) then
       begin
            Ret:=recv(FSocket,Buff,SizeOf(Buff),);
            if RET=SOCKET_ERROR then
            begin
              FLogger.Send('Read Error!');
              Continue;
            end;
            if RET > then
            begin
              if (g_preId<>Buff.id) then begin
                  g_preId:=Buff.id;
                  FLogger.Send('Recv Cmd:'+Buff.cmd) ;
                  FLogger.Send('Recv Data:'+Buff.Data) ;
                  FLogger.Send('Recv Id:'+inttostr(Buff.id)) ;
                  SendBuf:='Rec OK';
                  send(FSocket,SendBuf,SizeOf(SendBuf),);
                  break;

              end;

            end;
       end; //end select
  end;

end;

procedure TServerThread.Execute;
begin
  inherited;
  Synchronize(DecvDataLoop);
  if Terminated then Exit;
end;

end.

调用逻辑：

unit uMain;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    btn1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private
    { Private declarations }
     invoker:TInvokerThread;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  HostIp,HostPort:string;
begin
  HostIp:='192.168.50.1';
  HostPort:='';
  invoker:=TInvokerThread.Create(HostIp,StrToInt(HostPort));
 end;

procedure TForm1.btn1Click(Sender: TObject);
begin
 showmessage('@!@');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  invoker.Terminate;
//TerminateThread(invoker.Handle,0);

end;

end.

客户端

unit uSocketLibrary;

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

   type
      PPACKDATA=^TPACKDATA;
      TPACKDATA=record
      cmd:string[];
      data:string[];
      id:LongInt;
      end;

     TClient_Socket=class
   private
     FLogger:TLogger;
     client_socket:Integer;
     Fhost_port:Integer;
     client_hostent:PHostEnt;
     client_addr:TSockAddrIn;
     psaddr:^LongInt;
     saddr:LongInt;
     Fhost_ip:string;
   public
     procedure DisconnectServer();
     function ConnectionServer():Integer;
     function SendData(buff:TPACKDATA): integer;
     function RecvData():integer;
     constructor Create(IpAddr:string;HostPort:Integer);
   end;
implementation

{ TClient_Socket }

function TClient_Socket.ConnectionServer: Integer;
var
  Clt_WSADATA:TWSAData;
  Ret:Integer;
begin
   Ret:=WSAStartup(MakeWord(,),Clt_WSADATA);
   if (<>Ret) then
   begin
      FLogger.Send('WSASetUp error!');
      Result:=;
      Exit;
    end;
    client_addr.sin_family:=PF_INET;
    client_addr.sin_port:=htons(Fhost_port);
    client_hostent:=gethostbyname(PChar(Fhost_ip)) ;
    if nil=client_hostent then
    begin
       saddr:=inet_addr(PChar(Fhost_ip));
       if -<>saddr then
          client_addr.sin_addr.S_addr:=saddr;
      end
    else
    begin
      psaddr:=Pointer(client_hostent.h_addr_list^);
      client_addr.sin_addr.S_addr:=psaddr^;
      end;
    client_socket:=socket(PF_INET,SOCK_STREAM,);
    if INVALID_SOCKET = client_socket then
    begin
         FLogger.Send('create socket fail!');
         Result:=;
         exit;
      end;
    Ret:=connect(client_socket,client_addr,SizeOf(client_addr));
    if socket_error = Ret then
    begin
         closesocket(client_socket);
         FLogger.Send('Connect fail!');
         Result:=;
         exit;
    end;
    Result:=;
end;

constructor TClient_Socket.Create(IpAddr: string; HostPort: Integer);
begin
  FLogger:=TLogger.GetLoggerInstance('SocketLibaray');
  Fhost_ip:=IpAddr;
  Fhost_port:=HostPort;
end;

procedure TClient_Socket.DisconnectServer;
begin
  shutdown(client_socket,SD_SEND);
  closesocket(client_socket);
end;

function TClient_Socket.RecvData: integer;
var
   buff:string[];
   ret:integer;
begin
  Result:=;
   ret:=recv(client_socket,buff,SizeOf(buff),);
   if (SOCKET_ERROR=ret) then
   begin
       FLogger.Send('Read Error!');
       Result:=;
       Exit;
     end
   else if ret> then
   begin
     if (buff='Rec OK') then
       Result:=;
   end;
end;

function TClient_Socket.SendData(buff:TPACKDATA): integer;
var
  //strBuf:string[254];
  ret:Integer;
begin
  ret:=send(client_socket,buff,SizeOf(buff),);
  Result:=;
end;

end.

DLL工程逻辑：

library PrjDLL;

{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }

uses
  SysUtils,
  Classes,
  uSocketLibrary in 'uSocketLibrary.pas';

  function ConnectServerAndSendData(IpAddr:string;RPort:string;buffer:TPACKDATA):integer;stdcall;
  var
    clt:TClient_Socket;
    hostIp,sPort,sData:string;
    hostPort:Integer;
  begin
      hostIp:=IpAddr;
      sPort:=RPort;
      //sData:=;
      hostPort:=StrToInt(sPort);
      clt:=TClient_Socket.Create(hostIp,hostPort);
      try
        if clt.ConnectionServer= then
        begin
          if clt.SendData(buffer)= then
          begin
              while(clt.RecvData=) do
              begin
                Result:=;
                break;
              end;
            end;
        end;
      finally
        clt.DisconnectServer;
        clt.Free;
      end;
      Result:=;
  end;

  exports ConnectServerAndSendData;

{$R *.res}

begin

end.

好了，整个过程代码都在这了。有需要的兄弟可以贴下来试试，我是用Delphi7编译并测试通过的。希望有所帮助！