Sign in Join
Wiki copytemporary

Download from SourceForge/pl

English · Français · Polski

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.

pascal
...
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ą.

pascal
...
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


From the Free Pascal wiki, page "Download from SourceForge/pl", as it stood on 2022-07-06 after a change by Slawek, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's Licensing page. If you have concerns about this material, message the admin.

Revision 2, last changed by WikiArchive .

Edited on wiki.freepascal.org by 1 person, 2022

From the official wiki's backup of 26 May 2024: who edited this page there, and when. Edits made there after that date were not recorded, and the earlier versions are not shown here; the main page says why.

WhenWhoWhat changed
Slawektłumaczenie na j. polski
Slawektłumaczenie na j. polski, dokończenie
Slawekadd polish title (minor)
SlawekZobacz także: link (minor)

Talk about this page

Nobody has opened a bench for this page yet. Sign in to open one.