home *** CD-ROM | disk | FTP | other *** search
/ Delphi 5 for Professionals / DELPHI5.iso / Runimage / Delphi50 / Demos / FastNet / Ftp / ftpdem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  12.0 KB  |  395 lines
  1. ///////////////////////////////////////////////////////////////////////////
  2. //                                                                       //
  3. // Copyright ⌐ 1997-1998, NetMasters, L.L.C                              //
  4. //  - All rights reserved worldwide. -                                   //
  5. //  Portions may be Copyright ⌐ Inprise.                                 //
  6. //                                                                       //
  7. // FTP Demo Unit 1 :  (UNIT1.PAS)                                        //
  8. //                                                                       //
  9. // DESCRIPTION:                                                          //
  10. //                                                                       //
  11. // THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY //
  12. // KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE   //
  13. // IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR //
  14. // PURPOSE.                                                              //
  15. //                                                                       //
  16. ///////////////////////////////////////////////////////////////////////////
  17. //
  18. // Revision History
  19. //
  20. //                                                                       //
  21. ///////////////////////////////////////////////////////////////////////////
  22. unit FTPDem;
  23.  
  24. interface
  25.  
  26. uses
  27.   Windows, Messages, SysUtils, Classes, Graphics,  Forms, Dialogs,
  28.   ComCtrls, StdCtrls, Psock, NMFtp, Controls;
  29.  
  30. type
  31.   TForm1 = class(TForm)
  32.     PageControl1: TPageControl;
  33.     TabSheet1: TTabSheet;
  34.     TabSheet2: TTabSheet;
  35.     TabSheet3: TTabSheet;
  36.     TabSheet4: TTabSheet;
  37.     HostTxt: TEdit;
  38.     PortTxt: TEdit;
  39.     Label1: TLabel;
  40.     Label2: TLabel;
  41.     Button1: TButton;
  42.     Button2: TButton;
  43.     StatusBar1: TStatusBar;
  44.     Memo1: TMemo;
  45.     Button3: TButton;
  46.     Button4: TButton;
  47.     NMFTP1: TNMFTP;
  48.     UserTxt: TEdit;
  49.     Label3: TLabel;
  50.     PassTxt: TEdit;
  51.     Label4: TLabel;
  52.     DirTxt: TEdit;
  53.     Label5: TLabel;
  54.     Label6: TLabel;
  55.     Button5: TButton;
  56.     RemoteTxt: TEdit;
  57.     Label7: TLabel;
  58.     LocalTxt: TEdit;
  59.     Label8: TLabel;
  60.     Button6: TButton;
  61.     Button7: TButton;
  62.     TabSheet6: TTabSheet;
  63.     Edit3: TEdit;
  64.     Label11: TLabel;
  65.     Label12: TLabel;
  66.     Edit4: TEdit;
  67.     Button10: TButton;
  68.     Button11: TButton;
  69.     Button8: TButton;
  70.     Button9: TButton;
  71.     Button12: TButton;
  72.     Button13: TButton;
  73.     PosTxt: TEdit;
  74.     Label9: TLabel;
  75.     TabSheet5: TTabSheet;
  76.     Edit1: TEdit;
  77.     Label10: TLabel;
  78.     Edit2: TEdit;
  79.     Label13: TLabel;
  80.     Button14: TButton;
  81.     Button15: TButton;
  82.     TabSheet7: TTabSheet;
  83.     Edit5: TEdit;
  84.     Label14: TLabel;
  85.     Button16: TButton;
  86.     TabSheet8: TTabSheet;
  87.     Button17: TButton;
  88.     Label15: TLabel;
  89.     CheckBox1: TCheckBox;
  90.     Edit6: TEdit;
  91.     Edit7: TEdit;
  92.     Label16: TLabel;
  93.     Label17: TLabel;
  94.     TabSheet9: TTabSheet;
  95.     Edit8: TEdit;
  96.     Edit9: TEdit;
  97.     Label18: TLabel;
  98.     Label19: TLabel;
  99.     Button18: TButton;
  100.     procedure NMFTP1Success(Trans_Type: TCmdType);
  101.     procedure Button1Click(Sender: TObject);
  102.     procedure Button2Click(Sender: TObject);
  103.     procedure Button3Click(Sender: TObject);
  104.     procedure Button4Click(Sender: TObject);
  105.     procedure NMFTP1ListItem(Listing: String);
  106.     procedure TabSheet3MouseMove(Sender: TObject; Shift: TShiftState; X,
  107.       Y: Integer);
  108.     procedure Button5Click(Sender: TObject);
  109.     procedure Button8Click(Sender: TObject);
  110.     procedure NMFTP1PacketRecvd(Sender: TObject);
  111.     procedure Button7Click(Sender: TObject);
  112.     procedure Button10Click(Sender: TObject);
  113.     procedure Button11Click(Sender: TObject);
  114.     procedure Button12Click(Sender: TObject);
  115.     procedure Button13Click(Sender: TObject);
  116.     procedure Button6Click(Sender: TObject);
  117.     procedure Button14Click(Sender: TObject);
  118.     procedure Button15Click(Sender: TObject);
  119.     procedure Button16Click(Sender: TObject);
  120.     procedure Button17Click(Sender: TObject);
  121.     procedure NMFTP1Connect(Sender: TObject);
  122.     procedure NMFTP1Failure(var handled: Boolean; Trans_Type: TCmdType);
  123.     procedure NMFTP1TransactionStop(Sender: TObject);
  124.     procedure NMFTP1HostResolved(Sender: TComponent);
  125.     procedure NMFTP1InvalidHost(var handled: Boolean);
  126.     procedure NMFTP1PacketSent(Sender: TObject);
  127.     procedure NMFTP1TransactionStart(Sender: TObject);
  128.     procedure NMFTP1Disconnect(Sender: TObject);
  129.     procedure NMFTP1Error(Sender: TComponent; Errno: Word; Errmsg: String);
  130.     procedure NMFTP1Status(Sender: TComponent; Status: String);
  131.     procedure Button18Click(Sender: TObject);
  132.     procedure NMFTP1UnSupportedFunction(Trans_Type: TCmdType);
  133.     procedure NMFTP1ConnectionFailed(Sender: TObject);
  134.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  135.   private
  136.     { Private declarations }
  137.   public
  138.     { Public declarations }
  139.   end;
  140.  
  141. var
  142.   Form1: TForm1;
  143.  
  144. implementation
  145.  
  146. {$R *.DFM}
  147.  
  148. var
  149.   Q: Integer;
  150.  
  151. procedure TForm1.NMFTP1Success(Trans_Type: TCmdType);
  152. begin
  153.   Case Trans_Type of
  154.     cmdChangeDir: StatusBar1.SimpleText := 'ChangeDir success';
  155.     cmdMakeDir: StatusBar1.SimpleText := 'MakeDir success';
  156.     cmdDelete: StatusBar1.SimpleText := 'Delete success';
  157.     cmdRemoveDir: StatusBar1.SimpleText := 'RemoveDir success';
  158.     cmdList: StatusBar1.SimpleText := 'List success';
  159.     cmdRename: StatusBar1.SimpleText := 'Rename success';
  160.     cmdUpRestore: StatusBar1.SimpleText := 'UploadRestore success';
  161.     cmdDownRestore: StatusBar1.SimpleText := 'DownloadRestore success';
  162.     cmdDownload: StatusBar1.SimpleText := 'Download success';
  163.     cmdUpload: StatusBar1.SimpleText := 'Upload success';
  164.     cmdAppend: StatusBar1.SimpleText := 'UploadAppend success';
  165.     cmdReInit: StatusBar1.SimpleText := 'ReInit success';
  166.     cmdAllocate: StatusBar1.SimpleText := 'Allocate success';
  167.     cmdNList: StatusBar1.SimpleText := 'NList success';
  168.     cmdDoCommand: StatusBar1.SimpleText := 'DoCommand success';
  169.   end;
  170. end;
  171.  
  172. procedure TForm1.Button1Click(Sender: TObject);
  173. begin
  174.   If CheckBox1.Checked then
  175.   Begin
  176.     NMFTP1.Proxy := Edit6.Text;
  177.     NMFTP1.ProxyPort := StrToInt(Edit7.Text);
  178.   End;
  179.   NMFTP1.Host := HostTxt.Text;
  180.   NMFTP1.Port := StrToInt(PortTxt.Text);
  181.   NMFTP1.Timeout := 5000;
  182.   NMFTP1.UserID := UserTxt.Text;
  183.   NMFTP1.Password := PassTxt.Text;
  184.   try
  185.     NMFTP1.Connect;
  186.    except
  187.    On E:Exception do
  188.        writeln(E.message);
  189.    end
  190. end;
  191.  
  192. procedure TForm1.Button2Click(Sender: TObject);
  193. begin
  194.   NMFTP1.Disconnect;
  195. end;
  196.  
  197. procedure TForm1.Button3Click(Sender: TObject);
  198. begin
  199.   Q := 1;
  200.   try NMFTP1.Nlist;    except end;
  201. end;
  202.  
  203. procedure TForm1.Button4Click(Sender: TObject);
  204. begin
  205.   Q := 1;
  206.   try NMFTP1.List;   except end;
  207. end;
  208.  
  209. procedure TForm1.NMFTP1ListItem(Listing: String);
  210. begin
  211.   Memo1.Lines.Add(IntToStr(Q)+': '+Listing);
  212.   Inc(Q);
  213. end;
  214.  
  215. procedure TForm1.TabSheet3MouseMove(Sender: TObject; Shift: TShiftState; X,
  216.   Y: Integer);
  217. begin
  218.   Label5.Caption := 'Current Dir: ';
  219. end;
  220.  
  221. procedure TForm1.Button5Click(Sender: TObject);
  222. begin
  223.   NMFTP1.ChangeDir(DirTxt.Text);
  224. end;
  225.  
  226. procedure TForm1.Button8Click(Sender: TObject);
  227. begin
  228.   NMFTP1.DownloadRestore(RemoteTxt.Text, LocalTxt.Text);
  229. end;
  230.  
  231. procedure TForm1.NMFTP1PacketRecvd(Sender: TObject);
  232. begin
  233.   StatusBar1.SimpleText := IntToStr(NMFTP1.BytesRecvd)+' of '+IntToStr(NMFTP1.BytesTotal);
  234. end;
  235.  
  236. procedure TForm1.Button7Click(Sender: TObject);
  237. begin
  238.   NMFTP1.Abort;
  239. end;
  240.  
  241.  
  242. procedure TForm1.Button10Click(Sender: TObject);
  243. begin
  244.   try NMFTP1.Upload(Edit3.Text, Edit4.Text); except end;
  245. end;
  246.  
  247.  
  248. procedure TForm1.Button11Click(Sender: TObject);
  249. begin
  250.   try NMFTP1.UploadAppend(Edit3.Text, Edit4.Text);  except end;
  251. end;
  252.  
  253. procedure TForm1.Button12Click(Sender: TObject);
  254. begin
  255.   try   NMFTP1.UploadUnique(Edit3.Text);   except end;
  256. end;
  257.  
  258. procedure TForm1.Button13Click(Sender: TObject);
  259. begin
  260.   try  NMFTP1.UploadRestore(Edit3.Text,Edit4.Text,StrToInt(PosTxt.Text));  except end;
  261. end;
  262.  
  263. procedure TForm1.Button6Click(Sender: TObject);  
  264. begin
  265.  try  NMFTP1.Download(RemoteTxt.Text, LocalTxt.Text);  except end;
  266. end;
  267.  
  268. procedure TForm1.Button14Click(Sender: TObject);
  269. begin
  270.   NMFTP1.MakeDirectory(Edit1.Text);
  271. end;
  272.  
  273. procedure TForm1.Button15Click(Sender: TObject);
  274. begin
  275.   NMFTP1.RemoveDir(Edit2.Text);
  276. end;
  277.  
  278. procedure TForm1.Button16Click(Sender: TObject);
  279. begin
  280.   NMFTP1.Delete(Edit5.Text);
  281. end;
  282.  
  283. procedure TForm1.Button17Click(Sender: TObject);
  284. begin
  285.   NMFTP1.Reinitialize;
  286.   PageControl1.ActivePage := TabSheet2;
  287. end;
  288.  
  289. procedure TForm1.NMFTP1Connect(Sender: TObject);
  290. begin
  291.   StatusBar1.SimpleText := 'Connected';
  292. end;
  293.  
  294. procedure TForm1.NMFTP1Failure(var handled: Boolean; Trans_Type: TCmdType);
  295. begin
  296.   Case Trans_Type of
  297.     cmdChangeDir: StatusBar1.SimpleText := 'ChangeDir failure';
  298.     cmdMakeDir: StatusBar1.SimpleText := 'MakeDir failure';
  299.     cmdDelete: StatusBar1.SimpleText := 'Delete failure';
  300.     cmdRemoveDir: StatusBar1.SimpleText := 'RemoveDir failure';
  301.     cmdList: StatusBar1.SimpleText := 'List failure';
  302.     cmdRename: StatusBar1.SimpleText := 'Rename failure';
  303.     cmdUpRestore: StatusBar1.SimpleText := 'UploadRestore failure';
  304.     cmdDownRestore: StatusBar1.SimpleText := 'DownloadRestore failure';
  305.     cmdDownload: StatusBar1.SimpleText := 'Download failure';
  306.     cmdUpload: StatusBar1.SimpleText := 'Upload failure';
  307.     cmdAppend: StatusBar1.SimpleText := 'UploadAppend failure';
  308.     cmdReInit: StatusBar1.SimpleText := 'ReInit failure';
  309.     cmdAllocate: StatusBar1.SimpleText := 'Allocate failure';
  310.     cmdNList: StatusBar1.SimpleText := 'NList failure';
  311.     cmdDoCommand: StatusBar1.SimpleText := 'DoCommand failure';
  312.   end;
  313. end;
  314.  
  315. procedure TForm1.NMFTP1TransactionStop(Sender: TObject);
  316. begin
  317.   StatusBar1.SimpleText := 'Data Transfer Complete';
  318. end;
  319.  
  320. procedure TForm1.NMFTP1HostResolved(Sender: TComponent);
  321. begin
  322.   StatusBar1.SimpleText := 'Host resolved';
  323. end;
  324.  
  325. procedure TForm1.NMFTP1InvalidHost(var handled: Boolean);
  326. begin
  327.   ShowMessage('Invalid Host');
  328. end;
  329.  
  330. procedure TForm1.NMFTP1PacketSent(Sender: TObject);
  331. begin
  332.   StatusBar1.SimpleText := IntToStr(NMFTP1.BytesSent)+' of '+IntToStr(NMFTP1.BytesTotal);
  333. end;
  334.  
  335. procedure TForm1.NMFTP1TransactionStart(Sender: TObject);
  336. begin
  337.   StatusBar1.SimpleText := 'Beginning Data Transfer';
  338. end;
  339.  
  340. procedure TForm1.NMFTP1Disconnect(Sender: TObject);
  341. begin
  342.   If StatusBar1 <> nil then
  343.     StatusBar1.SimpleText := 'Disconnected';
  344. end;
  345.  
  346. procedure TForm1.NMFTP1Error(Sender: TComponent; Errno: Word;
  347.   Errmsg: String);
  348. begin
  349.   ShowMessage('Error '+IntToStr(Errno)+': '+Errmsg);
  350. end;
  351.  
  352. procedure TForm1.NMFTP1Status(Sender: TComponent; Status: String);
  353. begin
  354. //  If StatusBar1 <> nil then
  355. //    StatusBar1.SimpleText := status;
  356. end;
  357.  
  358. procedure TForm1.Button18Click(Sender: TObject);
  359. begin
  360.   NMFTP1.Rename(Edit8.Text,Edit9.Text);
  361. end;
  362.  
  363. procedure TForm1.NMFTP1UnSupportedFunction(Trans_Type: TCmdType);
  364. begin
  365.   Case Trans_Type of
  366.     cmdChangeDir: ShowMessage('ChangeDir unsupported');
  367.     cmdMakeDir: ShowMessage('MakeDir unsupported');
  368.     cmdDelete: ShowMessage('Delete unsupported');
  369.     cmdRemoveDir: ShowMessage('RemoveDir unsupported');
  370.     cmdList: ShowMessage('List unsupported');
  371.     cmdRename: ShowMessage('Rename unsupported');
  372.     cmdUpRestore: ShowMessage('UploadRestore unsupported');
  373.     cmdDownRestore: ShowMessage('DownloadRestore unsupported');
  374.     cmdDownload: ShowMessage('Download unsupported');
  375.     cmdUpload: ShowMessage('Upload unsupported');
  376.     cmdAppend: ShowMessage('UploadAppend unsupported');
  377.     cmdReInit: ShowMessage('ReInit unsupported');
  378.     cmdAllocate: ShowMessage('Allocate unsupported');
  379.     cmdNList: ShowMessage('NList unsupported');
  380.     cmdDoCommand: ShowMessage('DoCommand unsupported');
  381.   end;
  382. end;
  383.  
  384. procedure TForm1.NMFTP1ConnectionFailed(Sender: TObject);
  385. begin
  386.   ShowMessage('Connection Failed');
  387. end;
  388.  
  389. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  390. begin
  391.    NMFTP1.Abort;
  392. end;
  393.  
  394. end.
  395.