SSHポートフォワーディングするアプリの作成 ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• SSHポートフォワーディングするアプリの作成 ～Delphiソースコード集

SSHポートフォワーディングするアプリの作成 ～Delphiソースコード集

Ssh-Pascal-master.zipのダウンロード

プロジェクトとフォームの作成

プロジェクトとユニットの保存

一度コンパイルする

ソースコードの記述

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  Vcl.StdCtrls, Vcl.ExtCtrls,
  libssh2, SocketUtils, SSh2Client, SshTunnel;

type
  TForm1 = class(TForm)
    BConnect: TButton;
    BDisConnect: TButton;
    Memo1: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    E_LPort: TEdit;
    Label2: TLabel;
    E_MHost: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    E_MPort: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    E_RHost: TEdit;
    Label7: TLabel;
    E_RPort: TEdit;
    Label8: TLabel;
    E_MUser: TEdit;
    Label9: TLabel;
    E_MPass: TEdit;
    Label10: TLabel;
    procedure BConnectClick(Sender: TObject);
    procedure BDisConnectClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
    tunnel:ISshTunnel;
    sess:ISshSession;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


{ SSHトンネル、SSHポートフォワーディング }
procedure TForm1.BConnectClick(Sender: TObject);
var i:integer;
    auth:TAuthMethods;
    flag:boolean;
    Thread:TThread;
    p:TKnownHostCheckPolicy;
    stl:TStringList;
begin
  BConnect.Enabled:=False;
  BDisConnect.Enabled:=True;
  sess:=CreateSession(E_MHost.Text,StrToInt(E_MPort.Text));
  //未知のホスト鍵でも許可する設定を行う(フィンガープリントの確認)
  stl:=TStringList.Create;
  stl.Add('host '+E_MHost.Text);
  stl.Add('  StrictHostKeyChecking no');
  stl.SaveToFile(ExtractFilePath(Application.ExeName)+'config.ini');
  p[TKnownHostCheckState.khcsMatch]:=TKnownHostCheckAction.khcaContinue;
  p[TKnownHostCheckState.khcsMisMatch]:=TKnownHostCheckAction.khcaContinue;
  p[TKnownHostCheckState.khcsNotFound]:=TKnownHostCheckAction.khcaContinue;
  p[TKnownHostCheckState.khcsFailure]:=TKnownHostCheckAction.khcaContinue;
  sess.ConfigKnownHostCheckPolicy(
    true,p,
    ExtractFilePath(Application.ExeName)+'config.ini'
  );
  //sess.ConfigKeepAlive(false,5);
  //sess.SetTimeout(4000);
  //sess.CodePage:=65001;
  //接続
  sess.Connect(TIPVersion.IPv4);
  //認証
  flag:=sess.UserAuthPass(
    E_MUser.Text,
    E_MPass.Text
  );
  memo1.Lines.Add(sess.HostBanner);
  memo1.Lines.Add(sess.SessionMethods);
  if flag then
    memo1.Lines.Add('Connected')
  else
  begin
    memo1.Lines.Add('Can''t connect');
    BConnect.Enabled:=True;
    BDisConnect.Enabled:=False;
  end;

  //トンネルの作成
  tunnel:=CreateSshTunnel(sess);
  Thread := TThread.CreateAnonymousThread(
  procedure
  begin
    try
      tunnel.ForwardLocalPort(
        StrToInt(E_LPort.Text),
        E_RHost.Text,
        StrToInt(E_RPort.Text)
      );
    except
      sess.Disconnect;
      BConnect.Enabled:=True;
      BDisConnect.Enabled:=False;
      TThread.Synchronize(TThread.CurrentThread,
        procedure
        begin
          Memo1.Lines.Add('Disconnected');
        end
      );
    end;
  end
  );
  Thread.FreeOnTerminate:=True;
  Thread.Start;
end;

procedure TForm1.BDisConnectClick(Sender: TObject);
begin
  if BConnect.Enabled=False then
  begin
    BConnect.Enabled:=True;
    BDisConnect.Enabled:=False;
    tunnel.Cancel;
    sess.Disconnect;
    Memo1.Lines.Add('Disconnected');
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  BDisConnect.Enabled:=False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if BConnect.Enabled=False then
  begin
    BConnect.Enabled:=True;
    BDisConnect.Enabled:=False;
    tunnel.Cancel;
    sess.Disconnect;
  end;
end;

end.