home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 53 / IOPROG_53.ISO / soft / c++ / xceedftp.exe / Samples / Delphi / FTPClient / unMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-10-05  |  61.4 KB  |  1,675 lines
  1. { ----------------------------------------------------------------- }
  2. { Xceed FTP Library - FTP Client sample application                 }
  3. { Copyright (c) 2000 Xceed Software Inc.                            }
  4. {                                                                   }
  5. { [frmXceedFTP.pas]                                                 }
  6. {                                                                   }
  7. {  This form contains all the code for the FTP Client               }
  8. {                                                                   }
  9. {  This file is part of the Xceed FTP Library samples applications. }
  10. {  The source code in this file is only intended as a supplement    }
  11. {  to Xceed FTP Library's documentation, and is provided "as is",   }
  12. {  without warranty of any kind, either expressed or implied.       }
  13. { ----------------------------------------------------------------- }
  14.  
  15. unit unMain;
  16.  
  17. interface
  18.  
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  21.   StdCtrls, ComCtrls, Menus, XceedFTPLib_TLB, unConnectInfo, OleCtrls;
  22.  
  23. type
  24.   TfrmMain = class(TForm)
  25.     grpLocal              : TGroupBox;
  26.     grpRemote             : TGroupBox;
  27.     lstLocalView          : TListView;
  28.     lstRemoteView         : TListView;
  29.     lstConnectionInfo     : TListBox;
  30.     lstImages             : TImageList;
  31.     cboLocalPaths         : TComboBox;
  32.     cboRemotePaths        : TComboBox;
  33.     btDeleteLocalFile     : TButton;
  34.     btRenameLocalFile     : TButton;
  35.     btCreateLocalFolder   : TButton;
  36.     btDeleteLocalFolder   : TButton;
  37.     btParentLocalFolder   : TButton;
  38.     btParentRemoteFolder  : TButton;
  39.     btDeleteRemoteFile    : TButton;
  40.     btRenameRemoteFile    : TButton;
  41.     btCreateRemoteFolder  : TButton;
  42.     btDeleteRemoteFolder  : TButton;
  43.     btSendFiles           : TButton;
  44.     btReceiveFiles        : TButton;
  45.     btConnect             : TButton;
  46.     btDisconnect          : TButton;
  47.     btAbort               : TButton;
  48.     optBinary             : TRadioButton;
  49.     optAscii              : TRadioButton;
  50.     pgrProgess            : TProgressBar;
  51.     stbStatus             : TStatusBar;
  52.     mnuFtp                : TMainMenu;
  53.     miConnection          : TMenuItem;
  54.     miConnect             : TMenuItem;
  55.     miDisconnect          : TMenuItem;
  56.     miTransfer            : TMenuItem;
  57.     miSend                : TMenuItem;
  58.     miReceive             : TMenuItem;
  59.     miOperations          : TMenuItem;
  60.     miLocal               : TMenuItem;
  61.     miRemote              : TMenuItem;
  62.     miDeleteLocalFile     : TMenuItem;
  63.     miRenameLocalFile     : TMenuItem;
  64.     miCreateLocalFolder   : TMenuItem;
  65.     miDeleteLocalFolder   : TMenuItem;
  66.     miDeleteRemoteFile    : TMenuItem;
  67.     miRenameRemoteFile    : TMenuItem;
  68.     miCreateRemoteFolder  : TMenuItem;
  69.     miDeleteRemoteFolder  : TMenuItem;
  70.     miAbort               : TMenuItem;
  71.     popLocal              : TPopupMenu;
  72.     popRemote             : TPopupMenu;
  73.     pmiDeleteLocalFile    : TMenuItem;
  74.     pmiRenameLocalFile    : TMenuItem;
  75.     pmiCreateLocalFolder  : TMenuItem;
  76.     pmiDeleteLocalFolder  : TMenuItem;
  77.     pmiDeleteRemoteFile   : TMenuItem;
  78.     pmiRenameRemoteFile   : TMenuItem;
  79.     pmiCreateRemoteFolder : TMenuItem;
  80.     pmiDeleteRemoteFolder : TMenuItem;
  81.     xFtp                  : TXceedFtp;
  82.  
  83.     procedure FormCreate(Sender: TObject);
  84.     procedure lstAnyViewCompare(Sender: TObject; Item1, Item2: TListItem;
  85.                                 Data: Integer; var Compare: Integer);
  86.     procedure lstDragDrop(Sender, Source: TObject; X, Y: Integer);
  87.     procedure lstLocalViewDblClick(Sender: TObject);
  88.     procedure lstRemoteViewDblClick(Sender: TObject);
  89.     procedure lstLocalViewClick(Sender: TObject);
  90.     procedure lstRemoteViewClick(Sender: TObject);
  91.     procedure btParentLocalFolderClick(Sender: TObject);
  92.     procedure btDeleteLocalFileClick(Sender: TObject);
  93.     procedure btRenameLocalFileClick(Sender: TObject);
  94.     procedure btCreateLocalFolderClick(Sender: TObject);
  95.     procedure btDeleteLocalFolderClick(Sender: TObject);
  96.     procedure btConnectClick(Sender: TObject);
  97.     procedure btDisconnectClick(Sender: TObject);
  98.     procedure btAbortClick(Sender: TObject);
  99.     procedure btDeleteRemoteFileClick(Sender: TObject);
  100.     procedure btRenameRemoteFileClick(Sender: TObject);
  101.     procedure btCreateRemoteFolderClick(Sender: TObject);
  102.     procedure btDeleteRemoteFolderClick(Sender: TObject);
  103.     procedure btParentRemoteFolderClick(Sender: TObject);
  104.     procedure btSendFilesClick(Sender: TObject);
  105.     procedure btReceiveFilesClick(Sender: TObject);
  106.     procedure miDeleteLocalFileClick(Sender: TObject);
  107.     procedure miRenameLocalFileClick(Sender: TObject);
  108.     procedure miCreateLocalFolderClick(Sender: TObject);
  109.     procedure miDeleteLocalFolderClick(Sender: TObject);
  110.     procedure miDisconnectClick(Sender: TObject);
  111.     procedure miConnectClick(Sender: TObject);
  112.     procedure miAbortClick(Sender: TObject);
  113.     procedure miDeleteRemoteFileClick(Sender: TObject);
  114.     procedure miRenameRemoteFileClick(Sender: TObject);
  115.     procedure miCreateRemoteFolderClick(Sender: TObject);
  116.     procedure miDeleteRemoteFolderClick(Sender: TObject);
  117.     procedure miSendClick(Sender: TObject);
  118.     procedure miReceiveClick(Sender: TObject);
  119.     procedure pmiDeleteLocalFileClick(Sender: TObject);
  120.     procedure pmiRenameLocalFileClick(Sender: TObject);
  121.     procedure pmiCreateLocalFolderClick(Sender: TObject);
  122.     procedure pmiDeleteLocalFolderClick(Sender: TObject);
  123.     procedure pmiDeleteRemoteFileClick(Sender: TObject);
  124.     procedure pmiRenameRemoteFileClick(Sender: TObject);
  125.     procedure pmiCreateRemoteFolderClick(Sender: TObject);
  126.     procedure pmiDeleteRemoteFolderClick(Sender: TObject);  
  127.     procedure cboLocalPathsClick(Sender: TObject);
  128.     procedure cboRemotePathsClick(Sender: TObject);
  129.     procedure optBinaryClick(Sender: TObject);
  130.     procedure optAsciiClick(Sender: TObject);
  131.  
  132.     {XceedFtp events}
  133.     procedure xFtpDisconnected(Sender: TObject);
  134.     procedure xFtpListingFolderItem(Sender: TObject; const sName: WideString;
  135.                                     dtDate: TDateTime; lFileSize: Integer;
  136.                                     eItemType: TOleEnum;
  137.                                     const sUserData: WideString);
  138.     procedure xFtpFileTransferStatus(Sender: TObject; const sLocalFilename,
  139.                                      sRemoteFilename: WideString; lFileSize, lBytesTransferred: Integer;
  140.                                      nBytesPercent: Smallint; lTotalSize, lTotalBytesTransferred: Integer;
  141.                                      nTotalBytesPercent: Smallint; lTotalFiles,
  142.                                      lTotalFilesTransferred: Integer; nTotalFilesPercent: Smallint;
  143.                                      lBytesPerSecond, lTotalBytesPerSecond: Integer);
  144.     procedure xFtpLoggingCommandLine(Sender: TObject; const sLine: WideString;
  145.                                      eCommandType: TOleEnum);
  146.     procedure xFtpAccountRequired(Sender: TObject; var sAccountName: WideString);
  147.     procedure xFtpPasswordRequired(Sender: TObject; var sPassword: WideString);
  148.     procedure xFtpReceivingFile(Sender: TObject;
  149.                                 const sRemoteFilename: WideString;
  150.                                 var sLocalFilename: WideString;
  151.                                 lFileSize: Integer);
  152.     procedure xFtpReplacingFile(Sender: TObject; var sFilename: WideString;
  153.                                 dtDate: TDateTime; lFileSize: Integer;
  154.                                 const sRemoteFilename: WideString;
  155.                                 var eAction: TOleEnum);
  156.     procedure xFtpSendingFile(Sender: TObject; const sLocalFilename: WideString;
  157.                               var sRemoteFilename: WiDeString;
  158.                               lFileSize: Integer);
  159.     procedure xFtpSkippingFile(Sender: TObject;
  160.                                const sLocalFilename, sRemoteFilename: WideString;
  161.                                lSkippingReason: Integer);
  162.     procedure lstRemoteViewDragOver(Sender, Source: TObject; X, Y: Integer;
  163.                                     State: TDragState; var Accept: Boolean);
  164.     procedure lstLocalViewDragOver(Sender, Source: TObject; X, Y: Integer;
  165.                                    State: TDragState; var Accept: Boolean);
  166.     procedure FormDestroy(Sender: TObject);
  167.  
  168.  
  169.   private
  170.     {Private procedures and functions}
  171.     procedure ClearStatusBars;
  172.     procedure ClearLocalListView;
  173.     procedure ClearRemoteListView;
  174.     procedure RefreshLocalListView;
  175.     procedure RefreshRemoteListView;
  176.     procedure UpdateConnectionState(bIsConnected : boolean);
  177.     procedure UpdateRemoteState;
  178.     procedure UpdateLocalState;
  179.     procedure NewLocalEntry(sName : string; dtDate : TDateTime; lSize : integer;
  180.                             nAttrib : integer);
  181.     procedure NewRemoteEntry(sName : string; dtDate: TDateTime; lSize : longint;
  182.                              eItemType : EXFFolderItemType);
  183.     procedure DisplayMessage(sMessage : string);
  184.  
  185.     function  PathExists(sPathToCheck : string; bIsLocal : boolean) : boolean;
  186.  
  187.     {Procedures that perform FTP functionality}
  188.     procedure DoConnect;
  189.     procedure DoDisconnect;
  190.     procedure DoSendFiles;
  191.     procedure DoReceiveFiles;
  192.     procedure DoAbort;
  193.     procedure GetParentFolder;
  194.     procedure RetrieveRemoteFolderContents;
  195.  
  196.     function  GetCurrentConnectionState : EXFState;
  197.     function  GetRemoteFolder : string;
  198.     function  ChangeCurrentRemoteFolder(sNewCurrentFolder : string) : boolean;
  199.  
  200.     {Remote file and folder handling}
  201.     procedure DeleteSelectedRemoteFile;
  202.     procedure RenameRemoteFile;
  203.     procedure CreateRemoteFolder;
  204.     procedure DeleteRemoteFolder;
  205.  
  206.     {Local file and folder handling}
  207.     procedure RetrieveLocalFolderContents(sPath : string);
  208.     procedure RetrieveLogicalDrives;
  209.     procedure DeleteSelectedLocalFile;
  210.     procedure RenameLocalFile;
  211.     procedure CreateLocalFolder;
  212.     procedure DeleteLocalFolder;
  213.  
  214.   public
  215.     m_sCurrentLocalPath  : string;  { Keeps current local path }
  216.     m_sCurrentRemotePath : string;  { Keeps current remmote path }
  217.     m_bReplaceAll        : boolean; { Set in the ReplacingFile event }
  218.   end;
  219.  
  220. var
  221.   frmMain          : TfrmMain;
  222. implementation
  223.  
  224. {$R *.DFM}
  225. { ------------------------------------------------------------- }
  226. { Clear the progress bar and status panels                      }
  227. { ------------------------------------------------------------- }
  228. procedure TfrmMain.ClearStatusBars();
  229. begin
  230.   pgrProgess.Position := 0;
  231.   stbStatus.Panels[1].Text := '';
  232. end;
  233.  
  234. { ------------------------------------------------------------- }
  235. { Clear the contents of the local file list ListView control.   }
  236. { ------------------------------------------------------------- }
  237. procedure TfrmMain.ClearLocalListView();
  238. begin
  239.   lstLocalView.Items.Clear;
  240. end;
  241.  
  242. { ------------------------------------------------------------- }
  243. { Clear the contents of the remote file list ListView control.  }
  244. { ------------------------------------------------------------- }
  245. procedure TfrmMain.ClearRemoteListView();
  246. begin
  247.   lstRemoteView.Items.Clear;
  248. end;
  249.  
  250. { ------------------------------------------------------------- }
  251. { Refresh the local file list ListView control and display the  }
  252. { new contents by calling RetrieveLocalFolderContents procedure }
  253. { ------------------------------------------------------------- }
  254. procedure TfrmMain.RefreshLocalListView();
  255. begin
  256.   ClearLocalListView();
  257.   RetrieveLocalFolderContents(m_sCurrentLocalPath);
  258. end;
  259.  
  260. { ------------------------------------------------------------- }
  261. { Refresh the remote file list ListView control and display the }
  262. { new contents by calling RetrieveRemoteFolderContents          }
  263. { procedure                                                     }
  264. { ------------------------------------------------------------- }
  265. procedure TfrmMain.RefreshRemoteListView();
  266. begin
  267.   ClearRemoteListView();
  268.   RetrieveRemoteFolderContents();
  269. end;
  270.  
  271. { ------------------------------------------------------------- }
  272. { Here we will enable or disable some of the controls depending }
  273. { on the connection state.                                      }
  274. { ------------------------------------------------------------- }
  275. procedure TfrmMain.UpdateConnectionState(bIsConnected : boolean);
  276. begin
  277.   btDisconnect.Enabled := bIsConnected;
  278.   btAbort.Enabled := bIsConnected;
  279.   btParentRemoteFolder.Enabled := bIsConnected;
  280.   btSendFiles.Enabled := bIsConnected;
  281.   btReceiveFiles.Enabled := bIsConnected;
  282.  
  283.   btCreateRemoteFolder.Enabled := bIsConnected;
  284.   miCreateRemoteFolder.Enabled := bIsConnected;
  285.  
  286.   optAscii.Enabled := bIsConnected;
  287.   optBinary.Enabled := bIsConnected;
  288.  
  289.   cboRemotePaths.Enabled := bIsConnected;
  290.  
  291.   miDisconnect.Enabled := bIsConnected;
  292.   miTransfer.Enabled := bIsConnected;
  293.   miSend.Enabled := bIsConnected;
  294.   miReceive.Enabled := bIsConnected;
  295.   miRemote.Enabled := bIsConnected;
  296.  
  297.   btConnect.Enabled := not bIsConnected;
  298.   miConnect.Enabled := not bIsConnected;
  299. end;
  300.  
  301. { ------------------------------------------------------------- }
  302. { Update the state of the buttons and menus for remote file and }
  303. { folder operations. The button states depend largely on the    }
  304. { number and type of items selected in the remote file list     }
  305. { ListView object.                                              }
  306. { ------------------------------------------------------------- }
  307.  
  308. procedure TfrmMain.UpdateRemoteState();
  309. var
  310.   bMultipleItemsSelected : boolean;
  311.   bIsNothing             : boolean;
  312.   nItemType              : integer;
  313. begin
  314.  
  315.   { Make sure that the remote listview control is created }
  316.  
  317.   bIsNothing := not assigned(lstRemoteView.Selected);
  318.   nItemType := -1;
  319.   bMultipleItemsSelected := false;
  320.  
  321.   if not bIsNothing then
  322.   begin
  323.  
  324.     { Check if more than one item is selected }
  325.     bMultipleItemsSelected := lstRemoteView.SelCount > 1;
  326.  
  327.     if not bMultipleItemsSelected then
  328.       nItemType := lstRemoteView.Selected.ImageIndex; { ImageIndex doubles as item type }
  329.   end;
  330.  
  331.   btDeleteRemoteFile.Enabled := (not bIsNothing) and ((bMultipleItemsSelected) or
  332.                                 (nItemType = 2));
  333.   miDeleteRemoteFile.Enabled := btDeleteRemoteFile.Enabled;
  334.   pmiDeleteRemoteFile.Enabled := btDeleteRemoteFile.Enabled;
  335.  
  336.   btRenameRemoteFile.Enabled := (not bIsNothing) and (nItemType = 2);
  337.   miRenameRemoteFile.Enabled := btRenameRemoteFile.Enabled;
  338.   pmiRenameRemoteFile.Enabled := btRenameRemoteFile.Enabled;
  339.  
  340.   btDeleteRemoteFolder.Enabled := (not bIsNothing) and (nItemType = 0);
  341.   miDeleteRemoteFolder.Enabled := btDeleteRemoteFolder.Enabled;
  342.   pmiDeleteRemoteFolder.Enabled := btDeleteRemoteFolder.Enabled;
  343.  
  344.   btReceiveFiles.Enabled := (not bIsNothing) and (lstRemoteView.SelCount > 0);
  345.   miReceive.Enabled := btReceiveFiles.Enabled;
  346. end;
  347.  
  348. { ------------------------------------------------------------- }
  349. { Update the state of the buttons and menus for local file and  }
  350. { folder operations. The button states depend largely on the    }
  351. { number and type of items selected in the local file list      }
  352. { ListView object.                                              }
  353. { ------------------------------------------------------------- }
  354. procedure TfrmMain.UpdateLocalState();
  355. var
  356.   bMultipleItemsSelected : boolean;
  357.   bIsNothing             : boolean;
  358.   nItemType              : integer;
  359. begin
  360.  
  361.   { Make sure that the local listview control is created }
  362.   bIsNothing := not assigned(lstLocalView.Selected);
  363.  
  364.   if not bIsNothing then
  365.   begin
  366.  
  367.     { Check if more than one item is selected }
  368.     bMultipleItemsSelected := lstLocalView.SelCount > 1;
  369.  
  370.     if not bMultipleItemsSelected then
  371.       nItemType := lstLocalView.Selected.ImageIndex { ImageIndex represents the item type }
  372.     else
  373.       { If more than one item is selected, set the image index to -1 }
  374.       nItemType := -1;
  375.  
  376.   end
  377.   else
  378.   begin
  379.     nItemType := 0;
  380.     bMultipleItemsSelected := False;
  381.   end;
  382.  
  383.   btDeleteLocalFile.Enabled := (not bIsNothing) and ((bMultipleItemsSelected) or
  384.                                (nItemType = 2));
  385.   miDeleteLocalFile.Enabled := btDeleteLocalFile.Enabled;
  386.   pmiDeleteLocalFile.Enabled := btDeleteLocalFile.Enabled;
  387.  
  388.   btRenameLocalFile.Enabled := (not bIsNothing) and (nItemType = 2);
  389.   miRenameLocalFile.Enabled := btRenameLocalFile.Enabled;
  390.   pmiRenameLocalFile.Enabled := btRenameLocalFile.Enabled;
  391.  
  392.   btCreateLocalFolder.Enabled := true;
  393.   miCreateLocalFolder.Enabled := true;
  394.   pmiCreateLocalFolder.Enabled := true;
  395.  
  396.   btDeleteLocalFolder.Enabled := (not bIsNothing) and (nItemType = 0);
  397.   miDeleteLocalFolder.Enabled := btDeleteLocalFolder.Enabled;
  398.   pmiDeleteLocalFolder.Enabled := btDeleteLocalFolder.Enabled;
  399.  
  400.   btSendFiles.Enabled := (not bIsNothing) and (lstLocalView.SelCount > 0) and
  401.                          (GetCurrentConnectionState = fstConnected);
  402.   miSend.Enabled := btSendFiles.Enabled;
  403. end;
  404.  
  405. { ------------------------------------------------------------- }
  406. { Add a new entry to the local file list ListView control. We   }
  407. { will also set the appropriate icon (depends on whether the    }
  408. { item is a file a folder.                                      }
  409. { ------------------------------------------------------------- }
  410. procedure TfrmMain.NewLocalEntry(sName : string; dtDate : TDateTime;
  411.                                      lSize : integer; nAttrib : integer);
  412. var
  413.   xItem : TListItem;
  414. begin
  415.   xItem := lstLocalView.Items.Add;
  416.  
  417.   xItem.Caption := sName; { Name of the item being added to the local file listview }
  418.   xItem.SubItems.Add(IntToStr( (lSize + 1023) div 1024)); { Size in KB }
  419.   xItem.SubItems.Add(DateToStr(dtDate));  { Date }
  420.  
  421.   case (nAttrib and faDirectory) of
  422.     faDirectory : xItem.ImageIndex := 0 { Item is a folder }
  423.   else
  424.     xItem.ImageIndex := 2;  { Item is a file }
  425.   end;
  426. end;
  427.  
  428. { ------------------------------------------------------------- }
  429. { Add a new entry to the remote file list ListView control. We  }
  430. { will also set the appropriate icon depending on if the item   }
  431. { is a file a folder or a link.                                 }
  432. { ------------------------------------------------------------- }
  433. procedure TfrmMain.NewRemoteEntry(sName : string; dtDate: TDateTime;
  434.                                       lSize : longint;
  435.                                       eItemType : EXFFolderItemType);
  436. var
  437.   xItem : TListItem;
  438. begin
  439.   xItem := lstRemoteView.Items.Add;
  440.  
  441.   xItem.Caption := sName; { Name of the item being added to the remote file listview }
  442.   xItem.SubItems.Add(IntToStr( (lSize + 1023) div 1024)); { Size in KB }
  443.   xItem.SubItems.Add(DateToStr(dtDate)); { Date }
  444.  
  445.   case eItemType of
  446.     fitFolder : xItem.ImageIndex := 0;  { Item is a folder }
  447.     fitLink   : xItem.ImageIndex := 1;  { Item is a link }
  448.     fitFile   : xItem.ImageIndex := 2;  { Item is a file }
  449.   end
  450. end;
  451.  
  452. { ------------------------------------------------------------- }
  453. { Display a message in the lstConnectionInfo listbox. This      }
  454. { procedure can ba called from any other procedure or function  }
  455. { ------------------------------------------------------------- }
  456. procedure TfrmMain.DisplayMessage(sMessage : string);
  457. begin
  458.   lstConnectionInfo.Items.Add(sMessage);
  459.   lstConnectionInfo.ItemIndex := lstConnectionInfo.Items.Count - 1;
  460. end;
  461.  
  462. { ------------------------------------------------------------- }
  463. { This procedure verifies that the path to be added does not    }
  464. { already exist in the corresponding combo box and returns true }
  465. { or false depending on the case. The second parameter of this  }
  466. { procedure determines if the path to add is local or remote.   }
  467. { ------------------------------------------------------------- }
  468. function TfrmMain.PathExists(sPathToCheck : string;
  469.                                  bIsLocal : boolean) : boolean;
  470. var
  471.   nCount : integer;
  472. begin
  473.   nCount := 0;
  474.   PathExists := false;
  475.  
  476.   if bIsLocal then  { Verifying a local path }
  477.   begin
  478.     while nCount < cboLocalPaths.Items.Count do
  479.     begin
  480.       if sPathToCheck = cboLocalPaths.Items[nCount] then
  481.       begin
  482.         PathExists := true;
  483.         nCount := cboLocalPaths.Items.Count;
  484.       end;
  485.       nCount := nCount + 1;
  486.     end;
  487.   end
  488.   else  { Verify a remote path }
  489.   begin
  490.     while nCount < cboRemotePaths.Items.Count do
  491.     begin
  492.       if sPathToCheck = cboRemotePaths.Items[nCount] then
  493.       begin
  494.         PathExists := true;
  495.         nCount := cboRemotePaths.Items.Count;
  496.       end;
  497.       nCount := nCount + 1;
  498.     end;
  499.   end;
  500. end;
  501.  
  502. { ------------------------------------------------------------- }
  503. { The following procedure contains all the steps necessary to   }
  504. { connect to an FTP server.                                     }
  505. {-------------------------------------------------------------- }
  506. procedure TfrmMain.DoConnect();
  507. var
  508.   frmConnect        : TfrmConnect;
  509.   sHostName         : string;
  510.   nPort             : integer;
  511.   sUserName         : string;
  512.   sPassword         : string;
  513.   sRemoteFolder     : string;
  514. begin
  515.   frmConnect := TfrmConnect.Create(Self); { Create a new instance of frmConnect }
  516.  
  517.   if frmConnect.GetConnectInfo(sHostName, nPort, sUserName, sPassword) then
  518.   begin
  519.     xFtp.ServerAddress := sHostName;  { Set the Ftp server address }
  520.     xFtp.ServerPort := nPort;         { Set the Ftp server port }
  521.     xFtp.UserName := sUserName;       { Set the username }
  522.     xFtp.Password := sPassword;       { Set the password }
  523.  
  524.     Screen.Cursor := crHourGlass;
  525.     stbStatus.Panels[0].Text := 'Connecting to ' + sHostName + '...Please wait';
  526.     try
  527.       xFtp.Connect(); { Connect to the Ftp server }
  528.       RetrieveRemoteFolderContents(); { Retrieve a listing of the remote folder contents }
  529.       sRemoteFolder := GetRemoteFolder();
  530.       cboRemotePaths.Items.Add(sRemoteFolder);  { Add new path to the remote combo box }
  531.       cboRemotePaths.Text := sRemoteFolder;
  532.       m_sCurrentRemotePath := sRemoteFolder;  { Set the new current remote path }
  533.       UpdateConnectionState(true);  { Update the controls on the form }
  534.       stbStatus.Panels[0].Text := 'Connected to ' + sHostName;
  535.     except
  536.       on xErr: Exception do
  537.       begin
  538.         DisplayMessage(xErr.Message);
  539.         Screen.Cursor := crDefault;
  540.         stbStatus.Panels[0].Text := 'Could not connect.';
  541.       end;
  542.     end;
  543.   end;
  544.   frmConnect.Free;  { Free the instance of frmConnect we created }
  545. end;
  546.  
  547. { ------------------------------------------------------------- }
  548. { Disconnect from FTP server                                    }
  549. { ------------------------------------------------------------- }
  550. procedure TfrmMain.DoDisconnect();
  551. begin
  552.   try
  553.     { Make sure that we are connected }
  554.     if GetCurrentConnectionState() <> fstNotConnected then
  555.     begin
  556.       xFtp.Disconnect();  { Disconnect from Ftp server }
  557.  
  558.       cboRemotePaths.Clear;
  559.       stbStatus.Panels[0].Text := '';
  560.       stbStatus.Panels[2].Text := '';
  561.  
  562.       ClearRemoteListView();
  563.       ClearStatusBars();
  564.       UpdateConnectionState(false); { Update the controls on the form }
  565.     end;
  566.   except
  567.     on xErr : Exception do
  568.       DisplayMessage(xErr.Message);
  569.   end;
  570. end;
  571.  
  572. { ------------------------------------------------------------- }
  573. { This procedure will send a file(s) or folder(s) to the FTP    }
  574. { server by using either the SendMultipleFiles or the SendFile  }
  575. { methods.                                                      }
  576. { ------------------------------------------------------------- }
  577. procedure TfrmMain.DoSendFiles();
  578. var
  579.   sFullFilename : string;
  580.   sFilename     : string;
  581.   xItem         : TListItem;
  582.   nCount        : integer;
  583. begin
  584.   nCount := 0;
  585.  
  586.   { If the selected item is a folder, we will call the SendMultipleFiles method }
  587.   if lstLocalView.Selected.ImageIndex = 0 then
  588.   begin
  589.     sFullFilename := m_sCurrentLocalPath + lstLocalView.Selected.Caption;
  590.     sFilename := lstLocalView.Selected.Caption;
  591.  
  592.     try
  593.     if MessageDlg('Do you want to include any encountered subfolders?',
  594.                   mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  595.      begin
  596.         { Recursively send subfolders too }
  597.         xFtp.SendMultipleFiles(sFullFilename + '\*', sFilename, true, true);
  598.         RefreshRemoteListView();
  599.       end
  600.       else
  601.       begin
  602.         { Do not send subfolders }
  603.         xFtp.SendMultipleFiles(sFullFilename + '\*', sFilename, true, false);
  604.         RefreshRemoteListView();
  605.       end;
  606.     except
  607.       on xErr: Exception do
  608.         DisplayMessage(xErr.Message);
  609.     end;
  610.   end
  611.   else
  612.   begin
  613.     while nCount < lstLocalView.Items.Count do
  614.     begin
  615.       xItem := lstLocalView.Items.Item[nCount];
  616.       { Selected item is a file }
  617.       if (xItem.ImageIndex = 2) and (xItem.Selected) then
  618.       begin
  619.         sFullFilename := m_sCurrentLocalPath + xItem.Caption;
  620.         try
  621.           xFtp.SendFile(sFullFilename, 0, xItem.Caption, true);
  622.         except
  623.           on xErr: Exception do
  624.             DisplayMessage(xErr.Message);
  625.         end;
  626.       end;
  627.       nCount := nCount + 1;
  628.     end;
  629.   stbStatus.Panels[0].Text := 'Transfer completed';
  630.   RefreshRemoteListView();
  631.   end;
  632. end;
  633.  
  634. { ------------------------------------------------------------- }
  635. { This procedure will receive file(s) or folders from the FTP   }
  636. { server by using either the ReceiveMultipleFiles or            }
  637. { ReceiveFile methods.                                          }
  638. { ------------------------------------------------------------- }
  639. procedure TfrmMain.DoReceiveFiles();
  640. var
  641.   sFilename      : string;
  642.   nCount         : integer;
  643.   xItem          : TListItem;
  644.   sLocalFilename : string;
  645.   xAnswer        : Word;
  646. begin
  647.   nCount := 0;
  648.  
  649.   { If the selected item is a folder, we will call the ReceiveMultipleFiles method
  650.     and ask it to receive the folder, using the * wildcard }
  651.  
  652.   if lstRemoteView.Selected.ImageIndex = 0 then
  653.   begin
  654.     sFilename := lstRemoteView.Selected.Caption;
  655.  
  656.     try
  657.       xAnswer := MessageDlg('Do you include any encountered subfolders?',
  658.                             mtConfirmation, [mbYes, mbNo], 0);
  659.  
  660.       xFtp.ReceiveMultipleFiles(sFilename + '\*',
  661.                                 m_sCurrentLocalPath + sFilename,
  662.                                 ( xAnswer = mrYes ));
  663.       RefreshLocalListView();
  664.     except
  665.       on xErr: Exception do
  666.         DisplayMessage(xErr.Message);
  667.     end;
  668.   end
  669.   else
  670.   begin
  671.     while nCount < lstRemoteView.Items.Count do
  672.     begin
  673.       xItem := lstRemoteView.Items.Item[nCount];
  674.       { Selected item is a file }
  675.       if ((xItem.ImageIndex = 2) or (xItem.ImageIndex = 1)) and (xItem.Selected) then
  676.       begin
  677.         sFilename := xItem.Caption;
  678.         sLocalFilename :=  m_sCurrentLocalPath + sFilename;
  679.         try
  680.           xFtp.ReceiveFile(sFilename, 0, sLocalFilename);
  681.         except
  682.           on xErr: Exception do
  683.             DisplayMessage(xErr.Message);
  684.         end;
  685.       end;
  686.       nCount := nCount + 1;
  687.     end;
  688.     stbStatus.Panels[0].Text := 'Transfer completed';
  689.     RefreshLocalListView();
  690.   end;
  691. end;
  692.  
  693. { ------------------------------------------------------------- }
  694. { Retrieve the files in the current directory of the FTP server }
  695. { ------------------------------------------------------------- }
  696. procedure TfrmMain.RetrieveRemoteFolderContents();
  697. begin
  698.   Screen.Cursor := crHourGlass;
  699.   try
  700.     xFtp.ListFolderContents('');
  701.   except
  702.     on xErr: Exception do
  703.       DisplayMessage(xErr.Message);
  704.   end;
  705.   Screen.Cursor := crArrow;
  706. end;
  707.  
  708. { ------------------------------------------------------------- }
  709. { Go to the parent folder of our current remote directory       }
  710. { ------------------------------------------------------------- }
  711. procedure TfrmMain.GetParentFolder();
  712. begin
  713.   try
  714.     xFtp.ChangeToParentFolder();
  715.   except
  716.     on xErr: Exception do
  717.       DisplayMessage(xErr.Message);
  718.   end;
  719. end;
  720.  
  721. { ------------------------------------------------------------- }
  722. { Abort the current operation                                   }
  723. { ------------------------------------------------------------- }
  724. procedure TfrmMain.DoAbort();
  725. begin
  726.   try
  727.     xFtp.Abort := true;
  728.     RefreshLocalListView();
  729.     ClearStatusBars();
  730.     stbStatus.Panels[0].Text := 'Transfer aborted';
  731.     stbStatus.Panels[2].Text := '';
  732.   except
  733.     on xErr: Exception do
  734.       DisplayMessage(xErr.Message);
  735.   end;
  736. end;
  737.  
  738. { ------------------------------------------------------------- }
  739. { Get the current connection state                              }
  740. { ------------------------------------------------------------- }
  741. function  TfrmMain.GetCurrentConnectionState() : EXFState;
  742. begin
  743.   GetCurrentConnectionState := xFtp.CurrentState;
  744. end;
  745.  
  746. { ------------------------------------------------------------- }
  747. { Get the current remote folder                                 }
  748. { ------------------------------------------------------------- }
  749. function  TfrmMain.GetRemoteFolder() : string;
  750. begin
  751.   try
  752.     GetRemoteFolder := xFtp.CurrentFolder;
  753.   except
  754.     on xErr: Exception do
  755.       DisplayMessage(xErr.Message);
  756.   end;
  757. end;
  758.  
  759. { ------------------------------------------------------------- }
  760. { Change the current remote folder to the new one specifed by   }
  761. { the user.                                                     }
  762. { ------------------------------------------------------------- }
  763. function  TfrmMain.ChangeCurrentRemoteFolder(sNewCurrentFolder : string) : boolean;
  764. begin
  765.   ChangeCurrentRemoteFolder := false;
  766.   try
  767.     xFtp.ChangeCurrentFolder(sNewCurrentFolder);
  768.     ChangeCurrentRemoteFolder := true;
  769.     GetRemoteFolder();
  770.   except
  771.     on xErr: Exception do
  772.       DisplayMessage(xErr.Message);
  773.   end;
  774. end;
  775.  
  776. { ------------------------------------------------------------- }
  777. { Delete a file on the FTP server                               }
  778. { ------------------------------------------------------------- }
  779. procedure TfrmMain.DeleteSelectedRemoteFile();
  780. var
  781.   nCount        : integer;
  782.   xItem         : TListItem;
  783.   sFileToDelete : string;
  784. begin
  785.   if MessageDlg('Are you sure you want to delete the selected remote file(s)?',
  786.                 mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  787.   begin
  788.     nCount := 0;
  789.  
  790.     while nCount <  lstRemoteView.Items.Count do
  791.     begin
  792.       xItem := lstRemoteView.Items[nCount];
  793.       sFileToDelete := GetRemoteFolder() + '/' + xItem.Caption;
  794.       if xItem.Selected then
  795.       begin
  796.         try
  797.           xFtp.DeleteFile(sFileToDelete);
  798.         except
  799.           on xErr: Exception do
  800.             ShowMessage('Cannot delete ' + sFileToDelete);
  801.         end;
  802.       end;
  803.       nCount := nCount + 1;
  804.     end;
  805.     RefreshRemoteListView();
  806.   end;
  807. end;
  808.  
  809. { ------------------------------------------------------------- }
  810. { Rename a file on the FTP server                               }
  811. { ------------------------------------------------------------- }
  812. procedure TfrmMain.RenameRemoteFile();
  813. var
  814.   sCurrentName : string;
  815.   sNewName     : string;
  816. begin
  817.   sCurrentName := m_sCurrentRemotePath + '\' + lstRemoteView.Selected.Caption;
  818.  
  819.   if MessageDlg('Rename ' + sCurrentName + '?', mtConfirmation, [mbYes, mbNo],
  820.                 0) = mrYes then
  821.   begin
  822.     sNewName := InputBox('Xceed Ftp Client Sample', 'Enter the new name', '');
  823.     if sNewName <> '' then
  824.     begin
  825.       sNewName := m_sCurrentRemotePath + '\' + sNewName;
  826.       try
  827.         xFtp.RenameFile(sCurrentName, sNewName);
  828.         RefreshRemoteListView();
  829.       except
  830.         on xErr: Exception do
  831.           ShowMessage('Cannot rename ' + sCurrentName);
  832.       end;
  833.     end;
  834.   end;
  835. end;
  836.  
  837. { ------------------------------------------------------------- }
  838. { Create a new folder on the FTP server                         }
  839. { ------------------------------------------------------------- }
  840. procedure TfrmMain.CreateRemoteFolder();
  841. var
  842.   sFolderToCreate : string;
  843. begin
  844.   sFolderToCreate := InputBox('Xceed Ftp Client Sample', 'Enter the name of ' +
  845.                               'the new folder to create', '');
  846.   if sFolderToCreate <> '' then
  847.   begin
  848.     try
  849.       xFtp.CreateFolder(m_sCurrentRemotePath + '\' + sFolderToCreate);
  850.       RefreshRemoteListView();
  851.     except
  852.       on xErr: Exception do
  853.         ShowMessage('Unable to create ' + sFolderToCreate);
  854.     end;
  855.   end;
  856. end;
  857.  
  858. { ------------------------------------------------------------- }
  859. { Delete a folder on the FTP server                             }
  860. { ------------------------------------------------------------- }
  861. procedure TfrmMain.DeleteRemoteFolder();
  862. var
  863.   sFolderToDelete : string;
  864. begin
  865.   sFolderToDelete := m_sCurrentRemotePath + '\' + lstRemoteView.Selected.Caption;
  866.   if MessageDlg('Delete ' + sFolderToDelete + '?', mtConfirmation,
  867.                 [mbYes, mbNo], 0) = mrYes then
  868.   begin
  869.     try
  870.       xFtp.RemoveFolder(sFolderToDelete);
  871.       RefreshRemoteListView();
  872.     except
  873.       on xErr: Exception do
  874.         ShowMessage('Unable to delete ' + sFolderToDelete);
  875.     end;
  876.   end;
  877. end;
  878.  
  879. { ------------------------------------------------------------- }
  880. { The following procedure will read the contents of the         }
  881. { selected drive or folder. If the selected path is a file, the }
  882. { file's information will be also retrieved.                    }
  883. { ------------------------------------------------------------- }
  884. procedure TfrmMain.RetrieveLocalFolderContents(sPath : string);
  885. var
  886.   dtDate    : TDateTime;
  887.   lSize     : integer;
  888.   nAttrib   : integer;
  889.   SearchRec : TSearchRec;
  890.   nResult   : integer;
  891. begin
  892.   nResult := FindFirst(sPath + '*', faAnyFile, SearchRec);
  893.  
  894.   while (nResult = 0) do
  895.   begin
  896.     if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
  897.     begin
  898.       nAttrib := SearchRec.Attr;  { Attributes }
  899.       dtDate  := SearchRec.Time;  { Date }
  900.       lSize   := SearchRec.Size;  { Size }
  901.  
  902.       NewLocalEntry(SearchRec.Name, dtDate, lSize, nAttrib);
  903.     end;
  904.     nResult := FindNext(SearchRec); { Go to the next item }
  905.   end;
  906.   FindClose(SearchRec);
  907. end;
  908.  
  909. { ------------------------------------------------------------- }
  910. { Retrieve the logical drive names                              }
  911. { ------------------------------------------------------------- }
  912. procedure TfrmMain.RetrieveLogicalDrives();
  913. var
  914.   szDrives  : array[0..259] of char;
  915.   pszPos    : pchar;
  916.   sDrive    : string;
  917. begin
  918.   GetLogicalDriveStrings(260, szDrives);
  919.  
  920.   pszPos := szDrives;
  921.   while pszPos[0] > #0 do
  922.   begin
  923.     { Parse the string returned by the GetLogicalDriveStrings function }
  924.     sDrive := pszPos;
  925.     cboLocalPaths.Items.Add(sDrive);  { Add the drive to our local combo box }
  926.     pszPos := pszPos + StrLen(pszPos) + 1;
  927.   end;
  928. end;
  929.  
  930. { ------------------------------------------------------------- }
  931. { Delete the selected local file(s)                             }
  932. { ------------------------------------------------------------- }
  933. procedure TfrmMain.DeleteSelectedLocalFile();
  934. var
  935.   nCount        : integer;
  936.   xItem         : TListItem;
  937.   sFileToDelete : string;
  938. begin
  939.   if MessageDlg('Are you sure you want to delete the selected local file(s)?',
  940.                 mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  941.   begin
  942.     nCount := 0;
  943.  
  944.     while nCount <  lstLocalView.Items.Count do
  945.     begin
  946.       xItem := lstLocalView.Items[nCount];
  947.       sFileToDelete := m_sCurrentLocalPath + xItem.Caption;
  948.       if xItem.Selected then
  949.       begin
  950.         if not DeleteFile(sFileToDelete) then
  951.           ShowMessage('Cannot delete ' + sFileToDelete);
  952.       end;
  953.       nCount := nCount + 1;
  954.     end;
  955.     RefreshLocalListView();
  956.   end;
  957. end;
  958.  
  959. { ------------------------------------------------------------- }
  960. { Rename the selected local file                                }
  961. { ------------------------------------------------------------- } 
  962. procedure TfrmMain.RenameLocalFile();
  963. var
  964.   sCurrentName : string;
  965.   sNewName     : string;
  966. begin
  967.   sCurrentName := m_sCurrentLocalPath + lstLocalView.Selected.Caption;
  968.   If MessageDlg('Rename ' + sCurrentName + '?', mtConfirmation, [mbYes, mbNo],
  969.                 0) = mrYes then
  970.   begin
  971.     sNewName := InputBox('Xceed Ftp Client Sample', 'Enter the new name for ' +
  972.                          sCurrentName , '');
  973.  
  974.     if sNewName <> '' then
  975.     begin
  976.       If RenameFile(sCurrentName, m_sCurrentLocalPath + sNewName) then
  977.         RefreshLocalListView()
  978.       else
  979.         ShowMessage('Cannot rename ' + sCurrentName);
  980.     end;
  981.   end;
  982. end;
  983.  
  984. { ------------------------------------------------------------- }
  985. { Create a new local folder                                     }
  986. { ------------------------------------------------------------- }
  987. procedure TfrmMain.CreateLocalFolder();
  988. var
  989.   sNewFolder : string;
  990. begin
  991.   sNewFolder := InputBox('Xceed Ftp Client Sample', 'Enter the name of the ' +
  992.                          'folder to create.', '');
  993.   if sNewFolder <> '' then
  994.   begin
  995.     try
  996.       MkDir(m_sCurrentLocalPath + sNewFolder);
  997.       RefreshLocalListView();
  998.     except
  999.       on xErr : Exception do
  1000.         ShowMessage('Cannot create ' + m_sCurrentLocalPath + sNewFolder);
  1001.     end;
  1002.   end;
  1003. end;
  1004.  
  1005. { ------------------------------------------------------------- }
  1006. { Delete the selected local folder                              }
  1007. { ------------------------------------------------------------- }
  1008. procedure TfrmMain.DeleteLocalFolder();
  1009. var
  1010.   sFolderToDelete : string;
  1011. begin
  1012.   sFolderToDelete := m_sCurrentLocalPath + lstLocalView.Selected.Caption;
  1013.   if MessageDlg('Delete ' + sFolderToDelete + '?', mtConfirmation,
  1014.                 [mbYes, mbNo], 0) = mrYes then
  1015.   begin
  1016.     try
  1017.       RmDir(sFolderToDelete);
  1018.       RefreshLocalListView();
  1019.     except
  1020.       on xErr: Exception do
  1021.         ShowMessage('Cannot delete ' + sFolderToDelete);
  1022.     end;
  1023.   end;
  1024. end;
  1025.  
  1026. { ------------------------------------------------------------- }
  1027. procedure TfrmMain.FormCreate(Sender: TObject);
  1028. begin
  1029.   optBinary.Checked := true;  { Set binary as the default transfer mode }
  1030.   m_bReplaceAll := false;
  1031.  
  1032.   UpdateLocalState();
  1033.   UpdateRemoteState();
  1034.   UpdateConnectionState(false);
  1035.  
  1036.   RetrieveLogicalDrives();
  1037.  
  1038.   m_sCurrentLocalPath := 'C:\'; { the default local path }
  1039.   cboLocalPaths.Text := m_sCurrentLocalPath;
  1040.   RetrieveLocalFolderContents(m_sCurrentLocalPath);
  1041. end;
  1042.  
  1043. { ------------------------------------------------------------- }
  1044. { Sort the items in the list views depending on the image index }
  1045. { ------------------------------------------------------------- }
  1046. procedure TfrmMain.lstAnyViewCompare(Sender: TObject; Item1,
  1047.                                          Item2: TListItem; Data: Integer;
  1048.                                          var Compare: Integer);
  1049. begin
  1050.   if Item1.ImageIndex < Item2.ImageIndex then
  1051.     Compare := -1
  1052.   else if (Item1.ImageIndex = Item2.ImageIndex)and (UpperCase(Item1.Caption) <
  1053.            UpperCase(Item2.Caption)) then
  1054.     Compare := -1
  1055.   else
  1056.     Compare := 1;
  1057. end;
  1058.  
  1059. { ------------------------------------------------------------- }
  1060. { This procedure provides two possiblities. If the item         }
  1061. { selected is a file, it will call the SendFiles procedure and  }
  1062. { if the item selected is a folder, it will change the current  }
  1063. { local folder to the new folder and list it's contents.        }
  1064. { ------------------------------------------------------------- }
  1065. procedure TfrmMain.lstLocalViewDblClick(Sender: TObject);
  1066. var
  1067.   sSelectedItem : string;
  1068. begin
  1069.   if lstLocalView.SelCount > 0 then
  1070.   begin
  1071.     if lstLocalView.Selected.ImageIndex = 0 then  { Selected item is a folder }
  1072.     begin
  1073.       sSelectedItem := m_sCurrentLocalPath + lstLocalView.Selected.Caption + '\';
  1074.       ClearLocalListView();
  1075.       RetrieveLocalFolderContents(sSelectedItem);
  1076.       m_sCurrentLocalPath := sSelectedItem; { Set the new current local path }
  1077.  
  1078.       if not PathExists(m_sCurrentLocalPath, true) then
  1079.       begin
  1080.         cboLocalPaths.Items.Add(m_sCurrentLocalPath);
  1081.         cboLocalPaths.Text := m_sCurrentLocalPath;
  1082.       end
  1083.       else
  1084.         cboLocalPaths.Text := m_sCurrentLocalPath;
  1085.     end
  1086.     else  { Selected item is a file }
  1087.     begin
  1088.       if GetCurrentConnectionState = fstConnected then
  1089.         DoSendFiles();
  1090.     end;
  1091.   end;
  1092. end;
  1093.  
  1094. { ------------------------------------------------------------- }
  1095. { The items in the remote file list ListView control can be     }
  1096. { either files, folders or links.                               }
  1097. {                                                               }
  1098. { If the selected item is a file, then the ReceiveFiles         }
  1099. { procedure will be called. If it is a folder, then the current }
  1100. { remote folder will be changed and the new contents will be    }
  1101. { listed.                                                       }
  1102. {                                                               }
  1103. { If the item is a link, then it can either link to a file or a }
  1104. { folder. Since we do not have a way of determining beforehand  }
  1105. { if it is a file or a folder, we will first assume that it     }
  1106. { links to a folder and try to change the current               }
  1107. { remote folder. If this is successful, then we will list the   }
  1108. { contents of the new current remote folder. If this fails, we  }
  1109. { will consider the link to be a file and call the ReceiveFiles }
  1110. { method.                                                       }
  1111. { ------------------------------------------------------------- }
  1112. procedure TfrmMain.lstRemoteViewDblClick(Sender: TObject);
  1113. var
  1114.   sSelectedItem : string;
  1115. begin
  1116.   if lstRemoteView.SelCount > 0 then
  1117.   begin
  1118.     sSelectedItem := m_sCurrentRemotePath + '\' + lstRemoteView.Selected.Caption;
  1119.  
  1120.     case lstRemoteView.Selected.ImageIndex of
  1121.       0 : { Selected item is a folder }
  1122.         if ChangeCurrentRemoteFolder(sSelectedItem) then
  1123.         begin
  1124.           { Set the new remote path }
  1125.           m_sCurrentRemotePath := GetRemoteFolder();
  1126.           if not PathExists(m_sCurrentRemotePath,   false) then
  1127.             cboRemotePaths.Items.Add(m_sCurrentRemotePath);
  1128.  
  1129.           cboRemotePaths.Text := m_sCurrentRemotePath;
  1130.           ClearRemoteListView();
  1131.           RetrieveRemoteFolderContents();
  1132.         end;
  1133.       1 : { Selected item is a link }
  1134.         if ChangeCurrentRemoteFolder(sSelectedItem) then { Check if we can change folders into the link }
  1135.         begin
  1136.           { Yes, the link "links" to a folder so we set the new current remote path }
  1137.           m_sCurrentRemotePath := sSelectedItem;
  1138.           if not PathExists(m_sCurrentRemotePath,   false) then
  1139.             cboRemotePaths.Items.Add(m_sCurrentRemotePath);
  1140.           cboRemotePaths.Text := m_sCurrentRemotePath;
  1141.           ClearRemoteListView();
  1142.           RetrieveRemoteFolderContents();
  1143.         end
  1144.         else
  1145.           { Failed changing folders into the link. So the link "links" to a file. }
  1146.           DoReceiveFiles();
  1147.       2 : DoReceiveFiles(); { Selected item is a file }
  1148.     end;
  1149.   end;
  1150. end;
  1151.  
  1152. { ------------------------------------------------------------- }
  1153. { Change the current local folder to its parent folder and list }
  1154. { the contents of the parent folder.                            }
  1155. { ------------------------------------------------------------- }
  1156. procedure TfrmMain.btParentLocalFolderClick(Sender: TObject);
  1157. var
  1158.   sNewCurrentLocalPath : string;
  1159. begin
  1160.   if Length(m_sCurrentLocalPath) > 3 then { Check if not root }
  1161.   begin
  1162.     sNewCurrentLocalPath := Copy(m_sCurrentLocalPath, 0,
  1163.                                  Length(m_sCurrentLocalPath) - 1);
  1164.     sNewCurrentLocalPath := ExtractFilePath(sNewCurrentLocalPath);
  1165.  
  1166.     ClearLocalListView();
  1167.     RetrieveLocalFolderContents(sNewCurrentLocalPath);
  1168.     m_sCurrentLocalPath  := sNewCurrentLocalPath; { Set the new current local path }
  1169.     cboLocalPaths.Text   := m_sCurrentLocalPath;
  1170.     UpdateLocalState();
  1171.   end;
  1172. end;
  1173.  
  1174. { ------------------------------------------------------------- }
  1175.  procedure TfrmMain.btDeleteLocalFileClick(Sender: TObject);
  1176. begin
  1177.   DeleteSelectedLocalFile();
  1178. end;
  1179.  
  1180. { ------------------------------------------------------------- }
  1181. procedure TfrmMain.btRenameLocalFileClick(Sender: TObject);
  1182. begin
  1183.   RenameLocalFile();
  1184. end;
  1185.  
  1186. { ------------------------------------------------------------- }
  1187. procedure TfrmMain.btCreateLocalFolderClick(Sender: TObject);
  1188. begin
  1189.   CreateLocalFolder();
  1190. end;
  1191.  
  1192. { ------------------------------------------------------------- }
  1193. procedure TfrmMain.btDeleteLocalFolderClick(Sender: TObject);
  1194. begin
  1195.   DeleteLocalFolder();
  1196. end;
  1197.  
  1198. { ------------------------------------------------------------- }
  1199. procedure TfrmMain.miDeleteLocalFileClick(Sender: TObject);
  1200. begin
  1201.   DeleteSelectedLocalFile();
  1202. end;
  1203.  
  1204. { ------------------------------------------------------------- }
  1205. procedure TfrmMain.miRenameLocalFileClick(Sender: TObject);
  1206. begin
  1207.   RenameLocalFile();
  1208. end;
  1209.  
  1210. { ------------------------------------------------------------- }
  1211. procedure TfrmMain.miCreateLocalFolderClick(Sender: TObject);
  1212. begin
  1213.   CreateLocalFolder();
  1214. end;
  1215.  
  1216. { ------------------------------------------------------------- }
  1217. procedure TfrmMain.miDeleteLocalFolderClick(Sender: TObject);
  1218. begin
  1219.   DeleteLocalFolder();
  1220. end;
  1221.  
  1222. { ------------------------------------------------------------- }
  1223. { When a path is selected from the local paths combo box, this  }
  1224. { procedure is triggered to update the contents of the local    }
  1225. { file list ListView control                                    }
  1226. { ------------------------------------------------------------- }
  1227. procedure TfrmMain.cboLocalPathsClick(Sender: TObject);
  1228. var
  1229.   sPath : string;
  1230. begin
  1231.   sPath := cboLocalPaths.Items[cboLocalPaths.ItemIndex];
  1232.  
  1233.   ClearLocalListView();
  1234.   RetrieveLocalFolderContents(sPath);
  1235.  
  1236.   m_sCurrentLocalPath := sPath; { Set the new current local path }
  1237. end;
  1238.  
  1239. { ------------------------------------------------------------- }
  1240. { When a path is selected from the remote paths combo box, this }
  1241. { procedure is triggered to update the contents of the remote   }
  1242. { file list ListView control                                    }
  1243. { ------------------------------------------------------------- }
  1244. procedure TfrmMain.cboRemotePathsClick(Sender: TObject);
  1245. var
  1246.   sPath : string;
  1247. begin
  1248.   sPath := cboRemotePaths.Items[cboRemotePaths.ItemIndex];
  1249.  
  1250.   ChangeCurrentRemoteFolder(sPath);
  1251.   ClearRemoteListView();
  1252.   RetrieveRemoteFolderContents();
  1253.   m_sCurrentRemotePath := sPath;  { Set the enew remote path }
  1254. end;
  1255.  
  1256.  
  1257. { ------------------------------------------------------------- }
  1258. procedure TfrmMain.btConnectClick(Sender: TObject);
  1259. begin
  1260.   DoConnect();
  1261. end;
  1262.  
  1263. { ------------------------------------------------------------- }
  1264. procedure TfrmMain.miConnectClick(Sender: TObject);
  1265. begin
  1266.   DoConnect();
  1267. end;
  1268.  
  1269. { ------------------------------------------------------------- }
  1270. procedure TfrmMain.btDisconnectClick(Sender: TObject);
  1271. begin
  1272.   DoDisconnect();
  1273. end;
  1274.  
  1275. { ------------------------------------------------------------- }
  1276. procedure TfrmMain.miDisconnectClick(Sender: TObject);
  1277. begin
  1278.   DoDisconnect();
  1279. end;
  1280.  
  1281. { ------------------------------------------------------------- }
  1282. procedure TfrmMain.btAbortClick(Sender: TObject);
  1283. begin
  1284.   DoAbort();
  1285. end;
  1286.  
  1287. { ------------------------------------------------------------- }
  1288. procedure TfrmMain.miAbortClick(Sender: TObject);
  1289. begin
  1290.   DoAbort();
  1291. end;
  1292.  
  1293. { ------------------------------------------------------------- }
  1294. { Change the representation type to Binary                      }
  1295. { ------------------------------------------------------------- }
  1296. procedure TfrmMain.optBinaryClick(Sender: TObject);
  1297. begin
  1298.   try
  1299.     xFtp.RepresentationType := frtBinary;
  1300.   except
  1301.     on xErr: Exception do
  1302.       DisplayMessage(xErr.Message);
  1303.   end;
  1304. end;
  1305.  
  1306. { ------------------------------------------------------------- }
  1307. { Change the representation type to ASCII                       }
  1308. { ------------------------------------------------------------- }
  1309. procedure TfrmMain.optAsciiClick(Sender: TObject);
  1310. begin
  1311.   try
  1312.     xFtp.RepresentationType := frtASCII;
  1313.   except
  1314.     on xErr: Exception do
  1315.       DisplayMessage(xErr.Message);
  1316.   end;
  1317. end;
  1318.  
  1319. { ------------------------------------------------------------- }
  1320. procedure TfrmMain.btDeleteRemoteFileClick(Sender: TObject);
  1321. begin
  1322.   DeleteSelectedRemoteFile();
  1323. end;
  1324.  
  1325. { ------------------------------------------------------------- }
  1326. procedure TfrmMain.miDeleteRemoteFileClick(Sender: TObject);
  1327. begin
  1328.   DeleteSelectedRemoteFile();
  1329. end;
  1330.  
  1331. { ------------------------------------------------------------- }
  1332. procedure TfrmMain.btRenameRemoteFileClick(Sender: TObject);
  1333. begin
  1334.   RenameRemoteFile();
  1335. end;
  1336.  
  1337. { ------------------------------------------------------------- }
  1338. procedure TfrmMain.miRenameRemoteFileClick(Sender: TObject);
  1339. begin
  1340.   RenameRemoteFile();
  1341. end;
  1342.  
  1343. { ------------------------------------------------------------- }
  1344. procedure TfrmMain.btCreateRemoteFolderClick(Sender: TObject);
  1345. begin
  1346.   CreateRemoteFolder();
  1347. end;
  1348.  
  1349. { ------------------------------------------------------------- }
  1350. procedure TfrmMain.miCreateRemoteFolderClick(Sender: TObject);
  1351. begin
  1352.   CreateRemoteFolder();
  1353. end;
  1354.  
  1355. { ------------------------------------------------------------- }
  1356. procedure TfrmMain.btDeleteRemoteFolderClick(Sender: TObject);
  1357. begin
  1358.   DeleteRemoteFolder();
  1359. end;
  1360.  
  1361. { ------------------------------------------------------------- }
  1362. procedure TfrmMain.miDeleteRemoteFolderClick(Sender: TObject);
  1363. begin
  1364.   DeleteRemoteFolder();
  1365. end;
  1366.  
  1367. { ------------------------------------------------------------- }
  1368. procedure TfrmMain.pmiDeleteLocalFileClick(Sender: TObject);
  1369. begin
  1370.   DeleteSelectedLocalFile();
  1371. end;
  1372.  
  1373. { ------------------------------------------------------------- }
  1374. procedure TfrmMain.pmiRenameLocalFileClick(Sender: TObject);
  1375. begin
  1376.   RenameLocalFile();
  1377. end;
  1378.  
  1379. { ------------------------------------------------------------- }
  1380. procedure TfrmMain.pmiCreateLocalFolderClick(Sender: TObject);
  1381. begin
  1382.   CreateLocalFolder();
  1383. end;
  1384.  
  1385. { ------------------------------------------------------------- }
  1386. procedure TfrmMain.pmiDeleteLocalFolderClick(Sender: TObject);
  1387. begin
  1388.   DeleteLocalFolder();
  1389. end;
  1390.  
  1391. { ------------------------------------------------------------- }
  1392. procedure TfrmMain.pmiDeleteRemoteFileClick(Sender: TObject);
  1393. begin
  1394.   DeleteSelectedRemoteFile();
  1395. end;
  1396.  
  1397. { ------------------------------------------------------------- }
  1398. procedure TfrmMain.pmiRenameRemoteFileClick(Sender: TObject);
  1399. begin
  1400.   RenameRemoteFile();
  1401. end;
  1402.  
  1403. { ------------------------------------------------------------- }
  1404. procedure TfrmMain.pmiCreateRemoteFolderClick(Sender: TObject);
  1405. begin
  1406.   CreateRemoteFolder();
  1407. end;
  1408.  
  1409. { ------------------------------------------------------------- }
  1410. procedure TfrmMain.pmiDeleteRemoteFolderClick(Sender: TObject);
  1411. begin
  1412.   DeleteRemoteFolder();
  1413. end;
  1414.  
  1415. { ------------------------------------------------------------- }
  1416. { Change the current remote folder to its parent folder and     }
  1417. { list the contents of the parent folder                        }
  1418. { ------------------------------------------------------------- }
  1419. procedure TfrmMain.btParentRemoteFolderClick(Sender: TObject);
  1420. begin
  1421.   GetParentFolder();
  1422.   m_sCurrentRemotePath := GetRemoteFolder();  { Set the new current remote path }
  1423.   ClearRemoteListView();
  1424.   RetrieveRemoteFolderContents();
  1425.   cboRemotePaths.Text := m_sCurrentRemotePath;
  1426.   UpdateRemoteState();
  1427. end;
  1428.  
  1429. { ------------------------------------------------------------- }
  1430. procedure TfrmMain.btSendFilesClick(Sender: TObject);
  1431. begin
  1432.   DoSendFiles();
  1433. end;
  1434.  
  1435. { ------------------------------------------------------------- }
  1436. procedure TfrmMain.miSendClick(Sender: TObject);
  1437. begin
  1438.   DoSendFiles();
  1439. end;
  1440.  
  1441. { ------------------------------------------------------------- }
  1442. procedure TfrmMain.btReceiveFilesClick(Sender: TObject);
  1443. begin
  1444.   DoReceiveFiles();
  1445. end;
  1446.  
  1447. { ------------------------------------------------------------- }
  1448. procedure TfrmMain.miReceiveClick(Sender: TObject);
  1449. begin
  1450.   DoReceiveFiles();
  1451. end;
  1452.  
  1453. { ------------------------------------------------------------- }
  1454. procedure TfrmMain.lstLocalViewClick(Sender: TObject);
  1455. begin
  1456.   UpdateLocalState();
  1457. end;
  1458.  
  1459. { ------------------------------------------------------------- }
  1460. procedure TfrmMain.lstRemoteViewClick(Sender: TObject);
  1461. begin
  1462.   UpdateRemoteState();
  1463. end;
  1464.  
  1465. { ------------------------------------------------------------- }
  1466. procedure TfrmMain.xFtpDisconnected(Sender: TObject);
  1467. begin
  1468.   stbStatus.Panels[0].Text := 'Disconnected from server';
  1469. end;
  1470.  
  1471. { ------------------------------------------------------------- }
  1472. { The ListingFolderItem event is triggered by the               }
  1473. { ListFolderContents method and provides us with information on }
  1474. { every file, folder or link.                                   }
  1475. { ------------------------------------------------------------- }
  1476. procedure TfrmMain.xFtpListingFolderItem(Sender: TObject;
  1477.   const sName: WideString; dtDate: TDateTime; lFileSize: Integer;
  1478.   eItemType: TOleEnum; const sUserData: WideString);
  1479. begin
  1480.   NewRemoteEntry(sName, dtDate, lFileSize, eItemType);
  1481. end;
  1482.  
  1483. { ------------------------------------------------------------- }
  1484. { The FileTransferStatus event provides us with a variety of    }
  1485. { information regarding the transfer status of each individual  }
  1486. { file and the information on the global progress of the        }
  1487. { current operation.                                            }
  1488. { ------------------------------------------------------------- }
  1489. procedure TfrmMain.xFtpFileTransferStatus(Sender: TObject;
  1490.                                               const sLocalFilename, sRemoteFilename: WideString;
  1491.                                               lFileSize,lBytesTransferred: Integer;
  1492.                                               nBytesPercent: Smallint;
  1493.                                               lTotalSize, lTotalBytesTransferred: Integer;
  1494.                                               nTotalBytesPercent: Smallint;
  1495.                                               lTotalFiles, lTotalFilesTransferred: Integer;
  1496.                                               nTotalFilesPercent: Smallint;
  1497.                                               lBytesPerSecond, lTotalBytesPerSecond: Integer);
  1498. begin
  1499.   stbStatus.Panels[1].Text := 'Kb : ' + IntToStr((lBytesTransferred + 1023)
  1500.                                                      div 1024);
  1501.   stbStatus.Panels[2].Text := 'Total : ' + IntToStr((lTotalBytesTransferred
  1502.                                                      + 1023) div 1024);
  1503.   pgrProgess.Position := nTotalBytesPercent;
  1504. end;
  1505.  
  1506. { ------------------------------------------------------------- }
  1507. { The LoggingCommandLine event is triggered for every command   }
  1508. { sent and received from the FTP server. Instead of writing our }
  1509. { own custom messages for every possible action we will be      }
  1510. { using the information provided by the FTP server.             }
  1511. { ------------------------------------------------------------- }
  1512. procedure TfrmMain.xFtpLoggingCommandLine(Sender: TObject;
  1513.   const sLine: WideString; eCommandType: TOleEnum);
  1514. begin
  1515.   DisplayMessage(sLine);
  1516. end;
  1517.  
  1518. { ------------------------------------------------------------- }
  1519. { If an account is required the AccountRequired event will be   }
  1520. { triggered in order to prompt the user to enter the account    }
  1521. { information.                                                  }
  1522. { ------------------------------------------------------------- }
  1523. procedure TfrmMain.xFtpAccountRequired(Sender: TObject;
  1524.                                            var sAccountName: WideString);
  1525. var
  1526.   sNewAccountName : string;
  1527. begin
  1528.   sNewAccountName := InputBox('FTP Client sample application', 'Please enter a valid ' +
  1529.                               'account name.', '');
  1530.   if sNewAccountName <> '' then
  1531.   begin
  1532.     sAccountName := sNewAccountName;  { Set the new account name }
  1533.   end;
  1534. end;
  1535.  
  1536. { ------------------------------------------------------------- }
  1537. { If a password is required or if an invalid password was       }
  1538. { provided, the PasswordRequired event will be triggered.       }
  1539. { ------------------------------------------------------------- }
  1540. procedure TfrmMain.xFtpPasswordRequired(Sender: TObject;
  1541.                                             var sPassword: WideString);
  1542. var
  1543.   sNewPassword : string;
  1544. begin
  1545.   sNewPassword := InputBox('Xceed Ftp Client Sample', 'Please enter a valid ' +
  1546.                            'password.', '');
  1547.   if sNewPassword <> '' then
  1548.   begin
  1549.     sPassword := sNewPassword;  { Set the new password }
  1550.   end;
  1551. end;
  1552.  
  1553. { ------------------------------------------------------------- }
  1554. { The ReceivingFile event is triggered for every file that is   }
  1555. { about to be received and provides us with information         }
  1556. { regarding that file. It also gives us the option to change    }
  1557. { the filename of the file we are receiving.                    }
  1558. { ------------------------------------------------------------- }
  1559. procedure TfrmMain.xFtpReceivingFile(Sender: TObject;
  1560.   const sRemoteFilename: WideString; var sLocalFilename: WideString;
  1561.   lFileSize: Integer);
  1562. begin
  1563.   stbStatus.Panels[0].Text := 'Receiving ' + sRemoteFilename;
  1564. end;
  1565.  
  1566. { ------------------------------------------------------------- }
  1567. { If the file being received or sent exists, the ReplacingFile  }
  1568. { event gives us the option of overwriting, skipping it, etc... }
  1569. { ------------------------------------------------------------- }
  1570. procedure TfrmMain.xFtpReplacingFile(Sender: TObject;
  1571.                                          var sFilename: WideString;
  1572.                                          dtDate: TDateTime; lFileSize: Integer;
  1573.                                          const sRemoteFilename: WideString;
  1574.                                          var eAction: TOleEnum);
  1575. begin
  1576.   if m_bReplaceAll then
  1577.     eAction := fraOverwrite { Overwrite the existing file }
  1578.   else
  1579.   begin
  1580.     case MessageDlg(sFilename + ' already exists. Do you want to replace it?',
  1581.                     mtConfirmation, [mbYes, mbNo, mbAll], 0) of
  1582.       mrYes : eAction := fraOverwrite;   { Overwrite the existing file }
  1583.       mrNo  : eAction := fraSkip;       { Skip the existing file }
  1584.       mrAll :
  1585.         begin
  1586.           eAction := fraOverwrite; { Overwrite the existing file }
  1587.           m_bReplaceAll := true;
  1588.         end;
  1589.     end;
  1590.   end;
  1591. end;
  1592.  
  1593. { ------------------------------------------------------------ }
  1594. { The SendFile event is triggered for evert file that is about }
  1595. { to be sent and provides us with information regaring that    }
  1596. { file, It also gives us the option to change the filename of  }
  1597. { the file we are sending.                                     }
  1598. { ------------------------------------------------------------ }
  1599. procedure TfrmMain.xFtpSendingFile(Sender: TObject;
  1600.   const sLocalFilename: WideString; var sRemoteFilename: WideString;
  1601.   lFileSize: Integer);
  1602. begin
  1603.   stbStatus.Panels[0].Text := 'Sending ' + sRemoteFilename;
  1604. end;
  1605.  
  1606. { ------------------------------------------------------------- }
  1607. { For every file that is skipping, wether sending or            }
  1608. { receiveing, the SkippingFile event will be trigger to let us  }
  1609. { know which file is being skipped and for what reason.         }
  1610. { ------------------------------------------------------------- }
  1611. procedure TfrmMain.xFtpSkippingFile(Sender: TObject;
  1612.   const sLocalFilename, sRemoteFilename: WideString;
  1613.   lSkippingReason: Integer);
  1614. begin
  1615.   if sLocalFilename = '' then
  1616.     DisplayMessage(sRemoteFilename + ' was skipped. Reason #' + IntToStr
  1617.                    (lSkippingReason));
  1618.   if sRemoteFilename = ''then
  1619.     DisplayMessage(sLocalFilename + ' was skipped. Reason #' + IntToStr
  1620.                    (lSkippingReason));
  1621. end;
  1622.  
  1623. { ------------------------------------------------------------- }
  1624. { Only accept drag and drop in the remote listview control if   }
  1625. { the source is the local listview control and we are connected }
  1626. { the the FTP server                                            }
  1627. { ------------------------------------------------------------- }
  1628. procedure TfrmMain.lstRemoteViewDragOver(Sender, Source: TObject;
  1629.                                              X, Y: Integer; State: TDragState;
  1630.                                              var Accept: Boolean);
  1631. begin
  1632.   if (Source = lstLocalView) and (GetCurrentConnectionState = fstConnected) then
  1633.     Accept := true
  1634.   else
  1635.     Accept := false;
  1636. end;
  1637.  
  1638. { ------------------------------------------------------------- }
  1639. { Only accept drag and drop in the local listview control if    }
  1640. { the source is the remote                                      }
  1641. { ------------------------------------------------------------- }
  1642. procedure TfrmMain.lstLocalViewDragOver(Sender, Source: TObject;
  1643.                                             X, Y: Integer; State: TDragState;
  1644.                                             var Accept: Boolean);
  1645. begin
  1646.   if Source = lstRemoteView then
  1647.     Accept := true
  1648.   else
  1649.     Accept := false;
  1650. end;
  1651.  
  1652. { ------------------------------------------------------------- }
  1653. { If the files are "dropped" into the remote listview control,  }
  1654. { we will call the DoSendFiles procedure to send the files.     }
  1655. { If they are "dropped" into the local listview control, we     }
  1656. { call the DoReceiveFiles procedure whic will receive the files }
  1657. { ------------------------------------------------------------- }
  1658. procedure TfrmMain.lstDragDrop(Sender, Source: TObject; X, Y: Integer);
  1659. begin
  1660.   If Source = lstRemoteView then
  1661.     DoReceiveFiles()
  1662.   Else if Source = lstLocalView then
  1663.     DoSendFiles();
  1664. end;
  1665.  
  1666. { ------------------------------------------------------------- }
  1667. { If form is closed, make sure we disconnect!
  1668. { ------------------------------------------------------------- }
  1669. procedure TfrmMain.FormDestroy(Sender: TObject);
  1670. begin
  1671.   DoDisconnect();
  1672. end;
  1673. end.
  1674.  
  1675.