ProgressBar przy URLDownloadToFile

Hej!
Pobieram plik ze strony za pomoca funkcji URLDownloadToFile. Robie to w ten sposob i wszystko pieknie smiga:

URLDownloadToFile(nil,
                  'http://www.adres.eu/klient.zip',
                  PChar(ExtractFilePath(Application.ExeName) + 'pobieranie.zip'),
                  0,
                  nil); 

chcialbym zrobic oczywiscie to bardziej bajerancko wiec probuje dodac progress bar. Znalazlem rozwiazanie na 4p ale dosc stare i pod Delphi. W zwiazku z tym przy kompilacji otrzymuje komunikaty o nierozpoznawaniu typow np. LPCWSTR czy PFormatEtc.

Czy mozecie mi pomoc przerobic ponizszy fragment zeby smigal pod lazarusem?

Rozwiazanie zaproponowane przez @Szczawik 12 lat temu :P
Jak ściągnąć plik z Internetu

uses
UrlMon, ActiveX.

type

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
Cancel: Boolean = False;

implementation

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;


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;

Może to nie odpowiedź na pytanie, ale czemu nie skorzystasz z:

• synapse: http://andydunkel.net/lazarus/delphi/2015/09/09/lazarus_synapse_progress.html
• indy: http://forum.lazarus.freepascal.org/index.php?topic=11567.0
• fcl-web: http://forum.lazarus.freepascal.org/index.php?topic=21824.0

Bo niestety zaczalem swoj projekt korzystajac z pakietu lNet i jest teraz za bardzo zaawansowany zeby to zmieniac:(
Chce to wiec dokonczyc tak jak jest a nad czyms lepszym pomysle przepisujac to od nowa :)

Skorzystaj z biblioteki WinInet zamiast UrlMon. Wtedy bardzo łatwo można kontrolować cały proces pobierania.

dodaj do uses ctypes i/lub windows

Dzięki @pelsta, zgooglowalem i znalazlem takie cos:

 procedure DownloadFile(URL: string; Path: string);
const
  BLOCK_SIZE = 1024;
var
  InetHandle: Pointer;
  URLHandle: Pointer;
  FileHandle: Cardinal;
  BytesRead: Cardinal;
  DownloadBuffer: Pointer;
  Buffer: array [1 .. BLOCK_SIZE] of byte;
  BytesWritten: Cardinal;
begin
  InetHandle := InternetOpen(PWideChar(URL), 0, 0, 0, 0);
  if not Assigned(InetHandle) then RaiseLastOSError;
  try
    URLHandle := InternetOpenUrl(InetHandle, PWideChar(URL), 0, 0, 0, 0);
    if not Assigned(URLHandle) then RaiseLastOSError;
    try
      FileHandle := CreateFile(PWideChar(Path), GENERIC_WRITE, FILE_SHARE_WRITE, 0,
        CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
      if FileHandle = INVALID_HANDLE_VALUE then RaiseLastOSError;
      try
        DownloadBuffer := @Buffer;
        repeat
          if (not InternetReadFile(URLHandle, DownloadBuffer, BLOCK_SIZE, BytesRead) 
             or (not WriteFile(FileHandle, DownloadBuffer^, BytesRead, BytesWritten, 0)) then
            RaiseLastOSError;
        until BytesRead = 0;
      finally
        CloseHandle(FileHandle);
      end;
    finally
      InternetCloseHandle(URLHandle);
    end;
  finally
    InternetCloseHandle(InetHandle);
  end;
end;

no i uzycie:

 DownloadFile
    ('http://jakistamserwer.pl/plik.zip',
    '.\sciagamy.zip');

Nie mam mozliwosci teraz ale pewnie bedzie mozliwe w miare latwe dopisanie tutaj postepu pobierania.

Ja to robię w najprostszy możliwy sposób.

Po uzyskaniu URLHandle sprawdzam wielkość pliku do pobrania (zrobiłem do tego funkcję)

function BytesToRead(const service:hInternet):LongWord;
var i,n:LongWord;
begin
  i:=0;
  n:=SizeOf(Result);
  if not HttpQueryInfo(service,HTTP_QUERY_CONTENT_LENGTH+HTTP_QUERY_FLAG_NUMBER,@Result,n,i) then Result:=0;
end;

procedure DownloadFile(URL: string; Path: string);
const
  BLOCK_SIZE = 1024;
var
  InetHandle: Pointer;
  URLHandle: Pointer;
  FileHandle: Cardinal;
  BytesRead: Cardinal;
  DownloadBuffer: Pointer;
  Buffer: array [1 .. BLOCK_SIZE] of byte;
  BytesWritten: Cardinal;
  content_length,total_read:Cardinal;//by pelsta
begin
  total_read:=0;//by pelsta
  InetHandle := InternetOpen(PWideChar(URL), 0, 0, 0, 0);
  if not Assigned(InetHandle) then RaiseLastOSError;
  try
    URLHandle := InternetOpenUrl(InetHandle, PWideChar(URL), 0, 0, 0, 0);
    if not Assigned(URLHandle) then RaiseLastOSError;
    try
      content_length:=BytesToRead(URLHandle);//by pelsta
      FileHandle := CreateFile(PWideChar(Path), GENERIC_WRITE, FILE_SHARE_WRITE, 0,
        CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
      if FileHandle = INVALID_HANDLE_VALUE then RaiseLastOSError;
      try
        DownloadBuffer := @Buffer;
        repeat
          if (not InternetReadFile(URLHandle, DownloadBuffer, BLOCK_SIZE, BytesRead) 
             or (not WriteFile(FileHandle, DownloadBuffer^, BytesRead, BytesWritten, 0)) then RaiseLastOSError;
          total_read:=total_read+BytesRead;//by pelsta
          Label1.Caption:=Format('%d/%d',[total_read,content_length]);//by pelsta
          Label1.Repaint;//by pelsta
        until BytesRead = 0;
      finally
        CloseHandle(FileHandle);
      end;
    finally
      InternetCloseHandle(URLHandle);
    end;
  finally
    InternetCloseHandle(InetHandle);
  end;
end;

Oczywiście można też wykorzystać jakiś ProgressBar.

Nie mam czasu czytać obecnie tego wątku w całości, bo zaraz się zbieram na nockę do pracy. A i z wiadomych powodów udzielam się tutaj minimalnie od kilku miesięcy. Natomiast nie rozumiem dlaczego kolejna osoba upiera się na rozwiazanie bazujące na ustawieniach InternetExplorera, czyli na przykłąd gdy mamy tam odczytywanie z cache to nam pobierze poprzednia wersję pliku. Tak bywało kiedyś. Tylko Synpase lub Simple TCP dla WinAPI. Ewentualnie Indy. Ale róbcie jak chcecie, tylko po co sobie komplikować kod, kiedy są sprawdzone i proste, a także porządnie napisane i udokumentoiwane metody.