This is the wrong way to implement a passthrough proxy with TServerSocket.
The OnClientRead event is triggered every time TServerSocket receives raw data from the web browser. DO NOT connect and disconnect your TClientSocket on every block of data received. You should be connecting your TClientSocket in the server's OnClientConnect event instead, close that connection in the server's OnClientDisconnect event, and use ReceiveBuf()/SendBuf() in the OnClientRead event instead of ReceiveText()/SendText().
You also need to take into account that it may take multiple OnRead events before the web server has any data to send back. Use the TClientSocket in non-blocking mode with its own OnRead event handler to send data from the web server to the web browser.
You also have to take into account that in non-blocking mode, SendBuf() can fail with a WSAEWOULDBLOCK error. If that happens, you have to cache the data you are currently sending and wait for the socket's OnWrite event to be called before you can send data to that socket again.
You also need to take onto account that the web browser can, and likely will, create multiple connections to your proxy. Your proxy will thus need multiple TClientSocket connections, one for each web browser connection.
Try something more like this instead, at a bare minimum (implementing a proper HTTP proxy requires even more logic than this):
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;
With that said, you really should reconsider using third-party components. Indy ships preinstalled with Delhi and has a TIdMappedPortTCP component that does exactly what you are trying to accomplish. Indy 9 and 10 also have a TIdHTTPProxyServer component (Delphi 6 shipped with Indy 8, but newer versions of Indy still support Delphi 6).
