|
@@ -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
|