这是使用TServerSocket 实现直通代理的错误方法。
OnClientRead 事件在每次TServerSocket 从网络浏览器接收原始数据时触发。不要在收到的每个数据块上连接和断开您的TClientSocket。您应该在服务器的OnClientConnect 事件中连接您的TClientSocket，在服务器的OnClientDisconnect 事件中关闭该连接，并在OnClientRead 事件中使用SendBuf() 而不是ReceiveText()/@ 987654332@.
您还需要考虑到可能需要多个OnRead 事件才能让网络服务器有任何数据要发回。在非阻塞模式下使用TClientSocket 和它自己的OnRead 事件处理程序将数据从网络服务器发送到网络浏览器。
您还必须考虑到，在非阻塞模式下，SendBuf() 可能会失败并出现WSAEWOULDBLOCK 错误。如果发生这种情况，您必须缓存当前正在发送的数据并等待套接字的OnWrite 事件被调用，然后才能再次向该套接字发送数据。
您还需要考虑到网络浏览器可以并且很可能会创建到您的代理的多个连接。因此，您的代理将需要多个 TClientSocket 连接，每个网络浏览器连接一个。
至少尝试类似的方法（实现正确 HTTP 代理需要比这更多的逻辑）：
type
TMyBuffer = class(TMemoryStream)
private
FSocket: TCustomWinSocket;
public
constructor Create(ASocket: TCustomWinSocket);
procedure Send(Data: Pointer; DataLen: Integer);
procedure Flush;
end;
TMyServerSocketData = class;
TMyClientSocket = class(TClientSocket)
private
FBuffer: TMyBuffer;
FServerSocketData: TMyServerSocketData;
protected
procedure Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); override;
procedure Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); override;
public
constructor Create(AServerSocketData: TMyServerSocketData); reintroduce;
destructor Destroy; override;
procedure Send(Data: Pointer; DataLen: Integer);
property ServerSocketData: TMyServerSocketData read FServerSocketData;
end;
TMyServerSocketData = class
private
FBuffer: TMyBuffer;
FClientSocket: TMyClientSocket;
FServerSocket: TCustomWinSocket;
public
constructor Create(AServerSocket: TCustomWinSocket);
destructor Destroy; override;
procedure Send(Data: Pointer; DataLen: Integer);
procedure FlushBuffer;
property ClientSocket: TMyClientSocket read FClientSocket;
property ServerSocket: TCustomWinSocket read FServerSocket;
end;
constructor TMyBuffer.Create(ASocket: TCustomWinSocket);
begin
inherited Create;
FSocket := ASocket;
end;
procedure TMyBuffer.Send(Data: Pointer; DataLen: Integer);
var
PData: PByte;
begin
PData := PByte(Data);
if Self.Size = 0 then
begin
repeat
NumSent := FSocket.SendBuf(PData^, DataLen);
if NumSent < 1 then Break;
Inc(PData, NumSent);
Dec(DataLen, NumSent);
until DataLen = 0;
end;
if DataLen > 0 then
begin
Self.Seek(0, soEnd);
Self.WriteBuffer(PData^, DataLen);
end;
end;
procedure TMyBuffer.Flush;
var
PData: PByte;
DataLen, NumSent: Integer;
begin
if Self.Size = 0 then Exit;
Self.Position := 0;
PData := PByte(Self.Memory);
DataLen := Self.Size;
repeat
NumSent := FSocket.SendBuf(PData^, DataLen);
if NumSent < 1 then Break;
Inc(PData, NumSent);
Dec(DataLen, NumSent);
Self.Seek(NumSent, soCurrent);
until DataLen = 0;
if Self.Position = 0 then Exit;
if Self.Position = Self.Size then
Self.Clear
else begin
Move(PData, Self.Memory, DataLen);
Self.Size := DataLen;
end;
end;
constructor TMyClientSocket.Create(AServerSocketData: TMyServerSocketData);
begin
inherited Create(nil);
ClientType := ctNonBlocking;
FBuffer := TMyBuffer.Create(Socket);
FServerSocketData := AServerSocketData;
end;
destructor TMyClientSocket.Destroy;
begin
FBuffer.Free;
inherited;
end;
procedure TMyClientSocket.Send(Data: Pointer; DataLen: Integer);
begin
FBuffer.Send(Data, DataLen);
end;
procedure TMyClientSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
var
Buf: array[0..1023] of byte;
BufLen, NumSent: Integer;
PBuf: PByte;
begin
case SocketEvent of
seRead:
begin
if not FServerSocketData.ServerSocket.Connected then Exit;
BufLen := Socket.ReceiveBuf(Buf[0], SizeOf(Buf));
if BufLen > 0 then
FServerSocketData.Send(@Buf[0], BufLen);
end;
seWrite:
FBuffer.Flush;
else
inherited;
end;
end;
procedure TMyClientSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
FServerSocketData.ServerSocket.Close;
inherited;
end;
constructor TMyServerSocketData.Create(AServerSocket: TCustomWinSocket);
begin
inherited Create;
FBuffer := TMyBuffer.Create(AServerSocket);
FClientSocket := TMyClientSocket.Create(Self);
FServerSocket := AServerSocket;
end;
destructor TMyServerSocketData.Destroy;
begin
FBuffer.Free;
FClientSocket.Free;
inherited;
end;
procedure TMyServerSocketData.Send(Data: Pointer; DataLen: Integer);
begin
FBuffer.Send(Data, DataLen);
end;
procedure TMyServerSocketData.FlushBuffer;
begin
FBuffer.Flush;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.OnClientConnect := ServerSocket1ClientConnect;
ServerSocket1.OnClientDisconnect := ServerSocket1ClientDisconnect;
ServerSocket1.OnClientRead := ServerSocket1ClientRead;
ServerSocket1.Port := 80;
ServerSocket1.ServerType := stNonBlocking;
ServerSocket1.Active := true;
end;
Procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
Data: TMyServerSocketData;
begin
Data := TMyServerSocketData.Create(Socket);
try
Data.ClientSocket.Host := '192.168.69.1';
Data.ClientSocket.Port := 80;
Data.ClientSocket.Open;
except
Data.Free;
raise;
end;
Socket.Data := Data;
end;
Procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
TMyServerSocketData(Socket.Data).Free;
end;
Procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ClientSocket: TMyClientSocket;
Buf: array[0..1023] of byte;
BufLen: Integer;
begin
ClientSocket := TMyServerSocketData(Socket.Data).ClientSocket;
if not ClientSocket.Socket.Connected then Exit;
BufLen := Socket.ReceiveBuf(Buf[0], SizeOf(Buf));
if BufLen > 0 then
ClientSocket.Send(@Buf[0], BufLen);
end;
Procedure TForm1.ServerSocket1ClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
begin
TMyServerSocketData(Socket.Data).FlushBuffer;
end;
话虽如此，您确实应该重新考虑使用第三方组件。 Indy 预装了德里，并有一个TIdMappedPortTCP 组件，它完全可以完成您想要完成的工作。 Indy 9 和 10 也有一个 TIdHTTPProxyServer 组件（Indy 8 附带了 Delphi 6，但较新版本的 Indy 仍然支持 Delphi 6）。