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