Hi,
I tried to write my own proxyserver. I looked at the available proxyserver
(gphttpproxy) yet and found some errors in my code.
Now I think everything should work for the beginning. But often when I open
a remoteconnection and send data to the server, I did not receive any
answer.
I made a dump with ethreal and really there is no data.
But when I open the connection normally - without the proxy - everything
works fine. Connections from the google toolbars are working with the proxy
- strange...
I tried to open www.edv-bachmann.de/robots.txt
Has someone an idea?
Best wishes,
Marc
unit proxy;
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls,
Forms,
IniFiles, StdCtrls, ExtCtrls,
OverbyteIcsWSocket, OverbyteIcsWSocketS, OverbyteIcsWndControl;
const
TcpSrvVersion = 104;
CopyRight = ' ProxyServer (c) 2007';
WM_APPSTARTUP = WM_USER + 1;
max_open_requests = 300;
type
TTcpSrvClient = class(TWSocketClient)
public
RemoteConnection : TWSocket;
Komplette_Anfrage : String;
inuse : Boolean;
RcvdLine : String;
ConnectTime : TDateTime;
Anfrage_gesendet : Boolean;
proxy_closed : Boolean;
reqno : Word;
tries_remoteconnection : Word;
end;
TTcpSrvForm = class(TForm)
ToolPanel: TPanel;
DisplayMemo: TMemo;
WSocketServer1: TWSocketServer;
WSocket1: TWSocket;
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure WSocketServer1ClientConnect(Sender: TObject;
Client_org: TWSocketClient; Error: Word);
procedure WSocketServer1ClientDisconnect(Sender: TObject;
Client: TWSocketClient; Error: Word);
procedure WSocketServer1BgException(Sender: TObject; E: Exception;
var CanClose: Boolean);
private
FIniFileName : String;
FInitialized : Boolean;
actual_reqno : Word;
procedure Display(Msg : String);
procedure WMAppStartup(var Msg: TMessage); message
WM_APPSTARTUP;
procedure ClientDataAvailable(Sender: TObject; Error: Word);
procedure ProcessData(Client: TTcpSrvClient);
procedure ClientBgException(Sender : TObject;
E : Exception;
var CanClose : Boolean);
procedure ClientLineLimitExceeded(Sender : TObject;
Cnt : LongInt;
var ClearData : Boolean);
procedure ProxyConnected(
Sender : TObject;
ErrCode : WORD);
procedure ProxyDisconnected(
Sender : TObject;
ErrCode : WORD);
procedure ProxyDataAvailable(Sender: TObject; Error: Word);
public
property IniFileName : String read FIniFileName write FIniFileName;
end;
var
TcpSrvForm: TTcpSrvForm;
function LeftS(text: String; length: Integer): String;
function RightS(text: String; count: Integer): String;
implementation
{$R *.DFM}
const
SectionWindow = 'WindowTcpSrv';
KeyTop = 'Top';
KeyLeft = 'Left';
KeyWidth = 'Width';
KeyHeight = 'Height';
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTcpSrvForm.FormCreate(Sender: TObject);
begin
actual_reqno := 0;
{$IFDEF DELPHI10}
// BDS2006 has built-in memory leak detection and display
ReportMemoryLeaksOnShutdown := (DebugHook <> 0);
{$ENDIF}
end;
procedure TTcpSrvForm.FormShow(Sender: TObject);
var
IniFile : TIniFile;
begin
if not FInitialized then begin
FInitialized := TRUE;
DisplayMemo.Clear;
{ Delay startup code until our UI is ready and visible }
PostMessage(Handle, WM_APPSTARTUP, 0, 0);
end;
end;
procedure TTcpSrvForm.FormClose(Sender: TObject; var Action:
TCloseAction);
var
IniFile : TIniFile;
begin
end;
procedure TTcpSrvForm.Display(Msg : String);
var
I : Integer;
begin
DisplayMemo.Lines.BeginUpdate;
try
if DisplayMemo.Lines.Count > 200 then begin
for I := 1 to 50 do
DisplayMemo.Lines.Delete(0);
end;
DisplayMemo.Lines.Add(Msg);
finally
DisplayMemo.Lines.EndUpdate;
SendMessage(DisplayMemo.Handle, EM_SCROLLCARET, 0, 0);
end;
end;
procedure TTcpSrvForm.WMAppStartup(var Msg: TMessage);
var
MyHostName : String;
begin
Display(CopyRight);
Display(OverbyteIcsWSocket.Copyright);
Display(OverbyteIcsWSocketS.CopyRight);
WSocket_gethostname(MyHostName);
Display(' I am "' + MyHostName + '"');
Display(' IP: ' + LocalIPList.Text);
WSocketServer1.Proto := 'tcp'; { Use TCP protocol }
WSocketServer1.Port := '1081'; { Use telnet port }
WSocketServer1.Addr := '127.0.0.1'; { Use any interface }
WSocketServer1.Banner := '';
WSocketServer1.BannerTooBusy := '';
WSocketServer1.ClientClass := TTcpSrvClient; { Use our component }
WSocketServer1.Listen; { Start litening }
Display('Waiting for HTTP requests...');
end;
procedure TTcpSrvForm.WSocketServer1ClientConnect(
Sender : TObject;
Client_org : TWSocketClient;
Error : Word);
var
Client : TTcpSrvClient;
begin
client := TTcpSrvClient(Client_org);
actual_reqno := actual_reqno + 1;
Display('New request -> got no. ' + Inttostr(actual_reqno) );
with Client do
begin
LineMode := FALSE;
LineEdit := FALSE;
LineLimit := 65535;
OnDataAvailable := ClientDataAvailable;
OnLineLimitExceeded := ClientLineLimitExceeded;
OnBgException := ClientBgException;
ConnectTime := Now;
Anfrage_gesendet := FALSE;
inuse := TRUE;
proxy_closed := TRUE;
reqno := actual_reqno;
FreeandNil(RemoteConnection);
Display('New request #' + IntToStr(actual_reqno) +
' Remote: ' + PeerAddr + '/' + PeerPort +
' Local: ' + GetXAddr + '/' + GetXPort);
end;
end;
procedure TTcpSrvForm.WSocketServer1ClientDisconnect(
Sender : TObject;
Client : TWSocketClient;
Error : Word);
begin
with Client as TTcpSrvClient do begin
Display('Request aborted: ' + PeerAddr + ' ' +
'Duration: ');
// + FormatDateTime('hh:nn:ss',
// Now - ConnectTime));
Display('There is now ' +
IntToStr(TWSocketServer(Sender).ClientCount - 1) +
' open requests.');
end;
end;
procedure TTcpSrvForm.ClientLineLimitExceeded(
Sender : TObject;
Cnt : LongInt;
var ClearData : Boolean);
begin
with Sender as TTcpSrvClient do begin
Display('Line limit exceeded from ' + GetPeerAddr + '. Closing.');
ClearData := TRUE;
Close;
end;
end;
procedure TTcpSrvForm.ClientDataAvailable(
Sender : TObject;
Error : Word);
var
i : Word;
gefunden : Boolean;
Client : TTcpSrvClient;
begin
Client := TTcpSrvClient(Sender);
with Client do begin
RcvdLine := ReceiveStr;
if LineMode = true then
begin
while (Length(RcvdLine) > 0) and
(RcvdLine[Length(RcvdLine)] in [#13, #10]) do
RcvdLine := Copy(RcvdLine, 1, Length(RcvdLine) - 1);
end;
end;
ProcessData(Client);
end;
procedure TTcpSrvForm.ProxyDataAvailable(
Sender : TObject;
Error : Word);
var
i, max : Word;
gefunden : Boolean;
receiveddata, test : String;
Client, searchclient : TTcpSrvClient;
Remote : TWSocket;
begin
Remote := TWSocket(Sender);
i := 0;
max := WSocketServer1.ClientCount;
gefunden := FALSE;
while i < max do
begin
searchclient := TTcpSrvClient(WSocketServer1.Client[i]);
if searchclient.RemoteConnection = Remote then
begin
gefunden := TRUE;
Client := TtcpSrvClient(WSocketServer1.Client[i]);
end;
i := i + 1;
end;
if gefunden then
begin
if Error <> 0 then
Display(Client.RemoteConnection.Name + ': Error during receiving data
to ' + TWSocket(Sender).Addr + '. Error #' + IntToStr(Error))
else
begin
Display(Client.RemoteConnection.Name + ': ' +
IntToStr(Client.RemoteConnection.RcvdCount) + ' Bytes received' );
receiveddata := Client.RemoteConnection.ReceiveStr;
Display('Data received #'+IntToStr(Client.reqno)+': ' + receiveddata );
Display('test: ' + test);
// Send data to client
Client.SendStr(receiveddata);
end;
end;
end;
procedure TTcpSrvForm.ProxyDisconnected(
Sender : TObject;
ErrCode : WORD);
var
i, max : Word;
gefunden : Boolean;
Client, searchclient : TTcpSrvClient;
Remote : TWSocket;
begin
Remote := TWSocket(Sender);
i := 0;
max := WSocketServer1.ClientCount;
gefunden := FALSE;
while i < max do
begin
searchclient := TTcpSrvClient(WSocketServer1.Client[i]);
if searchclient.RemoteConnection = Remote then
begin
gefunden := TRUE;
Client := TtcpSrvClient(WSocketServer1.Client[i]);
end;
i := i + 1;
end;
if gefunden then
begin
if ErrCode <> 0 then
Display(Client.RemoteConnection.Name + ': Unable to disconnect to ' +
TWSocket(Sender).Addr + '. Error #' + IntToStr(ErrCode))
else
begin
Display(Client.RemoteConnection.Name + ': Disconnected');
Client.proxy_closed := true;
if Client.AllSent then
begin
Display('all sent');
Client.Close;
Client.inuse := false;
end
else
Display('not all sent');
end;
end;
end;
procedure TTcpSrvForm.ProxyConnected(
Sender : TObject;
ErrCode : WORD);
var
i, max : Word;
gefunden : Boolean;
Client, searchclient : TTcpSrvClient;
Remote : TWSocket;
begin
Remote := TWSocket(Sender);
i := 0;
max := WSocketServer1.ClientCount;
gefunden := FALSE;
while i < max do
begin
searchclient := TTcpSrvClient(WSocketServer1.Client[i]);
if searchclient.RemoteConnection = Remote then
begin
gefunden := TRUE;
Client := TtcpSrvClient(WSocketServer1.Client[i]);
end;
i := i + 1;
end;
if gefunden then
begin
if ErrCode <> 0 then
Display(Client.RemoteConnection.Name + ': Unable to connect to ' +
TWSocket(Sender).Addr + '. Error #' + IntToStr(ErrCode))
else
begin
Display(Client.RemoteConnection.Name + ': Connected');
Display('Send request #' + IntToStr(Client.reqno));
// Send request to remote connection
Client.RemoteConnection.SendStr(Client.Komplette_Anfrage);
Client.Anfrage_gesendet := true;
Client.proxy_closed := false;
end;
end
else
Display('Request not found');
end;
procedure TTcpSrvForm.ProcessData(Client: TTcpSrvClient);
var
I : Integer;
AClient : TTcpSrvClient;
host : String;
receiveddata : String;
begin
receiveddata := Client.RcvdLine;
Client.Komplette_Anfrage := Client.Komplette_Anfrage + receiveddata;
if Client.LineMode = TRUE then
Client.Komplette_Anfrage := Client.Komplette_Anfrage + #13#10;
if (Pos(#13#10#13#10, Client.Komplette_Anfrage) > 0) OR (Pos(#13#13,
Client.Komplette_Anfrage) > 0) then
begin
Display('#' + IntToStr(Client.reqno) + ' komplett: ' +
LeftS(Client.Komplette_Anfrage, Pos(#13, Client.Komplette_Anfrage) - 1));
if (Pos('Host: ', Client.Komplette_Anfrage) > 0) then
begin
if (Client.tries_remoteconnection = 0) then
begin
host := RightS(Client.Komplette_Anfrage,
Length(Client.Komplette_Anfrage) - Pos('Host: ',Client.Komplette_Anfrage) -
5);
host := LeftS(host, Pos(#13, host) - 1);
Display('#' + IntToStr(Client.reqno) + ' Verbindung auf zu Host: ' +
host
+ ' ...');
Client.RemoteConnection := TWSocket.Create(Self);
Client.RemoteConnection.Name := Client.Name + '_reqno' +
IntToStr(Client.reqno);
Display('NEW: ' + Client.RemoteConnection.Name + ' ' +
LeftS(Client.Komplette_Anfrage, Pos(#13, Client.Komplette_Anfrage) - 1) );
Client.RemoteConnection.Proto := 'tcp';
Client.RemoteConnection.Port := '80';
Client.RemoteConnection.Addr := host;
//Client.RemoteConnection.MultiThreaded := true;
Client.RemoteConnection.KeepAliveOnOff := wsKeepAliveOnSystem;
Client.RemoteConnection.KeepAliveTime := 30;
Client.RemoteConnection.OnSessionConnected := ProxyConnected;
Client.RemoteConnection.OnSessionClosed := ProxyDisconnected;
Client.RemoteConnection.OnDataAvailable := ProxyDataAvailable;
Client.tries_remoteconnection := 1;
Client.RemoteConnection.Connect;
end
else
begin
Client.RemoteConnection.SendStr(receiveddata);
end;
end;
end;
end;
procedure TTcpSrvForm.WSocketServer1BgException(
Sender : TObject;
E : Exception;
var CanClose : Boolean);
begin
Display('Server exception occured: ' + E.ClassName + ': ' + E.Message);
CanClose := FALSE; { Hoping that server will still work ! }
end;
procedure TTcpSrvForm.ClientBgException(
Sender : TObject;
E : Exception;
var CanClose : Boolean);
begin
Display('Client exception occured: ' + E.ClassName + ': ' + E.Message);
CanClose := TRUE; { Goodbye client ! }
end;
function LeftS(text: String; length: Integer): String;
begin
Result := Copy(text,1,length);
end;
function RightS(text: String; count: Integer): String;
begin
if count < Length(text) then
Result := Copy(text, Length(text) - count+1, count)
else
Result := text;
end;
end.
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://www.elists.org/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be
