home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / intmail2 / ftpmain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-02  |  13.4 KB  |  489 lines
  1. unit Ftpmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, Buttons, Menus, IniFiles,
  8. {$IFDEF VER120}
  9.   ImgList,
  10. {$ENDIF}
  11.   msFTP, msFTPCls, Mssocket, msWSock, ComCtrls, StdCtrls, msDef;
  12.  
  13. type
  14.   TFTPForm = class(TForm)
  15.     ToolBar: TPanel;
  16.     ConnectButton: TSpeedButton;
  17.     DisconnectButton: TSpeedButton;
  18.     ChDirButton: TSpeedButton;
  19.     UpdButton: TSpeedButton;
  20.     RetrieveFileButton: TSpeedButton;
  21.     StoreFileButton: TSpeedButton;
  22.     MkDirButton: TSpeedButton;
  23.     DeleteButton: TSpeedButton;
  24.     CancelButton: TSpeedButton;
  25.     ExitButton: TSpeedButton;
  26.     MainMenu1: TMainMenu;
  27.     File1: TMenuItem;
  28.     Connect1: TMenuItem;
  29.     Disconnect1: TMenuItem;
  30.     Retrieve1: TMenuItem;
  31.     Store1: TMenuItem;
  32.     Cancel1: TMenuItem;
  33.     N1: TMenuItem;
  34.     Exit1: TMenuItem;
  35.     Directory1: TMenuItem;
  36.     Change1: TMenuItem;
  37.     ChangeUp1: TMenuItem;
  38.     Create1: TMenuItem;
  39.     Help1: TMenuItem;
  40.     About1: TMenuItem;
  41.     OpenDialog1: TOpenDialog;
  42.     SaveDialog1: TSaveDialog;
  43.     RenameButton: TSpeedButton;
  44.     Rename1: TMenuItem;
  45.     Delete1: TMenuItem;
  46.     StatusBar: TStatusBar;
  47.     LogMemo: TMemo;
  48.     LogOnOffButton: TSpeedButton;
  49.     FTPListView: TListView;
  50.     ImageList1: TImageList;
  51.     msFTPClient1: TmsFTPClient;
  52.     procedure FormCreate(Sender: TObject);
  53.     procedure ConnectButtonClick(Sender: TObject);
  54.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  55.     procedure About1Click(Sender: TObject);
  56.     procedure ExitButtonClick(Sender: TObject);
  57.     procedure RetrieveFileButtonClick(Sender: TObject);
  58.     procedure StoreFileButtonClick(Sender: TObject);
  59.     procedure UpdButtonClick(Sender: TObject);
  60.     procedure MkDirButtonClick(Sender: TObject);
  61.     procedure ChDirButtonClick(Sender: TObject);
  62.     procedure DisconnectButtonClick(Sender: TObject);
  63.     procedure RenameButtonClick(Sender: TObject);
  64.     procedure CancelButtonClick(Sender: TObject);
  65.     procedure DeleteButtonClick(Sender: TObject);
  66.     procedure FTPListViewDblClick(Sender: TObject);
  67.     procedure agFTP1LineTransmitted(Sender: TObject; const TheLine: String);
  68.     procedure LogOnOffButtonClick(Sender: TObject);
  69.     procedure msFTPClient1DataTransferStart(Sender: TObject);
  70.     procedure msFTPClient1DataTransferTerminate(Sender: TObject);
  71.     procedure msFTPClient1Connecting(Sender: TObject);
  72.     procedure msFTPClient1Connected(Sender: TObject);
  73.     procedure msFTPClient1Disconnected(Sender: TObject);
  74.     procedure msFTPClient1DataTransferProgress(Sender: TObject;
  75.       ByteCount: Longint);
  76.   private
  77.     { Private declarations }
  78.     IniName : string;
  79.     FTPEntry : TmsFTPDirEntry;
  80.     TheFileSize : LongInt;
  81.     procedure EnableControls;
  82.     procedure DisableControls;
  83.     function GetFileSize(const FileName : string) : LongInt;
  84.     procedure FillFTPListView;
  85.     procedure UpdateFTPListView;
  86.   public
  87.     { Public declarations }
  88.   end;
  89.  
  90. var
  91.   FTPForm: TFTPForm;
  92.  
  93. implementation
  94.  
  95. uses FtpConn, msAbout, ftptrans;
  96.  
  97. {$R *.DFM}
  98.  
  99. procedure TFTPForm.EnableControls;
  100. var
  101.   i : Integer;
  102.   Btn : TSpeedButton;
  103. begin
  104.   with ToolBar do
  105.   begin
  106.     for i:=0 to ControlCount-1 do
  107.     if Controls[i] is TSpeedButton then
  108.     begin
  109.       Btn:=(Controls[i] as TSpeedButton);
  110.       if Btn.Tag=1 then Btn.Enabled:=true
  111.       else
  112.       if Btn.Tag>=2 then Btn.Enabled:=false;
  113.     end;
  114.   end;
  115.   Directory1.Enabled:=false;
  116.   for i:=0 to File1.Count-1 do
  117.   begin
  118.     if File1[i].Tag=1 then File1[i].Enabled:=true
  119.     else
  120.     if File1[i].Tag=2 then File1[i].Enabled:=false;
  121.   end;
  122. end;
  123.  
  124. procedure TFTPForm.DisableControls;
  125. var
  126.   i : Integer;
  127.   Btn : TSpeedButton;
  128. begin
  129.   with ToolBar do
  130.   begin
  131.     for i:=0 to ControlCount-1 do
  132.     if Controls[i] is TSpeedButton then
  133.     begin
  134.       Btn:=(Controls[i] as TSpeedButton);
  135.       if Btn.Tag=1 then
  136.        Btn.Enabled:=false
  137.       else
  138.        Btn.Enabled:=true;
  139.     end;
  140.   end;
  141.   Directory1.Enabled:=true;
  142.   for i:=0 to File1.Count-1 do
  143.   begin
  144.     if File1[i].Tag=1 then File1[i].Enabled:=false
  145.     else
  146.     if File1[i].Tag>=2 then File1[i].Enabled:=true;
  147.   end;
  148. end;
  149.  
  150. procedure TFTPForm.FormCreate(Sender: TObject);
  151. begin
  152.   EnableControls;
  153.   IniName:=ChangeFileExt(Application.ExeName,'.ini');
  154.   with TIniFile.Create(IniName) do
  155.   try
  156.     msFTPClient1.Host:=ReadString('Setup','Server','ftp.borland.com');
  157.     msFTPClient1.UserName:=ReadString('Setup','User Name','anonymous');
  158.     msFTPClient1.Password:=ReadString('Setup','Password','guest@');
  159.     msFTPClient1.TransferType:=TmsTransferType(ReadInteger('Setup','Transfer Type',0));
  160.     msFTPClient1.PassiveMode:=ReadBool('Setup','Passive Mode',false);
  161.     msFTPClient1.LogFileName:=ReadString('Setup','Log File','');
  162.     LogOnOffButton.Down:=ReadBool('Setup','Log Memo',true);
  163.     msFTPClient1.Proxy:=ReadString('Setup','Proxy Server','');
  164.     msFTPClient1.ProxyType:=TmsProxyType(ReadInteger('Setup','Proxy Type',0));
  165.     LogMemo.Visible:=LogOnOffButton.Down;
  166.   finally
  167.     free;
  168.   end;
  169. end;
  170.  
  171. procedure TFTPForm.ConnectButtonClick(Sender: TObject);
  172. var
  173.   Proceed : boolean;
  174.   i : Integer;
  175. begin
  176.   Proceed:=false;
  177.   with TFTPConnectDlg.Create(Self) do
  178.   try
  179.     ServerEdit.Text:=msFTPClient1.Host;
  180.     UserNameEdit.Text:=msFTPClient1.UserName;
  181.     PasswordEdit.Text:=msFTPClient1.Password;
  182.     TransferTypeComboBox.ItemIndex:=Ord(msFTPClient1.TransferType);
  183.     PassiveModeCheckBox.Checked:=msFTPClient1.PassiveMode;
  184.     LogFileNameEdit.Text:=msFTPClient1.LogFileName;
  185.     i:=Pos(':',msFTPClient1.Proxy);
  186.     if i>0 then
  187.     begin
  188.       ProxyServerEdit.Text:=Copy(msFTPClient1.Proxy,1,i-1);
  189.       ProxyPortEdit.Text:=Copy(msFTPClient1.Proxy,i+1,Length(msFTPClient1.Proxy));
  190.     end
  191.     else
  192.     begin
  193.       ProxyServerEdit.Text:=msFTPClient1.Proxy;
  194.       ProxyPortEdit.Text:='21';
  195.     end;
  196.     ServerTypeRadioGroup.ItemIndex:=Ord(msFTPClient1.ProxyType);
  197.     if ShowModal=mrOK then
  198.     begin
  199.       Proceed:=true;
  200.       msFTPClient1.Host:=ServerEdit.Text;
  201.       msFTPClient1.UserName:=UserNameEdit.Text;
  202.       msFTPClient1.Password:=PasswordEdit.Text;
  203.       msFTPClient1.TransferType:=TmsTransferType(TransferTypeComboBox.ItemIndex);
  204.       msFTPClient1.PassiveMode:=PassiveModeCheckBox.Checked;
  205.       msFTPClient1.LogFileName:=LogFileNameEdit.Text;
  206.       msFTPClient1.Proxy:=ProxyServerEdit.Text+':'+Trim(ProxyPortEdit.Text);
  207.       msFTPClient1.ProxyType:=TmsProxyType(ServerTypeRadioGroup.ItemIndex);
  208.     end;
  209.   finally
  210.     Free;
  211.   end;
  212.   if Proceed then
  213.   begin
  214.     msFTPClient1.Login;
  215.     UpdateFTPListView;
  216.   end;
  217. end;
  218.  
  219. procedure TFTPForm.FormClose(Sender: TObject; var Action: TCloseAction);
  220. begin
  221. //  if msFTPClient1.OnLine then
  222. //    msFTPClient1.Logout;
  223.   with TIniFile.Create(IniName) do
  224.   try
  225.     WriteString('Setup','Server',msFTPClient1.Host);
  226.     WriteString('Setup','User Name',msFTPClient1.UserName);
  227.     WriteString('Setup','Password',msFTPClient1.Password);
  228.     WriteInteger('Setup','Transfer Type',Ord(msFTPClient1.TransferType));
  229.     WriteBool('Setup','Passive Mode',msFTPClient1.PassiveMode);
  230.     WriteString('Setup','Log File',msFTPClient1.LogFileName);
  231.     WriteBool('Setup','Log Memo',LogOnOffButton.Down);
  232.     WriteString('Setup','Proxy Server',msFTPClient1.Proxy);
  233.     WriteInteger('Setup','Proxy Type',Ord(msFTPClient1.ProxyType));
  234.   finally
  235.     free;
  236.   end;
  237. end;
  238.  
  239. procedure TFTPForm.About1Click(Sender: TObject);
  240. begin
  241.   with TAboutDlg.Create(Self) do
  242.   try
  243.     ProgramName.Caption:='TmsFTPClient Component Demo';
  244.     ProductVersion.Caption:=msVersion;
  245.     ShowModal;
  246.   finally
  247.     Free;
  248.   end;
  249. end;
  250.  
  251. procedure TFTPForm.ExitButtonClick(Sender: TObject);
  252. begin
  253.   Close;
  254. end;
  255.  
  256. procedure TFTPForm.FillFTPListView;
  257. var
  258.   Item : TListItem;
  259.   i : Integer;
  260. begin
  261.   for i:=0 to msFTPClient1.DirList.Count-1 do
  262.   begin
  263.     FTPEntry:=msFTPClient1.DirList[i];
  264.     Item:=FTPListView.Items.Add;
  265.     Item.Caption:=FTPEntry.FileName;
  266.     Item.SubItems.Add(IntToStr(FTPEntry.Size));
  267.     Item.SubItems.Add(DateTimeToStr(FTPEntry.Date));
  268.     Item.StateIndex:=Ord(FTPEntry.Kind)-1;
  269.   end;
  270. end;
  271.  
  272. procedure TFTPForm.UpdateFTPListView;
  273. begin
  274.   FTPListView.Items.Clear;
  275.   msFTPClient1.GetDirList;
  276.   FillFTPListView;
  277. end;
  278.  
  279. procedure TFTPForm.RetrieveFileButtonClick(Sender: TObject);
  280. begin
  281.   if FTPListView.Selected<>nil then
  282.   begin
  283.     FTPEntry:=msFTPClient1.DirList[FTPListView.Selected.Index];
  284.     if (FTPEntry.FileName<>'') and (FTPEntry.Kind=fkFile) then
  285.     begin
  286.       SaveDialog1.FileName:=FTPEntry.FileName;
  287.       if SaveDialog1.Execute then
  288.       begin
  289.         TheFileSize:=FTPEntry.Size;
  290.         if TheFileSize=-1 then
  291.           TheFileSize:=msFTPClient1.GetFileSize(FTPEntry.FileName);
  292.         msFTPClient1.RetrieveFile(FTPEntry.FileName,SaveDialog1.FileName);
  293.       end;
  294.     end;
  295.   end;
  296. end;
  297.  
  298. function TFTPForm.GetFileSize(const FileName : string) : LongInt;
  299. var
  300.   f : file;
  301. begin
  302.   AssignFile(f,FileName);
  303.   Reset(f,1);
  304.   try
  305.     Result:=FileSize(f);
  306.   finally
  307.     CloseFile(f);
  308.   end;
  309. end;
  310.  
  311. procedure TFTPForm.StoreFileButtonClick(Sender: TObject);
  312. begin
  313.   if OpenDialog1.Execute then
  314.   begin
  315.     TheFileSize:=GetFileSize(OpenDialog1.FileName);
  316.     msFTPClient1.StoreFile(OpenDialog1.FileName,ExtractFileName(OpenDialog1.FileName));
  317.     UpdateFTPListView;
  318.   end;
  319. end;
  320.  
  321. procedure TFTPForm.UpdButtonClick(Sender: TObject);
  322. begin
  323.   msFTPClient1.ChangeToUpperDirectory;
  324.   UpdateFTPListView;
  325. end;
  326.  
  327. procedure TFTPForm.MkDirButtonClick(Sender: TObject);
  328. var
  329.   DirName : string;
  330. begin
  331.   DirName:='';
  332.   if InputQuery('Create Directory','Type a Name of Directory:',DirName) then
  333.   begin
  334.     msFTPClient1.MakeDirectory(DirName);
  335.     UpdateFTPListView;
  336.   end;
  337. end;
  338.  
  339. procedure TFTPForm.ChDirButtonClick(Sender: TObject);
  340. var
  341.   DirName : string;
  342. begin
  343.   DirName:='';
  344.   if InputQuery('Change Directory','Type a Name of Directory:',DirName) then
  345.   begin
  346.     msFTPClient1.ChangeDirectory(DirName);
  347.     UpdateFTPListView;
  348.   end;
  349. end;
  350.  
  351. procedure TFTPForm.DisconnectButtonClick(Sender: TObject);
  352. begin
  353.   msFTPClient1.Logout;
  354. //  EnableControls;
  355.   FTPListView.Items.Clear;
  356. end;
  357.  
  358. procedure TFTPForm.RenameButtonClick(Sender: TObject);
  359. var
  360.   OldName, NewName : string;
  361. begin
  362.   if FTPListView.Selected<>nil then
  363.   begin
  364.     FTPEntry:=msFTPClient1.DirList[FTPListView.Selected.Index];
  365.     if FTPEntry.Kind=fkLink then Exit;
  366.     OldName:=FTPEntry.FileName;
  367.     NewName:='';
  368.     if OldName<>'' then
  369.     begin
  370.       if FTPEntry.Kind=fkDirectory then
  371.       begin
  372.         if InputQuery('Rename','Rename directory '+OldName+' to:',NewName) then
  373.           msFTPClient1.RenameFile(OldName,NewName);
  374.       end
  375.       else
  376.       begin
  377.         if InputQuery('Rename File','Rename file '+OldName+' to:',NewName) then
  378.           msFTPClient1.RenameFile(OldName,NewName);
  379.       end;
  380.       UpdateFTPListView;
  381.     end;
  382.   end;
  383. end;
  384.  
  385. procedure TFTPForm.CancelButtonClick(Sender: TObject);
  386. begin
  387.   msFTPClient1.Cancel;
  388. end;
  389.  
  390. procedure TFTPForm.DeleteButtonClick(Sender: TObject);
  391. begin
  392.   if FTPListView.Selected<>nil then
  393.   begin
  394.     FTPEntry:=msFTPClient1.DirList[FTPListView.Selected.Index];
  395.     if FTPEntry.Kind=fkLink then Exit;
  396.     if FTPEntry.FileName<>'' then
  397.     begin
  398.       if FTPEntry.Kind=fkDirectory then
  399.         msFTPClient1.DeleteDirectory(FTPEntry.FileName)
  400.       else
  401.         msFTPClient1.EraseFile(FTPEntry.FileName);
  402.       UpdateFTPListView;
  403.     end;
  404.   end;
  405. end;
  406.  
  407. procedure TFTPForm.FTPListViewDblClick(Sender: TObject);
  408. begin
  409.   if FTPListView.Selected<>nil then
  410.   begin
  411.     FTPEntry:=msFTPClient1.DirList[FTPListView.Selected.Index];
  412.     if FTPEntry.FileName='' then exit;
  413.     if FTPEntry.Kind=fkDirectory then
  414.     begin
  415.       msFTPClient1.ChangeDirectory(FTPEntry.FileName);
  416.       UpdateFTPListView;
  417.     end
  418.     else
  419.     if FTPEntry.Kind=fkLink then
  420.     begin
  421.       try
  422.         msFTPClient1.ChangeDirectory(FTPEntry.LinkPtr);
  423.         UpdateFTPListView;
  424.       except
  425.         on EmsServerError do
  426.         begin
  427.           SaveDialog1.FileName:='';
  428.           if SaveDialog1.Execute then
  429.             msFTPClient1.RetrieveFile(FTPEntry.LinkPtr,SaveDialog1.FileName);
  430.         end
  431.         else
  432.           raise;
  433.       end;
  434.     end
  435.     else
  436.       RetrieveFileButtonClick(Sender);
  437.   end;
  438. end;
  439.  
  440. procedure TFTPForm.agFTP1LineTransmitted(Sender: TObject;
  441.   const TheLine: string);
  442. begin
  443.   LogMemo.Lines.Add(TheLine);
  444. end;
  445.  
  446. procedure TFTPForm.LogOnOffButtonClick(Sender: TObject);
  447. begin
  448.   LogMemo.Visible:=LogOnOffButton.Down;
  449. end;
  450.  
  451. procedure TFTPForm.msFTPClient1DataTransferStart(Sender: TObject);
  452. begin
  453.   StatusBar.SimpleText:='Opending data Connection';
  454.   TransferForm.ShowProgress(0,-1);
  455.   TransferForm.Show;
  456. end;
  457.  
  458. procedure TFTPForm.msFTPClient1DataTransferTerminate(Sender: TObject);
  459. begin
  460.   if TransferForm.Showing then
  461.     TransferForm.Hide;
  462.   StatusBar.SimpleText:='Data transfer ended';
  463. end;
  464.  
  465. procedure TFTPForm.msFTPClient1Connecting(Sender: TObject);
  466. begin
  467.   StatusBar.SimpleText:='Opening connection with '+msFTPClient1.Host;
  468. end;
  469.  
  470. procedure TFTPForm.msFTPClient1Connected(Sender: TObject);
  471. begin
  472.   StatusBar.SimpleText:='Connected';
  473.   DisableControls;
  474. end;
  475.  
  476. procedure TFTPForm.msFTPClient1Disconnected(Sender: TObject);
  477. begin
  478.   StatusBar.SimpleText:='Disconnected';
  479.   EnableControls;
  480. end;
  481.  
  482. procedure TFTPForm.msFTPClient1DataTransferProgress(Sender: TObject;
  483.   ByteCount: Longint);
  484. begin
  485.   TransferForm.ShowProgress(ByteCount,TheFileSize);
  486. end;
  487.  
  488. end.
  489.