mainform.pas

著名的SecureBlackBox控件完整源码

unit MainForm;

interface

// remember to install one of additional packages,
// located in <SecureBlackbox>\Classes\Indy,
// as described in SecureBlackbox readme file

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, IdIOHandler, IdIOHandlerSocket, SBIdFTPIOHandler,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,
  StdCtrls, ExtCtrls, ComCtrls, Buttons, ImgList, SBUtils, SBX509;

type
  TFormMain = class(TForm)
    ElIdFTP: TElIdFTP;
    ElIdFTPIOHandlerSocket: TElIdFTPIOHandlerSocket;
    GroupBoxConnection: TGroupBox;
    Label1: TLabel;
    EditHost: TEdit;
    Label2: TLabel;
    EditPort: TEdit;
    ButtonConnect: TButton;
    Label3: TLabel;
    EditUsername: TEdit;
    Label4: TLabel;
    EditPassword: TEdit;
    Memo1: TMemo;
    Splitter1: TSplitter;
    PanelNetworkOptions: TPanel;
    PanelAuthorization: TPanel;
    PanelSSLOptions: TPanel;
    CheckBoxUseSSL: TCheckBox;
    CheckBoxV2: TCheckBox;
    CheckBoxV3: TCheckBox;
    CheckBoxV31: TCheckBox;
    PanelClient: TPanel;
    PanelToolbar: TPanel;
    ListView: TListView;
    SpeedButtonDownload: TSpeedButton;
    SpeedButtonUpload: TSpeedButton;
    SpeedButtonRefresh: TSpeedButton;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    ImageList: TImageList;
    SpeedButtonChDir: TSpeedButton;
    SpeedButtonMkDir: TSpeedButton;
    SpeedButtonDel: TSpeedButton;
    ButtonDisconnect: TButton;
    CheckBoxV32: TCheckBox;
    procedure ButtonConnectClick(Sender: TObject);
    procedure ElIdFTPConnected(Sender: TObject);
    procedure ElIdFTPDisconnected(Sender: TObject);
    procedure ElIdFTPAfterClientLogin(Sender: TObject);
    procedure CheckBoxUseSSLClick(Sender: TObject);
    procedure SpeedButtonDownloadClick(Sender: TObject);
    procedure SpeedButtonUploadClick(Sender: TObject);
    procedure SpeedButtonRefreshClick(Sender: TObject);
    procedure SpeedButtonChDirClick(Sender: TObject);
    procedure SpeedButtonMkDirClick(Sender: TObject);
    procedure ListViewDblClick(Sender: TObject);
    procedure SpeedButtonDelClick(Sender: TObject);
    procedure ButtonDisconnectClick(Sender: TObject);
    procedure ElIdFTPIOHandlerSocketCertificateValidate(Sender: TObject;
      Certificate: TElX509Certificate; var Validate: Boolean);
  private
    procedure Log(const S : string);
    procedure RequestFileList;
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses
  SBConstants, IdFTPList;

procedure TFormMain.ButtonConnectClick(Sender: TObject);
var
  S : string;
begin
  if ElIdFtp.Connected then
  begin
    Log('Already connected');
    Exit;
  end;
  Log('Connecting to ' + EditHost.Text);
  if ElIdFtpIOHandlerSocket.UseSSL then
    S := 'On'
  else
    S := 'Off';
  Log('SSL: ' + S);
  if ElIdFtpIOHandlerSocket.UseSSL then
  begin
    ElIdFtpIOHandlerSocket.Versions := [];
    S := 'Versions: ';
    if CheckBoxV2.Checked then
    begin
      ElIdFtpIOHandlerSocket.Versions := ElIdFtpIOHandlerSocket.Versions + [sbSSL2];
      S := S + 'SSLv2 ';
    end;
    if CheckBoxV3.Checked then
    begin
      ElIdFtpIOHandlerSocket.Versions := ElIdFtpIOHandlerSocket.Versions + [sbSSL3];
      S := S + 'SSLv3 ';
    end;
    if CheckBoxV31.Checked then
    begin
      ElIdFtpIOHandlerSocket.Versions := ElIdFtpIOHandlerSocket.Versions + [sbTLS1];
      S := S + 'TLSv1 ';
    end;
    if CheckBoxV32.Checked then
    begin
      ElIdFtpIOHandlerSocket.Versions := ElIdFtpIOHandlerSocket.Versions + [sbTLS11];
      S := S + 'TLSv1.1 ';
    end;
    Log(S);
  end;
  ElIdFtp.Host := EditHost.Text;
  ElIdFtp.Port := StrToIntDef(EditPort.Text, 21);
  ElIdFtp.Username := EditUsername.Text;
  ElIdFtp.Password := EditPassword.Text;
  try
    ElIdFtp.Connect();
  except
    on E : Exception do
      Log(E.Message);
  end;
  RequestFileList;
end;

procedure TFormMain.Log(const S : string);
begin
  Memo1.Lines.Add('[' + DateTimeToStr(Now) + '] ' + S);
end;

procedure TFormMain.ElIdFTPConnected(Sender: TObject);
begin
  Log('ElIdFtp: Connected');
end;

procedure TFormMain.ElIdFTPDisconnected(Sender: TObject);
begin
  Log('ElIdFtp: Disconnected');
end;

procedure TFormMain.ElIdFTPAfterClientLogin(Sender: TObject);
begin
  Log('ElIdFtp: Client login succeeded');
end;

procedure TFormMain.CheckBoxUseSSLClick(Sender: TObject);
begin
  ElIdFtpIOHandlerSocket.UseSSL := CheckBoxUseSSL.Checked;
  CheckBoxV2.Enabled := CheckBoxUseSSL.Checked;
  CheckBoxV3.Enabled := CheckBoxUseSSL.Checked;
  CheckBoxV31.Enabled := CheckBoxUseSSL.Checked;
  CheckBoxV32.Enabled := CheckBoxUseSSL.Checked;
end;

procedure TFormMain.RequestFileList;
var
  Lst : TStringList;
  I : integer;
  Item : TListItem;
begin
  Log('Requesting file list');
  Lst := TStringList.Create;
  try
    try
      ElIdFtp.List(Lst);
    finally
      Lst.Free;
    end;
    ListView.Items.Clear;
    // adding items to ListView in 2 stages, first folders then files
    for I := 0 to ElIdFtp.DirectoryListing.Count - 1 do
    begin
      if ElIdFtp.DirectoryListing.Items[I].ItemType = ditDirectory then
      begin
        Item := ListView.Items.Add;
        Item.Caption := ElIdFtp.DirectoryListing.Items[I].FileName;
        Item.SubItems.Add('');
        Item.SubItems.Add(DateTimeToStr(ElIdFtp.DirectoryListing.Items[I].ModifiedDate));
        Item.Data := ElIdFtp.DirectoryListing.Items[I];
        Item.ImageIndex := 0
      end;
    end;
    for I := 0 to ElIdFtp.DirectoryListing.Count - 1 do
    begin
      if ElIdFtp.DirectoryListing.Items[I].ItemType <> ditDirectory then
      begin
        Item := ListView.Items.Add;
        Item.Caption := ElIdFtp.DirectoryListing.Items[I].FileName;
        Item.SubItems.Add(IntToStr(ElIdFtp.DirectoryListing.Items[I].Size));
        Item.SubItems.Add(DateTimeToStr(ElIdFtp.DirectoryListing.Items[I].ModifiedDate));
        Item.Data := ElIdFtp.DirectoryListing.Items[I];
        Item.ImageIndex := -1;
      end;
    end;
  except
    on E : Exception do
      Log(E.Message);
  end;
end;

procedure TFormMain.SpeedButtonDownloadClick(Sender: TObject);
var
  Strm : TFileStream;
begin
  if (not Assigned(ListView.Selected)) and (not Assigned(ListView.Selected.Data)) then
    Exit;
  if SaveDialog.Execute then
  begin
    Log('Downloading file ' + TIdFtpListItem(ListView.Selected.Data).FileName +
      ' to ' + SaveDialog.Filename);
    try
      Strm := TFileStream.Create(SaveDialog.Filename, fmCreate);
    except
      on E : Exception do
      begin
        Log(E.Message);
        Exit;
      end;
    end;
    try
      try
        ElIdFtp.Get(TIdFtpListItem(ListView.Selected.Data).FileName, Strm);
      finally
        Strm.Free;
      end;
    except
      on E : Exception do
        Log(E.Message);
    end;
    Log('Download finished');
  end;
end;

procedure TFormMain.SpeedButtonUploadClick(Sender: TObject);
var
  Strm : TFileStream;
begin
  if OpenDialog.Execute then
  begin
    Log('Uploading file ' + OpenDialog.Filename);
    try
      Strm := TFileStream.Create(OpenDialog.FileName, fmOpenRead);
    except
      on E : Exception do
      begin
        Log(E.Message);
        Exit;
      end;
    end;
    try
      try
        ElIdFtp.Put(Strm, ExtractFileName(OpenDialog.FileName));
      finally
        Strm.Free;
      end;
    except
      on E : Exception do
        Log(E.Message);
    end;
    Log('Upload finished');
    RequestFileList;
  end;
end;

procedure TFormMain.SpeedButtonRefreshClick(Sender: TObject);
begin
  RequestFileList;
end;

procedure TFormMain.SpeedButtonChDirClick(Sender: TObject);
begin
  if (not Assigned(ListView.Selected)) and (not Assigned(ListView.Selected.Data)) then
    Exit;
  if TIdFtpListItem(ListView.Selected.Data).ItemType = ditDirectory then
  begin
    Log('Changing directory to ' + TIdFtpListItem(ListView.Selected.Data).FileName);
    try
      ElIdFtp.ChangeDir(TIdFtpListItem(ListView.Selected.Data).FileName);
    except
      on E : Exception do
        Log(E.Message);
    end;
    Log('Done');
    RequestFileList;
  end;
end;

procedure TFormMain.SpeedButtonMkDirClick(Sender: TObject);
var
  S : string;
begin
  S := InputBox('New directory', 'Please enter the name for new directory:', '');
  if Length(S) = 0 then
    Exit;
  try
    ElIdFtp.MakeDir(S);
  except
    on E : Exception do
      Log(E.Message);
  end;
  Log('Done');
  RequestFileList;
end;

procedure TFormMain.ListViewDblClick(Sender: TObject);
begin
  SpeedButtonChDirClick(nil);
end;

procedure TFormMain.SpeedButtonDelClick(Sender: TObject);
begin
  if (not Assigned(ListView.Selected)) and (not Assigned(ListView.Selected.Data)) then
    Exit;
  if TIdFtpListItem(ListView.Selected.Data).ItemType = ditFile then
  begin
    if MessageDlg('Are you sure you want to delete file ' +
      TIdFtpListItem(ListView.Selected.Data).FileName + '?', mtConfirmation,
      [mbYes, mbNo], 0) = mrYes then
    begin
      Log('Deleting file ' + TIdFtpListItem(ListView.Selected.Data).FileName);
      try
        ElIdFtp.Delete(TIdFtpListItem(ListView.Selected.Data).FileName);
      except
        on E : Exception do
          Log(E.Message);
      end;
      Log('Done');
    end;
  end;
  RequestFileList;
end;

procedure TFormMain.ButtonDisconnectClick(Sender: TObject);
begin
  if ElIdFtp.Connected then
  begin
    Log('Disconnecting');
    ElIdFtp.Disconnect;
  end
  else
    Log('Not connected');
end;

procedure TFormMain.ElIdFTPIOHandlerSocketCertificateValidate(Sender: TObject;
  Certificate: TElX509Certificate; var Validate: Boolean);
begin
  Log('Certificate received. Issuer: ' + Certificate.IssuerName.CommonName +
    ', Subject: ' + Certificate.SubjectName.CommonName);
  Validate := true;
  // NEVER do this in real life since this makes security void. 
  // Instead validate the certificate as described on http://www.eldos.com/sbb/articles/1966.php
end;

initialization
SetLicenseKey('ADDCD14AD06709806817E0B3D7BFD0A2222D536FE156466C5D5FE65DB5DEAE76' + 
  'FFDEBC07E915A5751C12C01C783958872A38E4A5EDA140E7247E0F2E56442A3C' + 
  'F3E9347AD8FDE52083A0DFC86BC00ECB0FD0CF1B51159A2BCB84F6EA6349EF47' + 
  '5C15A59AFCC55F7C3AAD26C279628B5D91B1DC94BD2385354A70CCA3B76101D9' + 
  'F41C84A639FC3CCE4BA8F0CC4A66DCD150114A3F58C1AD46B7B94643741BC20A' + 
  '8DCA83AB921480951B423CAA19EF1863A47CA2C3422E7E5634BED98939A5AE43' + 
  'DE1E4BAD79E66D8A5C973B3455656C8C9B6FF024FADD6CDA02D0F506D98493C8' + 
  'BD1ED7B237DB75FA31F2C82654490CDDDEE24E19939137B9E1DB05508733B22F');

end.