Programowanie w języku Delphi » FAQ

Jak ściągnąć plik z Internetu

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

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


10 komentarzy

p0358 2011-12-08 14:19

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

Autre 2008-07-30 09:54

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

Setesh 2006-08-25 01:29

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 [email protected] lub na gg : 2320016

Szczawik 2005-06-24 01:01

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

uses
dodajemy UrlMon, ActiveX.

W sekcji
type
dodajemy klasę:
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
var
dodajemy zmienną:
Cancel: Boolean = False;


W sekcji
implementation
dodajemy kod:
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:
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;

AVsoft 2005-04-20 19:08

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

wojteksoszynski 2005-01-26 18:15

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.

              {...}
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... :)

Eskim 2004-09-18 13:32

dzięki - bardzo przydatne :)

WeeR 2004-06-06 10:06

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

Snowak 2004-05-19 18:44

Nie dziala :/