Download from SourceForge/pl

From Lazarus wiki
Revision as of 23:08, 6 July 2022 by Slawek (talk | contribs) (add polish title)
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=&amp;ts=1329648745&amp;use_mirror=kent">
</noscript>
na poprawny adres URL:
http://downloads.sourceforge.net/project/base64decoder/base64decoder/version%202.0/b64util.zip?r=&amp;ts=1329648745&amp;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;

Zobacz także