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, 
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP,
  StdCtrls, ExtCtrls, ComCtrls, Buttons, ImgList, SBX509, SBUtils,
  IdSSL, SBIndyIOHandler10, IdExplicitTLSClientServerBase, IdIOHandlerStack;

type
  TFormMain = class(TForm)
    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;
    ElIdFTP: TIdFTP;
    ElIdFtpIOHandlerSocket: TElClientIndySSLIOHandlerSocket;
    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);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FFileList : TList;
    procedure ClearFileList;
    procedure Log(const S : string);
    procedure RequestFileList;
    procedure ProcessFileList(List : TStrings);
  public
    { Public declarations }
  end;

  TFileInfo = class
    Filename : string;
    Size : Int64;
    Date : string;
    Directory : boolean;
  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 ElIdFTP.UseTLS = utUseExplicitTLS then
    S := 'On'
  else
    S := 'Off';
  Log('SSL: ' + S);

  if ElIdFTP.UseTLS = utUseExplicitTLS 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
  if CheckBoxUseSSL.Checked then
    ElIdFTP.UseTLS := utUseExplicitTLS
  else
    ElIdFTP.UseTLS := utNoTLSSupport;

  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
  ElIdFtp.Passive := true;
  Log('Requesting file list');
  Lst := TStringList.Create;
  try
    try
      ElIdFtp.List(Lst);
    finally
      Lst.Free;
    end;
    Log(ElIdFTP.ListResult.Text);
    // IdFTP sometimes incorrectly processes directory listing,
    // so we perform own processing here
    ProcessFileList(ElIdFTP.ListResult);
    ListView.Items.Clear;
    for I := 0 to FFileList.Count - 1 do
    begin
      Item := ListView.Items.Add;
      Item.Caption := TFileInfo(FFileList[I]).Filename;
      if TFileInfo(FFileList[I]).Directory then
        Item.SubItems.Add('')
      else
      begin
        Item.SubItems.Add(IntToStr(TFileInfo(FFileList[I]).Size));
        Item.ImageIndex := -1;
      end;
      Item.SubItems.Add(TFileInfo(FFileList[I]).Date);
      Item.Data := FFileList[I];
    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 ' + TFileInfo(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(TFileInfo(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 TFileInfo(ListView.Selected.Data).Directory then
  begin
    Log('Changing directory to ' + TFileInfo(ListView.Selected.Data).FileName);
    try
      ElIdFtp.ChangeDir(TFileInfo(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 not TFileInfo(ListView.Selected.Data).Directory then
  begin
    if MessageDlg('Are you sure you want to delete file ' +
      TFileInfo(ListView.Selected.Data).FileName + '?', mtConfirmation,
      [mbYes, mbNo], 0) = mrYes then
    begin
      Log('Deleting file ' + TFileInfo(ListView.Selected.Data).FileName);
      try
        ElIdFtp.Delete(TFileInfo(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;

function FileListSort(Item1, Item2: Pointer): Integer;
begin
  if (TFileInfo(Item1).Directory = TFileInfo(Item2).Directory) then
    Result := CompareStr(TFileInfo(Item1).Filename, TFileInfo(Item2).Filename)
  else
  begin
    if TFileInfo(Item1).Directory then
      Result := -1
    else
      Result := 1;
  end;
end;

procedure TFormMain.ProcessFileList(List : TStrings);
var
  I : integer;
  S : string;
  Info : TFileInfo;
  Index : integer;
begin
  ClearFileList;
  for I := 0 to List.Count - 1 do
  begin
    S := List[I];
    if Length(S) > 20 then // skipping 'total xyz' lines
    begin
      Info := TFileInfo.Create;
      // drwxrwxrwx
      S := Trim(Copy(S, 11, Length(S)));
      // number
      Index := Pos(' ', S);
      if Index > 0 then
        S := Trim(Copy(S, Index + 1, Length(S)));
      // owner
      Index := Pos(' ', S);
      if Index > 0 then
        S := Trim(Copy(S, Index + 1, Length(S)));
      // group
      Index := Pos(' ', S);
      if Index > 0 then
        S := Trim(Copy(S, Index + 1, Length(S)));
      // size
      Index := Pos(' ', S);
      if Index > 0 then
      begin
        Info.Size := StrToIntDef(Copy(S, 1, Index - 1), 0);
        S := Trim(Copy(S, Index + 1, Length(S)));
      end;
      // date (12 chars)
      Info.Date := Copy(S, 1, 12);
      // filename
      Info.Filename := Trim(Copy(S, 13, Length(S)));
      Info.Directory := List[I][1] = 'd';
      FFileList.Add(Info);
    end;
  end;
  FFileList.Sort(FileListSort);
end;

procedure TFormMain.ClearFileList;
var
  I : integer;
begin
  for I := 0 to FFileList.Count - 1 do
    TFileInfo(FFileList[I]).Free;
  FFileList.Clear;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  FFileList := TList.Create;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  ClearFileList;
  FreeAndNil(FFileList);
end;

initialization

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

end.