Recent

Author Topic: [MOVED IN NETWORKING] Upload File to ftp server using NON-visual lNet  (Read 3235 times)

cris75

  • Jr. Member
  • **
  • Posts: 59
--UPDATE--
I'm moving this topic under the section "Networking and Web Programming", where I should have posted it originally, sorry for my mistake.
Thank you,
Cris

----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Hi, in my little console application I'm using non-visual lNet to upload a file to my ftp server;
I'm forced to use non-visual lNet because my program will run as a console application on a WinCE/ARM PDA;
it's kinda of an ftp client, but what I basically need, is to be able to upload a file to the ftp server in the root position just after logon;
the filename is passed via Param, the other settings read via INI file;
I confess I've not experience with lNet, since that I always used Synapse until now, so I used the example in the lNet package as a start point, here is the code:

Code: Pascal  [Select][+][-]
  1. program lFTPClient;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   Classes, SysUtils, Crt, lFTP, lNet;
  7.  
  8. type
  9.  
  10.   { TClient }
  11.  
  12.   TClient = class
  13.    private
  14.     { These are the events which will get called when something happens on a socket.
  15.       OnConnect will get called when the client connection finished connecting successfuly.
  16.       OnReceive will get called when any data is received on the data stream (the one for files).
  17.       OnControl will get called when any data/info is received on the command stream (the one with command/responses for server.
  18.       OnSent will get called after sending big pieces of data to the other side, it'll report the progress indicated by "Bytes".
  19.       OnError will get called when any network error occurs, like ECONNRESET }
  20.     procedure OnConnect(aSocket: TLSocket);
  21.     procedure OnReceive(aSocket: TLSocket);
  22.     procedure OnControl(aSocket: TLSocket);
  23.     procedure OnSent(aSocket: TLSocket; const Bytes: Integer);
  24.     procedure OnError(const msg: string; aSocket: TLSocket);
  25.    protected
  26.     FCon: TLFTPClient;  // the FTP connection itself
  27.     FConnected: Boolean;
  28.     FQuit: Boolean;     // used as controller of the main loop
  29.     FFile: TFileStream; // file stream to save "GET" files into
  30.     function UserString: string;
  31.     function GetAnswer(const s: string; const NoEcho: Boolean = False): string;
  32.     procedure PrintHelp;
  33.    public
  34.     constructor Create;
  35.     destructor Destroy; override;
  36.     procedure Run(const Host: string; const Port: Word); // this is where the main loop is
  37.   end;
  38.  
  39. procedure TClient.OnConnect(aSocket: TLSocket);
  40. begin
  41.   FConnected := True;
  42.   Writeln('Connected succesfuly');
  43. end;
  44.  
  45. procedure TClient.OnReceive(aSocket: TLSocket);
  46. const
  47.   BUFFER_SIZE = 65536; // usual maximal recv. size defined by OS, no problem if it's more or less really
  48. var
  49.   n: Integer;
  50.   Buf: array[0..BUFFER_SIZE-1] of Byte;
  51. begin
  52.   if FCon.CurrentStatus = fsRetr then begin // if we're in getting mode
  53.     Write('.'); // inform of progress
  54.     n := FCon.GetData(Buf, BUFFER_SIZE); // get data, n is set to the amount
  55.     if (n = 0)
  56.     and (not FCon.DataConnection.Connected) then // if we got disconnected then
  57.       FreeAndNil(FFile)  // close the file
  58.     else
  59.       FFile.Write(Buf, n); // otherwise, write the data to file
  60.   end else
  61.     Write(FCon.GetDataMessage); // if we got data and we weren't in getting mode, write it on the screen as FTP info
  62. end;
  63.  
  64. procedure TClient.OnControl(aSocket: TLSocket);
  65. var
  66.   s: string;
  67. begin
  68.   if FCon.GetMessage(s) > 0 then // if we got some new message about FTP status, write it
  69.     Writeln(s);
  70. end;
  71.  
  72. procedure TClient.OnSent(aSocket: TLSocket; const Bytes: Integer);
  73. begin
  74.   Write('.'); // inform on progress, very basic
  75. end;
  76.  
  77. procedure TClient.OnError(const msg: string; aSocket: TLSocket);
  78. begin
  79.   Writeln(msg); // just write the error out
  80. end;
  81.  
  82. constructor TClient.Create;
  83. begin
  84.   FConnected := False; // we're not connected yet
  85.   FCon := TLFTPClient.Create(nil);
  86.   FCon.Timeout := 50; // 50 milliseconds is nice to save CPU but fast enough to be responsive to humans
  87.   FCon.OnConnect := @OnConnect; // assign all events
  88.   FCon.OnReceive := @OnReceive;
  89.   FCon.OnControl := @OnControl;
  90.   FCon.OnSent := @OnSent;
  91.   FCon.OnError := @OnError;
  92. end;
  93.  
  94. destructor TClient.Destroy;
  95. begin
  96.   FCon.Free;
  97. end;
  98.  
  99. procedure TClient.PrintHelp;
  100. begin
  101.   Writeln('lNet example FTP client copyright (c) 2005 by Ales Katona');
  102.   Writeln('Commands:');
  103.   Writeln('?   - Print this help');
  104.   Writeln('ESC - Quit');
  105.   Writeln('l - List remote directory');
  106.   Writeln('L - Nlst remote directory (lists only files sometimes)');
  107.   Writeln('g/G - Get remote file');
  108.   Writeln('p/P - Put local file');
  109.   Writeln('b/B - Change mode (binary on/off)');
  110.   Writeln('s/S - Get server system info');
  111.   Writeln('h/H - Print server help');
  112.   Writeln('x/X - Print current working directory');
  113.   Writeln('c/C - Change remote directory');
  114.   Writeln('m/M - Create new remote directory');
  115.   Writeln('r/R - Remove remote directory');
  116.   Writeln('n/N - Rename remote file/directory');
  117.   Writeln('d/D - Delete remote file');
  118.   Writeln('e/E - Echo on/off');
  119.   Writeln('f/F - Feature list');
  120. end;
  121.  
  122. procedure TClient.Run(const Host: string; const Port: Word);
  123. var
  124.   s, Name, Pass, Dir: string;
  125. begin
  126.   Dir := ExtractFilePath(ParamStr(0)); // get current working directory
  127.   FFile := nil; // set "GET" file to nothing for now
  128.   Name := GetAnswer('USER [' + GetEnvironmentVariable(UserString) + ']', False); // get info about username and pass from console
  129.   if Length(Name) = 0 then // if username wasn't set, presume it's the same as environment var for USER
  130.     Name := GetEnvironmentVariable('USER');
  131.   Pass := GetAnswer('PASS', True); // get password from user console
  132.  
  133.   if FCon.Connect(Host, PORT) then begin // if initial connect call worked
  134.     Writeln('Connecting... press escape to cancel'); // write info about status
  135.     repeat
  136.       FCon.CallAction; // repeat this until we either get connected, fail or user decides to quit manually
  137.       if KeyPressed then
  138.         if ReadKey = #27 then Exit;
  139.     until FConnected;
  140.   end else Halt;
  141.  
  142.   if FCon.Authenticate(Name, Pass) then begin // if authentication with server passed
  143.     FCon.Binary := True; // set binary mode, others are useless anyhow
  144.     s := '';
  145.     Writeln('Press "?" for help'); // just info
  146.     while not FQuit do begin // main loop is here, for events and user interaction
  147.       if KeyPressed then case ReadKey of // this is all user interaction stuff
  148.              #27: FQuit := True; // escape quits the client
  149.              '?': PrintHelp;
  150.         'g', 'G': begin // "GET" file, this means:
  151.                     s := GetAnswer('Filename'); // we need to find out which file from user
  152.                     if Length(s) > 0 then begin // then if it was valid info
  153.                       s := ExtractFileName(s); // see if the file exists already on local disk/dir
  154.                       if FileExists(Dir + s) then
  155.                         DeleteFile(Dir + s); // if so, delete it (I know it's not the best idea, but it's a simple client)
  156.                       FreeAndNil(FFile); // ensure any old file/data is not used
  157.                       FFile := TFileStream.Create(Dir + s, fmOpenWrite or fmCreate); // create new file for the incomming one
  158.                       FCon.Retrieve(s); // send request for the file over FTP control connnection
  159.                     end;
  160.                   end;
  161.              'l': FCon.List; // and send request for file listing
  162.              'L': FCon.Nlst; // send request for new type of file listing
  163.         'p', 'P': begin
  164.                      s := GetAnswer('Filename'); // see which file the user wants to PUT on the server
  165.                     if FileExists(Dir + s) then // if it exits locally
  166.                       FCon.Put(Dir + s) // then send it over
  167.                     else
  168.                       Writeln('No such file "', s, '"'); // otherwise inform user of their error
  169.                   end;
  170.         'b', 'B': FCon.Binary := not FCon.Binary; // set or unset binary
  171.         's', 'S': FCon.SystemInfo; // request systeminfo from server
  172.         'h', 'H': FCon.Help(GetAnswer('Help verb')); // request help from server, argument input from console
  173.         'x', 'X': FCon.PresentWorkingDirectory; // get current working directory info from server
  174.         'c', 'C': FCon.ChangeDirectory(GetAnswer('New dir')); // change directory, new dir is read from user console
  175.         'm', 'M': FCon.MakeDirectory(GetAnswer('New dir')); // make a new directory on server, dirname is read from user console
  176.         'n', 'N': FCon.Rename(GetAnswer('From'), GetAnswer('To')); // rename a file, old and new names read from user console
  177.         'r', 'R': FCon.RemoveDirectory(GetAnswer('Dirname')); // delete a directory on server, name read from user console
  178.         'd', 'D': FCon.DeleteFile(GetAnswer('Filename')); // delete a file on server, name read from user console
  179.         'e', 'E': FCon.Echo := not FCon.Echo; // set echo mode on/off
  180.         'f', 'F': FCon.ListFeatures; // get all FTP features from server
  181.       end;
  182.       FCon.CallAction; // this needs to be called ASAP, in a loop. It's the magic function which makes all the events work :)
  183.     end;
  184.   end else FCon.GetMessage(s); // if the authentication failed, get reason from server
  185.   if Length(s) > 0 then // if reason was given, write it
  186.     Write(s);
  187.   FreeAndNil(FFile); // make sure not to leak memory
  188. end;
  189.  
  190. function TClient.UserString: string;
  191. begin
  192.   {$ifdef WINDOWS}
  193.     Result := 'USERNAME';
  194.   {$else}
  195.     Result := 'USER';
  196.   {$endif}
  197. end;
  198.  
  199. function TClient.GetAnswer(const s: string; const NoEcho: Boolean = False): string;
  200. var
  201.   c: Char;
  202. begin
  203.   Result := '';
  204.   Write(s, ': ');
  205.   while True do begin
  206.     FCon.CallAction;
  207.     if KeyPressed then begin
  208.       c := ReadKey;
  209.       case c of
  210.         #13, #27 : begin
  211.                      Writeln;
  212.                      Exit;
  213.                    end;
  214.         #8       : if Length(Result) > 0 then begin
  215.                      SetLength(Result, Length(Result)-1);
  216.                      if not NoEcho then begin
  217.                        GotoXY(WhereX-1, WhereY);
  218.                        Write(' ');
  219.                        GotoXY(WhereX-1, WhereY);
  220.                      end;
  221.                    end;
  222.         else begin
  223.           Result := Result + c;
  224.           if not NoEcho then
  225.             Write(c);
  226.         end;
  227.       end;
  228.     end;
  229.   end;
  230. end;
  231.  
  232. var
  233.   aClient: TClient;
  234.   IP: string;
  235.   Port: Word = 21;
  236. begin
  237.   if Paramcount > 0 then begin
  238.     IP := ParamStr(1);
  239.     PORT := 21;
  240.     if ParamCount > 1 then try
  241.       Port := Word(StrToInt(ParamStr(2)));
  242.     except
  243.       on e: Exception do begin
  244.         Writeln(e.message);
  245.         Halt;
  246.       end;
  247.     end;
  248.  
  249.     aClient := TClient.Create;
  250.     aClient.Run(IP, Port);
  251.     aClient.Free;
  252.   end else Writeln('Usage: ', ParamStr(0), ' IP [PORT]');
  253. end.
  254.  

Considering that there will not be interaction at all with the user, and the goal is to have a sort of utility that can do the job (but at the same time NOT a complete ftp client), what I did is remove the unnecessary parts, because when invoked (with a filename as parameter) the application will simply verify if the file exists locally and if so login to ftp, upload the file to the server, then quietly disconnect itself and exit;
but i got troubles (an exception) with the Put method of TLFTPClient, or at least I think the problem is that, so I compiled the example lftpclient.pp (console) on my pc to test it but when i try to upload a file, I get again an unhandled exception:

Code: Text  [Select][+][-]
  1. USER [user]: test
  2. PASS:
  3. Connecting... press escape to cancel
  4. Connected succesfuly
  5. 220-FileZilla Server 0.9.60 beta
  6. 220-written by Tim Kosse (tim.kosse@filezilla-project.org)
  7. 220 Please visit https://filezilla-project.org/
  8.  
  9. Press "?" for help
  10. 331 Password required for test
  11.  
  12. 230 Logged on
  13.  
  14. 200 Type set to I
  15.  
  16. Filename: project1.lps
  17. 227 Entering Passive Mode (127,0,0,1,228,177)
  18.  
  19. Error on connect: connection refused
  20. An unhandled exception occurred at $000000010002F6E5:
  21. EAccessViolation: Access violation
  22.   $000000010002F6E5 line 1018 of ../lib/lftp.pp
  23.   $000000010002E9C0 line 680 of ../lib/lftp.pp
  24.   $000000010002E05F line 808 of ../lib/lftp.pp
  25.   $000000010002D2BF line 549 of ../lib/lftp.pp
  26.   $000000010002FAE4 line 1070 of ../lib/lftp.pp
  27.   $0000000100001A61 line 68 of project1.lpr
  28.   $000000010002CF1F line 476 of ../lib/lftp.pp
  29.   $0000000100036355 line 431 of ../lib/ltelnet.pp
  30.   $0000000100032A4F line 1086 of ../lib/lnet.pp
  31.   $00000001000335B0 line 1549 of ../lib/lnet.pp
  32.   $0000000100037CCD line 591 of ../lib/levents.pp
  33.   $0000000100033299 line 1471 of ../lib/lnet.pp
  34.   $000000010003702F line 556 of ../lib/ltelnet.pp
  35.   $0000000100030F4F line 1280 of ../lib/lftp.pp
  36.   $00000001000027D3 line 182 of project1.lpr
  37.   $0000000100002C20 line 250 of project1.lpr
  38.   $0000000100002CF6
  39.  

I can't figure out where the problem is in the example, and also, how can I quit the while loop after the file has been (correctly) uploaded?
In the example the loop is exited via keypress #27, but I need to disconnect and exit as soon as the file is correctly uploaded, do you guys have some clue to help me?
Thank you,
Cris 
« Last Edit: November 30, 2018, 04:27:16 pm by cris75 »
Lazarus: 3.0 / FPC: 3.2.2
[x86_64-win64-win32/win64]
OS IDE: Win10 64bit

 

TinyPortal © 2005-2018