Upload File to ftp server using NON-visual lNet
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
cris75 · 2018-11-30 14:59

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
lFTPClient; {$mode objfpc}{$H+} uses  Classes, SysUtils, Crt, lFTP,
lNet;  type   { TClient }   TClient = class   private    { These are
the events which will get called when something happens on a socket. 
   OnConnect will get called when the client connection finished
connecting successfuly.      OnReceive will get called when any data
is received on the data stream (the one for files).      OnControl
will get called when any data/info is received on the command stream
(the one with command/responses for server.      OnSent will get
called after sending big pieces of data to the other side, it'll
report the progress indicated by "Bytes".      OnError will get called
when any network error occurs, like ECONNRESET }    procedure
OnConnect(aSocket: TLSocket);    procedure OnReceive(aSocket:
TLSocket);    procedure OnControl(aSocket: TLSocket);    procedure
OnSent(aSocket: TLSocket; const Bytes: Integer);    procedure
OnError(const msg: string; aSocket: TLSocket);   protected    FCon:
TLFTPClient;  // the FTP connection itself    FConnected: Boolean;   
FQuit: Boolean;     // used as controller of the main loop    FFile:
TFileStream; // file stream to save "GET" files into    function
UserString: string;    function GetAnswer(const s: string; const
NoEcho: Boolean = False): string;    procedure PrintHelp;   public   
constructor Create;    destructor Destroy; override;    procedure
Run(const Host: string; const Port: Word); // this is where the main
loop is  end; procedure TClient.OnConnect(aSocket: TLSocket);begin 
FConnected := True;  Writeln('Connected succesfuly');end; procedure
TClient.OnReceive(aSocket: TLSocket);const  BUFFER_SIZE = 65536; //
usual maximal recv. size defined by OS, no problem if it's more or
less reallyvar  n: Integer;  Buf: array[0..BUFFER_SIZE-1] of
Byte;begin  if FCon.CurrentStatus = fsRetr then begin // if we're in
getting mode    Write('.'); // inform of progress    n :=
FCon.GetData(Buf, BUFFER_SIZE); // get data, n is set to the amount  
if (n = 0)    and (not FCon.DataConnection.Connected) then // if we
got disconnected then      FreeAndNil(FFile)  // close the file   
else      FFile.Write(Buf, n); // otherwise, write the data to file 
end else    Write(FCon.GetDataMessage); // if we got data and we
weren't in getting mode, write it on the screen as FTP
infoend; procedure TClient.OnControl(aSocket: TLSocket);var  s:
string;begin  if FCon.GetMessage(s) > 0 then // if we got some new
message about FTP status, write it    Writeln(s);end; procedure
TClient.OnSent(aSocket: TLSocket; const Bytes: Integer);begin 
Write('.'); // inform on progress, very basicend; procedure
TClient.OnError(const msg: string; aSocket: TLSocket);begin 
Writeln(msg); // just write the error outend; constructor
TClient.Create;begin  FConnected := False; // we're not connected yet 
FCon := TLFTPClient.Create(nil);  FCon.Timeout := 50; // 50
milliseconds is nice to save CPU but fast enough to be responsive to
humans  FCon.OnConnect := @OnConnect; // assign all events 
FCon.OnReceive := @OnReceive;  FCon.OnControl := @OnControl; 
FCon.OnSent := @OnSent;  FCon.OnError := @OnError;end; destructor
TClient.Destroy;begin  FCon.Free;end; procedure
TClient.PrintHelp;begin  Writeln('lNet example FTP client copyright
(c) 2005 by Ales Katona');  Writeln('Commands:');  Writeln('?   -
Print this help');  Writeln('ESC - Quit');  Writeln('l - List remote
directory');  Writeln('L - Nlst remote directory (lists only files
sometimes)');  Writeln('g/G - Get remote file');  Writeln('p/P - Put
local file');  Writeln('b/B - Change mode (binary on/off)'); 
Writeln('s/S - Get server system info');  Writeln('h/H - Print server
help');  Writeln('x/X - Print current working directory'); 
Writeln('c/C - Change remote directory');  Writeln('m/M - Create new
remote directory');  Writeln('r/R - Remove remote directory'); 
Writeln('n/N - Rename remote file/directory');  Writeln('d/D - Delete
remote file');  Writeln('e/E - Echo on/off');  Writeln('f/F - Feature
list');end; procedure TClient.Run(const Host: string; const Port:
Word);var  s, Name, Pass, Dir: string;begin  Dir :=
ExtractFilePath(ParamStr(0)); // get current working directory  FFile
:= nil; // set "GET" file to nothing for now  Name := GetAnswer('USER
[' + GetEnvironmentVariable(UserString) + ']', False); // get info
about username and pass from console  if Length(Name) = 0 then // if
username wasn't set, presume it's the same as environment var for
USER    Name := GetEnvironmentVariable('USER');  Pass :=
GetAnswer('PASS', True); // get password from user console   if
FCon.Connect(Host, PORT) then begin // if initial connect call worked 
  Writeln('Connecting... press escape to cancel'); // write info about
status    repeat       FCon.CallAction; // repeat this until we either
get connected, fail or user decides to quit manually      if
KeyPressed then        if ReadKey = #27 then Exit;    until
FConnected;  end else Halt;   if FCon.Authenticate(Name, Pass) then
begin // if authentication with server passed    FCon.Binary := True;
// set binary mode, others are useless anyhow    s := '';   
Writeln('Press "?" for help'); // just info    while not FQuit do
begin // main loop is here, for events and user interaction      if
KeyPressed then case ReadKey of // this is all user interaction stuff 
           #27: FQuit := True; // escape quits the client           
 '?': PrintHelp;        'g', 'G': begin // "GET" file, this means:   
               s := GetAnswer('Filename'); // we need to find out
which file from user                    if Length(s) > 0 then begin //
then if it was valid info                      s :=
ExtractFileName(s); // see if the file exists already on local
disk/dir                       if FileExists(Dir + s) then           
           DeleteFile(Dir + s); // if so, delete it (I know it's not
the best idea, but it's a simple client)                     
FreeAndNil(FFile); // ensure any old file/data is not used           
         FFile := TFileStream.Create(Dir + s, fmOpenWrite or
fmCreate); // create new file for the incomming one                  
  FCon.Retrieve(s); // send request for the file over FTP control
connnection                    end;                  end;           
 'l': FCon.List; // and send request for file listing             'L':
FCon.Nlst; // send request for new type of file listing        'p',
'P': begin                     s := GetAnswer('Filename'); // see
which file the user wants to PUT on the server                    if
FileExists(Dir + s) then // if it exits locally                     
FCon.Put(Dir + s) // then send it over                    else       
             Writeln('No such file "', s, '"'); // otherwise inform
user of their error                  end;        'b', 'B': FCon.Binary
:= not FCon.Binary; // set or unset binary        's', 'S':
FCon.SystemInfo; // request systeminfo from server        'h', 'H':
FCon.Help(GetAnswer('Help verb')); // request help from server,
argument input from console        'x', 'X':
FCon.PresentWorkingDirectory; // get current working directory info
from server        'c', 'C': FCon.ChangeDirectory(GetAnswer('New
dir')); // change directory, new dir is read from user console       
'm', 'M': FCon.MakeDirectory(GetAnswer('New dir')); // make a new
directory on server, dirname is read from user console        'n',
'N': FCon.Rename(GetAnswer('From'), GetAnswer('To')); // rename a
file, old and new names read from user console        'r', 'R':
FCon.RemoveDirectory(GetAnswer('Dirname')); // delete a directory on
server, name read from user console        'd', 'D':
FCon.DeleteFile(GetAnswer('Filename')); // delete a file on server,
name read from user console        'e', 'E': FCon.Echo := not
FCon.Echo; // set echo mode on/off        'f', 'F': FCon.ListFeatures;
// get all FTP features from server      end;      FCon.CallAction; //
this needs to be called ASAP, in a loop. It's the magic function which
makes all the events work :)    end;  end else FCon.GetMessage(s); //
if the authentication failed, get reason from server  if Length(s) > 0
then // if reason was given, write it    Write(s);  FreeAndNil(FFile);
// make sure not to leak memoryend; function TClient.UserString:
string;begin  {$ifdef WINDOWS}    Result := 'USERNAME';  {$else}   
Result := 'USER';  {$endif}end; function TClient.GetAnswer(const s:
string; const NoEcho: Boolean = False): string;var  c: Char;begin 
Result := '';  Write(s, ': ');  while True do begin   
FCon.CallAction;    if KeyPressed then begin      c := ReadKey;     
case c of        #13, #27 : begin                     Writeln;       
            Exit;                   end;        #8       : if
Length(Result) > 0 then begin                     SetLength(Result,
Length(Result)-1);                     if not NoEcho then begin      
               GotoXY(WhereX-1, WhereY);                       Write('
');                       GotoXY(WhereX-1, WhereY);                  
 end;                   end;        else begin          Result :=
Result + c;          if not NoEcho then            Write(c);       
end;      end;    end;  end;end; var  aClient: TClient;  IP: string; 
Port: Word = 21;begin  if Paramcount > 0 then begin    IP :=
ParamStr(1);    PORT := 21;    if ParamCount > 1 then try      Port :=
Word(StrToInt(ParamStr(2)));    except      on e: Exception do begin 
     Writeln(e.message);        Halt;      end;    end;     aClient :=
TClient.Create;    aClient.Run(IP, Port);    aClient.Free;  end else
Writeln('Usage: ', ParamStr(0), ' IP [PORT]');end. 
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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i USER
[user]: testPASS:Connecting... press escape to cancelConnected
succesfuly220-FileZilla Server 0.9.60 beta220-written by Tim Kosse
(tim.kosse@filezilla-project.org)220 Please visit https://filezilla-
project.org/ Press "?" for help331 Password required for test 230
Logged on 200 Type set to I Filename: project1.lps227 Entering Passive
Mode (127,0,0,1,228,177) Error on connect: connection refusedAn
unhandled exception occurred at $000000010002F6E5:EAccessViolation:
Access violation  $000000010002F6E5 line 1018 of ../lib/lftp.pp 
$000000010002E9C0 line 680 of ../lib/lftp.pp  $000000010002E05F line
808 of ../lib/lftp.pp  $000000010002D2BF line 549 of ../lib/lftp.pp 
$000000010002FAE4 line 1070 of ../lib/lftp.pp  $0000000100001A61 line
68 of project1.lpr  $000000010002CF1F line 476 of ../lib/lftp.pp 
$0000000100036355 line 431 of ../lib/ltelnet.pp  $0000000100032A4F
line 1086 of ../lib/lnet.pp  $00000001000335B0 line 1549 of
../lib/lnet.pp  $0000000100037CCD line 591 of ../lib/levents.pp 
$0000000100033299 line 1471 of ../lib/lnet.pp  $000000010003702F line
556 of ../lib/ltelnet.pp  $0000000100030F4F line 1280 of
../lib/lftp.pp  $00000001000027D3 line 182 of project1.lpr 
$0000000100002C20 line 250 of project1.lpr  $0000000100002CF6 
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

----------------------------------------------------------------------
Remy Lebeau · 2018-12-01 20:08

Quote from: cris75 on November 30, 2018, 03:59:07 pm227 Entering
Passive Mode (127,0,0,1,228,177)

Error on connect: connection refused

Your logging does not show the actual FTP commands your client is
sending to the server, but presumably Put() is sending a PASV
command.  The FTP server is then sending a response telling the client
to connect to 127.0.0.1:58545 to transfer files.  But, unless the FTP
server is running on the same machine as your client, connecting to
127.0.0.1 will not work.  The server is sending you the wrong IP to
connect to.

----------------------------------------------------------------------
cris75 · 2018-12-03 13:22

Hi Remy,
thank you very much for your replay,

Quote from: Remy Lebeau on December 01, 2018, 09:08:33 pmBut, unless
the FTP server is running on the same machine as your client,
connecting to 127.0.0.1 will not work.  The server is sending you the
wrong IP to connect to.

yes, the server is running on the same machine..
But I also tested the code using a different ftp server machine in the
lan (with it's static private ip of course) and the result is the
same;
As I said, having not experience with lNet, to avoid possible mistakes
in my personal code, i compiled "as it is" the example  that I found
in the lNet package source "\examples\console\lftp\lftpclient.pp", so
I expected it working  "out of the box", but instead it fails with
that access violation..
I hoped to use it as a start point, but unfortunately I had no luck.
The example not working (in my case) and my inexperience with lNet are
maybe taking me on the wrong direction while trying to detect the
problem..
If you have the time, obviously, try to compile the example i'm
talking about; then, after a succesfully authentication, try to "put"
(p/P as the souce says), you should get the error too..
I confess I'm feeling a bit lost in this situation 
Any suggestion is welcome, thank you very much again,
Cris

----------------------------------------------------------------------
Remy Lebeau · 2018-12-03 20:03

Quote from: cris75 on December 03, 2018, 02:22:36 pmQuote from: Remy
Lebeau on December 01, 2018, 09:08:33 pmBut, unless the FTP server is
running on the same machine as your client, connecting to 127.0.0.1
will not work.  The server is sending you the wrong IP to connect to.

yes, the server is running on the same machine..

Well, don't you think that would have been important information to
state up front?

Is the server listening on 127.0.0.1?

Quote from: cris75 on December 03, 2018, 02:22:36 pmBut I also tested
the code using a different ftp server machine in the lan (with it's
static private ip of course) and the result is the same;

Then either lNet is not connecting to the reported IP correctly, or
there may be a firewall blocking the connection.  Have you tried
sniffing the network traffic with a packet sniffer, such as Wireshark,
to see exactly where Put() is trying to connect to, and that it
matches where the server says to connect?

Quote from: cris75 on December 03, 2018, 02:22:36 pmIf you have the
time, obviously, try to compile the example i'm talking about; then,
after a succesfully authentication, try to "put" (p/P as the souce
says), you should get the error too..

I can't do that, as I don't have FreePascal/Lazarus installed.