RDP tunneling Lazarus-ide

 {$mode objfpc}{$H+}

uses

  Classes, SysUtils, IdGlobal, IdTCPServer, IdContext, IdTCPClient, IdThread;

type

  TRDPTunnel = class(TIdTCPServer)

  private

    FTargetHost: string;

    FTargetPort: Integer;

    procedure Execute(AContext: TIdContext);

  public

    constructor Create(AOwner: TComponent); override;

  end;

  TRDPTunnelThread = class(TIdThread)

  private

    FClient: TIdTCPClient;

    FServer: TRDPTunnel;

    procedure ForwardData;

  public

    constructor Create(AClient: TIdTCPClient; AServer: TRDPTunnel);

  end;

constructor TRDPTunnel.Create(AOwner: TComponent);

begin

  inherited Create(AOwner);

  OnExecute := @Execute;

end;

procedure TRDPTunnel.Execute(AContext: TIdContext);

var

  Client: TIdTCPClient;

begin

  Client := TIdTCPClient.Create(nil);

  try

    Client.Connect(FTargetHost, FTargetPort);

    TRDPTunnelThread.Create(AContext.Connection, Client, Self);

  except

    on E: Exception do

    begin

      AContext.Connection.Disconnect;

      Client.Disconnect;

      raise;

    end;

  end;

end;

constructor TRDPTunnelThread.Create(AServer: TIdTCPConnection; AClient: TIdTCPClient; AServer: TRDPTunnel);

begin

  inherited Create(True);

  FClient := AClient;

  FServer := AServer;

  FreeOnTerminate := True;

  Start;

end;

procedure TRDPTunnelThread.ForwardData;

var

  Buffer: TIdBytes;

begin

  SetLength(Buffer, 1024);

  while not Terminated do

  begin

    if FServer.Connection.Connected and FClient.Connected then

    begin

      FServer.Connection.ReadBytes(Buffer, Length(Buffer));

      FClient.Write(Buffer);

    end

    else

      Break;

  end;

end;

var

  Tunnel: TRDPTunnel;

begin

  Tunnel := TRDPTunnel.Create(nil);

  try

    Tunnel.DefaultPort := 13000;

    Tunnel.FTargetHost := '127.0.0.1';

    Tunnel.FTargetPort := 3389;

    Tunnel.Active := True;

    WriteLn('RDP tunnel started, press Enter to stop.');

    ReadLn;