Download from SourceForge/pl
From Lazarus wiki
Jump to navigationJump to search
│
English (en) │
français (fr) │
polski (pl) │
Pobieranie z SourceForge
Możesz użyć biblioteki sieciowej Synapse do pobierania plików z SourceForge. Ponieważ SourceForge przechowuje pliki na wielu serwerach lustrzanych, musisz poradzić sobie z przekierowaniami.
...
uses httpsend {moduł Synapse}
...
function DownloadHTTPStream(URL: string; Buffer: TStream): boolean;
// Pobieranie pliku; w razie potrzeby próbuje ponownie.
const
MaxRetries = 3;
var
RetryAttempt: integer;
HTTPGetResult: boolean;
begin
Result:=false;
RetryAttempt := 1;
HTTPGetResult := False;
while ((HTTPGetResult = False) and (RetryAttempt < MaxRetries)) do
begin
HTTPGetResult := HttpGetBinary(URL, Buffer);
//Application.ProcessMessages;
Sleep(100 * RetryAttempt);
RetryAttempt := RetryAttempt + 1;
end;
if HTTPGetResult = False then
raise Exception.Create('Nie można załadować dokumentu ze zdalnego serwera');
Buffer.Position := 0;
if Buffer.Size = 0 then
raise Exception.Create('Pobrany dokument jest pusty.');
Result := True;
end;
function SFDirectLinkURL(URL: string; Document: TMemoryStream): string;
{
Przekształć tę część dokumentu:
<noscript>
<meta http-equiv="refresh" content="5; url=http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&ts=1329648745&use_mirror=kent">
</noscript>
na poprawny adres URL:
http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&ts=1329648745&use_mirror=kent
}
const
Refresh='<meta http-equiv="refresh"';
URLMarker='url=';
var
Counter: integer;
HTMLBody: TStringList;
RefreshStart: integer;
URLStart: integer;
begin
HTMLBody:=TStringList.Create;
try
HTMLBody.LoadFromStream(Document);
for Counter:=0 to HTMLBody.Count-1 do
begin
// Ta linia powinna znajdować się między tagami noscript i podawać bezpośrednią lokalizację pobierania:
RefreshStart:=Ansipos(Refresh, HTMLBody[Counter]);
if RefreshStart>0 then
begin
URLStart:=AnsiPos(URLMarker, HTMLBody[Counter])+Length(URLMarker);
if URLStart>RefreshStart then
begin
// Znajdź cudzysłów zamykający "
URL:=Copy(HTMLBody[Counter],
URLStart,
PosEx('"',HTMLBody[Counter],URLStart+1)-URLStart);
infoln('debug: nowy adres URL po tagu noscript:');
infoln(URL);
break;
end;
end;
end;
finally
HTMLBody.Free;
end;
result:=URL;
end;
function SourceForgeURL(URL: string): string;
// Wykrywa pobieranie z sourceforge i próbuje poradzić sobie
// z przekierowaniami i wyodrębnieniem bezpośredniego linku do pobrania.
// Dziękuję
// Ocye: http://lazarus.freepascal.org/index.php/topic,13425.msg70575.html#msg70575
const
SFProjectPart = '//sourceforge.net/projects/';
SFFilesPart = '/files/';
SFDownloadPart ='/download';
var
HTTPSender: THTTPSend;
i, j: integer;
FoundCorrectURL: boolean;
SFDirectory: string; //Katalog Sourceforge
SFDirectoryBegin: integer;
SFFileBegin: integer;
SFFilename: string; //Nazwa pliku Sourceforge
SFProject: string;
SFProjectBegin: integer;
begin
// Wykryj pobieranie SourceForge; np. z adresu URL
// 1 2 3 4 5 6 7 8 9
// 1234557890123456789012345578901234567890123455789012345678901234557890123456789012345578901234567890
// http://sourceforge.net/projects/base64decoder/files/base64decoder/version%202.0/b64util.zip/download
// ^^^projekt^^^ ^^^katalog..............^^^ ^^^plik^^^
FoundCorrectURL:=true; //Załóżmy, że nie jest to pobieranie z SourceForge
i:=Pos(SFProjectPart, URL);
if i>0 then
begin
// Ewentualnie znaleziony projekt; teraz wyodrębnij części projektu, katalogu i nazwy pliku.
SFProjectBegin:=i+Length(SFProjectPart);
j := PosEx(SFFilesPart, URL, SFProjectBegin);
if (j>0) then
begin
SFProject:=Copy(URL, SFProjectBegin, j-SFProjectBegin);
SFDirectoryBegin:=PosEx(SFFilesPart, URL, SFProjectBegin)+Length(SFFilesPart);
if SFDirectoryBegin>0 then
begin
// Znajdź plik
// URL może mieć końcowe argumenty... więc: wyszukaj pierwszą
// napotkaną nazwę z prawej strony, ale powinna być po /files/
i:=RPos(SFDownloadPart, URL);
// Teraz poszukaj poprzedni ukośnik /, abyśmy mogli rozpoznać plik.
// Może to być końcowy / w /files/
SFFileBegin:=RPosEx('/',URL,i-1)+1;
if SFFileBegin>0 then
begin
SFFilename:=Copy(URL,SFFileBegin, i-SFFileBegin);
//Uwzględnij końcowy ukośnik /
SFDirectory:=Copy(URL, SFDirectoryBegin, SFFileBegin-SFDirectoryBegin);
FoundCorrectURL:=false;
end;
end;
end;
end;
if not FoundCorrectURL then
begin
try
// Przepisz adres URL, jeśli jest to konieczne do przekierowania pobierania Sourceforge
// Wykryj bezpośredni link w treści HTML i uzyskaj z niego adres URL
HTTPSender := THTTPSend.Create;
//Kto wie, może to pomóc:
HTTPSender.UserAgent:='curl/7.21.0 (i686-pc-linux-gnu) libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18';
while not FoundCorrectURL do
begin
HTTPSender.HTTPMethod('GET', URL);
infoln('debug: headers:');
infoln(HTTPSender.Headers.Text);
case HTTPSender.Resultcode of
301, 302, 307:
begin
for i := 0 to HTTPSender.Headers.Count - 1 do
if (Pos('Location: ', HTTPSender.Headers.Strings[i]) > 0) or
(Pos('location: ', HTTPSender.Headers.Strings[i]) > 0) then
begin
j := Pos('use_mirror=', HTTPSender.Headers.Strings[i]);
if j > 0 then
URL :=
'http://' + RightStr(HTTPSender.Headers.Strings[i],
length(HTTPSender.Headers.Strings[i]) - j - 10) +
'.dl.sourceforge.net/project/' +
SFProject + '/' + SFDirectory + SFFilename
else
URL:=StringReplace(
HTTPSender.Headers.Strings[i], 'Location: ', '', []);
HTTPSender.Clear;//httpsend
FoundCorrectURL:=true;
break; // opuść pętlę przepisywania
end;
end;
100..200:
begin
//Pobierz stronę sourceforge z bezpośredniego linku
URL:=SFDirectLinkURL(URL, HTTPSender.Document); //Zapytaj
FoundCorrectURL:=true; //Już skończyliśmy
end;
500: raise Exception.Create('Brak połączenia internetowego');
//Internal Server Error ('+aURL+')');
else
raise Exception.Create('Pobieranie nie powiodło się. Kod błędu ' +
IntToStr(HTTPSender.ResultCode) + ' (' + HTTPSender.ResultString + ')');
end;//case
end;//while
infoln('debug: wynikowy adres URL po przekierowaniu sf: *' + URL + '*');
finally
HTTPSender.Free;
end;
end;
result:=URL;
end;
Następnie możesz pobrać plik standardową metodą.
...
function DownloadHTTP(URL, TargetFile: string): boolean;
// Pobieranie pliku; w razie potrzeby spróbuj ponownie.
// Oferty z linkami do pobierania SourceForge
var
Buffer: TMemoryStream;
begin
result:=false;
URL:=SourceForgeURL(URL); //Zajmij się adresami URL Sourceforge
try
Buffer := TMemoryStream.Create;
DownloadHTTPStream(URL, Buffer);
Buffer.SaveToFile(TargetFile);
result:=true;
finally
FreeAndNil(Buffer);
end;
end;
