home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / DEMOS / INTERNET / FTP / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-04  |  13.0 KB  |  470 lines
  1. unit main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Buttons, StdCtrls, ComCtrls, OleCtrls, Menus, ExtCtrls, isp3;
  8.  
  9. const
  10.   FTPServer = 0;
  11.   Folder = 1;
  12.   OpenFolder = 2;
  13.  
  14. type
  15.   TMainForm = class(TForm)
  16.     Bevel1: TBevel;
  17.     Panel1: TPanel;
  18.     Panel2: TPanel;
  19.     Panel3: TPanel;
  20.     StatusBar: TStatusBar;
  21.     FileList: TListView;
  22.     DirTree: TTreeView;
  23.     ConnectBtn: TSpeedButton;
  24.     FTP: TFTP;
  25.     RefreshBtn: TSpeedButton;
  26.     MainMenu1: TMainMenu;
  27.     FileMenu: TMenuItem;
  28.     FileNewItem: TMenuItem;
  29.     FileDeleteItem: TMenuItem;
  30.     FileRenameItem: TMenuItem;
  31.     N2: TMenuItem;
  32.     FileExitItem: TMenuItem;
  33.     View1: TMenuItem;
  34.     ViewLargeItem: TMenuItem;
  35.     ViewSmallItem: TMenuItem;
  36.     ViewListItem: TMenuItem;
  37.     ViewDetailsItem: TMenuItem;
  38.     N1: TMenuItem;
  39.     ViewRefreshItem: TMenuItem;
  40.     FilePopup: TPopupMenu;
  41.     DeleteItem: TMenuItem;
  42.     RenameItem: TMenuItem;
  43.     CopyItem: TMenuItem;
  44.     Bevel2: TBevel;
  45.     Label1: TLabel;
  46.     Bevel3: TBevel;
  47.     Bevel5: TBevel;
  48.     Label2: TLabel;
  49.     SaveDialog1: TSaveDialog;
  50.     CopyButton: TSpeedButton;
  51.     LargeBtn: TSpeedButton;
  52.     SmallBtn: TSpeedButton;
  53.     ListBtn: TSpeedButton;
  54.     DetailsBtn: TSpeedButton;
  55.     Tools1: TMenuItem;
  56.     ToolsConnectItem: TMenuItem;
  57.     ToolsDisconnectItem: TMenuItem;
  58.     FileCopyItem: TMenuItem;
  59.     PasteFromItem: TMenuItem;
  60.     OpenDialog1: TOpenDialog;
  61.     SmallImages: TImageList;
  62.     procedure ConnectBtnClick(Sender: TObject);
  63.     procedure FTPProtocolStateChanged(Sender: TObject;
  64.       ProtocolState: Smallint);
  65.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  66.     procedure FormCreate(Sender: TObject);
  67.     procedure FTPBusy(Sender: TObject; isBusy: Wordbool);
  68.     procedure DirTreeChange(Sender: TObject; Node: TTreeNode);
  69.     procedure RefreshBtnClick(Sender: TObject);
  70.     procedure DirTreeChanging(Sender: TObject; Node: TTreeNode;
  71.       var AllowChange: Boolean);
  72.     procedure FTPStateChanged(Sender: TObject; State: Smallint);
  73.     procedure Open1Click(Sender: TObject);
  74.     procedure FileExitItemClick(Sender: TObject);
  75.     procedure FormResize(Sender: TObject);
  76.     procedure ViewLargeItemClick(Sender: TObject);
  77.     procedure ViewSmallItemClick(Sender: TObject);
  78.     procedure ViewListItemClick(Sender: TObject);
  79.     procedure ViewDetailsItemClick(Sender: TObject);
  80.     procedure ViewRefreshItemClick(Sender: TObject);
  81.     procedure CopyItemClick(Sender: TObject);
  82.     procedure ToolsDisconnectItemClick(Sender: TObject);
  83.     procedure FileNewItemClick(Sender: TObject);
  84.     procedure DeleteItemClick(Sender: TObject);
  85.     procedure PasteFromItemClick(Sender: TObject);
  86.     procedure FilePopupPopup(Sender: TObject);
  87.     procedure FileMenuClick(Sender: TObject);
  88.     procedure FileDeleteItemClick(Sender: TObject);
  89.     procedure FTPListItem(Sender: TObject; const Item: FTPDirItem);
  90.   private
  91.     Root: TTreeNode;
  92.     function CreateItem(const FileName, Attributes, Size, Date: Variant): TListItem;
  93.     procedure Disconnect;
  94.   public
  95.     function NodePath(Node: TTreeNode): String;
  96.   end;
  97.  
  98. var
  99.   MainForm: TMainForm;
  100.   UserName,
  101.   Pwd: String;
  102.  
  103. implementation
  104.  
  105. {$R *.DFM}
  106.  
  107. uses ShellAPI, UsrInfo;
  108.  
  109. function FixCase(Path: String): String;
  110. var
  111.   OrdValue: byte;
  112. begin
  113.   if Length(Path) = 0 then exit;
  114.   OrdValue := Ord(Path[1]);
  115.   if (OrdValue >= Ord('a')) and (OrdValue <= Ord('z')) then
  116.     Result := Path
  117.   else
  118.   begin
  119.     Result := AnsiLowerCaseFileName(Path);
  120.     Result[1] := UpCase(Result[1]);
  121.   end;
  122. end;
  123.  
  124. procedure TMainForm.ConnectBtnClick(Sender: TObject);
  125. begin
  126.   if FTP.State = prcConnected then
  127.     Disconnect;
  128.   ConnectForm := TConnectForm.Create(Self);
  129.   try
  130.     if ConnectForm.ShowModal = mrOk then
  131.       with FTP, ConnectForm do
  132.       begin
  133.         UserName := UserNameEdit.Text;
  134.         Pwd := PasswordEdit.Text;
  135.         RemoteHost := RemoteHostEdit.Text;
  136.         RemotePort := StrToInt(RemotePortEdit.Text);
  137.         Connect(RemoteHost, RemotePort);
  138.         Root := DirTree.Items.AddChild(nil, RemoteHost);
  139.         Root.ImageIndex := FTPServer;
  140.         Root.SelectedIndex := FTPServer;
  141.         DirTree.Selected := Root;
  142.       end;
  143.   finally
  144.     ConnectForm.Free;
  145.   end;
  146. end;
  147.  
  148. procedure TMainForm.FTPProtocolStateChanged(Sender: TObject;
  149.   ProtocolState: Smallint);
  150. begin
  151.   case ProtocolState of
  152.     ftpAuthentication: FTP.Authenticate(UserName, Pwd);
  153.     ftpTransaction: FTP.List('/');
  154.   end;
  155. end;
  156.  
  157. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  158. begin
  159.   if FTP.Busy then
  160.   begin
  161.     FTP.Cancel;
  162.     FTP.Quit;
  163.     while FTP.Busy do
  164.       Application.ProcessMessages;
  165.   end;
  166. end;
  167.  
  168. function TMainForm.CreateItem(const FileName, Attributes, Size, Date: Variant): TListItem;
  169. var
  170.   Ext: String;
  171.   ShFileInfo: TSHFILEINFO;
  172. begin
  173.   Result := FileList.Items.Add;
  174.   with Result do
  175.   begin
  176.     Caption := FixCase(Trim(FileName));
  177.     if Size > 0 then
  178.     begin
  179.       if Size div 1024 <> 0 then
  180.       begin
  181.         SubItems.Add(IntToStr(Size div 1024));
  182.         SubItems[0] := SubItems[0] + 'KB';
  183.       end
  184.       else
  185.         SubItems.Add(Size);
  186.     end
  187.     else
  188.       SubItems.Add('');
  189.     if Attributes = '1' then
  190.     begin
  191.       SubItems.Add('File Folder');
  192.       ImageIndex := 3;
  193.     end
  194.     else
  195.     begin
  196.       Ext := ExtractFileExt(FileName);
  197.       ShGetFileInfo(PChar('c:\*' + Ext), 0, SHFileInfo, SizeOf(SHFileInfo),
  198.         SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME);
  199.       if Length(SHFileInfo.szTypeName) = 0 then
  200.       begin
  201.         if Length(Ext) > 0 then
  202.         begin
  203.           System.Delete(Ext, 1, 1);
  204.           SubItems.Add(Ext + ' File');
  205.         end
  206.         else
  207.           SubItems.Add('File');
  208.       end
  209.       else
  210.         SubItems.Add(SHFileInfo.szTypeName);
  211.       ImageIndex := SHFileInfo.iIcon;
  212.     end;
  213.     SubItems.Add(Date);
  214.   end;
  215. end;
  216.  
  217. procedure TMainForm.Disconnect;
  218. begin
  219.   FTP.Quit;
  220.   Application.ProcessMessages;
  221. end;
  222.  
  223. procedure TMainForm.FormCreate(Sender: TObject);
  224. var
  225.   SHFileInfo: TSHFileInfo;
  226. begin
  227.   with DirTree do
  228.   begin
  229.     DirTree.Images := SmallImages;
  230.     SmallImages.ResourceLoad(rtBitmap, 'IMAGES', clOlive);
  231.   end;
  232.   with FileList do
  233.   begin
  234.     SmallImages := TImageList.CreateSize(16,16);
  235.     SmallImages.ShareImages := True;
  236.     SmallImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,
  237.       SizeOf(SHFileInfo), SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);
  238.     LargeImages := TImageList.Create(nil);
  239.     LargeImages.ShareImages := True;
  240.     LargeImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,
  241.       SizeOf(SHFileInfo), SHGFI_LARGEICON or SHGFI_ICON or SHGFI_SYSICONINDEX);
  242.   end;
  243. end;
  244.  
  245. procedure TMainForm.FTPBusy(Sender: TObject; isBusy: Wordbool);
  246. begin
  247.   if isBusy then
  248.   begin
  249.     Screen.Cursor := crHourGlass;
  250.     FileList.Items.BeginUpdate;
  251.     FileList.Items.Clear;
  252.   end
  253.   else
  254.   begin
  255.     Screen.Cursor := crDefault;
  256.     FileList.Items.EndUpdate;
  257.   end;
  258. end;
  259.  
  260. function TMainForm.NodePath(Node: TTreeNode): String;
  261. begin
  262.   if Node = Root then
  263.     Result := '.'
  264.   else
  265.     Result := NodePath(Node.Parent) + '/' + Node.Text;
  266. end;
  267.  
  268. procedure TMainForm.DirTreeChange(Sender: TObject; Node: TTreeNode);
  269. var
  270.   NP: String;
  271. begin
  272.   if (FTP.State <> prcConnected) or FTP.Busy then exit;
  273.   if Node <> nil then
  274.   begin
  275.     NP := NodePath(DirTree.Selected);
  276.     FTP.List(NP);
  277.     Label2.Caption := Format('Contents of: ''%s/''',[NP]);
  278.   end;
  279. end;
  280.  
  281. procedure TMainForm.RefreshBtnClick(Sender: TObject);
  282. begin
  283.   FTP.List(NodePath(DirTree.Selected));
  284. end;
  285.  
  286. procedure TMainForm.DirTreeChanging(Sender: TObject; Node: TTreeNode;
  287.   var AllowChange: Boolean);
  288. begin
  289.   AllowChange := not FTP.Busy;
  290. end;
  291.  
  292. procedure TMainForm.FTPStateChanged(Sender: TObject; State: Smallint);
  293. begin
  294.   with FTP, Statusbar.Panels[0] do
  295.     case State of
  296.       prcConnecting   : Text := 'Connecting';
  297.       prcResolvingHost: Text := 'Connecting';
  298.       prcHostResolved : Text := 'Host resolved';
  299.       prcConnected    :
  300.         begin
  301.           Text := 'Connected to: ' + RemoteHost;
  302.           ConnectBtn.Hint := 'Disconnect';
  303.           FileNewItem.Enabled := True;
  304.           ViewLargeItem.Enabled := True;
  305.           ViewSmallItem.Enabled := True;
  306.           ViewListItem.Enabled := True;
  307.           ViewDetailsItem.Enabled := True;
  308.           ViewRefreshItem.Enabled := True;
  309.           ToolsDisconnectItem.Enabled := True;
  310.           LargeBtn.Enabled := True;
  311.           SmallBtn.Enabled := True;
  312.           ListBtn.Enabled := True;
  313.           DetailsBtn.Enabled := True;
  314.           RefreshBtn.Enabled := True;
  315.         end;
  316.       prcDisconnecting: Text := 'Disconnecting';
  317.       prcDisconnected :
  318.         begin
  319.           Text := 'Disconnected';
  320.           ConnectBtn.Hint := 'Connect';
  321.           DirTree.Items.Clear;
  322.           FileNewItem.Enabled := False;
  323.           ViewLargeItem.Enabled := False;
  324.           ViewSmallItem.Enabled := False;
  325.           ViewListItem.Enabled := False;
  326.           ViewDetailsItem.Enabled := False;
  327.           ViewRefreshItem.Enabled := False;
  328.           ToolsDisconnectItem.Enabled := False;
  329.           LargeBtn.Enabled := False;
  330.           SmallBtn.Enabled := False;
  331.           ListBtn.Enabled := False;
  332.           DetailsBtn.Enabled := False;
  333.           RefreshBtn.Enabled := False;
  334.         end;
  335.     end;
  336. end;
  337.  
  338. procedure TMainForm.Open1Click(Sender: TObject);
  339. begin
  340.   FTP.Quit;
  341.   DirTree.Items.BeginUpdate;
  342.   try
  343.     DirTree.Items.Clear;
  344.   finally
  345.     DirTree.Items.EndUpdate;
  346.   end;
  347. end;
  348.  
  349. procedure TMainForm.FileExitItemClick(Sender: TObject);
  350. begin
  351.   Close;
  352. end;
  353.  
  354. procedure TMainForm.FormResize(Sender: TObject);
  355. begin
  356.   Statusbar.Panels[0].Width := Width - 150;
  357. end;
  358.  
  359. procedure TMainForm.ViewLargeItemClick(Sender: TObject);
  360. begin
  361.   FileList.ViewStyle := vsIcon;
  362. end;
  363.  
  364. procedure TMainForm.ViewSmallItemClick(Sender: TObject);
  365. begin
  366.   FileList.ViewStyle := vsSmallIcon;
  367. end;
  368.  
  369. procedure TMainForm.ViewListItemClick(Sender: TObject);
  370. begin
  371.   FileList.ViewStyle := vsList;
  372. end;
  373.  
  374. procedure TMainForm.ViewDetailsItemClick(Sender: TObject);
  375. begin
  376.   FileList.ViewStyle := vsReport;
  377. end;
  378.  
  379. procedure TMainForm.ViewRefreshItemClick(Sender: TObject);
  380. begin
  381.   DirTreeChange(nil, DirTree.Selected);
  382. end;
  383.  
  384. procedure TMainForm.CopyItemClick(Sender: TObject);
  385. begin
  386.   SaveDialog1.FileName := FileList.Selected.Caption;
  387.   if SaveDialog1.Execute then
  388.     FTP.GetFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption,
  389.       SaveDialog1.FileName);
  390. end;
  391.  
  392. procedure TMainForm.ToolsDisconnectItemClick(Sender: TObject);
  393. begin
  394.   DisConnect;
  395. end;
  396.  
  397. procedure TMainForm.FileNewItemClick(Sender: TObject);
  398. var
  399.   DirName: String;
  400. begin
  401.   if InputQuery('Input Box', 'Prompt', DirName) then
  402.     FTP.CreateDir(NodePath(DirTree.Selected) + '/' + DirName);
  403. end;
  404.  
  405. procedure TMainForm.DeleteItemClick(Sender: TObject);
  406. begin
  407.   if ActiveControl = DirTree then
  408.     FTP.DeleteDir(NodePath(DirTree.Selected));
  409.   if ActiveControl = FileList then
  410.     FTP.DeleteFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption);
  411. end;
  412.  
  413. procedure TMainForm.PasteFromItemClick(Sender: TObject);
  414. begin
  415.   if OpenDialog1.Execute then
  416.     FTP.PutFile(OpenDialog1.FileName, NodePath(DirTree.Selected));
  417. end;
  418.  
  419. procedure TMainForm.FilePopupPopup(Sender: TObject);
  420. begin
  421.   CopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  422.   PasteFromItem.Enabled := (ActiveControl = DirTree) and (DirTree.Selected <> nil);
  423.   DeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  424.   RenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  425. end;
  426.  
  427. procedure TMainForm.FileMenuClick(Sender: TObject);
  428. begin
  429.   FileCopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  430.   FileDeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  431.   FileRenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  432. end;
  433.  
  434. procedure TMainForm.FileDeleteItemClick(Sender: TObject);
  435. begin
  436.   if (DirTree.Selected <> nil) and (FileList.Selected <> nil) then
  437.     FTP.DeleteFile(FileList.Selected.Caption);
  438. end;
  439.  
  440. procedure TMainForm.FTPListItem(Sender: TObject; const Item: FTPDirItem);
  441. var
  442.   Node: TTreeNode;
  443. begin
  444.   CreateItem(Item.FileName, Item.Attributes, Item.Size, Item.Date);
  445.   if Item.Attributes = 1 then
  446.     if DirTree.Selected <> nil then
  447.      begin
  448.        if DirTree.Selected <> nil then
  449.          Node := DirTree.Selected.GetFirstChild
  450.        else
  451.          Node := nil;
  452.        while Node <> nil do
  453.          if AnsiCompareFileName(Node.Text, Item.FileName) = 0 then
  454.            exit
  455.          else
  456.            Node := DirTree.Selected.GetNextChild(Node);
  457.        if Node = nil then
  458.        begin
  459.          Node := DirTree.Items.AddChild(DirTree.Selected,
  460.            Item.FileName);
  461.          Node.ImageIndex := Folder;
  462.          Node.SelectedIndex := OpenFolder;
  463.        end;
  464.      end
  465.      else
  466.        DirTree.Items.AddChild(Root, Item.FileName);
  467. end;
  468.  
  469. end.
  470.