如何使用 SSL 配置 TidFTP？

Question

我编写了一个小型 FTP 客户端来管理我的 bluehost.com 帐户上的文件。现在我已经迁移到一家新的托管公司，我的程序将连接，但仅此而已。

连接后，我尝试获取根文件的清单；程序挂了一会儿，最后产生“读取超时”。

经过研究，我得出结论（可能是错误的）这与 SSL（我可以通过我的新主机使用）有关。我在表单中添加了一个TIdSSLIOHandlerSocketOpenSSL 组件，将其分配给myFTP 并设置UseTLS = utUseExplicitTLS。

现在，当我尝试连接时，我收到 10054 错误。我找不到任何关于如何配置此连接的示例。

代码如下：

unit ct_FTP_Test;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Forms, Vcl.StdCtrls, Vcl.Controls, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, IdBaseComponent, IdComponent, IdIOHandler,
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdAntiFreezeBase,
  IdFTPCommon, IdAntiFreeze;

type
  TForm1 = class(TForm)
    btnConnectFTP: TButton;
    Label2: TLabel;
    Label4: TLabel;
    mem: TMemo;
    btnShowFolder: TButton;
    idSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
    myFTP: TIdFTP;
    edHost: TEdit;
    edUser: TEdit;
    edPassword: TEdit;
    Label1: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    idAntiFreeze: TIdAntiFreeze;
    edPort: TEdit;
    Label6: TLabel;
    ckbUseSSL: TCheckBox;
    procedure btnConnectFTPClick(Sender: TObject);
    procedure btnShowFolderClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure GetFolderInventory;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.GetFolderInventory;
var DirList : TStringList;
begin
  if (not myFTP.Connected) then
    begin
      Label2.Caption := 'You are not connected...';
      Exit;
    end;

  try
    try
      Label4.Caption := 'Going to root...';
      myFTP.ChangeDir('/');
      Label4.Caption := 'At root, getting DirList...';

      DirList := TStringList.Create;
      myFTP.List(DirList, '', True);

      Label2.Caption := '';
      Label4.Caption := IntToStr(DirList.Count) + ' files and folders found';

      mem.Lines.Assign(DirList);
    except on e:Exception do
      begin
        Label4.Caption := 'Unable to show contents';
        Label2.Caption := e.Message;
      end;
    end;
  finally
    FreeAndNil(DirList);
  end;
end;

procedure TForm1.btnShowFolderClick(Sender: TObject);
begin
  GetFolderInventory;
end;

procedure TForm1.btnConnectFTPClick(Sender: TObject);
begin
  try
    Label2.Caption := '';
    Label4.Caption := '';

    if (myFTP.Connected) then
      myFTP.Disconnect;

    if (edHost.Text = '') then
      begin
        edHost.SetFocus;
        Label4.Caption := 'Host required.';
        Exit;
      end;

    if (edUser.Text = '') then
      begin
        edUser.SetFocus;
        Label4.Caption := 'User required.';
        Exit;
      end;

    if (edPassword.Text = '') then
      begin
        edPassword.SetFocus;
        Label4.Caption := 'Password required.';
        Exit;
      end;

    if (edPort.Text = '') then
      begin
        edPort.SetFocus;
        Label4.Caption := 'Port required.';
        Exit;
      end;

    myFTP.Host := edHost.Text;
    myFTP.Username := edUser.Text;
    myFTP.Password := edPassword.Text;
    myFTP.Port := StrToInt(edPort.Text);

    if (ckbUseSSL.Checked) then
      begin
        myFTP.UseTLS := utUseExplicitTLS;
        myFTP.DataPortProtection := ftpdpsPrivate;
        myFTP.Passive := True;
      end
    else
      begin
        myFTP.DataPortProtection := ftpdpsClear;
        myFTP.UseTLS := utNoTLSSupport;
        myFTP.Passive := False;
      end;


    myFTP.Connect;
    Label4.Caption := 'Connected';
    Label2.Caption := '';
  except on e:Exception do
    begin
      Label4.Caption := 'Failed to connect';
      Label2.Caption := e.Message;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label2.Caption := '';
  Label4.Caption := '';
end;

end.

这是 dfm：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 568
  ClientWidth = 704
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label2: TLabel
    Left = 120
    Top = 101
    Width = 496
    Height = 44
    AutoSize = False
    Caption = '[...]'
    WordWrap = True
  end
  object Label4: TLabel
    Left = 120
    Top = 72
    Width = 20
    Height = 13
    Caption = '[...]'
  end
  object Label1: TLabel
    Left = 120
    Top = 37
    Width = 22
    Height = 13
    Caption = 'Host'
  end
  object Label3: TLabel
    Left = 272
    Top = 37
    Width = 22
    Height = 13
    Caption = 'User'
  end
  object Label5: TLabel
    Left = 456
    Top = 37
    Width = 32
    Height = 13
    Caption = 'PWord'
  end
  object Label6: TLabel
    Left = 605
    Top = 37
    Width = 20
    Height = 13
    Caption = 'Port'
  end
  object btnConnectFTP: TButton
    Left = 32
    Top = 32
    Width = 75
    Height = 25
    Caption = 'Connect'
    TabOrder = 0
    OnClick = btnConnectFTPClick
  end
  object mem: TMemo
    Left = 113
    Top = 160
    Width = 503
    Height = 377
    ScrollBars = ssVertical
    TabOrder = 1
    WordWrap = False
  end
  object btnShowFolder: TButton
    Left = 32
    Top = 160
    Width = 75
    Height = 25
    Caption = 'Show Folder'
    TabOrder = 2
    OnClick = btnShowFolderClick
  end
  object edHost: TEdit
    Left = 148
    Top = 32
    Width = 105
    Height = 21
    TabOrder = 3
  end
  object edUser: TEdit
    Left = 300
    Top = 32
    Width = 137
    Height = 21
    TabOrder = 4
  end
  object edPassword: TEdit
    Left = 495
    Top = 32
    Width = 90
    Height = 21
    TabOrder = 5
  end
  object edPort: TEdit
    Left = 633
    Top = 32
    Width = 40
    Height = 21
    NumbersOnly = True
    TabOrder = 6
    Text = '21'
  end
  object ckbUseSSL: TCheckBox
    Left = 40
    Top = 72
    Width = 57
    Height = 17
    Caption = 'Use SSL'
    TabOrder = 7
  end
  object idSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL
    MaxLineAction = maException
    DefaultPort = 0
    ReadTimeout = 60000
    SSLOptions.Mode = sslmClient
    SSLOptions.VerifyMode = []
    SSLOptions.VerifyDepth = 0
    Left = 69
    Top = 318
  end
  object myFTP: TIdFTP
    IOHandler = idSSLIOHandlerSocketOpenSSL
    IPVersion = Id_IPv4
    ConnectTimeout = 0
    NATKeepAlive.UseKeepAlive = False
    NATKeepAlive.IdleTimeMS = 0
    NATKeepAlive.IntervalMS = 0
    ProxySettings.ProxyType = fpcmNone
    ProxySettings.Port = 0
    Left = 22
    Top = 278
  end
  object idAntiFreeze: TIdAntiFreeze
    Left = 24
    Top = 216
  end
end

任何帮助将不胜感激。

Answer 1

尝试通过设置TIdSSLIOHandlerSocketOpenSSL 的正确属性（不记得实际属性名称）来允许所有 SLL 方法/类型。