Browse Source

* adds FTP support in lNet downloader

git-svn-id: trunk@5232 -
Almindor 19 years ago
parent
commit
2bcf64c815
1 changed files with 63 additions and 2 deletions
  1. 63 2
      utils/fppkg/pkglnet.pas

+ 63 - 2
utils/fppkg/pkglnet.pas

@@ -25,6 +25,10 @@ Type
     procedure OnLNetDisconnect(aSocket: TLSocket);
     procedure OnHttpDoneInput(aSocket: TLHTTPClientSocket);
     procedure OnLNetError(const msg: string; aSocket: TLSocket);
+    procedure OnFTPControl(Sender: TLFtpClient);
+    procedure OnFTPReceive(Sender: TLFtpClient);
+    procedure OnFTPSuccess(Sender: TLFTPClient; const aStatus: TLFTPStatus);
+    procedure OnFTPFailure(Sender: TLFTPClient; const aStatus: TLFTPStatus);
     // overrides
     procedure FTPDownload(Const URL : String; Dest : TStream); override;
     procedure HTTPDownload(Const URL : String; Dest : TStream); override;
@@ -62,9 +66,61 @@ begin
   FQuit:=True;
 end;
 
+procedure TLNetDownloader.OnFTPControl(Sender: TLFtpClient);
+var
+  s: string;
+begin
+  FFTP.GetMessage(s); // have to empty OS buffer, write the info if you wish to debug
+end;
+
+procedure TLNetDownloader.OnFTPReceive(Sender: TLFtpClient);
+const
+  BUF_SIZE = 65536; // standard OS recv buffer size
+var
+  Buf: array[1..BUF_SIZE] of Byte;
+begin
+  FOutStream.Write(Buf[1], FFTP.GetData(Buf[1], BUF_SIZE));
+end;
+
+procedure TLNetDownloader.OnFTPSuccess(Sender: TLFTPClient;
+  const aStatus: TLFTPStatus);
+begin
+  FFTP.Disconnect;
+  FQuit:=True;
+end;
+
+procedure TLNetDownloader.OnFTPFailure(Sender: TLFTPClient;
+  const aStatus: TLFTPStatus);
+begin
+  FFTP.Disconnect;
+  Error('Retrieve failed');
+  FQuit:=True;
+end;
+
 procedure TLNetDownloader.FTPDownload(const URL: String; Dest: TStream);
+var
+  URI: TURI;
 begin
-  inherited FTPDownload(URL, Dest); // TODO
+  FOutStream:=Dest;
+  { parse URL }
+  URI:=ParseURI(URL);
+  
+  if URI.Port = 0 then
+    URI.Port := 21;
+    
+  FFTP.Connect(URI.Host, URI.Port);
+  while not FFTP.Connected and not FQuit do
+    FFTP.CallAction;
+    
+  if not FQuit then begin
+    FFTP.Authenticate(URI.Username, URI.Password);
+    FFTP.ChangeDirectory(URI.Path);
+    FFTP.Retrieve(URI.Document);
+    while not FQuit do
+      FFTP.CallAction;
+  end;
+  
+  FOutStream:=nil;
 end;
 
 procedure TLNetDownloader.HTTPDownload(const URL: String; Dest: TStream);
@@ -82,7 +138,6 @@ begin
   FHTTP.Method := hmGet;
   FHTTP.Port := URI.Port;
   FHTTP.URI := '/' + URI.Document;
-  Writeln(FHTTP.Host + FHTTP.URI);
   FHTTP.SendRequest;
 
   FQuit:=False;
@@ -96,7 +151,13 @@ begin
   inherited Create(AOwner);
 
   FFTP:=TLFTPClient.Create(Self);
+  FFTP.Timeout:=1000;
+  FFTP.StatusSet:=[fsRetr]; // watch for success/failure of retreives only
   FFTP.OnError:=@OnLNetError;
+  FFTP.OnControl:=@OnFTPControl;
+  FFTP.OnReceive:=@OnFTPReceive;
+  FFTP.OnSuccess:=@OnFTPSuccess;
+  FFTP.OnFailure:=@OnFTPFailure;
 
   FHTTP:=TLHTTPClient.Create(Self);
   FHTTP.Timeout := 1000; // go by 1s times if nothing happens