哈哈，我也来发一段我写的tcpsocket的源代码吧---临时之作，大家指正！

Question

unit GDKWithNetSocket;interfaceuses  Classes,SysUtils,Windows,WinSock;const
  SOCKET_LENGTH_READ   = 1024*8;
  SOCKET_LENGTH_WRITE  = 1024*8;  IOC_VENDOR           = $18000000;
  SIO_KEEPALIVE_VALS   = IOC_IN or IOC_VENDOR or 4;type
  WSAIoctl = function (s: TSocket; dwIoControlCode: DWORD; lpvInBuffer: Pointer;
                       cbInBuffer: DWORD; lpvOutBuffer: Pointer; cbOutBuffer: DWORD;
                       lpcbBytesReturned: Cardinal; lpOverlapped: Pointer;
                       lpCompletionRoutine: pointer): u_int; stdcall;
  TTcpKeepAlive = packed record
    OnOff             : u_long;
    KeepAliveTime     : u_long;
    KeepAliveInterval : u_long;
  end;////////////////////////////////////////////////////////////////////////////////
  TGDKSocket  =  class(TObject)
  private
    m_Socket          : TSocket;
    m_TimeStamp_Read  : Cardinal;
    m_TimeStamp_Write : Cardinal; 
  public
    procedure   UpdateTimeStamp_Read;           //自动更新时间戳;
    procedure   UpdateTimeStamp_Write;
    function    GetTimeStamp_Read  : Cardinal;  //获得时间戳;
    function    GetTimeStamp_Write : Cardinal;
  public
    constructor Create;
    destructor  Destroy; override;
  published
    property    SocketHandle    : TSocket      read m_Socket;
  public    //以下定义主要的接口方法!
    procedure   Close;                        //关闭;    function    IsValid:Boolean;                          //是否是合法有效的Socket?
    procedure   Assign(ASocket:TSocket);    function    SetNonBlocking(enabled:Boolean):Boolean;       //设置非堵塞模式;
    function   IsNonBlocking:Boolean;                         //查询是否处于堵塞模式    function   SetReuseAddr:Boolean;                          //使socket可以捆绑(bind())到一个已经使用的本地地址
    function   SetKeepAlive:Boolean;                   //启用/禁用保持活动状态的套接字 TCP连接非正常断开的检测(KeepAlive探测)    function    InAddrToIP(addr : TInAddr ):String;    //以下是优化Socket部分,慎用!!!!
    function   SetSendBufferSize   (iSize:Integer):Boolean;
    function   SetReceiveBufferSize(iSize:Integer):Boolean;
    function GetSendBufferSize    : Integer;
    function GetReceiveBufferSize : Integer;
  end;
////////////////////////////////////////////////////////////////////////////////
  TGDKTCPSocket = class(TGDKSocket)
  private
    m_Buffer_Read  : PCHAR;
  protected
    function    _SetOption:Boolean;
  public
    constructor Create ; overload;    
    destructor  Destroy; override;
  public
    //下面是核心操作;
    function ReadBuffer (var buffer   : PChar  ; len:Integer;timeout:Cardinal):Integer;
    function Read       (var str      : string ; len:Integer;timeout:Cardinal):Integer;
    function    ReadLn     (var str      : String ;             timeout:Cardinal):Integer;    function WriteBuffer(Buffer       : PChar  ; len:Integer;timeout:Cardinal):Integer;
    function Write      (str          : string ; len:Integer;timeout:Cardinal):Integer;
    function    WriteLn    (str          : String ;             timeout:Cardinal):Integer;
  end;
////////////////////////////////////////////////////////////////////////////////
  TGDKTCPClientSocket = class(TGDKTCPSocket)
  public
    constructor Create ; overload;     //自动创建Socket!!!
    destructor  Destroy; override;
  public
   function   IsConnected:Boolean;                                           //是否已经连接？
    function    Connect(host:String; port:Integer;ATimeOut:Integer=3):Boolean; //核心操作!!!!
  private
  m_IsConnected : Boolean;
  end;
////////////////////////////////////////////////////////////////////////////////
  TGDKTCPServerSocket = class(TGDKTCPSocket)
  public
//核心操作!!!!
  function    Bind(port:Integer):Boolean;
   function   Listen(backlog:Integer):Boolean;    function    Accept(newsocket:TSocket;newip:String):Boolean;
  end;
////////////////////////////////////////////////////////////////////////////////implementation////////////////////////////////////////////////////////////////////////////////
function  GDK_WSAStartup : Boolean;
var
  wsd : WSADATA;
  ret : Integer;
begin
ret := WinSock.WSAStartup(MAKEWORD(2, 2), wsd);
  Result := ret<>SOCKET_ERROR; 
end;function  GDK_WSACleanup : Boolean;
begin
WinSock.WSACleanup;
  Result := true;
end;
////////////////////////////////////////////////////////////////////////////////

Answer 1

////////////////////////////////////////////////////////////////////////////////
{ TGDKSocket }
constructor TGDKSocket.Create;
begin
  inherited;                 
  m_Socket := INVALID_SOCKET;  m_TimeStamp_Read  := GetTickCount;
  m_TimeStamp_Write := GetTickCount;
end;destructor TGDKSocket.Destroy;
begin
  Close;
  inherited;
end;procedure TGDKSocket.Close;
begin
if IsValid then
  begin
    WinSock.shutdown(m_Socket, SD_BOTH);
    closesocket(m_Socket);
  end;
  m_Socket := INVALID_SOCKET;
end;
procedure TGDKSocket.Assign(ASocket: TSocket);
begin
  m_Socket := ASocket;
end;function TGDKSocket.IsValid: Boolean;
begin
  Result := (m_Socket<>INVALID_SOCKET);
end;function TGDKSocket.InAddrToIP(addr: TInAddr): String;
begin
  Result := string(inet_ntoa(addr));
end;function TGDKSocket.IsNonBlocking: Boolean;
var
  ul  : Longint;
  ret : Integer;
begin
  Result := false; if (not IsValid) then exit; ul  := 0;
ret := ioctlsocket(m_Socket, FIONBIO, ul);
if ( ret = SOCKET_ERROR ) then  exit; if ( ret = 0 ) then
  begin
if ( ul = 0 ) then exit;
if ( ul = 1) then
    begin
Result := true;
      exit;
    end;
  end;
end;
function TGDKSocket.SetNonBlocking(enabled: Boolean): Boolean;
var
   ul  : Longint;
begin
  Result := false; if (not IsValid) then exit; if ( enabled )  then
    ul := 1
else
ul := 0; if  ioctlsocket(m_Socket, FIONBIO, ul)= 0 then Result := true;
end;function TGDKSocket.SetReuseAddr: Boolean;
var
flag   : Integer;
ret    : Integer;
begin
  Result := false;
if (not IsValid) then exit; flag := 1;
ret  := setsockopt(m_Socket, SOL_SOCKET, SO_REUSEADDR, PCHAR(IntToStr(flag)), sizeof(flag));
  Result := ret<>-1;
end;
 
function TGDKSocket.SetKeepAlive: Boolean;
var
  OptVal        : Integer;
  KeepAliveIn   : TTcpKeepAlive;
  KeepAliveOut  : TTcpKeepAlive;  BytesReturned : Cardinal;  LibHandle : Cardinal;
  _FileName : String;  _WSAIoctl : WSAIoctl;
begin
  Result := false;
if (not IsValid) then exit;  //动态加载!!!!
  _FileName := 'ws2_32.dll';
  LibHandle  := LoadLibrary(PChar(_FileName));
  if LibHandle <> 0 then
  begin
    _WSAIoctl := GetProcAddress(LibHandle, PChar('WSAIoctl'));
    if @_WSAIoctl<>nil then
    begin
      FillChar(KeepAliveIn, SizeOf(KeepAliveIn), 0);
      FillChar(KeepAliveOut, SizeOf(KeepAliveOut), 0);
      BytesReturned := 0;      KeepAliveIn.OnOff             := 1;
      KeepAliveIn.KeepAliveInterval := 1000;
      KeepAliveIn.KeepAliveTime     := 30000;
      OptVal := _WSAIoctl(m_Socket,      SIO_KEEPALIVE_VALS,
                          @KeepAliveIn,  SizeOf(KeepAliveIn),
                          @KeepAliveOut, SizeOf(KeepAliveOut),
                          BytesReturned, nil, nil) ;
      Result := OptVal =0;      //ShowMessage(IntToStr(OptVal) + '|'+IntToStr(WSAGetLastError));    end;
    FreeLibrary(LibHandle);
  end;
end;function TGDKSocket.GetReceiveBufferSize: Integer;
var
  ret,sz,len : Integer;
begin
  Result := -1;
if (not IsValid) then exit;  sz  := 0;
  len := sizeof(sz); ret := getsockopt(m_Socket, SOL_SOCKET, SO_RCVBUF,  PCHAR(IntToStr(sz)),len);
  if ret<>-1 then Result := sz;
end;function TGDKSocket.GetSendBufferSize: Integer;
var
  ret,sz,len : Integer;
begin
  Result := -1;
if (not IsValid) then exit;  sz  := 0;
  len := sizeof(sz); ret := getsockopt(m_Socket, SOL_SOCKET, SO_SNDBUF,  PCHAR(IntToStr(sz)), len);
  if ret<>-1 then Result := sz;
end;
function TGDKSocket.SetReceiveBufferSize(iSize: Integer): Boolean;
var
  ret : Integer;
begin
  Result := false;
if (not IsValid) then exit; ret := setsockopt( m_Socket, SOL_SOCKET, SO_RCVBUF,PCHAR(IntToStr(iSize)), sizeof(iSize)  );
Result := Ret<>-1;
end;function TGDKSocket.SetSendBufferSize(iSize: Integer): Boolean;
var
  ret : Integer;
begin
  Result := false;
if (not IsValid) then exit; ret := setsockopt( m_Socket, SOL_SOCKET, SO_SNDBUF,PCHAR(IntToStr(iSize)), sizeof(iSize) );
Result := Ret<>-1;
end;////////////////////////////////////////////////////////////////////////////////
function TGDKSocket.GetTimeStamp_Read: Cardinal;
begin
  Result := m_TimeStamp_Read;
end;function TGDKSocket.GetTimeStamp_Write: Cardinal;
begin
  Result := m_TimeStamp_Write;
end;procedure TGDKSocket.UpdateTimeStamp_Read;
begin
  m_TimeStamp_Read := GetTickCount;
end;procedure TGDKSocket.UpdateTimeStamp_Write;
begin
  m_TimeStamp_Write:= GetTickCount;
end;
////////////////////////////////////////////////////////////////////////////////
{ TGDKTCPSocket }
constructor TGDKTCPSocket.Create;
begin
  inherited;  GetMem(m_Buffer_Read ,SOCKET_LENGTH_READ);  m_Socket := winsock.socket(AF_INET,SOCK_STREAM,0);
  _SetOption;
end;destructor TGDKTCPSocket.Destroy;
begin
  FreeMem(m_Buffer_Read);
  m_Buffer_Read := nil;  inherited;
end;function TGDKTCPSocket._SetOption:Boolean;
begin
  Result := false;
  if m_Socket <> INVALID_SOCKET then
  begin
    //将自己设置为非堵塞模式的。
    Result := SetNonBlocking(true);    //设置收发缓冲区;
    SetSendBufferSize(SOCKET_LENGTH_READ*2);
    SetReceiveBufferSize(SOCKET_LENGTH_READ*2);
  end;
end;

Answer 2

function TGDKTCPSocket.WriteBuffer(Buffer: PChar; len: Integer; timeout: Cardinal): Integer;
begin
  Result := Write(String(Buffer),len,timeout);
end;function TGDKTCPSocket.Write(str: string; len:Integer; timeout: Cardinal): Integer;
var
_start      : Cardinal;
_total, _count,_actcount,lserr : Integer;
begin
  Result := -1;
  if (not IsValid) then exit; _start      := GetTickCount;
_total      := len;
result     := 0; while (_total > 0) do
  begin
    //计算还有多少要发;
     _actcount := _total;
    if _total >= (SOCKET_LENGTH_WRITE) then _actcount := SOCKET_LENGTH_WRITE; _count := send(SocketHandle, str[Result+1],_actcount , 0); if( _count <= 0 )  then
begin
lserr := WSAGetLastError();
if (_count = -1) and (lserr = WSAEWOULDBLOCK) then
begin
if (timeout <= 0) or (GetTickCount - _start <= timeout ) then
begin
          Sleep(5);
continue;
end else
        begin
          break;
        end;
      end else //表示socket断了!
      begin
        Result := -2;
        break;
      end;
end else //正常读取!!!
begin
Result := Result + _count;
_total := _Total - _count;
end; if (GetTickCount - _start> timeout ) then break; Sleep(5);
  end;  //如果正确写出，则更新时间戳;
  if Result >0 then UpdateTimeStamp_Write;
end;
function TGDKTCPSocket.WriteLn(str: String; timeout: Cardinal): Integer;
var
  S : String;
begin
  Result := -1;
  if (not IsValid) then exit;  S := Str+#13#10;
  Result := Write(S,Length(S),timeout);
end;function TGDKTCPSocket.ReadBuffer(var buffer: PChar; len: Integer; timeout: Cardinal): Integer;
  procedure _WaitForReading(ATimeout:Cardinal);
  var
    FDSet: TFDSet;
    TimeVal: TTimeVal;
    WaitTime, RC : Integer;
  begin
    TimeVal.tv_sec  := ATimeout div 1000;
    TimeVal.tv_usec := ATimeout mod 1000;
    WaitTime := 100;
    repeat
      FD_ZERO(FDSet);
      FD_SET(SocketHandle, FDSet);
      RC := select(0, @FDSet, nil, nil, @TimeVal);
      Dec(WaitTime);
    until (RC <> 0) or (WaitTime = 0);
  end;
begin
  Result := -1;
  if (not IsValid) then exit;  Result := Winsock.recv(SocketHandle, buffer[0], len, 0);
  if Result = SOCKET_ERROR then
  begin
    _WaitForReading(timeout);
    Result := Winsock.recv(SocketHandle, Buffer[0], len, 0);
  end;  //如果正确读出，则更新时间戳;
  if Result>0 then UpdateTimeStamp_Read;
end;
function TGDKTCPSocket.Read(var str: string; len:Integer; timeout: Cardinal): Integer;
var
_start      : Cardinal;
_total, _count,_actcount : Integer;
  S : String;
begin
str :='';  Result := -1;
  if (not IsValid) then exit; _start      := GetTickCount;
_total      := len;
result     := 0;  while (_total > 0) do
  begin
    //计算还有多少要读;
    _actcount := _total;
    if _total >= SOCKET_LENGTH_READ then _actcount := SOCKET_LENGTH_READ;    ZeroMemory(m_Buffer_Read,Sizeof(m_Buffer_Read));    _count := ReadBuffer(m_Buffer_Read,_actcount,timeout);
    if _Count>0 then
    begin
      SetLength(S,_Count);
      CopyMemory(@(S[1]),@(m_Buffer_read[0]),_Count);      str := Str + S;
      Result := Result + _count;
      _total := _Total - _count;
    end;    Sleep(5);
    if (GetTickCount - _start> timeout ) then break;
  end;end;function TGDKTCPSocket.ReadLn(var str: String; timeout: Cardinal): Integer;
var
_start      : Cardinal;
_count      : Integer;
begin
str :='';  Result := -1;
  if (not IsValid) then exit; _start      := GetTickCount;
result     := 0;  while (true) do
  begin
    ZeroMemory(m_Buffer_Read,Sizeof(m_Buffer_Read));    _count := ReadBuffer(m_Buffer_Read,1,timeout div 100);
    if _Count=1 then
    begin
      str := Str + m_Buffer_Read[0];
      Result := Result + _count;
    end;    //若接收到了"\r\n",则返回!!!
    if (Result>=2) and (Str[Result-1]=#13) and (Str[Result]=#10) then  break;
    if (GetTickCount - _start> timeout ) then break;
  end;end;
////////////////////////////////////////////////////////////////////////////////
{ TGDKTCPClientSocket }
constructor TGDKTCPClientSocket.Create;
begin
  inherited ;
  m_IsConnected := false;
end;destructor TGDKTCPClientSocket.Destroy;
begin
  m_IsConnected := false;
  inherited;
end;function TGDKTCPClientSocket.Connect(host: String; port : Integer;ATimeOut:Integer): Boolean;
  procedure _WaitForConnecting(wtimeout:Cardinal);
  var
    EFDSet, WFDSet: TFDSet;
    TimeVal: TTimeVal;
    WaitTime, RC : Integer;
  begin
    TimeVal.tv_sec  := wtimeout div 1000;
    TimeVal.tv_usec := wtimeout mod 1000;
    WaitTime := 100;
    repeat
      FD_ZERO(WFDSet);
      FD_SET(SocketHandle, WFDSet);
      FD_ZERO(EFDSet);
      FD_SET(SocketHandle, EFDSet);
      RC := select(0, nil, @WFDSet, @EFDSet, @TimeVal);
      Dec(WaitTime)
    until (RC <> 0) or (WaitTime = 0);
  end;var
  pHost : PHostEnt;
  servAddr : sockaddr_in;  szHostName: array[0..128] of Char;
  nRet,nErr : Integer;
begin
  m_IsConnected := false;
  Result := false;  if(not IsValid) then
  begin
m_Socket := winsock.socket(AF_INET,SOCK_STREAM,0);      //重新建立一个socket连接;
  end; servAddr.sin_family := AF_INET;
servAddr.sin_port   := htons(port);
servAddr.sin_addr.s_addr := inet_addr(PCHAR(host)); // 如果给的是主机的名字而不是IP地址
if(servAddr.sin_addr.s_addr = INADDR_NONE) then
begin
pHost := gethostbyname(szHostName);
if(pHost = nil)  then exit; CopyMemory(@servAddr.sin_addr, pHost.h_addr_list, pHost.h_length);
end;  nRet := WinSock.connect( SocketHandle, servAddr, sizeof(servAddr));
  if( nRet = SOCKET_ERROR ) then
  begin
    nErr := WSAGetLastError();
    if( nErr=WSAEISCONN )  then
      m_IsConnected := true //10056
    else
    begin
      Sleep(5);
      //等待一下；
      _WaitForConnecting(ATimeOut*1000);      //再次判断;
      nRet := WinSock.connect( SocketHandle, servAddr, sizeof(servAddr));
      if( nRet = SOCKET_ERROR ) then
      begin
        nErr := WSAGetLastError();
        if( nErr=WSAEISCONN )  then  m_IsConnected := true //10056
      end
      else
       m_IsConnected := true;
    end;
  end
  else
    m_IsConnected := true;  Result :=  m_IsConnected;
end;function TGDKTCPClientSocket.IsConnected: Boolean;
begin
  Result := m_IsConnected;
end;////////////////////////////////////////////////////////////////////////////////
{ TGDKTCPServerSocket }
function TGDKTCPServerSocket.Accept(newsocket: TSocket;   newip: String): Boolean;
var
  addr : sockaddr_in;
  len  : Integer;
begin
  Result := false;  newip := '';
  len   := sizeof(addr);  newsocket := WinSock.accept(SocketHandle, @addr, @len);
  if ( newsocket < 0 ) then exit; //把IP写入clientip;
newip := InAddrToIP(addr.sin_addr); //排除非法IP!!!!!!!!!!!!!!!!!!!!!!
//这里现在是粗糙的办法 来捕捉异常！
Result := ( newip <> '204.204.204.204');
end;function TGDKTCPServerSocket.Bind(port: Integer): Boolean;
var
  saddr : sockaddr_in;
  bret  : Integer;
begin
ZeroMemory(@saddr,sizeof(saddr)); saddr.sin_family    := AF_INET;
saddr.sin_addr.s_addr := htonl(INADDR_ANY);
saddr.sin_port    := htons(port);
ZeroMemory(@(saddr.sin_zero),8); bret := WinSock.bind(SocketHandle, saddr, sizeof(saddr));
  Result := (bret = 0);
end;function TGDKTCPServerSocket.Listen(backlog: Integer): Boolean;
var
  ret  : Integer;
begin
ret := WinSock.listen(SocketHandle, backlog);
  Result := (ret=0);
end;
////////////////////////////////////////////////////////////////////////////////
initialization
  GDK_WSAStartup;
finalization
  GDK_WSACleanup;
////////////////////////////////////////////////////////////////////////////////
end.

Answer 3

serversocket是给TCPServer来用的，你可以自由发挥了，嘿嘿。
////////////////////////////////////////////////////////////////////////////////
//                                                                            //
// GDK 1.0 - General Development Kit For Delphi                               //
//                                                                            //
// Authors: zhangxf                                                           //
//                                                                            //
// E-mail:  [email protected]                                               //
//                                                                            //
// Legal issues: Copyright (C) 1996-2008 by  杭州锐虎科技有限公司             //
//                                                                            //
// Last modification: 2007-10-18                                              //
//                                                                            //
// -------------------------------------------------------------------------- //
//                                                                            //
//                                                                            //
//                                                                            //
// History:                                                                   //
//                                                                            //
// 2010-1-8   First release of this file.                                     //
//                                                                            //
////////////////////////////////////////////////////////////////////////////////需要引用请标明出处！

Answer 4

学习一下，有时间也玩一玩SOCKET

Answer 5

代码并不是玩弄技巧的，当你不满足indy控件，但你继续通过封装来实现你自己的所谓中间件，所谓业务的时候，你就知道他有用了

Answer 6

这段代码来自我们写的GDK，你们放心使用，只要标明出处，就可以使用。为什么说临时的呢，是因为这段代码修改自我们的gdk for c++,是从那边翻译过来的。嘿嘿我测试了一下，好像没啥问题，就是keepalive似乎错了没空去细查了大家自己发挥。有好的建议发邮件给我。 [email protected]

Answer 7

WriteBuffer又调用一次Write，明显是多余的，从效率上来讲，完全是一个“画蛇添足”，首先WriteBuffer本身有一个数据指针和一个长度两个参数，已经足够用了，接着又去调用Write，却对数据做了一次复制，而一个动作是完全不必要的。

Answer 8

僵哥 ---,除非你再想把send的代码写一遍，哈。我是懒得写了。

Answer 9

function TGDKTCPSocket.WriteBuffer(Buffer: PChar; len: Integer; timeout: Cardinal): Integer;
var
_start      : Cardinal;
_total, _count,_actcount,lserr : Integer;
begin
  Result := -1;
  if (not IsValid) then exit; _start      := GetTickCount;
_total      := len;
result     := 0; while (_total > 0) do
  begin
    //计算还有多少要发;
     _actcount := _total;
    if _total >= (SOCKET_LENGTH_WRITE) then _actcount := SOCKET_LENGTH_WRITE; _count := send(SocketHandle, Buffer[Result],_actcount , 0); if( _count <= 0 )  then
begin
lserr := WSAGetLastError();
if (_count = -1) and (lserr = WSAEWOULDBLOCK) then
begin
if (timeout <= 0) or (GetTickCount - _start <= timeout ) then
begin
          Sleep(5);
continue;
end else
        begin
          break;
        end;
      end else //表示socket断了!
      begin
        Result := -2;
        break;
      end;
end else //正常读取!!!
begin
Result := Result + _count;
_total := _Total - _count;
end; if (GetTickCount - _start> timeout ) then break; Sleep(5);
  end;  //如果正确写出，则更新时间戳;
  if Result >0 then UpdateTimeStamp_Write;end;

Answer 10

大家帮我测试哈http://1024cm.com/work/?29050-1.html

Answer 11

弱弱的问下，socket做什么用的？小弟初来乍道，什么都不懂。还有这位大哥，这是什么语言写的？

Answer 12

ding 下哈，看的不是很懂…… 不过顶……