home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / nastroje / d5 / MFTP.ZIP / demo / ftppanel / main.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2001-03-05  |  8.6 KB  |  328 lines
  1. unit main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ImgList, FTPSock, Ftp, ComCtrls, FtpListView, FtpTreeView, ToolWin, ClipBrd,
  8.   StdCtrls, FtpMsg, FtpCache, ExtCtrls, Menus;
  9.  
  10. type
  11.   TfrmMain = class(TForm)
  12.     ToolBar1: TToolBar;
  13.     ToolButton1: TToolButton;
  14.     ToolButton2: TToolButton;
  15.     MFtpTreeView1: TMFtpTreeView;
  16.     MFtp1: TMFtp;
  17.     ImageList1: TImageList;
  18.     ToolButton3: TToolButton;
  19.     ToolButton4: TToolButton;
  20.     ToolButton5: TToolButton;
  21.     ToolButton6: TToolButton;
  22.     ToolButton7: TToolButton;
  23.     ToolButton8: TToolButton;
  24.     ToolButton9: TToolButton;
  25.     ToolButton10: TToolButton;
  26.     OpenDialog1: TOpenDialog;
  27.     SaveDialog1: TSaveDialog;
  28.     ToolButton11: TToolButton;
  29.     ToolButton13: TToolButton;
  30.     Splitter1: TSplitter;
  31.     Notebook1: TNotebook;
  32.     MFtpListView1: TMFtpListView;
  33.     Splitter2: TSplitter;
  34.     MFtpMessenger1: TMFtpMessenger;
  35.     ProgressBar1: TProgressBar;
  36.     StatusBar1: TStatusBar;
  37.     PopupMenu1: TPopupMenu;
  38.     LargeIcons1: TMenuItem;
  39.     SmallIcons1: TMenuItem;
  40.     List1: TMenuItem;
  41.     Details1: TMenuItem;
  42.     N1: TMenuItem;
  43.     CopyLocation1: TMenuItem;
  44.     procedure ToolButton10Click(Sender: TObject);
  45.     procedure ToolButton8Click(Sender: TObject);
  46.     procedure ToolButton1Click(Sender: TObject);
  47.     procedure ToolButton2Click(Sender: TObject);
  48.     procedure MFtp1FtpBusy(Sender: TObject);
  49.     procedure MFtp1FtpReady(Sender: TObject);
  50.     procedure MFtp1LoggedIn(Sender: TObject);
  51.     procedure MFtp1DirectoryChanged(Sender: TObject);
  52.     procedure MFtp1ContentChanged(Sender: TObject);
  53.     procedure ToolButton6Click(Sender: TObject);
  54.     procedure MFtpListView1DblClick(Sender: TObject);
  55.     procedure MFtpListView1Edited(Sender: TObject; Item: TListItem;
  56.       var S: String);
  57.     procedure ToolButton11Click(Sender: TObject);
  58.     procedure ToolButton4Click(Sender: TObject);
  59.     procedure ToolButton5Click(Sender: TObject);
  60.     procedure MFtp1FtpInfo(Sender: TObject; info: FtpInfo;
  61.       addinfo: String);
  62.     procedure MFtp1FtpQuit(Sender: TObject);
  63.     procedure MFtpListView1FileDropped(Sender: TObject);
  64.     procedure MFtp1FtpError(Sender: TObject; error: FtpError;
  65.       addinfo: String);
  66.     procedure ViewmenuClick(Sender: TObject);
  67.     procedure MFtpListView1InfoTip(Sender: TObject; Item: TListItem;
  68.       var InfoTip: String);
  69.     procedure FormCreate(Sender: TObject);
  70.     procedure CopyLocation1Click(Sender: TObject);
  71.     procedure PopupMenu1Popup(Sender: TObject);
  72.     procedure MFtp1FtpNeedInfo(Sender: TObject; need: TMFtpInfoNeeded;
  73.       var Value: String);
  74.   private
  75.     { Private declarations }
  76.   public
  77.     { Public declarations }
  78.   end;
  79.  
  80. var
  81.    frmMain: TfrmMain;
  82.  
  83. function Strip(S: String): String;
  84.  
  85. implementation
  86.  
  87. {$define DISPLAY_PARENT_DIRECTORY}
  88.  
  89. uses connect, confirm, banner;
  90.  
  91. {$R *.DFM}
  92.  
  93. procedure TfrmMain.ToolButton10Click(Sender: TObject);
  94. begin
  95.    MFtp1.Abort;
  96. end;
  97.  
  98. procedure TfrmMain.ToolButton8Click(Sender: TObject);
  99. begin
  100.    MFtp1.ChangeToParentDirectory;
  101. end;
  102.  
  103. procedure TfrmMain.ToolButton1Click(Sender: TObject);
  104. begin
  105.    if MFtp1.Connected then Exit;
  106.    frmConnect.ShowModal;
  107. end;
  108.  
  109. procedure TfrmMain.ToolButton2Click(Sender: TObject);
  110. begin
  111.    MFtp1.Disconnect;
  112. end;
  113.  
  114. procedure TfrmMain.MFtp1FtpBusy(Sender: TObject);
  115. begin
  116.    Cursor := crDefault;
  117.    MFtpListView1.Accept := False;
  118. end;
  119.  
  120. procedure TfrmMain.MFtp1FtpReady(Sender: TObject);
  121. begin
  122.    Cursor := crDefault;
  123.    ProgressBar1.Visible := False;
  124.    StatusBar1.Visible := True;
  125.    MFtpListView1.Accept := True;
  126. end;
  127.  
  128. procedure TfrmMain.MFtp1LoggedIn(Sender: TObject);
  129. begin
  130.    MFtp1.Refresh;
  131. end;
  132.  
  133. procedure TfrmMain.MFtp1DirectoryChanged(Sender: TObject);
  134. begin
  135.    MFtp1.Refresh;
  136. end;
  137.  
  138. procedure TfrmMain.MFtp1ContentChanged(Sender: TObject);
  139. begin
  140.    {we want to refresh cache}
  141.    if not MFtp1.Connected then Exit;
  142.    with MFtp1 do
  143.    begin
  144.       Cache := False;
  145.       Refresh;
  146.       Cache := True;
  147.    end;
  148. end;
  149.  
  150. procedure TfrmMain.ToolButton6Click(Sender: TObject);
  151. begin
  152.    if MFtpListview1.SelectedFiles.Count > 0 then
  153.       MFtp1.DeleteFile(MFtpListview1.SelectedFiles[0]);
  154.  
  155.    if MFtpListview1.SelectedDirectories.Count > 0 then
  156.       MFtp1.DeleteDirectory(MFtpListview1.SelectedDirectories[0]);
  157. end;
  158.  
  159. procedure TfrmMain.MFtpListView1DblClick(Sender: TObject);
  160. begin
  161.    if MFtpListview1.SelectedDirectories.Count > 0 then
  162.       {$ifdef DISPLAY_PARENT_DIRECTORY}
  163.       if (MFtpListview1.Items[0].Caption = 'Parent Directory') and
  164.          (MFtpListview1.SelectedDirectories[0] = 'Parent Directory') then
  165.          MFtp1.ChangeToParentDirectory
  166.       else
  167.          MFtp1.ChangeDirectory(MFtpListview1.SelectedDirectories[0]);
  168.       {$else}
  169.       MFtp1.ChangeDirectory(MFtpListview1.SelectedDirectories[0]);
  170.       {$endif}
  171. end;
  172.  
  173. procedure TfrmMain.MFtpListView1Edited(Sender: TObject; Item: TListItem;
  174.   var S: String);
  175. begin
  176.    MFtp1.RenameFile(Item.Caption, S);
  177. end;
  178.  
  179. procedure TfrmMain.ToolButton11Click(Sender: TObject);
  180. var S: String;
  181. begin
  182.    if InputQuery('FTP Panel', 'What name is the new directory?', S) then
  183.       MFtp1.CreateDirectory(S);
  184. end;
  185.  
  186. procedure TfrmMain.ToolButton4Click(Sender: TObject);
  187. begin
  188.    if MFtpListview1.SelectedFiles.Count > 0 then
  189.    begin
  190.       with SaveDialog1 do
  191.       begin
  192.          Filename := MFtpListview1.SelectedFiles[0];
  193.          if Execute then MFtp1.GetFile(MFtpListview1.SelectedFiles[0], Filename);
  194.          ProgressBar1.Visible := True;
  195.          StatusBar1.Visible := False;
  196.       end;
  197.    end;
  198. end;
  199.  
  200. procedure TfrmMain.ToolButton5Click(Sender: TObject);
  201. begin
  202.    with OpenDialog1 do
  203.    begin
  204.       if Execute then
  205.       begin
  206.          MFtp1.PutFile(Filename, Strip(Filename));
  207.          ProgressBar1.Visible := True;
  208.          StatusBar1.Visible := False;
  209.       end;
  210.    end;
  211. end;
  212.  
  213. procedure TfrmMain.MFtp1FtpInfo(Sender: TObject; info: FtpInfo;
  214.   addinfo: String);
  215. begin
  216.    case info of
  217.       ftpBannerAvailable:
  218.       begin
  219.          frmBanner.Banner.Lines.Assign(MFtp1.Banner);
  220.          frmBanner.Show;
  221.       end;
  222.       ftpDataTrace:
  223.          if ProgressBar1.Visible then
  224.             ProgressBar1.Position := MFtp1.BytesTransferred;
  225.       ftpFileSize:
  226.          ProgressBar1.Max := StrToInt(addinfo);
  227.    end;
  228. end;
  229.  
  230. procedure TfrmMain.MFtp1FtpError(Sender: TObject; error: FtpError;
  231.   addinfo: String);
  232. begin
  233.    ProgressBar1.Visible := False;
  234.    StatusBar1.Visible := True;   
  235. end;
  236.  
  237. procedure TfrmMain.MFtp1FtpQuit(Sender: TObject);
  238. begin
  239.    MFtpTreeView1.Sites.Clear;
  240.    MFtpListView1.Items.Clear;
  241. end;
  242.  
  243. procedure TfrmMain.MFtpListView1FileDropped(Sender: TObject);
  244. var i: Integer;
  245.     R: TStringList;
  246. begin
  247.    R := TStringList.Create;
  248.    with R do
  249.    try
  250.       for i := 0 to MFtpListView1.FileDropped.Count - 1 do
  251.          Add(Strip(MFtpListView1.FileDropped[i]));
  252.  
  253.       MFtp1.PutFile(MFtpListView1.FileDropped, R);
  254.       ProgressBar1.Visible := True;
  255.       StatusBar1.Visible := False;
  256.    finally
  257.       Free;
  258.    end;
  259. end;
  260.  
  261. procedure TfrmMain.ViewmenuClick(Sender: TObject);
  262. begin
  263.    MFtpListview1.ViewStyle := TViewStyle(TMenuItem(Sender).Tag);
  264.    TMenuItem(Sender).Checked := True;
  265. end;
  266.  
  267. procedure TfrmMain.MFtpListView1InfoTip(Sender: TObject; Item: TListItem;
  268.   var InfoTip: String);
  269. begin
  270.    InfoTip := Item.Caption;
  271. end;
  272.  
  273. procedure TfrmMain.FormCreate(Sender: TObject);
  274. begin
  275.    // clear outdated cache
  276.    CleanCache(True, True, 7);
  277. end;
  278.  
  279. procedure TfrmMain.CopyLocation1Click(Sender: TObject);
  280. begin
  281.    with TClipBoard.Create do
  282.    try
  283.       if MFtpListView1.SelectedDirectories.Count = 1 then
  284.          SetTextBuf(PChar(MFtp1.URL + MFtpListView1.SelectedDirectories[0] + '/'))
  285.       else
  286.          SetTextBuf(PChar(MFtp1.URL + MFtpListView1.SelectedFiles[0]));
  287.    finally
  288.       Free;
  289.    end;
  290. end;
  291.  
  292. procedure TfrmMain.PopupMenu1Popup(Sender: TObject);
  293. begin
  294.    CopyLocation1.Enabled := (MFtpListView1.SelCount > 0);
  295. end;
  296.  
  297. function Strip;
  298. var i: Integer;
  299. begin
  300.    if Pos('\', S) > 0 then
  301.    begin
  302.       for i := Length(S) downto 1 do
  303.          if S[i] = '\' then Break;
  304.  
  305.       Result := Copy(S, i + 1, 999);
  306.    end
  307.    else
  308.       Result := S;
  309. end;
  310.  
  311. procedure TfrmMain.MFtp1FtpNeedInfo(Sender: TObject; need: TMFtpInfoNeeded;
  312.   var Value: String);
  313. begin
  314.    if need = niOverwrite then
  315.    begin
  316.       frmConfirm.Button1.Enabled := MFtp1.SupportResume;
  317.       frmConfirm.Label1.Caption := MFtpListView1.SelectedFiles[0] + ' already exists.';
  318.       frmConfirm.ShowModal;
  319.       case Tag of
  320.          0: Value := 'Resume';
  321.          1: Value := 'Overwrite';
  322.          2: Value := 'Cancel';
  323.       end;
  324.    end;
  325. end;
  326.  
  327. end.
  328.