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

Reply via email to