Download nebo upload přes HTTP za pomocí Synapse

vložil Radek Červinka 20. ledna 2011 00:45

Celkem častým požadavkem (a dotazem) je stažení určitého souboru z webu. Osobně to např. používám pro download novinek, které mám uložené v RSS formátu na webu a zobrazení v aplikaci. Pokud používáte knihovnu Synapse, tak to není problém (věřím, že někdo následně ukáže i možnost v Indy).

Základem je jednotka httpsend. Pokud člověk potřebuje jen stáhnout soubor (textový nebo i binární) tak mu to v podstatě stačí. Lukáš tam má několik pěkných procedur jako HttpGetText, HttpGetBinary nebo HttpPostFile a další. S tím si v normálním případě opravdu vystačíme.

Např.:

    1program Project1;
    2{$APPTYPE CONSOLE}
    3uses
    4  SysUtils, httpsend, Classes;
    5
    6var
    7  sl: TStringList;
    8
    9begin
   10  sl := TStringList.Create;
   11  try
   12    HttpGetText('http://www.google.cz/', sl);
   13    writeln(sl.Text);  
   14   // zde si muzeme se stazenym souborem neco udelat,
   15   // napr. pokud je to xml tak ho jednoduse zpracujeme
   16  finally
   17    FreeAndNil(sl);
   18  end;
   19end.

Uvedená funkce jen vytváří instanci THTTPSend definované v uvedené třídě. Pokud potřebujeme speciální chování, jednoduše proceduru zkopírujeme a rozšíříme, např. o podporu nastavení proxy, nebo verze HTTP protokolu:

    1function bHttpGetText(const URL: string; const Response: TStrings): Boolean;
    2var
    3  HTTP: THTTPSend;
    4begin
    5  HTTP := THTTPSend.Create;
    6  try
    7    HTTP.ProxyHost := 'host';
    8    HTTP.ProxyPass := 'password';
    9    HTTP.ProxyPort := port;
   10    HTTP.ProxyUser := 'user'
   11    HTTP.Protocol := '1.1';
   12
   13    Result := HTTP.HTTPMethod('GET', URL);
   14    if Result then
   15      Response.LoadFromStream(HTTP.Document);
   16  finally
   17    HTTP.Free;
   18  end;
   19end;

Pokud potřebujeme nějak zobrazit průběh stahování máme tuto možnost: THTTPSend má interně socket dostupný přes property Sock a ten má pro změnu událost OnStatus, což je proměnná typu metoda

 THookSocketStatus = procedure(Sender: TObject; Reason: THookSocketReason;
    const Value: String) of object;

kde Sender je socket, Reason je typ události a Value je volitelný parametr. Pokud si všimnete toho of object tak je jasné, že se musí jednat o metodu.

Jedna z událostí je i HR_ReadCount, což je výhodné v případě zobrazování stavu stahování. Celková délka je v THTTPSend.Downloadsize (pokud ji tedy server poslal - nezkoušejte to např. s google.cz - ten podle useragenta klienta posílá různé data). Pokud je tam 0 tak celková délka není známá - můžete zkusit změnit verzi protokolu nebo UserAgent string.

Jak se říká: zbytek nechám na laskavém čtenáři - myslím, že jako výkop to stačí.

    1program Project2;
    2{$APPTYPE CONSOLE}
    3uses
    4  SysUtils, httpsend, Classes, blcksock;
    5
    6var
    7  sl: TStringList;
    8
    9type
   10  TStatusWriter = class
   11  private
   12    fiProgress: Int64;
   13    foHttp: THTTPSend;
   14  public
   15    constructor Create(HTTP: THTTPSend);
   16    procedure Status (Sender: TObject; Reason: THookSocketReason;
   17      const Value: String);
   18  end;
   19
   20constructor TStatusWriter.Create(HTTP: THTTPSend);
   21begin
   22  foHttp := HTTP;
   23end;
   24
   25procedure TStatusWriter.Status (Sender: TObject; Reason: THookSocketReason;
   26  const Value: String);
   27begin
   28  case Reason of
   29    HR_Connect:
   30     writeln('Connect!');
   31    HR_SocketClose:
   32     writeln('Close!');
   33
   34    HR_SocketCreate:
   35       fiProgress := 0;
   36    HR_ReadCount:
   37    begin
   38       inc(fiProgress, StrToIntDef(Value, 0));
   39       writeln('Read:', fiProgress);
   40       writeln('Size:', foHttp.Downloadsize);
   41    end;
   42  end;
   43end;
   44
   45
   46function bHttpGetText(const URL: string; const Response: TStrings): Boolean;
   47var
   48  HTTP: THTTPSend;
   49  oWriter: TStatusWriter;
   50begin
   51  HTTP := THTTPSend.Create;
   52  oWriter := TStatusWriter.Create(HTTP);
   53  try
   54{    HTTP.ProxyHost := 'host';
   55    HTTP.ProxyPass := 'password';
   56    HTTP.ProxyPort := port;
   57    HTTP.ProxyUser := 'user'}
   58    HTTP.Protocol := '1.1';
   59//    HTTP.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 5.0; rv:1.7.6) Gecko/20050321 Firefox/1.0.2';
   60
   61    HTTP.Sock.OnStatus := oWriter.Status;
   62    Result := HTTP.HTTPMethod('GET', URL);
   63    if Result then
   64      Response.LoadFromStream(HTTP.Document);
   65  finally
   66    HTTP.Free;
   67    oWriter.Free;
   68  end;
   69end;
   70
   71
   72begin
   73  sl := TStringList.Create;
   74  try
   75{    HttpGetText('http://www.google.cz/', sl);
   76    writeln(sl.Text);  }
   77
   78    bHttpGetText('http://www.idnes.cz/', sl);
   79//    writeln(sl.Text);
   80    writeln('Delka:'+IntToStr(Length(sl.Text)));
   81
   82
   83  finally
   84    FreeAndNil(sl);
   85  end;
   86end.


Nabízíme Delphi školení na různá témata, primárně ve Vaší firmě.

Tagy: ,

Praxe

Komentování ukončeno

Naše nabídka

Partial English version.

MVP
Ing. Radek Červinka - Embarcadero MVP
profil na linkedin, Twitter:@delphicz

Nabízím placené poradenství a konzultace v oblasti programování a vývoje SW.
Dále nabízíme i vývoj speciálního software na zakázku.

Neváhejte nás kontaktovat (i ohledně reklamy nebo burzy práce).

Pokud chcete podpořit tento server libovolnou částkou, můžete použít PayPal. Moc děkuji.

Delphi Certified Developer

O Delphi.cz

Delphi je jediný moderní RAD nástroj podporující tvorbu nativních aplikací pro platformu Win32, Win64 , Mac OSX a na iPhone a Android (s výhledem na další platformy díky FireMonkey) na současném trhu (včetně Windows 8.1).

V současnosti je světová komunita přes dva miliónů vývojářů.

Delphi.cz je nezávislý portál pro uživatele Delphi. Portál není koncipován pro úplné začátečníky, i když i ti se zde nebudou nudit, ale spíše na programátory, kteří již něco znají a chtějí své znalosti dále rozvíjet a sledovat novinky.

Anketa

Poslední komentáře

Comment RSS