mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 06:21:15 +02:00
* Initial implementation of Synapse-based downloader
git-svn-id: trunk@5211 -
This commit is contained in:
parent
e17b424e28
commit
202191e2cf
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -7791,6 +7791,7 @@ utils/fppkg/pkghandler.pp svneol=native#text/plain
|
||||
utils/fppkg/pkgmessages.pp svneol=native#text/plain
|
||||
utils/fppkg/pkgmkconv.pp svneol=native#text/plain
|
||||
utils/fppkg/pkgropts.pp svneol=native#text/plain
|
||||
utils/fppkg/pkgsynapse.pp svneol=native#text/plain
|
||||
utils/fppkg/pkgwget.pp svneol=native#text/plain
|
||||
utils/fppkg/rep2xml.lpi svneol=native#text/plain
|
||||
utils/fppkg/rep2xml.lpr svneol=native#text/plain
|
||||
|
76
utils/fppkg/pkgsynapse.pp
Normal file
76
utils/fppkg/pkgsynapse.pp
Normal file
@ -0,0 +1,76 @@
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
unit pkgsynapse;
|
||||
|
||||
interface
|
||||
|
||||
uses Classes,pkgdownload;
|
||||
|
||||
Type
|
||||
TSynapseDownloader = Class(TBasePackageDownloader)
|
||||
Protected
|
||||
Procedure FTPDownload(Const URL : String; Dest : TStream); override;
|
||||
Procedure HTTPDownload(Const URL : String; Dest : TStream); override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses sysutils,uriparser,httpsend,ftpsend,pkgmessages;
|
||||
|
||||
Procedure TSynapseDownloader.FTPDownload(Const URL : String; Dest : TStream);
|
||||
|
||||
Var
|
||||
URI : TURI;
|
||||
FN : String;
|
||||
F : TFileStream;
|
||||
|
||||
begin
|
||||
// Download in temporary file.
|
||||
FN:=GetTempFileName();
|
||||
try
|
||||
URI:=ParseURI(URL);
|
||||
with TFTPSend.Create do
|
||||
try
|
||||
if URI.UserName <> '' then
|
||||
begin
|
||||
Username := URI.UserName;
|
||||
Password := URI.Password;
|
||||
end;
|
||||
TargetHost := URI.Host;
|
||||
if (URI.Port<>0) then
|
||||
TargetPort := IntToStr(URI.Port);
|
||||
if not Login then
|
||||
Error(SErrLoginFailed);
|
||||
DirectFileName := FN;
|
||||
DirectFile:=True;
|
||||
If (URI.Path<>'') then
|
||||
if not ChangeWorkingDir(URI.Path) then
|
||||
Error(SErrCWDFailed,[URI.PATH]);
|
||||
BinaryMode:=True;
|
||||
If Not RetrieveFile(URI.Document, False) then
|
||||
Error(SErrGETFailed,[URI.Document]);
|
||||
Logout;
|
||||
finally
|
||||
Free;
|
||||
end;
|
||||
F:=TFileStream.Create(FN,fmOpenRead);
|
||||
Try
|
||||
Dest.CopyFrom(F,0);
|
||||
Finally
|
||||
F.Free;
|
||||
end;
|
||||
finally
|
||||
// Delete temporary file.
|
||||
If FileExists(FN) then
|
||||
DeleteFile(FN);
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TSynapseDownloader.HTTPDownload(Const URL : String; Dest : TStream);
|
||||
|
||||
begin
|
||||
If Not HttpGetBinary(URL,Dest) then
|
||||
Error(SErrHTTPGetFailed);
|
||||
end;
|
||||
|
||||
end.
|
Loading…
Reference in New Issue
Block a user