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[20];
    data:string[254];
    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(2,2),XL_WSADATA);
  if (0<>Ret) then 
  begin
    FLogger.Send('WSASetUp error!');
    Exit;
  end;
  //create socket
  m_serversocket:=socket(PF_INET,SOCK_STREAM,0);
  if INVALID_SOCKET = m_serversocket then
  begin
    FLogger.Send('Create socket error!');
     Exit;
  end;
  tm:=1;//非鎖定模式 ;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,2);
   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),0);
       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:=-1;
end;

procedure TServerThread.DecvDataLoop;
var
    Buff:TPACKDATA;
    SendBuf:string[10];
    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:=0;
       TimeVal.tv_usec:=500;
       if (select(0,@FdSet,nil,nil,@TimeVal)>0) and (not terminated) then
       begin
            Ret:=recv(FSocket,Buff,SizeOf(Buff),0);
            if RET=SOCKET_ERROR then
            begin
              FLogger.Send('Read Error!');
              Continue;
            end;
            if RET >0 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),0);
                  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:='8090';
  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[20];
      data:string[254];
      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(2,2),Clt_WSADATA);
   if (0<>Ret) then
   begin
      FLogger.Send('WSASetUp error!');
      Result:=0;
      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 -1<>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,0);
    if INVALID_SOCKET = client_socket then
    begin
         FLogger.Send('create socket fail!');
         Result:=0;
         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:=0;
         exit;
    end;
    Result:=1;
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[254];
   ret:integer;
begin
  Result:=0; 
   ret:=recv(client_socket,buff,SizeOf(buff),0);
   if (SOCKET_ERROR=ret) then
   begin
       FLogger.Send('Read Error!');
       Result:=0;
       Exit;
     end
   else if ret>0 then
   begin
     if (buff='Rec OK') then
       Result:=1;
   end;
end;

function TClient_Socket.SendData(buff:TPACKDATA): integer;
var
  //strBuf:string[254];
  ret:Integer;
begin
  ret:=send(client_socket,buff,SizeOf(buff),0);
  Result:=1;
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=1 then
        begin
          if clt.SendData(buffer)=1 then
          begin
              while(clt.RecvData=1) do
              begin
                Result:=1;
                break;
              end;
            end;
        end;
      finally
        clt.DisconnectServer;
        clt.Free;
      end;
      Result:=0;
  end;

  exports ConnectServerAndSendData;

  
{$R *.res}

begin

end.

 

 

 

 

好了，整個過程代碼都在這了。有需要的兄弟可以貼下來試試，我是用Delphi7編譯並測試通過的。希望有所幫助！