1 program FTPTest;
2 
3 uses
4  FTPApi;
5 
6 const
7  TstName1 = 'FTPTEST1';
8  TstName2 = 'FTPTEST2';
9 {$IFDEF USECON}
10  ListName = 'CON';
11      (* Using output file name 'CON' here causes output directly to console. *)
12 {$ELSE USECON}
13  ListName = 'FTP.LST';
14 {$ENDIF USECON}
15  TstText = 'This is a sample test file for FTPTest'#13#10'check it for yourself.';
16 
17 var
18  Hst, Usr, Pwd: string;
19  T: text;
20  L: longint;
21  S: string;
22 
23 begin
24  if ParamCount < 1 then
25  begin
26   WriteLn ('Syntax: FTPTest <host_name> [<user_name> [<password>]] ' + LineEnding + LineEnding +
27            '        User "anonymous" is used if no user name is supplied on command line,' + LineEnding +
28            '        password is being asked for if omitted');
29   Halt (1);
30  end;
31  WriteLn;
32  Hst := ParamStr (1);
33  if ParamCount > 1 then
34  begin
35   Usr := ParamStr (2);
36   if ParamCount > 2 then Pwd := ParamStr (3) else
37   begin
38    Write ('Password for user "' + Usr + '" (it _will_ be displayed on screen!): ');
39    ReadLn (Pwd);
40   end;
41  end else
42  begin
43   Usr := 'anonymous';
44   Pwd := 'nobody@nowhere.com';
45  end;
46  Write ('Preparing test file ' + TstName1 + '... ');
47  Assign (T, TstName1);
48  Rewrite (T);
49  WriteLn (T, TstText);
50  Close (T);
51  WriteLn ('done');
52  FtpVer (S);
53  WriteLn ('FTPAPI.DLL was compiled ', S);
54  FtpSetUser (Hst, Usr, Pwd, '');
55  WriteLn ('Finding out the current directory on "', Hst, '"...');
56  L := FtpPwd (S);
57  if L = 0 then WriteLn (S);
58  WriteLn ('RC = ', L);
59  Write ('The remote system is ');
60  L := FtpSys (S);
61  if L = 0 then WriteLn (S);
62  WriteLn ('RC = ', L);
63  WriteLn ('Switching to binary');
64  FtpSetBinary (T_BINARY);
65  Write ('Uploading "' + TstName1 + '" to "' + Hst + '" as "' + TstName2 + '"... ');
66  WriteLn ('RC = ', FtpPut (TstName1, TstName2));
67  WriteLn ('Getting dir listing from "' + Hst + '" to "' + ListName + '"... ');
68  L := FtpDir (ListName, '');
69 {$IFNDEF USECON}
70  if L = 0 then
71  begin
72   Assign (T, ListName);
73   Reset (T);
74   while not (Eof (T)) do
75   begin
76    ReadLn (T, S);
77    WriteLn (S);
78   end;
79   Close (T);
80  end;
81 {$ENDIF USECON}
82  WriteLn ('RC = ', L);
83  Write ('Downloading "' + TstName2 + '"... ');
84  WriteLn ('RC = ', FtpGet (TstName2, TstName2, 'w'));
85  Write ('Setting time of the downloaded file to that one on server... ');
86  WriteLn ('Result = ', Keep_File_Date (TstName2, TstName2));
87  Write ('Removing "', TstName2, '" again from "', Hst, '"... ');
88  WriteLn ('RC = ', FtpDelete (TstName2));
89  Write ('Closing all connections... ');
90  FtpLogoff;
91  WriteLn ('done.');
92  WriteLn (LineEnding + 'Finished.');
93 end.
94