mainform.pas

来自「著名的SecureBlackBox控件完整源码」· PAS 代码 · 共 617 行 · 第 1/2 页

// set this define is you are using Indy 10
{$define INDY100}
// set this define is you are using Indy 9
{.$define INDY90}

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ToolWin, ComCtrls, ExtCtrls, ScktComp, SBUtils, SBIdSFTP, SBSftpCommon,
  SBSSHConstants, SBSSHKeyStorage, StdCtrls, ImgList,
  IdComponent, IdGlobal, IdTcpClient, IdFTPList;

type
  TfrmMain = class(TForm)
    tbToolbar: TToolBar;
    MainMenu: TMainMenu;
    mnuConnection: TMenuItem;
    mnuConnect: TMenuItem;
    mnuDisconnect: TMenuItem;
    N1: TMenuItem;
    mnuExit: TMenuItem;
    mnuHelp: TMenuItem;
    mnuAbout: TMenuItem;
    lvLog: TListView;
    lvFiles: TListView;
    tbConnect: TToolButton;
    tbDisconnect: TToolButton;
    tbDelim1: TToolButton;
    tbRename: TToolButton;
    tbMakeDir: TToolButton;
    tbDelete: TToolButton;
    tbDelim2: TToolButton;
    tbDownload: TToolButton;
    tbUpload: TToolButton;
    tbDelim3: TToolButton;
    tbRefresh: TToolButton;
    spLog: TSplitter;
    pPath: TPanel;
    lPath: TLabel;
    SaveDialog: TSaveDialog;
    OpenDialog: TOpenDialog;
    imgListViews: TImageList;

    Image1: TImage;
    procedure tbConnectClick(Sender: TObject);
    procedure tbDisconnectClick(Sender: TObject);
    procedure tbRenameClick(Sender: TObject);
    procedure tbMakeDirClick(Sender: TObject);
    procedure tbDeleteClick(Sender: TObject);
    procedure tbDownloadClick(Sender: TObject);
    procedure tbUploadClick(Sender: TObject);
    procedure tbRefreshClick(Sender: TObject);
    procedure SftpClientAuthenticationFailed(Sender: TObject;
      AuthenticationType: Integer);
    procedure SftpClientAuthenticationSuccess(Sender: TObject);
    procedure SftpClientCloseConnection(Sender: TObject);
    procedure SftpClientError(Sender: TObject; ErrorCode: Integer);
    procedure SftpClientKeyValidate(Sender: TObject; ServerKey: TElSSHKey;
      var Validate: Boolean);
    procedure SftpClientWork(Sender: TObject; AWorkMode: TWorkMode; {$ifdef INDY90}const{$endif} AWorkCount: Integer);
    procedure SftpClientWorkBegin(Sender: TObject; AWorkMode: TWorkMode; {$ifdef INDY90}const{$endif} AWorkCountMax: Integer);
    procedure lvFilesDblClick(Sender: TObject);
    procedure mnuConnectClick(Sender: TObject);
    procedure mnuDisconnectClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);

    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  private
    FSFTPClient : TElIdSFTPClient;
    FDirList : TIdSFTPListItems;
    FKeyStorage: TElSSHMemoryKeyStorage;
    Processed : integer;
    ToProcess : integer;

    procedure Connect;
    procedure Disconnect;
    procedure Rename;
    procedure MakeDir;
    procedure Delete;
    procedure Download;
    procedure Upload;
    procedure ChangeDir;
    procedure Refresh;
    procedure Log(const S : string; Error : boolean = false);
    procedure ClearFileList;
    procedure FileListSort(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
    function InternalMessageLoop : boolean;
    function AbsPath(FileName: string): string;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses ConnPropsForm, ProgressForm, AboutForm;

const SFTP_BLOCK_SIZE = $10000;

{$R *.DFM}

procedure TfrmMain.tbConnectClick(Sender: TObject);
begin
  Connect;
end;

procedure TfrmMain.tbDisconnectClick(Sender: TObject);
begin
  Disconnect;
end;

procedure TfrmMain.tbRenameClick(Sender: TObject);
begin
  Rename;
end;

procedure TfrmMain.tbMakeDirClick(Sender: TObject);
begin
  MakeDir;
end;

procedure TfrmMain.tbDeleteClick(Sender: TObject);
begin
  Delete;
end;

procedure TfrmMain.tbDownloadClick(Sender: TObject);
begin
  Download;
end;

procedure TfrmMain.tbUploadClick(Sender: TObject);
begin
  Upload;
end;

procedure TfrmMain.tbRefreshClick(Sender: TObject);
begin
  Refresh;
end;

procedure TfrmMain.Connect;
var
  Key : TElSSHKey;
begin
  if FSFTPClient.Active then
  begin
    MessageDlg('Already connected', mtInformation, [mbOk], 0);
    Exit;
  end;

  if frmConnProps.ShowModal = mrOk then
  begin
    if Pos(':', frmConnProps.editHost.Text) > 0 then
    begin
      FSFTPClient.Host := Copy(frmConnProps.editHost.Text, 1, Pos(':', frmConnProps.editHost.Text) - 1);
      FSFTPClient.Port := StrToIntDef(Copy(frmConnProps.editHost.Text, Pos(':', frmConnProps.editHost.Text) + 1, Length(frmConnProps.editHost.Text)), 22);
    end
    else
    begin
      FSFTPClient.Host := frmConnProps.editHost.Text;
      FSFTPClient.Port := 22;
    end;

    FSFTPClient.Versions := [sbSFTP0, sbSFTP1, sbSFTP2, sbSFTP3, sbSFTP4, sbSFTP5, sbSFTP6];
    FSFTPClient.Username := frmConnProps.editUsername.Text;
    FSFTPClient.Password := frmConnProps.editPassword.Text;

    FKeyStorage.Clear;
    Key := TElSSHKey.Create;
    if (frmConnProps.edPrivateKey.Text <> '') and FileExists(frmConnProps.edPrivateKey.Text) and
       (Key.LoadPrivateKey(frmConnProps.edPrivateKey.Text) = 0) then
    begin
      FKeyStorage.Add(Key);
      FSFTPClient.AuthenticationTypes := FSFTPClient.AuthenticationTypes or SSH_AUTH_TYPE_PUBLICKEY;
    end
    else
      FSFTPClient.AuthenticationTypes := FSFTPClient.AuthenticationTypes and not SSH_AUTH_TYPE_PUBLICKEY;

    Key.Free;

    Log('Connecting to ' + FSFTPClient.Address);
    try
      FSFTPClient.Connect;
    except
      on E: Exception do
      begin
        Log('Sftp connection failed with message [' + E.Message + ']', true);
        Exit;
      end;
    end;
    Log('Sftp connection established');
    Refresh;
  end;
end;

procedure TfrmMain.Disconnect;
begin
  Log('Disconnecting');
  FSFTPClient.Quit;
end;

procedure TfrmMain.Rename;
var
  NewName: string;
begin
  if FSFTPClient.Active and Assigned(lvFiles.Selected) and Assigned(lvFiles.Selected.Data) then
  begin
    NewName := InputBox('Rename', 'Please enter the new name for ' + TIdSFTPListItem(lvFiles.Selected.Data).FileName, '');
    if NewName = '' then Exit;
    Log('Renaming ' + TIdSFTPListItem(lvFiles.Selected.Data).FileName + ' to ' + NewName);
    try
      FSFTPClient.Rename(AbsPath(TIdSFTPListItem(lvFiles.Selected.Data).FileName), AbsPath(NewName));
    except
      on E: Exception do
      begin
        Log('Failed to rename file "' + TIdSFTPListItem(lvFiles.Selected.Data).FileName + '" to "' +
          NewName + '", ' + E.Message, true);
      end;
    end;
    Refresh;
  end;
end;

procedure TfrmMain.MakeDir;
var
  DirName : string;
begin
  if FSFTPClient.Active then
  begin
    DirName := InputBox('Make directory', 'Please enter the name for new directory', '');
    if DirName = '' then Exit;
    Log('Creating directory ' + DirName);
    try
      FSFTPClient.MakeDir(AbsPath(DirName));
    except
      on E: Exception do
      begin
        Log('Failed to create directory "' + DirName + '", ' + E.Message, true);
      end;
    end;
    Refresh;
  end;
end;

procedure TfrmMain.Delete;
begin
  if FSFTPClient.Active and Assigned(lvFiles.Selected) and Assigned(lvFiles.Selected.Data) then
  begin
    if MessageDlg('Please confirm that you want to delete "' +
      TIdSFTPListItem(lvFiles.Selected.Data).FileName + '"', mtConfirmation,
      [mbYes, mbNo], 0) = mrYes then
    begin
      Log('Removing item ' + TIdSFTPListItem(lvFiles.Selected.Data).FileName);
      try
        if TIdSFTPListItem(lvFiles.Selected.Data).ItemType = ditDirectory then
          FSFTPClient.RemoveDir(AbsPath(TIdSFTPListItem(lvFiles.Selected.Data).FileName))
        else
          FSFTPClient.Delete(AbsPath(TIdSFTPListItem(lvFiles.Selected.Data).FileName));
      except
        on E: Exception do
        begin
          Log('Failed to delete "' + TIdSFTPListItem(lvFiles.Selected.Data).FileName + '", ' +
            E.Message, true);
        end;
      end;
      Refresh;
    end;
  end;
end;

procedure TfrmMain.Download;
var
  Size : integer;
  F : TFileStream;
begin
  if FSFTPClient.Active and Assigned(lvFiles.Selected) and Assigned(lvFiles.Selected.Data) and
    (TIdSFTPListItem(lvFiles.Selected.Data).ItemType = ditFile) then
  begin
    SaveDialog.FileName := TIdSFTPListItem(lvFiles.Selected.Data).FileName;
    if SaveDialog.Execute then
    begin
      try
        F := TFileStream.Create(SaveDialog.Filename, Classes.fmCreate);
      except
        on E : Exception do
        begin
          Log('Failed to create local file ' + SaveDialog.Filename, true);
          Exit;
        end;
      end;

      Log('Downloading file ' + TIdSFTPListItem(lvFiles.Selected.Data).FileName);
      Size := TIdSFTPListItem(lvFiles.Selected.Data).Size;
      frmProgress.lSourceFilename.Caption := AbsPath(TIdSFTPListItem(lvFiles.Selected.Data).FileName);
      frmProgress.lDestFilename.Caption := SaveDialog.Filename;
      frmProgress.lProgress.Caption := '0 / ' + IntToStr(Size);
      frmProgress.pbProgress.Position := 0;
      frmProgress.Canceled := false;
      frmProgress.Caption := 'Download';
      frmProgress.Show;
      try