4programmers.net 4p Delphi FAQ Jak ściągnąć plik z Internetu
Delphi » FAQ

Jak ściągnąć plik z Internetu

Adam Boduch

Przede wszytkim należy do listy modułów Uses dodać słowo: URLMon. Kod:

Kopiuj
if URLDownloadToFile(nil, 'http://www.serwer.com/plik.htm',  'c:\plik.htm', 0, nil)  <> 0 then
    ShowMessage('Błąd podczas ściągania pliku');
FAQ

10 komentarzy

P0

@Setesh: Nie działa, bo to do Delphi :) Poza tym podałeś błędną nazwę funkcji. :D

AU

bug : najłatwiej przez GetHTML (4programmers, delphi, gotowce)

Setesh

A wie ktos czemu w C++ Builder 6 wywala mi blad w tym kodzie :

if(URLDownloadToFileA(NULL,
"http://www.serwer.pl/plik.exe",
"c:\plik.exe",
0,
NULL) != 0)
ShowMessage("Wystąpil blad przy sciaganiu pliku!");

blad jest taki :

[Linker Error] Unresolved external 'URLDownloadToFileA' referenced from J:\program\UNIT1.OBJ

bede bardzo wdzieczny za info na TMSeth@o2.pl lub na gg : 2320016

SZ

Jak ktoś chce widzieć postęp pobierania, a nie chce stosować dodatkowych komponentów, to może zrobić tak:

Form1 (Caption='Pobieranie pliku'), Button1 (Caption='Pobieraj'), ProgressBar1.

W sekcji

Kopiuj
uses

dodajemy UrlMon, ActiveX.

W sekcji

Kopiuj
type

dodajemy klasę:

Kopiuj
TCallbackObject = class(TObject, IBindStatusCallBack)
  public
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall; 
    function _Release: Integer; stdcall;
    function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
    function GetPriority(out nPriority): HResult; stdcall; 
    function OnLowResource(reserved: DWORD): HResult; stdcall;
    function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
    function OnObjectAvailable(const IID: TGUID; punk: IUnknown): HResult; stdcall;
    function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
  end;

W sekcji

Kopiuj
var

dodajemy zmienną:

Kopiuj
Cancel: Boolean = False;

W sekcji

Kopiuj
implementation

dodajemy kod:

Kopiuj
function TCallbackObject._AddRef: Integer;
begin 
result:=S_OK;
end; 

function TCallbackObject._Release: Integer;
begin
result:=S_OK;
end; 

function TCallbackObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin 
if(GetInterface(IID,Obj)) then
  result:=S_OK
else
  result:=E_NOINTERFACE;
end; 

function TCallbackObject.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin 
result:=S_OK;
end; 

function TCallbackObject.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
begin
result:=S_OK;
end;

function TCallbackObject.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
begin
result:=S_OK;
end;

function TCallbackObject.GetPriority(out nPriority): HResult;
begin 
result:=S_OK;
end; 

function TCallbackObject.OnLowResource(reserved: DWORD): HResult;
begin 
result:=S_OK;
end; 

function TCallbackObject.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin 
result:=S_OK;
end; 

function TCallbackObject.OnObjectAvailable(const IID: TGUID; punk: IUnknown): HResult; stdcall;
begin 
result:=S_OK;
end; 

function TCallbackObject.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
begin 
case ulStatusCode of
  BINDSTATUS_FINDINGRESOURCE:
    begin
    Form1.Caption:='Nawiązywanie połączenia';
    if (Cancel) then
      begin
      result:=E_ABORT;
      exit;
      end;
    end;
  BINDSTATUS_CONNECTING:
    begin
    if (Cancel) then
      begin
      Form1.Caption:='Anulowano!';
      result:=E_ABORT;
      exit;
      end
    else
      Form1.Caption:='Łączenie..';
    end;
  BINDSTATUS_BEGINDOWNLOADDATA:
    begin
    Form1.ProgressBar1.Position:=0;
    if (Cancel) then
      begin
      Form1.Caption:='Anulowano!';
      result:=E_ABORT;
      exit;
      end
    else
      Form1.Caption:='Rozpoczynam pobieranie..';
    end;
  BINDSTATUS_DOWNLOADINGDATA:
    begin
    if (Cancel) then
      begin
      Form1.Caption:='Anulowano!';
      result:=E_ABORT;
      exit;
      end
    else
      begin
      Form1.ProgressBar1.Max:=ulProgressMax;
      Form1.ProgressBar1.Position:=ulProgress;
      Form1.Caption:='Trwa pobieranie ( '+inttostr(ulProgress div 1024)+'kB / '+inttostr(ulProgressMax div 1024)+'kB )';
      end;
    end;
  BINDSTATUS_ENDDOWNLOADDATA:
    begin
    Form1.Caption:='Zakończono pobieranie danych';
    end;
end;
Application.ProcessMessages;
result:=S_OK;
end;

Ostatecznie przyda się akcja na przycisk:

Kopiuj
procedure TForm1.Button1Click(Sender: TObject);
var
  CallBack:TCallbackObject;
begin
if Button1.Caption='Pobieraj' then
  begin
  Button1.Caption:='Anuluj';
  CallBack := TCallBackObject.Create;
  try
    Form1.Caption:='Pobieranie zakończono kodem: '+inttostr( URLDownloadToFile(nil,'http://serwer/plik','dysk:\katalog\plik',0,CallBack) );
  finally
    CallBack.Free;
    end;
  end
else
  Cancel:=TRUE;
end;
AV

Jak sie chce uniwersalnie to sie pakuje Edit.Text :D pozdro

WO

Miałem problem, ponieważ nie chciałem podawać bezwzględnej ścieżki do pliku na dysku, w końcu program ma być uniwersalny... :)
Oto rozwiązanie mojego problemu, mam nadzieję, że się komuś przyda.

Kopiuj
              {...}
type
   TFileName = array[0..259] of Char;
              {...}
procedure NBPdownload;
var FileName : TFileName;
    Str : AnsiString;
    i,k : integer;
begin
  Str:=SciezkaDoProgramu+'kursy.xml';
  k:=length(Str);  
  for i:=0 to k do
   begin
     FileName[i]:=Str[i+1];
   end;
  if URLDownloadToFile(nil, 'http://www.nbp.pl/kursy/xml/a018z050126.xml', FileName , 0, nil)  <> 0 then
  ShowMessage('Błąd podczas ściągania pliku');
end;

Pozdrawiam serdecznie... :)

ES

dzięki - bardzo przydatne :)

WeeR

Nie zapominaj Snowak, że musisz dopisać do usus: URLMon, a w miejsce adresu wpisać prawidłowy adres:D