Synapse/pl

{Ten kod obsługuje szyfrowanie TLS/SSL; jeśli wysyłasz do portu 25, SMTP używa zwykłego tekstu.}

uses
  ..., smtpsend,ssl_openssl; //prawdopodobnie można użyć również inne moduły SSL.

// MailData to tekst wiadomości.
function SendMail(
  User, Password, 
  MailFrom, MailTo, 
  SMTPHost, SMTPPort: string; 
  MailData: string): Boolean;
var
  SMTP: TSMTPSend;
  sl:TStringList;
begin
  Result:=False;
  SMTP:=TSMTPSend.Create;
  sl:=TStringList.Create;
  try
    sl.text:=Maildata;
    SMTP.UserName:=User;
    SMTP.Password:=Password;
    SMTP.TargetHost:=SMTPHost;
    SMTP.TargetPort:=SMTPPort;
    SMTP.AutoTLS:=true;
    if Trim(SMTPPort)<>'25' then
      SMTP.FullSSL:=true; // jeśli wysyłasz na port 25, nie używaj szyfrowania
    if SMTP.Login then
    begin
      result:=SMTP.MailFrom(MailFrom, Length(MailData)) and
         SMTP.MailTo(MailTo) and
         SMTP.MailData(sl);
      SMTP.Logout;
    end;
  finally
    SMTP.Free;
    sl.Free;
  end;
end;

FtpGetFile

function DownloadFTP(URL, TargetFile: string): boolean;
const
  FTPPort=21;
  FTPScheme='ftp://'; //Nazwa schematu URI dla adresów URL FTP
var
  Host: string;
  Port: integer;
  Source: string;
  FoundPos: integer;
begin
  // Usuń informacje o schemacie:
  if LeftStr(URL, length(FTPScheme))=FTPScheme then URL:=Copy(URL, length(FTPScheme)+1, length(URL));

  // Surowa analiza; można użyć kodu parsującego URI z pakietów FPC...
  FoundPos:=pos('/', URL);
  Host:=LeftStr(URL, FoundPos-1);
  Source:=Copy(URL, FoundPos+1, Length(URL));

  //Sprawdź numery portów:
  FoundPos:=pos(':', Host);
  Port:=FTPPort;
  if FoundPos>0 then
  begin
    Host:=LeftStr(Host, FoundPos-1);
    Port:=StrToIntDef(Copy(Host, FoundPos+1, Length(Host)),21);
  end;
  Result:=FtpGetFile(Host, IntToStr(Port), Source, TargetFile, 'anonymous', 'fpc@example.com');
  if result=false then writeln('DownloadFTP: error downloading '+URL+'. Details: host: '+Host+'; port: '+Inttostr(Port)+'; remote path: '+Source+' to '+TargetFile);
end;

//Użyj modułu ftpsend

function FtpGetDir(const IP, Port, Path, User, Pass: string; DirList: TStringList): Boolean;
var
  i: Integer;
  s: string;
begin
  Result := False;
  with TFTPSend.Create do
  try
    Username := User;
    Password := Pass;
    TargetHost := IP;
    TargetPort := Port;
    if not Login then
      Exit;
    Result := List(Path, False);
    for i := 0 to FtpList.Count -1 do
    begin
      s := FTPList[i].FileName;
      DirList.Add(s);
    end;
    Logout;
  finally
    Free;
  end;
end;

...
uses httpsend,
...
function DownloadHTTP(URL, TargetFile: string): Boolean;
var
  HTTPGetResult: Boolean;
  HTTPSender: THTTPSend;
begin
  Result := False;
  HTTPSender := THTTPSend.Create;
  try
    HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
    if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin
      HTTPSender.Document.SaveToFile(TargetFile);
      Result := True;
    end; 
  finally
    HTTPSender.Free;
  end;
end;

...
uses httpsend
...
function DownloadHTTP(URL, TargetFile: string): Boolean;
// Pobieranie pliku; w razie potrzeby spróbuj ponownie.
// Można próbować użyć funkcji Synapse HttpGetBinary, ale to nie działa
// z kodami wyników (tzn. szczęśliwie pobiera dokument błędu 404)
const
  MaxRetries = 3;
var
  HTTPGetResult: Boolean;
  HTTPSender: THTTPSend;
  RetryAttempt: Integer;
begin
  Result := False;
  RetryAttempt := 1;
  HTTPSender := THTTPSend.Create;
  try
    try
      // Spróbuj pobrać plik
      HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
      while (HTTPGetResult = False) and (RetryAttempt < MaxRetries) do
      begin
        Sleep(500 * RetryAttempt);
        HTTPSender.Clear;
        HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
        RetryAttempt := RetryAttempt + 1;
      end;
      // Jeśli mamy odpowiedź z serwera, sprawdź, czy plik został do nas wysłany.
      case HTTPSender.Resultcode of
        100..299:
          begin
            HTTPSender.Document.SaveToFile(TargetFile);
            Result := True;
          end; //informational, success
        300..399: Result := False; // przekierowanie. Nie zaimplementowano, ale może się zdarzyć.
        400..499: Result := False; // błąd klienta; 404 nie znaleziono itp.
        500..599: Result := False; // wewnętrzny błąd serwera
        else Result := False; // kod nieznany
      end;
    except
      // Nie obchodzi nas przyczyna tego błędu; pobieranie nie powiodło się.
      Result := False;
    end;
  finally
    HTTPSender.Free;
  end;
end;

unit uhttpdownloader;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, httpsend, blcksock, typinfo;

type
  IProgress = interface
    procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);
  end;

type
  { THttpDownloader }

  THttpDownloader = class
  public
    function DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;
  private
    Bytes : Integer;
    MaxBytes : Integer;
    HTTPSender: THTTPSend;
    ProgressMonitor : IProgress;
    procedure Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
    function GetSizeFromHeader(Header: String):integer;
  end;

implementation

function THttpDownloader.DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;
var
  HTTPGetResult: Boolean;
begin
  Result := False;
  Bytes:= 0;
  MaxBytes:= -1;
  Self.ProgressMonitor:= ProgressMonitor;

  HTTPSender := THTTPSend.Create;
  try
    HTTPSender.Sock.OnStatus:= Status;
    HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
    if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin
      HTTPSender.Document.SaveToFile(TargetFile);
      Result := True;
    end;
  finally
    HTTPSender.Free;
  end;
end;

procedure THttpDownloader.Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
var
  V, currentHeader: String;
  i: integer;
begin
  //spróbuj pobrać rozmiar pliku z nagłówków
  if (MaxBytes = -1) then
  begin
    for i:= 0 to HTTPSender.Headers.Count - 1 do
    begin
      currentHeader:= HTTPSender.Headers[i];
      MaxBytes:= GetSizeFromHeader(currentHeader);
      if MaxBytes <> -1 then break;
    end;
  end;

  V := GetEnumName(TypeInfo(THookSocketReason), Integer(Reason)) + ' ' + Value;

  if Reason = THookSocketReason.HR_ReadCount then
  begin
    Bytes:= Bytes + StrToInt(Value);
    ProgressMonitor.ProgressNotification(V, Bytes, MaxBytes);
  end;
end;

function THttpDownloader.GetSizeFromHeader(Header: String): integer;
var
  item : TStringList;
begin
  Result:= -1;

  if Pos('Content-Length:', Header) <> 0 then
  begin
    item:= TStringList.Create();
    item.Delimiter:= ':';
    item.StrictDelimiter:=true;
    item.DelimitedText:=Header;
    if item.Count = 2 then
    begin
      Result:= StrToInt(Trim(item[1]));
    end;
  end;
end;

end.

procedure TMainForm.ProgressNotification(Text: String; CurrentProgress: integer; MaxProgress: integer);
begin
  if (MaxProgress <> -1) then
  begin
    ProgressBar.Max:= MaxProgress;
  end;

  ProgressBar.Position:= CurrentProgress;
  memoStatus.Lines.Add(Text);
  Application.ProcessMessages;
end;

unit uMain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls, httpsend, blcksock, typinfo,
  uhttpdownloader;

type

  { TMainForm }

  TMainForm = class(TForm, IProgress)
    btnStartDownload: TButton;
    edtUrl: TEdit;
    labelUrl: TLabel;
    memoStatus: TMemo;
    ProgressBar: TProgressBar;
    SaveDialog: TSaveDialog;
    procedure btnStartDownloadClick(Sender: TObject);
  private
    { private declarations }
    function GetFileNameFromURL(url: String):string;
  public
    { public declarations }
    procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}

{ TMainForm }

procedure TMainForm.btnStartDownloadClick(Sender: TObject);
var
  fileName: String;
  downloader: THttpDownloader;
  success: boolean;
begin
  fileName:= GetFileNameFromURL(edtUrl.Text);
  SaveDialog.FileName:=fileName;
  if (SaveDialog.Execute) then
  begin
    memoStatus.Lines.Clear;
    ProgressBar.Position:=0;
    downloader:= THttpDownloader.Create();
    success:= downloader.DownloadHTTP(edtUrl.Text, SaveDialog.FileName, Self);

    ProgressBar.Position:=0;
    if Success then
      memoStatus.Lines.Add('Download successful')
    else
      memoStatus.Lines.Add('Error during download');

  end;
end;

function TMainForm.GetFileNameFromURL(url: String): string;
var i, l : integer;
    fileName, current : String;
begin
  fileName:= '';
  l:= Length(url);
  for i:= l downto 0 do begin
    current:= url[i];
    if current <> '/' then
    begin
      fileName:= current + fileName;
    end else begin
      Result:= fileName;
      break;
    end;
  end;
end;

procedure TMainForm.ProgressNotification(Text: String; CurrentProgress: integer; MaxProgress: integer);
begin
  if (MaxProgress <> -1) then ProgressBar.Max:= MaxProgress;
  ProgressBar.Position:= CurrentProgress;
  memoStatus.Lines.Add(Text);
  Application.ProcessMessages;
end;

end.

{
  ssl_libssh2.pas wersja 0.2

  Wtyczka obsługi SSH2 (zarys) dla biblioteki Synapse (http://www.ararat.cz/synapse) do LibSSH2 (http://libssh2.org)
  Wymaga: interfejsu libssh2 pascal - http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465 oraz
  libssh2.dll z OpenSSL.

  (С) Alexey Suhinin http://x-alexey.narod.ru
}

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$H+}

unit ssl_libssh2;

interface

uses
  SysUtils,
  blcksock, synsock,
  libssh2;

type
  {:@abstract(klasa implementująca wtyczkę CryptLib SSL/SSH.)
   Instancja tej klasy zostanie utworzona dla każdego @link(TTCPBlockSocket).
   Nie musisz tworzyć instancji tej klasy, wszystko robi sam Synapse!}
  TSSLLibSSH2 = class(TCustomSSL)
  protected
    FSession: PLIBSSH2_SESSION;
    FChannel: PLIBSSH2_CHANNEL;
    function SSHCheck(Value: integer): Boolean;
    function DeInit: Boolean;
  public
    {:Zobacz @inherited}
    constructor Create(const Value: TTCPBlockSocket); override;
    destructor Destroy; override;
    function Connect: boolean; override;
    function LibName: String; override;
    function Shutdown: boolean; override;
    {:Zobacz @inherited}
    function BiShutdown: boolean; override;
    {:Zobacz @inherited}
    function SendBuffer(Buffer: TMemory; Len: Integer): Integer; override;
    {:Zobacz @inherited}
    function RecvBuffer(Buffer: TMemory; Len: Integer): Integer; override;
    {:Zobacz @inherited}
    function WaitingData: Integer; override;
    {:Zobacz @inherited}
    function GetSSLVersion: string; override;
  published
  end;

implementation

{==============================================================================}
function TSSLLibSSH2.SSHCheck(Value: integer): Boolean;
var
  PLastError: PAnsiChar;
  ErrMsgLen: Integer;
begin
  Result := true;
  FLastError := 0;
  FLastErrorDesc := '';
  if Value<0 then
  begin
    FLastError := libssh2_session_last_error(FSession, PLastError, ErrMsglen, 0);
    FLastErrorDesc := PLastError;
    Result := false;
  end;
end;

function TSSLLibSSH2.DeInit: Boolean;
begin
  if Assigned(FChannel) then
  begin
    libssh2_channel_free(FChannel);
    FChannel := nil;
  end;
  if Assigned(FSession) then
  begin
    libssh2_session_disconnect(FSession,'Goodbye');
    libssh2_session_free(FSession);
    FSession := nil;
  end;
  FSSLEnabled := False;
  Result := true;
end;

constructor TSSLLibSSH2.Create(const Value: TTCPBlockSocket);
begin
  inherited Create(Value);
  FSession := nil;
  FChannel := nil;
end;

destructor TSSLLibSSH2.Destroy;
begin
  DeInit;
  inherited Destroy;
end;

function TSSLLibSSH2.Connect: boolean;
begin
  Result := False;
  if SSLEnabled then DeInit;
  if (FSocket.Socket <> INVALID_SOCKET) and (FSocket.SSL.SSLType = LT_SSHv2) then
    begin
      FSession := libssh2_session_init();
      if not Assigned(FSession) then
      begin
        FLastError := -999;
        FLastErrorDesc := 'Cannot initialize SSH session';
        exit;
      end;
      if not SSHCheck(libssh2_session_startup(FSession, FSocket.Socket)) then
        exit;
      if (FSocket.SSL.PrivateKeyFile<>'') then
      begin
        if (not SSHCheck(libssh2_userauth_publickey_fromfile(FSession, PChar(FSocket.SSL.Username), nil, PChar(FSocket.SSL.PrivateKeyFile), PChar(FSocket.SSL.KeyPassword)))) then
          exit;
      end
      else
      if (FSocket.SSL.Username<>'') and (FSocket.SSL.Password<>'') then
      begin
        if (not SSHCheck(libssh2_userauth_password(FSession, PChar(FSocket.SSL.Username), PChar(FSocket.SSL.Password)))) then
          exit;
      end;
      FChannel := libssh2_channel_open_session(FSession);
      if not assigned(FChannel) then
      begin
        SSHCheck(-1); // get error
        if FLastError = 0 then
        begin
          FLastError := -999; // unknown error
          FLastErrorDesc := 'Cannot open session';
        end;
        exit;
      end;
      if not SSHCheck(libssh2_channel_request_pty(FChannel, 'vanilla')) then
        exit;
      if not SSHCheck(libssh2_channel_shell(FChannel)) then
        exit;
      FSSLEnabled := True;
      Result := True;
    end;
end;

function TSSLLibSSH2.LibName: String;
begin
  Result := 'ssl_libssh2';
end;

function TSSLLibSSH2.Shutdown: boolean;
begin
  Result := DeInit;
end;

function TSSLLibSSH2.BiShutdown: boolean;
begin
  Result := DeInit;
end;

function TSSLLibSSH2.SendBuffer(Buffer: TMemory; Len: Integer): Integer;
begin
  Result:=libssh2_channel_write(FChannel, PChar(Buffer), Len);
  SSHCheck(Result);
end;

function TSSLLibSSH2.RecvBuffer(Buffer: TMemory; Len: Integer): Integer;
begin
  result:=libssh2_channel_read(FChannel, PChar(Buffer), Len);
  SSHCheck(Result);
end;

function TSSLLibSSH2.WaitingData: Integer;
begin
  if libssh2_poll_channel_read(FChannel, Result) <> 1 then Result := 0;
end;

function TSSLLibSSH2.GetSSLVersion: string;
begin
  Result:=libssh2_version(0);
end;

initialization
  if libssh2_init(0)=0 then
                SSLImplementation := TSSLLibSSH2;

finalization
  libssh2_exit;

end.

unit telnetsshclient;
 
{ Wrapper wokół bibliotek Synapse i biblioteki SSL (obecnie używane są libssh2+libssl)
Pobierz skompilowaną bibliotekę Windows dll, np. z
http://alxdm.dyndns-at-work.com:808/files/windll_libssh2.zip
Pobierz pliki interfejsu FreePascal:
http://www.lazarus.freepascal.org/index.php/topic,15935.msg86465.html#msg86465

Ten moduł umożliwia użytkownikowi wysyłanie poleceń Telnet lub SSH i uzyskiwanie danych wyjściowych
Dzięki Leonardo Rame
http://leonardorame.blogspot.com/2010/01/synapse-based-ssh-client.html
i Ludo Brands.
 
Napisany przez Reiniera Olislagersa 2011.
Zmodyfikowany dla libssh2 przez Alexeya Suhinina 2012.

Licencja kodu:
* MIT
* LGPLv2 lub nowszy (z wyjątkiem statycznego linkowania FreePascal)
* GPLv2 lub nowszy
zgodnie z twoim wyborem.
Dozwolone jest bezpłatne korzystanie, ale proszę nie pozywać mnie ani nie obwiniać.
 
Korzysta z innych bibliotek/komponentów, dla których mogą obowiązywać różne licencje, które również mogą wpływać na skompilowaną pracę.
}
 
{$mode objfpc}{$H+}
{$DEFINE HAS_SSH_SUPPORT} //zakomentuj, jeśli wymagana jest tylko obsługa telnet
{$DEFINE LIBSSH2}
 
interface
 
uses
  Classes, SysUtils,
  tlntsend
  {$IFDEF HAS_SSH_SUPPORT}
  {ssl - a właściwie teraz ssh - biblioteki wymagane przez tlntsend}
    {$IFDEF LIBSSH2}
      ssl_libssh2
    {$ELSE}
      ssl_cryptlib
  {$ENDIF}
  {$ENDIF HAS_SSH_SUPPORT}  ;
 
type
  TProtocolType = (Telnet, SSH); //Różne sposoby łączenia
  TServerType = (Unix, Windows); //głównie dotyczy zakończenia linii tekstu
  { TelnetSSHClient }
 
  { TTelnetSSHClient }
 
  TTelnetSSHClient = class(TTelnetSend)
  protected
    FConnected: boolean;
    FOutputPosition: integer; //Śledzi pozycję w strumieniu wyjściowym
    FProtocolType: TProtocolType;
    FServerLineEnding: string; //zależy od FServerType
    FServerType: TServerType;
    FWelcomeMessage, FTelnetLoginPrompt, FTelnetPasswordPrompt: string;
    procedure SetPrivateKeyFile(Value: string);
    function GetPrivateKeyFile: string;
    { Na podstawie protokołu i typu serwera ustaw oczekiwane zakończenie linii po stronie serwera}
    procedure DetermineLineEnding;
    { Ustawia port, jeśli portu nie ustawiono jawnie. Używa protokołu typu: SSH lub telnet}
    procedure DeterminePort;
    function GetSessionLog: string;
    procedure ProtocolTypeChange(Value: TProtocolType);
    function ReceiveData: string; //Może być używany do odbierania wiadomości powitalnej itp.
    procedure SendData(Data: string);
    procedure ServerTypeChange(Value: TServerType);
  public
    {Wszystkie dane wyjściowe wygenerowane podczas całej sesji do tej pory}
    property AllOutput: string read GetSessionLog;
    {Ma wartość True, jeśli jest podłączony do serwera}
    property Connected: boolean read FConnected;
    {Nazwa lub adres IP hosta, z którym chcesz się połączyć}
    property HostName: string read FTargetHost write FTargetHost;
    {Port na hoście używany do połączenia. Jeśli zostanie pozostawiony jako 0, zostanie określony przez typ protokołu (22 dla SSH, 23 dla Telnet}
    property Port: String read FTargetPort write FTargetPort;
    {Lokalizacja pliku klucza prywatnego}
    property PrivateKeyFile: string read GetPrivateKeyFile write SetPrivateKeyFile;
    {Pytanie o login Telnet}
    property TelnetLoginPrompt: string read FTelnetLoginPrompt write FTelnetLoginPrompt;
    {Pytanie o hasło Telnet}
    property TelnetPasswordPrompt: string read FTelnetPasswordPrompt write FTelnetPasswordPrompt;
    {Nazwa użytkownika używana podczas łączenia}
    property UserName: string read FUserName write FUserName;
    {Hasło używane podczas łączenia. Używane jako hasło (passphrase), jeśli używany jest klucz prywatny}
    property Password: string read FPassword write FPassword;
    {Czy powinniśmy rozmawiać z serwerem przez Telnet czy SSH? Domyślnie jest to SSH}
    property ProtocolType: TProtocolType read FProtocolType write ProtocolTypeChange;
    {Serwer Windows czy Unix/Linux? Ma to wpływ na końcówki linii. Domyślnie jest to Unix. UWAGA: nieprzetestowane}
    property Servertype: TServerType read FServerType write ServerTypeChange;
    {Pierwsza wiadomość wyświetlana przy logowaniu}
    property WelcomeMessage: string read FWelcomeMessage;
    {Połącz/zaloguj się do serwera. Wymaga poprawnych wszystkich opcji uwierzytelniania, protokołu i nazwy hosta/portu.
    Zwraca opisowy wynik. Następnie możesz użyć właściwości Connected.}
    function Connect: string;
    {Jeśli połączony, wyloguj się z serwera}
    procedure Disconnect;
    {Wyślij polecenie do serwera i odbierz wynik}
    function CommandResult(Command: string): string; //Wyślij polecenie i uzyskaj wyniki
    constructor Create;
    destructor Destroy; override;
  end;
 
implementation
 
 
{ TelnetSSHClient }
procedure TTelnetSSHClient.SetPrivateKeyFile(value: string);
begin
  Sock.SSL.PrivateKeyFile := value;
end;

function TTelnetSSHClient.GetPrivateKeyFile: string;
begin
  Result := Sock.SSL.PrivateKeyFile;
end;

procedure TTelnetSSHClient.DetermineLineEnding;
begin
  case FProtocolType of
    SSH:
    begin
      if FServerType = Unix then
        FServerLineEnding := #10 //Unix
      else
        FServerLineEnding := #13 + #10; //windows
    end;
    Telnet:
    begin
      if FServerType = Unix then
        FServerLineEnding := #10 //Unix
      else
        FServerLineEnding := #13 + #10; //windows
    end;
    else
      raise Exception.Create('Nieznany typ protokołu.');
  end;
end;
 
procedure Ttelnetsshclient.DeterminePort;
begin
  if FTargetPort = '' then
    //Ustaw domyślny port dla protokołu
  begin
    case FProtocolType of
      Telnet: FTargetPort := '23';
      SSH: FTargetPort := '22';
      else
        raise Exception.Create('Nieznany typ protokołu.');
    end;
 
  end;
end;
 
procedure TTelnetSSHClient.ServerTypeChange(Value: Tservertype);
begin
  FServerType := Value;
  DetermineLineEnding;
end;
 
function TTelnetSSHClient.Connect: string;
var
  Received: string;
begin
  result:='Nieznany błąd podczas łączenia';
  FOutputPosition := 1; //Pierwszy znak w strumieniu wyjściowym
  FWelcomeMessage := '';
  //Tylko dla pewności:
  DetermineLineEnding;
  DeterminePort;
  if FTargetPort='0' then
  begin
   result:='Port nie może być równy 0.';
   exit; //wyskoczyć z funkcji
  end;
  case FProtocolType of
    Telnet:
    begin
      try
        if Login then
          begin
            FConnected := True;
            result:='Połączono z serwerem telnet.';
          end
        else
          if Sock.LastError<>0 then raise Exception.Create(Sock.LastErrorDesc);
      except
        on E: Exception do
        begin
          FConnected:=false;
          result:='Błąd połączenia z serwerem telnet '+FTargetHost+':'+
          FTargetPort+' jako użytkownik ' + FUserName +
          '. Szczegóły techniczne: '+E.Message;
        end;
      end;
    end;
    SSH:
    begin
      {$IFNDEF HAS_SSH_SUPPORT}
      raise Exception.Create(
        'Obsługa SSH nie została skompilowana do biblioteki telnetsshclient.');
      {$ENDIF HAS_SSH_SUPPORT}
      try
        if (PrivateKeyFile <> '') and (FPassword <> '') then
          Sock.SSL.KeyPassword:=FPassword;
        if SSHLogin then
          begin
            FConnected := True;
            result:='Connected to SSH server.';
          end
        else
          begin
            if Sock.LastError<>0 then raise Exception.Create(Sock.LastErrorDesc);
            if Sock.SSL.LastError<0 then raise Exception.Create(Sock.SSL.LastErrorDesc);
          end;
      except
        on E: Exception do
        begin
          FConnected:=false;
          result:='Błąd połączenia z serwerem SSH '+FTargetHost+':'+
          FTargetPort+' jako użytkownik ' + FUserName +
          '. Szczegóły techniczne: '+E.Message;
        end;
      end;
    end;
    else
      raise Exception.Create('Nieznany typ protokołu.');
  end;
  if FConnected = True then
  begin
    FWelcomeMessage := ReceiveData;
    if FProtocolType=Telnet then
    begin
      //Niestety, będziemy musieli sami wyodrębnić login
      //Mam nadzieję, że dotyczy to wszystkich typów serwerów.
      if (AnsiPos(AnsiLowerCase(FTelnetLoginPrompt),AnsiLowerCase(FWelcomeMessage))>0) then
      begin
        SendData(UserName);
      end;
      Received:=ReceiveData;
      if (AnsiPos(AnsiLowerCase(FTelnetPasswordPrompt),AnsiLowerCase(Received))>0) then
      begin
        SendData(Password);
      end;
      //Otrzymuj dodatkową wiadomość powitalną/wiadomość dnia
      FWelcomeMessage:=FWelcomeMessage+LineEnding+ReceiveData;
    end;
  end;
end;
 
procedure TTelnetSSHClient.Disconnect;
begin
  Logout;
  FConnected := False;
end;
 
function TTelnetSSHClient.ReceiveData: string;
begin
  Result := '';
  while Sock.CanRead(1000) or (Sock.WaitingData > 0) do
  begin
    Sock.RecvPacket(1000);
    Result := Result + Copy(SessionLog, FOutputPosition,
      Length(SessionLog));
    FOutputPosition := Length(SessionLog) + 1;
  end;
end;
 
procedure Ttelnetsshclient.SendData(Data: String);
begin
  Data := Data + FServerLineEnding; //Może to być linux, może być Windows
  Send(Data);
end;
 
function TTelnetSSHClient.GetSessionLog: string;
begin
  // Do tej pory uzyskuje pełne dane wyjściowe
  Result := SessionLog;
end;
 
procedure TTelnetSSHClient.ProtocolTypeChange(Value: Tprotocoltype);
begin
  FProtocolType := Value;
  //W razie potrzeby automatycznie określ port i zakończenie linii
  DeterminePort;
  DetermineLineEnding;
end;
 
function TTelnetSSHClient.CommandResult(Command: string): string;
begin
  Result := '';
  if FConnected then
  begin
    SendData(Command);
    Result := ReceiveData; //dostaje za dużo
  end
  else
  begin
    //podnieś wyjątek
    Result := '';
    raise Exception.Create('Polecenie można uruchomić tylko po podłączeniu');
  end;
end;
 
constructor TTelnetSSHClient.Create;
begin
  inherited;
  FConnected := False;
  FProtocolType := SSH; //Może to też być telnet
  FServerType := Unix; //Prawdopodobnie bezpieczna wartość domyślna.
  FTelnetLoginPrompt := 'login:';
  FTelnetPasswordPrompt := 'password:';
  DetermineLineEnding;
  DeterminePort;
end;
 
destructor TTelnetSSHClient.Destroy;
begin
  if FConnected then
    Disconnect;
  inherited Destroy;
end;
 
end.

program sshtest;

{Program testowy dla telnetsshclient

Napisany przez Reiniera Olislagersa 2011.
Zmodyfikowany dla libssh2 przez Alexeya Suhinina 2012.

Licencja kodu:
* MIT
* LGPLv2 lub nowszy (z wyjątkiem statycznego linkowania FreePascal)
* GPLv2 lub nowszy
zgodnie z twoim wyborem.
Dozwolone jest bezpłatne korzystanie, ale proszę nie pozywać mnie ani nie obwiniać.
 
Korzysta z innych bibliotek/komponentów, dla których mogą obowiązywać różne licencje, które również mogą wpływać na skompilowaną pracę.

Uruchamianie: sshtest <serverIPorhostname> [PrivateKeyFile]
}
{$mode objfpc}{$H+}
{$APPTYPE CONSOLE}

uses
  telnetsshclient;
var
  comm: TTelnetSSHClient;
  Command: string;
begin
  writeln('Start.');
  comm:=TTelnetSSHClient.Create;
  comm.HostName:= ParamStr(1); //Pierwszy argument w wierszu poleceń
  if comm.HostName='' then
  begin
    writeln('Proszę podać nazwę hosta w wierszu poleceń.');
    halt(1);
  end;

  comm.PrivateKeyFile := ParamStr(2);

  comm.TargetPort:='0'; //automatyczne określanie na podstawie typu protokołu
  comm.UserName:='root'; //zmień dla swojej sytuacji
  comm.Password:='password'; //zmień dla swojej sytuacji
  comm.ProtocolType:=SSH; //Telnet lub SSH
  writeln(comm.Connect); //Pokaż wynik połączenia
  if comm.Connected then
  begin
    writeln('Serwer: ' + comm.HostName + ':'+comm.TargetPort+', użytkownik: '+comm.UserName);
    writeln('Wiadomość powitalna:');
    writeln(comm.WelcomeMessage);
    Command:='ls -al';
    writeln('*** Wysyłanie ' + Command);
    writeln('*** Początek wyniku****');
    writeln(comm.CommandResult(Command));
    writeln('*** Koniec wyniku****');
    writeln('');
    writeln('');
    Command:='df -h';
    writeln('*** Wysyłanie ' + Command);
    writeln('*** Początek wyniku****');
    writeln(comm.CommandResult(Command));
    writeln('*** Koniec wyniku****');
    writeln('');
    writeln('');
    writeln('Wszystkie wyjścia:');
    writeln('*** Początek wyniku****');
    writeln(comm.AllOutput);
    writeln('*** Koniec wyniku****');
    comm.Disconnect;
  end
  else
  begin
    writeln('Połączenie z ' +
      comm.HostName + ':' +
      comm.TargetPort + ' nie udało się.');
  end;
  comm.Free;
end.