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ř.:

program Project1;
{$APPTYPE CONSOLE}
uses
  SysUtils, httpsend, Classes;

var
  sl: TStringList;

begin
  sl := TStringList.Create;
  try
    HttpGetText('http://www.google.cz/', sl);
    writeln(sl.Text);  
   // zde si muzeme se stazenym souborem neco udelat,
   // napr. pokud je to xml tak ho jednoduse zpracujeme
  finally
    FreeAndNil(sl);
  end;
end.

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:

function bHttpGetText(const URL: string; const Response: TStrings): Boolean;
var
  HTTP: THTTPSend;
begin
  HTTP := THTTPSend.Create;
  try
    HTTP.ProxyHost := 'host';
    HTTP.ProxyPass := 'password';
    HTTP.ProxyPort := port;
    HTTP.ProxyUser := 'user'
    HTTP.Protocol := '1.1';

    Result := HTTP.HTTPMethod('GET', URL);
    if Result then
      Response.LoadFromStream(HTTP.Document);
  finally
    HTTP.Free;
  end;
end;

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čí.


program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils, httpsend, Classes, blcksock;

var
  sl: TStringList;

type
  TStatusWriter = class
  private
    fiProgress: Int64;
    foHttp: THTTPSend;
  public
    constructor Create(HTTP: THTTPSend);
    procedure Status (Sender: TObject; Reason: THookSocketReason;
      const Value: String);
  end;

constructor TStatusWriter.Create(HTTP: THTTPSend);
begin
  foHttp := HTTP;
end;

procedure TStatusWriter.Status (Sender: TObject; Reason: THookSocketReason;
  const Value: String);
begin
  case Reason of
    HR_Connect:
     writeln('Connect!');
    HR_SocketClose:
     writeln('Close!');

    HR_SocketCreate:
       fiProgress := 0;
    HR_ReadCount:
    begin
       inc(fiProgress, StrToIntDef(Value, 0));
       writeln('Read:', fiProgress);
       writeln('Size:', foHttp.Downloadsize);
    end;
  end;
end;


function bHttpGetText(const URL: string; const Response: TStrings): Boolean;
var
  HTTP: THTTPSend;
  oWriter: TStatusWriter;
begin
  HTTP := THTTPSend.Create;
  oWriter := TStatusWriter.Create(HTTP);
  try
{    HTTP.ProxyHost := 'host';
    HTTP.ProxyPass := 'password';
    HTTP.ProxyPort := port;
    HTTP.ProxyUser := 'user'}
    HTTP.Protocol := '1.1';
//    HTTP.UserAgent := 'Mozilla/5.0 (Windows; U; Windows NT 5.0; rv:1.7.6) Gecko/20050321 Firefox/1.0.2';

    HTTP.Sock.OnStatus := oWriter.Status;
    Result := HTTP.HTTPMethod('GET', URL);
    if Result then
      Response.LoadFromStream(HTTP.Document);
  finally
    HTTP.Free;
    oWriter.Free;
  end;
end;


begin
  sl := TStringList.Create;
  try
{    HttpGetText('http://www.google.cz/', sl);
    writeln(sl.Text);  }

    bHttpGetText('http://www.idnes.cz/', sl);
//    writeln(sl.Text);
    writeln('Delka:'+IntToStr(Length(sl.Text)));


  finally
    FreeAndNil(sl);
  end;
end.

Tagy: ,

Praxe

Komentování ukončeno

Naše nabídka

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

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.

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.

Poslední komentáře

Comment RSS