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

Тема в разделе "Delphi - Компоненты", создана пользователем kyran29, 22 ноя 2009.

  1. kyran29

    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">
    Код (Text):
    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>
     
  2. vital

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.470
    Симпатии:
    27
    Перед скачиванием нужно узнать размер файла - это максимальное значения прогрессбара. Потом каждые пускай 20 сек проверять размер уже скачанного - это текущая позиция прогрессбара. Элементарщина..
     
  3. zubr

    zubr Гость

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

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.470
    Симпатии:
    27
    zubr, епт.. есть хоть что-нибудь чего ты не знаешь?=) Да и вообще.. нафиг столько бессымысленного кода..
     
  5. zubr

    zubr Гость

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

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.470
    Симпатии:
    27
    Uses WinInet=>HttpQueryInfo(HTTP_QUERY_CONTENT_LENGTH)
     
  7. zubr

    zubr Гость

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

    vital Больной Компом Детектед
    Команда форума Web Team

    Регистрация:
    29 янв 2006
    Сообщения:
    2.470
    Симпатии:
    27
    Ну хз.. Не мне с тобой спорить=) Не красиво, да. Но проще.. ИМхо.
     
  9. RoLife

    RoLife Гость

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

Поделиться этой страницей