home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 February / DPPCPRO0299.ISO / February / Delphi / Runimage / DELPHI20 / DEMOS / INTERNET / FTP / MAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-06-10  |  13.1 KB  |  475 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, ISP;
  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 FTPListItem(Sender: TObject; const Item: Variant);
  64.     procedure FTPProtocolStateChanged(Sender: TObject;
  65.       ProtocolState: Smallint);
  66.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  67.     procedure FormCreate(Sender: TObject);
  68.     procedure FTPBusy(Sender: TObject; isBusy: Wordbool);
  69.     procedure DirTreeChange(Sender: TObject; Node: TTreeNode);
  70.     procedure RefreshBtnClick(Sender: TObject);
  71.     procedure DirTreeChanging(Sender: TObject; Node: TTreeNode;
  72.       var AllowChange: Boolean);
  73.     procedure FTPStateChanged(Sender: TObject; State: Smallint);
  74.     procedure Open1Click(Sender: TObject);
  75.     procedure FileExitItemClick(Sender: TObject);
  76.     procedure FormResize(Sender: TObject);
  77.     procedure ViewLargeItemClick(Sender: TObject);
  78.     procedure ViewSmallItemClick(Sender: TObject);
  79.     procedure ViewListItemClick(Sender: TObject);
  80.     procedure ViewDetailsItemClick(Sender: TObject);
  81.     procedure ViewRefreshItemClick(Sender: TObject);
  82.     procedure CopyItemClick(Sender: TObject);
  83.     procedure ToolsDisconnectItemClick(Sender: TObject);
  84.     procedure FileNewItemClick(Sender: TObject);
  85.     procedure DeleteItemClick(Sender: TObject);
  86.     procedure PasteFromItemClick(Sender: TObject);
  87.     procedure FilePopupPopup(Sender: TObject);
  88.     procedure FileMenuClick(Sender: TObject);
  89.     procedure FileDeleteItemClick(Sender: TObject);
  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 := LowerCase(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.FTPListItem(Sender: TObject; const Item: Variant);
  149. var
  150.   AnItem: TListItem;
  151.   Node: TTreeNode;
  152. begin
  153.   CreateItem(Item.FileName, Item.Attributes, Item.Size, Item.Date);
  154.   if Item.Attributes = 1 then
  155.     if DirTree.Selected <> nil then
  156.      begin
  157.        if DirTree.Selected <> nil then
  158.          Node := DirTree.Selected.GetFirstChild
  159.        else
  160.          Node := nil;
  161.        while Node <> nil do
  162.          if CompareText(Node.Text, Item.FileName) = 0 then
  163.            exit
  164.          else
  165.            Node := DirTree.Selected.GetNextChild(Node);
  166.        if Node = nil then
  167.        begin
  168.          Node := DirTree.Items.AddChild(DirTree.Selected,
  169.            Item.FileName);
  170.          Node.ImageIndex := Folder;
  171.          Node.SelectedIndex := OpenFolder;
  172.        end;
  173.      end
  174.      else
  175.        DirTree.Items.AddChild(Root, Item.FileName);
  176. end;
  177.  
  178. procedure TMainForm.FTPProtocolStateChanged(Sender: TObject;
  179.   ProtocolState: Smallint);
  180. begin
  181.   case ProtocolState of
  182.     ftpAuthentication: FTP.Authenticate(UserName, Pwd);
  183.     ftpTransaction: FTP.List('/');
  184.   end;
  185. end;
  186.  
  187. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  188. begin
  189.   FTP.Cancel;
  190.   FTP.Quit;
  191.   while FTP.Busy do
  192.     Application.ProcessMessages;
  193. end;
  194.  
  195. function TMainForm.CreateItem(const FileName, Attributes, Size, Date: Variant): TListItem;
  196. var
  197.   Ext: String;
  198.   ShFileInfo: TSHFILEINFO;
  199. begin
  200.   Result := FileList.Items.Add;
  201.   with Result do
  202.   begin
  203.     Caption := FixCase(Trim(FileName));
  204.     if Size > 0 then
  205.     begin
  206.       if Size div 1024 <> 0 then
  207.       begin
  208.         SubItems.Add(IntToStr(Size div 1024));
  209.         SubItems[0] := SubItems[0] + 'KB';
  210.       end
  211.       else
  212.         SubItems.Add(Size);
  213.     end
  214.     else
  215.       SubItems.Add('');
  216.     if Attributes = '1' then
  217.     begin
  218.       SubItems.Add('File Folder');
  219.       ImageIndex := 3;
  220.     end
  221.     else
  222.     begin
  223.       Ext := ExtractFileExt(FileName);
  224.       ShGetFileInfo(PChar('c:\*' + Ext), 0, SHFileInfo, SizeOf(SHFileInfo),
  225.         SHGFI_SMALLICON or SHGFI_SYSICONINDEX or SHGFI_TYPENAME);
  226.       if Length(SHFileInfo.szTypeName) = 0 then
  227.       begin
  228.         if Length(Ext) > 0 then
  229.         begin
  230.           System.Delete(Ext, 1, 1);
  231.           SubItems.Add(Ext + ' File');
  232.         end
  233.         else
  234.           SubItems.Add('File');
  235.       end
  236.       else
  237.         SubItems.Add(SHFileInfo.szTypeName);
  238.       ImageIndex := SHFileInfo.iIcon;
  239.     end;
  240.     SubItems.Add(Date);
  241.   end;
  242. end;
  243.  
  244. procedure TMainForm.Disconnect;
  245. begin
  246.   FTP.Quit;
  247.   Application.ProcessMessages;
  248. end;
  249.  
  250. procedure TMainForm.FormCreate(Sender: TObject);
  251. var
  252.   SHFileInfo: TSHFileInfo;
  253.   i: Char;
  254.   Node: TTreeNode;
  255. begin
  256.   with DirTree do
  257.   begin
  258.     DirTree.Images := SmallImages;
  259.     SmallImages.ResourceLoad(rtBitmap, 'IMAGES', clOlive);
  260.   end;
  261.   with FileList do
  262.   begin
  263.     SmallImages := TImageList.CreateSize(16,16);
  264.     SmallImages.ShareImages := True;
  265.     SmallImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,
  266.       SizeOf(SHFileInfo), SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX);
  267.     LargeImages := TImageList.Create(nil);
  268.     LargeImages.ShareImages := True;
  269.     LargeImages.Handle := ShGetFileInfo('*.*', 0, SHFileInfo,
  270.       SizeOf(SHFileInfo), SHGFI_LARGEICON or SHGFI_ICON or SHGFI_SYSICONINDEX);
  271.   end;
  272. end;
  273.  
  274. procedure TMainForm.FTPBusy(Sender: TObject; isBusy: Wordbool);
  275. begin
  276.   if isBusy then
  277.   begin
  278.     Screen.Cursor := crHourGlass;
  279.     FileList.Items.BeginUpdate;
  280.     FileList.Items.Clear;
  281.   end
  282.   else
  283.   begin
  284.     Screen.Cursor := crDefault;
  285.     FileList.Items.EndUpdate;
  286.   end;
  287. end;
  288.  
  289. function TMainForm.NodePath(Node: TTreeNode): String;
  290. begin
  291.   if Node = Root then
  292.     Result := '.'
  293.   else
  294.     Result := NodePath(Node.Parent) + '/' + Node.Text;
  295. end;
  296.  
  297. procedure TMainForm.DirTreeChange(Sender: TObject; Node: TTreeNode);
  298. var
  299.   NP: String;
  300.   i: Integer;
  301. begin
  302.   if (FTP.State = prcDisconnected) or FTP.Busy then exit;
  303.   if Node <> nil then
  304.   begin
  305.     NP := NodePath(DirTree.Selected);
  306.     FTP.List(NP);
  307.     Label2.Caption := Format('Contents of: ''%s/''',[NP]);
  308.   end;
  309. end;
  310.  
  311. procedure TMainForm.RefreshBtnClick(Sender: TObject);
  312. begin
  313.   FTP.List(NodePath(DirTree.Selected));
  314. end;
  315.  
  316. procedure TMainForm.DirTreeChanging(Sender: TObject; Node: TTreeNode;
  317.   var AllowChange: Boolean);
  318. begin
  319.   AllowChange := not FTP.Busy;
  320. end;
  321.  
  322. procedure TMainForm.FTPStateChanged(Sender: TObject; State: Smallint);
  323. begin
  324.   with FTP, Statusbar.Panels[0] do
  325.     case State of
  326.       prcConnecting   : Text := 'Connecting';
  327.       prcResolvingHost: Text := 'Connecting';
  328.       prcHostResolved : Text := 'Host resolved';
  329.       prcConnected    :
  330.         begin
  331.           Text := 'Connected to: ' + RemoteHost;
  332.           ConnectBtn.Hint := 'Disconnect';
  333.           FileNewItem.Enabled := True;
  334.           ViewLargeItem.Enabled := True;
  335.           ViewSmallItem.Enabled := True;
  336.           ViewListItem.Enabled := True;
  337.           ViewDetailsItem.Enabled := True;
  338.           ViewRefreshItem.Enabled := True;
  339.           ToolsDisconnectItem.Enabled := True;
  340.           LargeBtn.Enabled := True;
  341.           SmallBtn.Enabled := True;
  342.           ListBtn.Enabled := True;
  343.           DetailsBtn.Enabled := True;
  344.           RefreshBtn.Enabled := True;
  345.         end;
  346.       prcDisconnecting: Text := 'Disconnecting';
  347.       prcDisconnected :
  348.         begin
  349.           Text := 'Disconnected';
  350.           ConnectBtn.Hint := 'Connect';
  351.           DirTree.Items.Clear;
  352.           FileNewItem.Enabled := False;
  353.           ViewLargeItem.Enabled := False;
  354.           ViewSmallItem.Enabled := False;
  355.           ViewListItem.Enabled := False;
  356.           ViewDetailsItem.Enabled := False;
  357.           ViewRefreshItem.Enabled := False;
  358.           ToolsDisconnectItem.Enabled := False;
  359.           LargeBtn.Enabled := False;
  360.           SmallBtn.Enabled := False;
  361.           ListBtn.Enabled := False;
  362.           DetailsBtn.Enabled := False;
  363.           RefreshBtn.Enabled := False;
  364.         end;
  365.     end;
  366. end;
  367.  
  368. procedure TMainForm.Open1Click(Sender: TObject);
  369. begin
  370.   FTP.Quit;
  371.   DirTree.Items.BeginUpdate;
  372.   try
  373.     DirTree.Items.Clear;
  374.   finally
  375.     DirTree.Items.EndUpdate;
  376.   end;
  377. end;
  378.  
  379. procedure TMainForm.FileExitItemClick(Sender: TObject);
  380. begin
  381.   FTP.Quit;
  382.   Application.ProcessMessages;
  383.   while FTP.Busy do
  384.     Application.ProcessMessages;
  385.   Close;
  386. end;
  387.  
  388. procedure TMainForm.FormResize(Sender: TObject);
  389. begin
  390.   Statusbar.Panels[0].Width := Width - 150;
  391. end;
  392.  
  393. procedure TMainForm.ViewLargeItemClick(Sender: TObject);
  394. begin
  395.   FileList.ViewStyle := vsIcon;
  396. end;
  397.  
  398. procedure TMainForm.ViewSmallItemClick(Sender: TObject);
  399. begin
  400.   FileList.ViewStyle := vsSmallIcon;
  401. end;
  402.  
  403. procedure TMainForm.ViewListItemClick(Sender: TObject);
  404. begin
  405.   FileList.ViewStyle := vsList;
  406. end;
  407.  
  408. procedure TMainForm.ViewDetailsItemClick(Sender: TObject);
  409. begin
  410.   FileList.ViewStyle := vsReport;
  411. end;
  412.  
  413. procedure TMainForm.ViewRefreshItemClick(Sender: TObject);
  414. begin
  415.   DirTreeChange(nil, DirTree.Selected);
  416. end;
  417.  
  418. procedure TMainForm.CopyItemClick(Sender: TObject);
  419. begin
  420.   SaveDialog1.FileName := FileList.Selected.Caption;
  421.   if SaveDialog1.Execute then
  422.     FTP.GetFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption,
  423.       SaveDialog1.FileName);
  424. end;
  425.  
  426. procedure TMainForm.ToolsDisconnectItemClick(Sender: TObject);
  427. begin
  428.   DisConnect;
  429. end;
  430.  
  431. procedure TMainForm.FileNewItemClick(Sender: TObject);
  432. var
  433.   DirName: String;
  434. begin
  435.   if InputQuery('Input Box', 'Prompt', DirName) then
  436.     FTP.CreateDir(NodePath(DirTree.Selected) + '/' + DirName);
  437. end;
  438.  
  439. procedure TMainForm.DeleteItemClick(Sender: TObject);
  440. begin
  441.   if ActiveControl = DirTree then
  442.     FTP.DeleteDir(NodePath(DirTree.Selected));
  443.   if ActiveControl = FileList then
  444.     FTP.DeleteFile(NodePath(DirTree.Selected) + '/' + FileList.Selected.Caption);
  445. end;
  446.  
  447. procedure TMainForm.PasteFromItemClick(Sender: TObject);
  448. begin
  449.   if OpenDialog1.Execute then
  450.     FTP.PutFile(OpenDialog1.FileName, NodePath(DirTree.Selected));
  451. end;
  452.  
  453. procedure TMainForm.FilePopupPopup(Sender: TObject);
  454. begin
  455.   CopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  456.   PasteFromItem.Enabled := (ActiveControl = DirTree) and (DirTree.Selected <> nil);
  457.   DeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  458.   RenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  459. end;
  460.  
  461. procedure TMainForm.FileMenuClick(Sender: TObject);
  462. begin
  463.   FileCopyItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  464.   FileDeleteItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  465.   FileRenameItem.Enabled := (ActiveControl = FileList) and (FileList.Selected <> nil);
  466. end;
  467.  
  468. procedure TMainForm.FileDeleteItemClick(Sender: TObject);
  469. begin
  470.   if (DirTree.Selected <> nil) and (FileList.Selected <> nil) then
  471.     FTP.DeleteFile(FileList.Selected.Caption);
  472. end;
  473.  
  474. end.
  475.