paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 14:29:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

* adds FTP support in lNet downloader

Browse Source 
git-svn-id: trunk@5232 -
This commit is contained in:
Almindor 2006-11-05 10:13:21 +00:00
parent 46b6f00bc7
commit 2bcf64c815
1 changed files with 64 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
utils/fppkg/pkglnet.pas
View File

@ -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.FTPDownload(const URL: String; Dest: TStream);
procedure TLNetDownloader.OnFTPControl(Sender: TLFtpClient);
var
s: string;
begin
inherited FTPDownload(URL, Dest); // TODO
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
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