请问如何用socket和Indy发送枚举类型的数据，如何接收及使用，谢谢大家！(300分)

入题，想用socket和Indy发送枚举等类型的数据，如何接收既使用，那位给个详细的例子呢？300分奉上！

晕，怎么这么容易呢，自己搞定了，嘿嘿

确实容易，强制转换成BYTE就可以了。

LZ舍得是个大方人啊！
呵呵

socket indy
clientsocket发送字符，server接收字符及返回消息，发送接收类型可以为数字，字符，字符串，结构体等，保证serversocket可以给任意clientsocket返回及发送消息。同时用多客户端同时给serversocket发送，保证接收数据准确及同时返回不同客户端不同消息
ps：表达能力有限，谁给提供个例子及说明清楚，300送上，呵呵对于通讯还是不怎么了解

有人帮忙么

300分太少么，可以加呢

真是厉害![]

如何在socket服务器端，在得到一个客户端连接时自动开一个线程处理
汗...这个要让人怎么回答你啊?太容易了吧? 客户连接你知道吧.直接创建一个线程去处理呼.要不就使用线程池.这种模式不适合多个客户端.不然SERVER很容易就S掉的.

来自：njg2005, 时间：2008-3-24 15:02:17, ID：3882348
真是厉害![]

啥厉害啊，高手们，给讲讲吧

来自：fghyxxe, 时间：2008-3-24 15:26:10, ID：3882359
如何在socket服务器端，在得到一个客户端连接时自动开一个线程处理
汗...这个要让人怎么回答你啊?太容易了吧? 客户连接你知道吧.直接创建一个线程去处理呼.要不就使用线程池.这种模式不适合多个客户端.不然SERVER很容易就S掉的.
给个例子好不好

我的邮箱gotiger2008&qq.com，发个完整的给你。

印象中Sever在接收到一个client的请求后就自动新开一个线程去处理，不知对不对。

接收主线程中，简单的自己找咯
while truedo
..
sClient := accept(sListen, ...
if sclient <> INVALID_SOCKET then
create thread..

Indy 的Server 端在检测到有客户端连接时会自动创建并启动一个线程去处理此客户端的请求,直到此客户端连接断开或超时..销毁线程

谢谢各位，gotiger邮件已发，多指教
哪位能给写个例子，简单明白点的，呵呵，server端接收client端数据后还要向其他服务器传输数据，读写数据库，所以想在线程中处理，大致是这种结构吧，客户端-〉服务器处理-〉服务器处理2-〉数据库处理，现在在服务器处理这个环节可能要同时接收大量客户端传入消息，用socket如何控制比较好呢

来自：酷辰, 时间：2008-3-24 23:50:40, ID：3882475
印象中Sever在接收到一个client的请求后就自动新开一个线程去处理，不知对不对。
=====================================
这个好像是这么回事，delphi对winsock封装好象就是这种机制，我也不太清楚，不过想自己控制线程处理

在Server中开线程，对于少数Client存在的情况下是可以的
如果Client数目过多，建议使用完成端口来实现，他的基本原理是使用有限的线程（一般来说基于处理器的数目）来响应客户端
提供一点代码供参考

{ Sparrow Soft 使用完成端口实现通讯管理 }
{ Copyright (c) 2007, Sparrow Software }
{ Date: 2007-12-27 }
{ Build: 2007-12-27 }
{ Author: muhx }
{**********************************************************************}
{ Modify History }
{ }
{ Name Date Description }
{ ------- ---------- ----------------------------------------------- }
{ muhx 2007-12-27 封装了Socket的操作，包括服务端和客户端的类。 }
{ 使用了WinSock2中Socket的定义和完成端口模型。 }
{ 这并不是我的代码，我在别人的代码上做了一些修改，}
{ 感谢原作者 }
{**********************************************************************}
unit SpIOCPCommunication;
interface
{$IFDEF VER150}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$ENDIF}
uses
SpSystem, SpCommunication, Windows, SysUtils, Classes, Messages, WinSock2;
const
MAX_BUFSIZE = 4096;
WM_CLIENTSOCKET = WM_USER + $2000;
type
TBuffer = array[0..MAX_BUFSIZE - 1] of Char;
TSocketMessage = packed record
smMsg: Cardinal;
smSocketHandle: TSocket;
smSelectEvent: Word;
smSelectError: Word;
smResult: Longint;
end;

TSocketEvent = (seInitIOPort, seInitSocket, seConnect, seDisconnect,
seListen, seAccept, seWrite, seRead);
TErrorEvent = (eeGeneral, eeSend, eeReceive, eeConnect, eeDisconnect, eeAccept);
PPerHandleData = ^TPerHandleData;
TPerHandleData = packed record
phdOverlapped: OVERLAPPED;
phdWsaBuffer: WSABUF;
phdEvent: TSocketEvent;
phdIsUse: Boolean;
phdBuffer: TBuffer;
end;

PBlock = ^TBlock;
TBlock = packed record
blockData: TPerHandleData;
blockIsUse: Boolean;
end;

EMemoryBuffer = class(Exception);
ESocketError = class(Exception);
TCustomSocket = class;
TServerClientSocket = class;
TOnDataEvent = function(ASocket: TCustomSocket;
AData: Pointer;
ACount: Integer): Integer of object;
TSocketErrorEvent = procedure(ASocket: TCustomSocket;
AErrorEvent: TErrorEvent;
var AErrCode: Integer) of object;
TSocketEventEvent = procedure(ASocket: TCustomSocket;
ASocketEvent: TSocketEvent) of object;
TMemoryBuffer = class
private
FList: TList;
FSocket: TCustomSocket;
function GetCount: Integer;
function GetBlock(const AIndex: Integer): PBlock;
protected
property Count: Integer read GetCount;
property Blocks[const AIndex: Integer]: PBlock read GetBlock;
public
constructor Create(ASocket: TCustomSocket);
overload;
constructor Create(ASocket: TCustomSocket;
ABlockCount: Integer);
overload;
destructor Destroy;
override;
function AllocBlock: PBlock;
procedure RemoveBlock(APBlock: PBlock);
end;

{ 通讯基类 }
TSpIOCPCommunication = TCustomSocket;
TCustomSocket = class(TSpCommunication)
private
FSocketHandle: TSocket;
FActive: Boolean;
FName: string;
FInitLock: Boolean;
FLock: TRTLCriticalSection;
FOnRead: TOnDataEvent;
FOnErrorEvent: TSocketErrorEvent;
FOnEventEvent: TSocketEventEvent;
function GetRemoteAddress: string;
function GetLocalAddress: string;
function GetRemoteHost: string;
function GetRemotePort: string;
proceduredo
Read(AData: Pointer;
ACount: Integer);
protected
procedure SetActive(AValue: Boolean);
virtual;
abstract;
procedure Event(ASocketEvent: TSocketEvent);
virtual;
procedure Error(AErrorEvent: TErrorEvent;
var AErrCode: Integer);
virtual;
property OnRead: TOnDataEvent read FOnRead write FOnRead;
property OnErrorEvent: TSocketErrorEvent read FOnErrorEvent write FOnErrorEvent;
property OnEventEvent: TSocketEventEvent read FOnEventEvent write FOnEventEvent;
public
constructor Create(ASocketHandle: TSocket);
destructor Destroy;
override;
procedure Close;
procedure Open;
procedure Lock;
procedure UnLock;
function Write(var ABuffer;
ACount: Integer): Integer;
override;
function Read(var ABuffer;
ACount: Integer): Integer;
override;
property SocketHandle: TSocket read FSocketHandle;
property Active: Boolean read FActive write SetActive;
property Name: string read FName;
property RemoteHost: string read GetRemoteHost;
property LocalAddress: string read GetLocalAddress;
property RemoteAddress: string read GetRemoteAddress;
property RemotePort: string read GetRemotePort;
end;

TCustomerServerSocket = class(TCustomSocket)
private
FOnClientRead: TOnDataEvent;
FOnClientError: TSocketErrorEvent;
FOnClientEvent: TSocketEventEvent;
protected
functiondo
ClientRead(ASocket: TCustomSocket;
AData: Pointer;
ACount: Integer): Integer;
procedure ClientSocketError(ASocket: TCustomSocket;
AErrorEvent: TErrorEvent;
var AErrCode: Integer);
procedure ClientSocketEvent(ASocket: TCustomSocket;
ASocketEvent: TSocketEvent);
public
property OnClientRead: TOnDataEvent read FOnClientRead write FOnClientRead;
property OnClientError: TSocketErrorEvent read FOnClientError write FOnClientError;
property OnClientEvent: TSocketEventEvent read FOnClientEvent write FOnClientEvent;
property OnErrorEvent;
property OnEventEvent;
end;

TGetSocketEvent = procedure(ASocketHandle: TSocket;
var AClientSocket: TServerClientSocket) of object;
TServerSocket = class(TCustomerServerSocket)
private
FPort: Integer;
FAddr: TSockAddr;
FAcceptThread: TThread;
FCompletionPort: THandle;
FClients: TList;
FThreads: TList;
FHandle: THandle;
FBuffer: TMemoryBuffer;
FOnGetSocket: TGetSocketEvent;
procedure SetPort(AValue: Integer);
function RegisterClient(ASocket: TCustomSocket): Integer;
procedure RemoveClient(ASocket: TCustomSocket);
procedure WMClientClose(var AMessage: TSocketMessage);
message WM_CLIENTSOCKET;
procedure WndProc(var AMessage: TMessage);
function FindClientSocket(ASocketHandle: TSocket): TCustomSocket;
function GetClientCount: Integer;
function GetClients(const AIndex: Integer): TServerClientSocket;
protected
procedure InternalOpen;
procedure InternalClose;
procedure SetActive(AValue: Boolean);
override;
property CompletionPort: THandle read FCompletionPort;
function IsAccept(ASocketHandle: TSocket): Boolean;
virtual;
public
constructor Create;
destructor Destroy;
override;
procedure Accept(ASocketHandle: TSocket;
ACompletionPort: THandle);
property Handle: THandle read FHandle;
property Port: Integer read FPort write SetPort;
property ClientCount: Integer read GetClientCount;
property Clients[const AIndex: Integer]: TServerClientSocket read GetClients;
property OnGetSocket: TGetSocketEvent read FOnGetSocket write FOnGetSocket;
end;

TServerClientSocket = class(TCustomSocket)
private
FBlock: TList;
FBuffer: TMemoryBuffer;
FServerSocket: TServerSocket;
FClientIndex: Integer;
function AllocBlock: PBlock;
function PrepareRecv(APBlock: PBlock = nil): Boolean;
function WorkBlock(var APBlock: PBlock;
ATransfered: DWORD): DWORD;
protected
procedure SetActive(AValue: Boolean);
override;
public
constructor Create(AServerSocket: TServerSocket;
ASocket: TSocket);
destructor Destroy;
override;
function Read(var ABuffer;
ACount: Integer): Integer;
override;
function Write(var ABuffer;
ACount: Integer): Integer;
override;
property ClientIndex: Integer read FClientIndex;
end;

TClientSocket = class(TCustomSocket)
private
FServerIP: string;
FServerPort: Word;
FHandle: THandle;
FServerAddr: TSockAddr;
FBuffer: TBuffer;
procedure SetServerIP(const AValue: string);
procedure SetServerPort(const AValue: Word);
procedure InternalOpen;
procedure InternalClose;
procedure WMClientRead(var AMessage: TSocketMessage);
message WM_CLIENTSOCKET;
procedure WndProc(var AMessage: TMessage);
protected
procedure SetActive(AValue: Boolean);
override;
public
constructor Create;
destructor Destroy;
override;
function Write(var ABuffer;
ACount: Integer): Integer;
override;
property ServerIP: string read FServerIP write SetServerIP;
property ServerPort: Word read FServerPort write SetServerPort;
property OnRead;
property OnErrorEvent;
property OnEventEvent;
end;

TSocketThread = class(TThread)
private
FServer: TServerSocket;
public
constructor Create(AServer: TServerSocket);
end;

TAcceptThread = class(TSocketThread)
protected
procedure Execute;
override;
end;

TWorkerThread = class(TSocketThread)
protected
procedure Execute;
override;
end;

implementation
uses RTLConsts;
const
SHUTDOWN_FLAG = $FFFFFFFF;
BlockSize: Word = SizeOf(TBlock);
var
WSData: TWSAData;
{ TMemoryBuffer }
constructor TMemoryBuffer.Create(ASocket: TCustomSocket);
begin
Create(ASocket, 200);
end;

constructor TMemoryBuffer.Create(ASocket: TCustomSocket;
ABlockCount: Integer);
var
I: Integer;
P: PBlock;
begin
inherited Create;
FSocket := ASocket;
FList := TList.Create;
for I := 0 to ABlockCount - 1do
begin
New(P);
FillChar(P^, BlockSize, 0);
FList.Add(P);
end;
end;

destructor TMemoryBuffer.Destroy;
var
I: Integer;
begin
for I := 0 to FList.Count - 1do
Dispose(FList);
FList.Free;
inherited Destroy;
end;

function TMemoryBuffer.AllocBlock: PBlock;
var
I: Integer;
begin
FSocket.Lock;
try
Result := nil;
for I := 0 to FList.Count - 1do
begin
Result := FList;
if not Result.blockIsUse then
Break;
end;
if not Assigned(Result) or Result.blockIsUse then
begin
New(Result);
FList.Add(Result);
end;
FillChar(Result^.blockData, SizeOf(Result^.blockData), 0);
Result^.blockIsUse := True;
finally
FSocket.UnLock;
end;
end;

procedure TMemoryBuffer.RemoveBlock(APBlock: PBlock);
begin
FSocket.Lock;
try
APBlock.blockIsUse := False;
finally
FSocket.UnLock;
end;
end;

function TMemoryBuffer.GetCount: Integer;
begin
Result := FList.Count;
end;

function TMemoryBuffer.GetBlock(const AIndex: Integer): PBlock;
begin
if (AIndex >= Count) or (AIndex <= -1) then
raise EMemoryBuffer.CreateFmt(SListIndexError, [AIndex])
else
Result := FList[AIndex];
end;

procedure CheckError(ResultCode: Integer;
const OP: string);
var
ErrCode: Integer;
begin
if ResultCode <> 0 then
begin
ErrCode := WSAGetLastError;
if (ErrCode <> WSAEWOULDBLOCK) or (ErrCode <> ERROR_IO_PENDING) then
raise ESocketError.CreateFmt(SWindowsSocketError,
[SysErrorMessage(ErrCode), ErrCode, Op]);
end;
end;

{ TCustomSocket }
constructor TCustomSocket.Create(ASocketHandle: TSocket);
begin
inherited Create;
FInitLock := False;
FName := '';
if WSAStartup($0202, WSData) <> 0 then
raise ESocketError.Create(SysErrorMessage(GetLastError));
FSocketHandle := ASocketHandle;
FActive := FSocketHandle <> INVALID_SOCKET;
end;

destructor TCustomSocket.Destroy;
begin
SetActive(False);
WSACleanup;
if FInitLock then
DeleteCriticalSection(FLock);
inherited Destroy;
end;

procedure TCustomSocket.Lock;
begin
if not FInitLock then
begin
InitializeCriticalSection(FLock);
FInitLock := True;
end;
EnterCriticalSection(FLock);
end;

procedure TCustomSocket.UnLock;
begin
if FInitLock then
LeaveCriticalSection(FLock);
end;

procedure TCustomSocket.Close;
begin
SetActive(False);
end;

procedure TCustomSocket.Open;
begin
SetActive(True);
end;

procedure TCustomSocket.DoRead(AData: Pointer;
ACount: Integer);
begin
if Assigned(FOnRead) then
FOnRead(Self, AData, ACount);
end;

procedure TCustomSocket.Error(AErrorEvent: TErrorEvent;
var AErrCode: Integer);
begin
if Assigned(FOnErrorEvent) then
FOnErrorEvent(Self, AErrorEvent, AErrCode);
end;

procedure TCustomSocket.Event(ASocketEvent: TSocketEvent);
begin
if Assigned(FOnEventEvent) then
FOnEventEvent(Self, ASocketEvent);
end;

function TCustomSocket.GetRemoteAddress: string;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Result := '';
if not FActive then
Exit;
Size := SizeOf(SockAddrIn);
CheckError(getpeername(FSocketHandle, SockAddrIn, Size), 'getpeername');
Result := inet_ntoa(SockAddrIn.sin_addr);
end;

function TCustomSocket.GetLocalAddress: string;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Result := '';
if not FActive then
Exit;
Size := SizeOf(SockAddrIn);
CheckError(getsockname(FSocketHandle, SockAddrIn, Size), 'getsockname');
Result := inet_ntoa(SockAddrIn.sin_addr);
end;

function TCustomSocket.GetRemoteHost: string;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
HostEnt: PHostEnt;
begin
Result := '';
if not FActive then
Exit;
Size := SizeOf(SockAddrIn);
CheckError(getpeername(FSocketHandle, SockAddrIn, Size), 'getpeername');
HostEnt := gethostbyaddr(@SockAddrIn.sin_addr.s_addr, 4, PF_INET);
if HostEnt <> nil then
Result := HostEnt.h_name;
end;

function TCustomSocket.GetRemotePort: string;
var
SockAddrIn: TSockAddrIn;
Size: Integer;
begin
Result := '';
if not FActive then
Exit;
Size := SizeOf(SockAddrIn);
CheckError(getpeername(FSocketHandle, SockAddrIn, Size), 'getpeername');
Result := IntToStr(ntohs(SockAddrIn.sin_port));
end;

function TCustomSocket.Read(var ABuffer;
ACount: Integer): Integer;
begin
raise ESocketError.Create('Error');
end;

function TCustomSocket.Write(var ABuffer;
ACount: Integer): Integer;
begin
raise ESocketError.Create('Error');
end;

{ TCustomerServerSocket }
function TCustomerServerSocket.DoClientRead(ASocket: TCustomSocket;
AData: Pointer;
ACount: Integer): Integer;
begin
if not Assigned(FOnClientRead) then
Result := 0
else
Result := FOnClientRead(ASocket, AData, ACount);
end;

procedure TCustomerServerSocket.ClientSocketError(ASocket: TCustomSocket;
AErrorEvent: TErrorEvent;
var AErrCode: Integer);
begin
if Assigned(FOnClientError) then
FOnClientError(ASocket, AErrorEvent, AErrCode);
end;

procedure TCustomerServerSocket.ClientSocketEvent(ASocket: TCustomSocket;
ASocketEvent: TSocketEvent);
begin
if Assigned(FOnClientEvent) then
FOnClientEvent(ASocket, ASocketEvent);
end;

{ TServerSocket }
procedure TServerSocket.Accept(ASocketHandle: TSocket;
ACompletionPort: THandle);
var
Addr: TSockAddrIn;
AddrLen, Ret, ErrCode: Integer;
ClientWinSocket: TSocket;
ClientSocket: TServerClientSocket;
begin
AddrLen := SizeOf(Addr);
ClientWinSocket := WinSock2.accept(ASocketHandle, Addr, AddrLen);
if ClientWinSocket <> INVALID_SOCKET then
begin
if not Active and not IsAccept(ClientWinSocket) then
begin
closesocket(ClientWinSocket);
Exit;
end;
try
Event(seAccept);
ClientSocket := nil;
if Assigned(FOnGetSocket) then
FOnGetSocket(ClientWinSocket, ClientSocket);
if not Assigned(ClientSocket) then
ClientSocket := TServerClientSocket.Create(Self, ClientWinSocket);
ClientSocket.FName := ClientSocket.RemoteAddress + ':' + ClientSocket.RemotePort;
except
closesocket(ClientWinSocket);
ErrCode := GetLastError;
Error(eeAccept, ErrCode);
Exit;
end;
Ret := CreateIoCompletionPort(ClientWinSocket, ACompletionPort, DWORD(ClientSocket), 0);
if Ret = 0 then
ClientSocket.Free;
end;
end;

constructor TServerSocket.Create;
begin
inherited Create(INVALID_SOCKET);
FBuffer := TMemoryBuffer.Create(Self);
FClients := TList.Create;
FThreads := TList.Create;
FPort := DEFAULT_SERVICE_PORT;
FAcceptThread := nil;
FCompletionPort := 0;
IsMultiThread := True;
FHandle := Classes.AllocateHWnd(WndProc);
end;

destructor TServerSocket.Destroy;
begin
SetActive(False);
FThreads.Free;
FClients.Free;
Classes.DeallocateHWnd(FHandle);
FBuffer.Free;
inherited Destroy;
end;

function TServerSocket.FindClientSocket(ASocketHandle: TSocket): TCustomSocket;
var
I: Integer;
begin
Lock;
try
for I := 0 to FClients.Count - 1do
begin
Result := FClients;
if ASocketHandle = Result.SocketHandle then
Exit;
end;
Result := nil;
finally
UnLock;
end;
end;

function TServerSocket.GetClientCount: Integer;
begin
Result := FClients.Count;
end;

function TServerSocket.GetClients(const AIndex: Integer): TServerClientSocket;
begin
Result := FClients[AIndex];
end;

procedure TServerSocket.InternalClose;
procedure CloseObject(var Handle: THandle);
begin
if Handle <> 0 then
begin
CloseHandle(Handle);
Handle := 0;
end;
end;

var
I: Integer;
Thread: TThread;
begin
Lock;
try
while FClients.Count > 0do
TObject(FClients.Last).Free;
FClients.Clear;
for I := FThreads.Count - 1do
wnto 0do
begin
Thread := FThreads;
PostQueuedCompletionStatus(FCompletionPort, 0, 0, Pointer(SHUTDOWN_FLAG));
Thread.Terminate;
end;
FThreads.Clear;
if FSocketHandle <> INVALID_SOCKET then
begin
Event(seDisconnect);
closesocket(FSocketHandle);
FSocketHandle := INVALID_SOCKET;
end;
FAcceptThread.Terminate;
CloseObject(FCompletionPort);
finally
UnLock;
FActive := False;
end;
end;

procedure TServerSocket.InternalOpen;
var
I: Integer;
Thread: TThread;
SystemInfo: TSystemInfo;
begin
Lock;
try
try
FCompletionPort := CreateIoCompletionPort(INVALID_HANDLE_VALUE, 0, 0, 0);
if FCompletionPort = 0 then
raise ESocketError.Create(SysErrorMessage(GetLastError));
Event(seInitIOPort);
GetSystemInfo(SystemInfo);
for I := 0 to SystemInfo.dwNumberOfProcessors * 2 - 1do
begin
Thread := TWorkerThread.Create(Self);
FThreads.Add(Thread);
end;

FSocketHandle := WSASocket(PF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
if FSocketHandle = INVALID_SOCKET then
raise ESocketError.Create(SysErrorMessage(GetLastError));
Event(seInitSocket);
FillChar(FAddr, SizeOf(FAddr), 0);
FAddr.sin_family := AF_INET;
FAddr.sin_port := htons(FPort);
FAddr.sin_addr.S_addr := INADDR_ANY;
CheckError(bind(FSocketHandle, @FAddr, SizeOf(FAddr)), 'bind');
Event(seListen);
CheckError(listen(FSocketHandle, SOMAXCONN), 'listen');
FAcceptThread := TAcceptThread.Create(Self);
except
InternalClose;
raise;
end;
finally
UnLock;
end;
end;

function TServerSocket.IsAccept(ASocketHandle: TSocket): Boolean;
begin
Result := True;
end;

function TServerSocket.RegisterClient(ASocket: TCustomSocket): Integer;
begin
Lock;
try
if FClients.IndexOf(ASocket) = -1 then
begin
FClients.Add(ASocket);
WSAAsyncSelect(ASocket.SocketHandle, FHandle, WM_CLIENTSOCKET, FD_CLOSE);
end;
Result := FClients.IndexOf(ASocket);
finally
UnLock;
end;
end;

procedure TServerSocket.RemoveClient(ASocket: TCustomSocket);
var
Index: Integer;
begin
Lock;
try
Index := FClients.IndexOf(ASocket);
if Index <> -1 then
FClients.Delete(Index);
finally
UnLock;
end;
end;

procedure TServerSocket.SetActive(AValue: Boolean);
begin
if FActive = AValue then
Exit;
FActive := AValue;
if AValue then
InternalOpen
else
InternalClose;
end;

procedure TServerSocket.SetPort(AValue: Integer);
begin
if Active then
raise ESocketError.Create('Cann''t change port');
FPort := AValue;
end;

procedure TServerSocket.WMClientClose(var AMessage: TSocketMessage);
var
ClientSocket: TCustomSocket;
begin
ClientSocket := FindClientSocket(AMessage.smSocketHandle);
if Assigned(ClientSocket) then
ClientSocket.Free;
end;

procedure TServerSocket.WndProc(var AMessage: TMessage);
begin
try
Dispatch(AMessage);
except
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self);
end;
end;

{ TServerClientSocket }
constructor TServerClientSocket.Create(AServerSocket: TServerSocket;
ASocket: TSocket);
begin
inherited Create(ASocket);
FServerSocket := AServerSocket;
FBuffer := FServerSocket.FBuffer;
FBlock := TList.Create;
FClientIndex := FServerSocket.RegisterClient(Self);
FOnRead := FServerSocket.OnClientRead;
OnErrorEvent := FServerSocket.ClientSocketError;
OnEventEvent := FServerSocket.ClientSocketEvent;
PrepareRecv;
Event(seConnect);
end;

destructor TServerClientSocket.Destroy;
var
I: Integer;
begin
FServerSocket.RemoveClient(Self);
for I := FBlock.Count - 1do
wnto 0do
FBuffer.RemoveBlock(FBlock);
FBlock.Free;
inherited Destroy;
end;

procedure TServerClientSocket.SetActive(AValue: Boolean);
var
Linger: TLinger;
begin
if FActive = AValue then
Exit;
if not AValue then
begin
if FSocketHandle <> INVALID_SOCKET then
begin
Event(seDisconnect);
FillChar(Linger, SizeOf(Linger), 0);
setsockopt(FSocketHandle, SOL_SOCKET, SO_LINGER, @Linger, Sizeof(Linger));
closesocket(FSocketHandle);
FSocketHandle := INVALID_SOCKET;
end;
end else
raise ESocketError.Create('当前socket不支持连接操作');
FActive := AValue;
end;

function TServerClientSocket.AllocBlock: PBlock;
var
I: Integer;
begin
for I := 0 to FBlock.Count - 1do
begin
Result := FBlock;
if not Result.blockData.phdIsUse then
begin
Result.blockData.phdIsUse := True;
Exit;
end;
end;
Result := FBuffer.AllocBlock;
FBlock.Add(Result);
Result.blockData.phdIsUse := True;
end;

function TServerClientSocket.Read(var ABuffer;
ACount: Integer): Integer;
begin
{ 读操作由DoReceive触发OnRead进行读 }
raise ESocketError.Create('读操作错误');
end;

function TServerClientSocket.Write(var ABuffer;
ACount: Integer): Integer;
var
Block: PBlock;
ErrCode: Integer;
Flags, BytesSend: Cardinal;
begin
Result := ACount;
if Result = 0 then
Exit;
Block := AllocBlock;
with Block^.blockDatado
begin
Flags := 0;
phdEvent := seWrite;
phdWsaBuffer.buf := @ABuffer;
phdWsaBuffer.len := Result;
if SOCKET_ERROR = WSASend(FSocketHandle, @phdWsaBuffer, 1, BytesSend, Flags, @phdOverlapped, nil) then
begin
ErrCode := WSAGetLastError;
if ErrCode <> ERROR_IO_PENDING then
begin
Result := SOCKET_ERROR;
Error(eeSend, ErrCode);
end;
end;
end;
end;

function TServerClientSocket.PrepareRecv(APBlock: PBlock = nil): Boolean;
var
ErrCode: Integer;
Flags, Transfer: Cardinal;
begin
if not Assigned(APBlock) then
APBlock := AllocBlock;
with APBlock^.blockDatado
begin
Flags := 0;
phdEvent := seRead;
FillChar(phdBuffer, SizeOf(phdBuffer), 0);
FillChar(phdOverlapped, SizeOf(phdOverlapped), 0);
phdWsaBuffer.buf := phdBuffer;
phdWsaBuffer.len := MAX_BUFSIZE;
Result := SOCKET_ERROR <> WSARecv(FSocketHandle, @phdWsaBuffer, 1, Transfer, Flags, @phdOverlapped, nil);
if not Result then
begin
ErrCode := WSAGetLastError;
Result := ErrCode = ERROR_IO_PENDING;
if not Result then
begin
APBlock.blockData.phdIsUse := False;
Error(eeReceive, ErrCode);
end;
end;
end;
end;

const
RESPONSE_UNKNOWN = $0001;
RESPONSE_SUCCESS = $0002;
RESPONSE_FAIL = $FFFF;

function TServerClientSocket.WorkBlock(var APBlock: PBlock;
ATransfered: DWORD): DWORD;
var
ErrCode: Integer;
Flag, BytesSend: Cardinal;
begin
Result := RESPONSE_SUCCESS;
with APBlock^.blockDatado
try
case APBlock^.blockData.phdEvent of
seRead:
begin
Self.Event(seRead);
do
Read(@phdBuffer, ATransfered);
if not PrepareRecv(APBlock) then
Result := RESPONSE_FAIL;
end;
seWrite:
begin
Self.Event(seWrite);
Dec(phdWsaBuffer.len, ATransfered);
if phdWsaBuffer.len <= 0 then
begin
{ 发送完成，将Block置空，返回到FBlock的可使用的缓区中 }
APBlock.blockData.phdIsUse := False;
APBlock := nil;
end else
begin
{ 数据还没发送完成，继续发送 }
Flag := 0;
Inc(phdWsaBuffer.buf, ATransfered);
FillChar(phdOverlapped, SizeOf(phdOverlapped), 0);
if SOCKET_ERROR = WSASend(FSocketHandle, @phdWsaBuffer, 1, BytesSend,
Flag, @phdOverlapped, nil) then
begin
ErrCode := WSAGetLastError;
if ErrCode <> ERROR_IO_PENDING then
Error(eeSend, ErrCode);
end;
end;
end;
end;
except
Result := RESPONSE_FAIL;
end;
end;

{ TSocketThread }
constructor TSocketThread.Create(AServer: TServerSocket);
begin
FServer := AServer;
inherited Create(False);
FreeOnTerminate := True;
end;

{ TAcceptThread }
procedure TAcceptThread.Execute;
begin
with FServerdo
while not Terminated and Activedo
Accept(SocketHandle, CompletionPort);
end;

{ TWorkerThread }
procedure TWorkerThread.Execute;
var
Block: PBlock;
Transfered: DWORD;
ClientSocket: TServerClientSocket;
begin
while FServer.Activedo
begin
Block := nil;
Transfered := 0;
ClientSocket := nil;
if not GetQueuedCompletionStatus(FServer.CompletionPort, Transfered,
DWORD(ClientSocket), POverlapped(Block), INFINITE) then
begin
if Assigned(ClientSocket) then
FreeAndNil(ClientSocket);
Continue;
end;

{ 客户可能超时?? 或是断开连接，I/O失败 }
if Transfered = 0 then
begin
FreeAndNil(ClientSocket);
Continue;
end;
{ 通知结束 }
if Cardinal(Block) = SHUTDOWN_FLAG then
Break;
if not FServer.Active then
Break;
case ClientSocket.WorkBlock(Block, Transfered) of
RESPONSE_UNKNOWN:
{ 操作未知的话，应该返回给客户端：...不应该Close....保留 }
FreeAndNil(ClientSocket);
RESPONSE_FAIL:
FreeAndNil(ClientSocket);
end;
end;
end;

{ TClientSocket }
constructor TClientSocket.Create;
begin
inherited Create(INVALID_SOCKET);
FServerIP := '127.0.0.1';
FServerPort := DEFAULT_SERVICE_PORT;
FHandle := Classes.AllocateHWnd(WndProc);
FillChar(FBuffer, SizeOf(FBuffer), 0);
FillChar(FServerAddr, SizeOf(FServerAddr), 0);
end;

destructor TClientSocket.Destroy;
begin
SetActive(False);
Classes.DeallocateHWnd(FHandle);
inherited;
end;

procedure TClientSocket.InternalOpen;
begin
Lock;
try
try
FSocketHandle := WSASocket(PF_INET, SOCK_STREAM, 0, nil, 0, WSA_FLAG_OVERLAPPED);
if FSocketHandle = INVALID_SOCKET then
raise ESocketError.Create(SysErrorMessage(GetLastError));
Event(seInitSocket);
FServerAddr.sin_family := AF_INET;
FServerAddr.sin_port := htons(FServerPort);
FServerAddr.sin_addr.S_addr := inet_addr(PAnsiChar(FServerIP));
CheckError(WinSock2.WSAConnect(FSocketHandle, @FServerAddr, SizeOf(FServerAddr), nil, nil, nil, nil), 'WSAConnect');
Event(seConnect);
WSAAsyncSelect(FSocketHandle, FHandle, WM_CLIENTSOCKET, FD_READ);
except
InternalClose;
raise;
end;
finally
UnLock;
end;
end;

procedure TClientSocket.InternalClose;
begin
Lock;
try
if FSocketHandle <> INVALID_SOCKET then
begin
Event(seDisconnect);
ShutDown(FSocketHandle, SD_BOTH);
closesocket(FSocketHandle);
FSocketHandle := INVALID_SOCKET;
end;
finally
UnLock;
end;
end;

procedure TClientSocket.SetActive(AValue: Boolean);
begin
if FActive = AValue then
Exit;
if AValue then
InternalOpen
else
InternalClose;
FActive := AValue;
end;

procedure TClientSocket.SetServerIP(const AValue: string);
var
I, TmpCount: Integer;
begin
if FServerIP = AValue then
Exit;
if inet_addr(PAnsiChar(AValue)) = INADDR_NONE then
Exit;
if Length(AValue) > 15 then
Exit;
TmpCount := 0;
for I := 1 to Length(AValue)do
if AValue = '.' then
Inc(TmpCount);
if TmpCount <> 3 then
Exit;
FServerIP := AValue;
end;

procedure TClientSocket.SetServerPort(const AValue: Word);
begin
if FServerPort = AValue then
Exit;
FServerPort := AValue;
end;

procedure TClientSocket.WMClientRead(var AMessage: TSocketMessage);
var
TmpBufLength, TmpErrCode: Integer;
begin
FillChar(FBuffer, SizeOf(FBuffer), 0);
Self.Event(seRead);
try
TmpBufLength := WinSock2.recv(FSocketHandle, FBuffer, SizeOf(FBuffer), 0);
if TmpBufLength = SOCKET_ERROR then
begin
TmpErrCode := WSAGetLastError;
Error(eeReceive, TmpErrCode);
Exit;
end;
if Assigned(FOnRead) then
FOnRead(Self, @FBuffer, TmpBufLength);
except
TmpErrCode := WSAGetLastError;
Error(eeReceive, TmpErrCode);
end;
end;

procedure TClientSocket.WndProc(var AMessage: TMessage);
begin
try
Dispatch(AMessage);
except
if Assigned(ApplicationHandleException) then
ApplicationHandleException(Self);
end;
end;

function TClientSocket.Write(var ABuffer;
ACount: Integer): Integer;
var
TmpBuf: PChar;
TmpSend, TmpLeft, TmpPosition, TmpErrCode: Integer;
begin
if not FActive then
begin
Result := SOCKET_ERROR;
Exit;
end;
Result := ACount;
if Result = 0 then
Exit;
TmpBuf := @ABuffer;
TmpLeft := ACount;
TmpPosition := 0;
try
while TmpLeft > 0do
begin
TmpSend := WinSock2.send(FSocketHandle, TmpBuf^, TmpLeft, 0);
if TmpSend = SOCKET_ERROR then
begin
Result := SOCKET_ERROR;
TmpErrCode := WSAGetLastError;
Error(eeSend, TmpErrCode);
Exit;
end;
TmpLeft := TmpLeft - TmpSend;
TmpPosition := TmpPosition + TmpSend;
Inc(TmpBuf, TmpPosition);
end;
except
Result := SOCKET_ERROR;
TmpErrCode := WSAGetLastError;
Error(eeSend, TmpErrCode);
end;
end;

end.

另外这个单元使用到了WinSock2.pas，这个可以在网上查一下

谢谢gotiger帮忙，谢谢大家