компоненты Tprogressbar и Tlabel.

[kyran29]

Код выполняется в отдельном потоке.
Подскажите, пожалуйста, как отразить весь процесс закачки файла, с помощью компонентов TProgressBar и TLabel.
<div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable"> Код здесь</div></div><div class="sp-body"><div class="sp-content">

Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,URLMon;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TLoadThread = class(TThread)
protected
FResult:String;
procedure Execute; override;
procedure ShowResult;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}


function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0, nil) = 0;
except
Result := False;
end;
end; 


procedure TLoadThread.Execute;
const
//// Адресок
SourceFile = 'http://downloads.kaspersky-labs.com/trial/registered/8NGILSWTCHAPVSJ1NTX8/kav9.0.0.736ru.exe ';
// Куда качаем
DestFile = 'c:\kav9.0.0.736ru.exe ';
begin

if DownloadFile(SourceFile, DestFile) then
FResult:='Файл загружен!'
else
FResult:='Ошибка при загрузке - '+ SourceFile;
Synchronize(ShowResult);
end;


procedure TLoadThread.ShowResult;
begin
ShowMessage(FResult);
end;


procedure TForm1.Button1Click(Sender: TObject);
var
lt:TLoadThread;
begin
lt:=TLoadThread.Create(False);
lt.FreeOnTerminate:=True;
lt.Resume;
end;

<table valign="top" style='margin:0;width:100%;border:1px dashed red;'>[tr]<td align='middle' bgcolor='#ff6060' valign='top' width='1%'>
<FONT color='#ffffff' size='+3'> ! </font>
</td><td align="midle" valign='top' style='background:#fff;'>ОФОРМЛЯЙ ПОСТЫ ПО ЧЕЛОВЕЧЕСКИ! Предупреждение. Vital</td>[/tr]</table>

 

[vital]

Перед скачиванием нужно узнать размер файла - это максимальное значения прогрессбара. Потом каждые пускай 20 сек проверять размер уже скачанного - это текущая позиция прогрессбара. Элементарщина..

 

[zubr]

Использовать метод интерфейса IBindStatusCallback.OnProgress. Для этого
1. Определяем класс-наследник от TInterfacedObject с применением интерфейса IBindStatusCallback
2. Определяем (ставим заглушки) на методы интерфейса IBindStatusCallback.
3. Определяем метод IBindStatusCallback.OnProgress
4. Создаем объект вышеуказанного класса и вводим его в качестве последнего параметра в функцию UrlDownloadToFile.
Пример:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, UrlMon, StdCtrls, ComObj, ActiveX, ComCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
ProgressBar1: TProgressBar;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TBindStatusCallback = class(TInterfacedObject, IBindStatusCallback)
public
function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
function GetPriority(out nPriority): HResult; stdcall;
function OnLowResource(reserved: DWORD): HResult; stdcall;
function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR): HResult; stdcall;
function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
stgmed: PStgMedium): HResult; stdcall;
function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

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

function TBindStatusCallback.GetPriority(out nPriority): HResult;
begin
Result:=S_OK;
end;

function TBindStatusCallback.OnLowResource(reserved: DWORD): HResult;
begin
Result:=S_OK;
end;

function TBindStatusCallback.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
szStatusText: LPCWSTR): HResult;
begin
Form1.ProgressBar1.Max := ulProgressMax;
Form1.ProgressBar1.Position := ulProgress;
Result:=S_OK;
end;

function TBindStatusCallback.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin
Result:=S_OK;
end;

function TBindStatusCallback.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
begin
Result:=S_OK;
end;

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

function TBindStatusCallback.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult;
begin
Result:=S_OK;
end;



procedure TForm1.Button1Click(Sender: TObject);
var
cb: TBindStatusCallback;
begin
cb := TBindStatusCallback.Create;
try
UrlDownloadToFile(nil, PChar(Source), PChar(Dest), 0, cb);
finally
cb.Free;
end;
end;

end.

 

[vital]

zubr, епт.. есть хоть что-нибудь чего ты не знаешь?=) Да и вообще.. нафиг столько бессымысленного кода..

 

[zubr]

vital
а как ты узнаешь размер скачиваемого файла?

 

[vital]

Uses WinInet=>HttpQueryInfo(HTTP_QUERY_CONTENT_LENGTH)

 

[zubr]

Ну тогда и закачку надо делать WinInet-ными функциями, иначе некрасиво, имхо.
З.Ы. Насчет компактности и простоты решения вопрос спорный. Используя WinInet кода не меньше придется писать.

 

[vital]

Ну хз.. Не мне с тобой спорить=) Не красиво, да. Но проще.. ИМхо.

 

[RoLife]

Все было уж да хорошо, пошол статусбар но в конце (когда прогрес скачки подошол к концу) выдало ошибку ввида "Access violation at address 00000000. Read of addres 00000000."