HTTP Proxy Tunneler

With all respect to author of original app source... I made few fixes to be able to compile on Delphi 10.2 Tokyo (might work in recent lower versions .... ex. Xe8,....).
Here is my fixed unit (did not alter any additional comments - but can be use some source diff app to look what I changed):

unit TunnelU;

interface

uses
  { Windows }
  Windows, Messages, ShellAPI,

  { RTL }
  SysUtils, Variants, Classes,

  { VCL }
  Graphics, Controls, Forms, Dialogs,

  { Indy 9.0.14 }
  IdBaseComponent, IdComponent, IdTCPServer, IdMappedPortTCP,
  IdTCPConnection, Menus, IdContext;

type
  TMapState = (msUnMapped, msPaused, msActive);
  TForm1 = class(TForm)
    yTrayMenu: TPopupMenu;
    xRestart: TMenuItem;
    xPause: TMenuItem;
    xUnpause: TMenuItem;
    xLoadConfig: TMenuItem;
    xQuit: TMenuItem;
    N1: TMenuItem;
    yOpenDialog: TOpenDialog;
    procedure ProxyConnect(AContext: TIdContext);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure xPauseClick(Sender: TObject);
    procedure xUnpauseClick(Sender: TObject);
    procedure xRestartClick(Sender: TObject);
    procedure xQuitClick(Sender: TObject);
    procedure yTrayMenuPopup(Sender: TObject);
    procedure xLoadConfigClick(Sender: TObject);
  private
    { Private declarations }
    fNID:NOTIFYICONDATAA;
    fMappings: TStringList;
    fConfigXML: string;
    fTimeOut: Integer;
    fMapState: TMapState;
    procedure TrayClickMessage(var Message:TMsg); Message WM_User+1;
    procedure Setup(const AConfigFile: string);
    procedure Unmap;
    procedure Start;
    procedure Pause;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  { RTL }
  XMLDoc, XMLIntf, IdSocketHandle;

{$R *.dfm}

procedure TForm1.ProxyConnect(AContext: TIdContext);
var
  lLine: string;
  LContext: TIdMappedPortContext;
begin
  LContext := TIdMappedPortContext(AContext);

  lLine := fMappings[LContext.Server.Tag];
  LContext.OutboundClient.SendCmd(Format('CONNECT %s HTTP/1.0',[lLine]));

  {lLine := '';
  repeat
    lLine := AThread.OutboundClient.ReadLn(#$A,fTimeOut);
  until lLine = '';}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  fTimeOut := 5000;
  fMappings := TStringList.Create;
  fMapState := msUnMapped;
  fConfigXML := '';
  if (ParamCount > 0) then
    fConfigXML := ExpandFileName(ParamStr(1));
  if (fConfigXML = '' ) or not FileExists(fConfigXML) then
    fConfigXML := ChangeFileExt(ParamStr(0),'.xml');
  if (fConfigXML = '' ) or not FileExists(fConfigXML) then
    fConfigXML := ChangeFileExt(ParamStr(0),'.xml');
  if (fConfigXML = '' ) or not FileExists(fConfigXML) then
    fConfigXML := '';

  Setup(fConfigXML);
  Start;

  with fNID do
  begin
    cbSize:=System.sizeof(NOTIFYICONDATAA);
    Wnd := Handle;
    uFlags:=NIF_MESSAGE or NIF_ICON or NIF_TIP;
    uCallbackMessage := WM_User + 1;
    hIcon := Application.Icon.Handle;
    szTip := 'HTTP Proxy Tunnel';
    Shell_NotifyIcon(NIM_ADD, @fNID);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Unmap;
  fMappings.Free;
  Shell_NotifyIcon(NIM_DELETE, @fNID);
end;

procedure TForm1.TrayClickMessage(var Message: TMsg);
begin
 if Message.wParam = WM_LBUTTONDBLCLK then
   Visible := not Visible;
 if (Message.wParam = WM_RBUTTONUP) then
 begin
   PopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
 end;
end;

procedure Split(const AComplex: string; out AHost: string; out APort: Integer);
var
  lColn: Integer;
begin
  lColn := Pos(':',AComplex);
  if lColn = 0 then
    APort := -1
  else if not TryStrToInt(Copy(AComplex,succ(lColn),MaxInt),APort) then
    raise Exception.Create(AComplex + ' has invalid port number!');
  AHost := Copy(AComplex, 1, pred(lColn));
end;

procedure TForm1.Setup(const AConfigFile: string);
var
  lXML: IXMLDocument;
  lNode: IXMLNode;
  lIdx: Integer;
  lMap: TIdMappedPortTCP;
  lComplex, lHost: string;
  lPort: Integer;
begin
  Unmap;
  if not FileExists(AConfigFile) then Exit;
  lXML := LoadXMLDocument(AConfigFile);
  for lIdx := 0 to pred(lXML.DocumentElement.ChildNodes.Count) do
  begin
    lNode := lXML.DocumentElement.ChildNodes.Get(lIdx);
    lMap := TIdMappedPortTCP.Create(nil);
    try
      lMap.Tag := lIdx;
      //lMap.CommandHandlersEnabled := False;
      lMap.OnOutboundConnect := ProxyConnect;

      // Listen on
      lComplex := lNode.Attributes['listen'];
      Split(lComplex, lHost, lPort);
      lMap.DefaultPort := lPort;
      with lMap.Bindings.Add do
      begin
        IP := lHost;
        Port := lPort;
      end;

      // map too
      lComplex := lNode.Attributes['proxy'];
      if lComplex <> '' then
      begin // map to proxy server
        Split(lComplex, lHost, lPort);
        lMap.MappedHost := lHost;
        lMap.MappedPort := lPort;
        // save the destination to connect to later
        fMappings.AddObject(lNode.Attributes['mapped'],lMap)
      end else begin
        // no proxy, just a direct map
        lComplex := lNode.Attributes['mapped'];
        Split(lComplex, lHost, lPort);
        lMap.MappedHost := lHost;
        lMap.MappedPort := lPort;
        // save the object to manage
        fMappings.AddObject('',lMap);
      end;
    except
      if fMappings.Count = succ(lIdx) then
        fMappings[lIdx] := '';
      lMap.Free;
      raise;
    end;
  end;
  fMapState := msPaused;
end;

procedure TForm1.Pause;
var
  lIdx: Integer;
  lMap: TIdMappedPortTCP;
begin
  fMapState := msPaused;
  for lIdx := pred(fMappings.Count) downto 0 do
  begin
    lMap := TIdMappedPortTCP(fMappings.Objects[lIdx]);
    if Assigned(lMap) then
      lMap.Active := False;
  end;
end;

procedure TForm1.Start;
var
  lIdx: Integer;
  lMap: TIdMappedPortTCP;
begin
  fMapState := msPaused;
  for lIdx := pred(fMappings.Count) downto 0 do
  begin
    lMap := TIdMappedPortTCP(fMappings.Objects[lIdx]);
    if Assigned(lMap) then
      lMap.Active := True;
  end;
  fMapState := msActive;
end;

procedure TForm1.Unmap;
var
  lIdx: Integer;
  lMap: TIdMappedPortTCP;
begin
  fMapState := msUnMapped;
  Pause;
  sleep(100);
  for lIdx := pred(fMappings.Count) downto 0 do
  begin
    lMap := TIdMappedPortTCP(fMappings.Objects[lIdx]);
    if Assigned(lMap) then
      lMap.Free;
    fMappings.Delete(lIdx);
  end;
  Assert(fMappings.Count = 0);
end;

procedure TForm1.xPauseClick(Sender: TObject);
begin
  Pause;
end;

procedure TForm1.xUnpauseClick(Sender: TObject);
begin
  Start;
end;

procedure TForm1.xRestartClick(Sender: TObject);
begin
  Setup(fConfigXML);
end;

procedure TForm1.xQuitClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.yTrayMenuPopup(Sender: TObject);
begin
  xPause.Visible := fMapState = msActive;
  xUnpause.Visible := fMapState = msPaused;
end;

procedure TForm1.xLoadConfigClick(Sender: TObject);
begin
  if yOpenDialog.Execute then
  begin
    fConfigXML := yOpenDialog.FileName;
    Setup(fConfigXML);
    Start;
  end;
end;

end.

Select allOpen in new window

...and note: did not run any test if it is working... Please send comments about that...

Hi! Do you still need help about your problem?