forum.boolean.name - Progressbar и Winnet

forum.boolean.name

forum.boolean.name (http://forum.boolean.name/index.php)

- Delphi (http://forum.boolean.name/forumdisplay.php?f=66)

- - Progressbar и Winnet (http://forum.boolean.name/showthread.php?t=9752)

<-TzX->

05.11.2009 15:55

Progressbar и Winnet

Есть такая функция для загрузки файла через WInNet

Код:

function GetInetFile(const fileURL, FileName: string): boolean;

const

  BufferSize = 1024;

var

  hSession, hURL: HInternet;

  Buffer: array[1..BufferSize] of Byte;

  BufferLen: DWORD;

  f: file;

  sAppName: string;

begin

  Result := False;

  sAppName := ExtractFileName(Application.ExeName);

  hSession := InternetOpen(PChar(sAppName),

  INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  try

    hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);

    try

      AssignFile(f, FileName);

      Rewrite(f,1);

      repeat

        InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);

        BlockWrite(f, Buffer, BufferLen);

      until

        BufferLen = 0;

      CloseFile(f);

      Result := True;

    finally

      InternetCloseHandle(hURL);

    end;

  finally

    InternetCloseHandle(hSession);

  end;

end;



end.

Теперь вопрос:
Как к ней прикрутить прогресс бар? Лично я понимаю что нужно выделить буфер уже загруженых данных, и из него и общего размера файла уже вычислять загруженный процент. Но как это сделать хз, т.к. с Winnet работаю впервые.
Заранее спасибо за ответ

WaReZ_MEN

05.11.2009 16:40

Ответ: Progressbar и Winnet

Для начало надо определить размер файла. Щас поищу дето был у меня код...

WaReZ_MEN

05.11.2009 16:43

Ответ: Progressbar и Winnet

Вод код

Код:

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Wininet, StdCtrls, ComCtrls;



type

  TForm1 = class(TForm)

    ProgressBar1: TProgressBar;

    Label1: TLabel;

    Label2: TLabel;

    Button1: TButton;

    Label3: TLabel;

    Button2: TButton;

    Button3: TButton;

    procedure FormCreate(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    { Private declarations }

  public

     CanLoad:boolean;

     LoadOrNot:boolean;

     NewUpdateFile : TStringList;

     OldUpdateFile: TStringList;

     SizeDownLoadFile:Real;

     FileOnNet, LocalFileName: String;

     LoadFileName:String;



     function GetInetFile(const fileURL, FileName: String): boolean;



     Function GetUrlInfo(const dwInfoLevel: DWORD; const FileURL: string): string;

    { Public declarations }

  end;



var

  Form1: TForm1;

implementation



{$R *.dfm}



{ TForm1 }





procedure TForm1.Button1Click(Sender: TObject);

begin

  CanLoad:=True;

  IF GetInetFile(FileOnNet,LocalFileName) then

    Begin

      Label3.Caption:='Скачивание завершено';

      LoadOrNot:=True;

      WinExec('Update.exe',1);

      Application.Terminate;

    End

  Else

    IF Label3.Caption<>'Загрузка файла прервана!!!' then

      Label3.Caption:='Ошибка во время скачивания';



end;



procedure TForm1.Button2Click(Sender: TObject);

begin

   CanLoad:=False;

end;



procedure TForm1.Button3Click(Sender: TObject);

begin

  Close;

end;



procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  if LoadOrNot=False then OldUpdateFile.SaveToFile('Update.txt');

  OldUpdateFile.Free;  

  

end;



procedure TForm1.FormCreate(Sender: TObject);

begin

  OldUpdateFile:=TStringList.Create;

  NewUpdateFile:=TStringList.Create;

  CanLoad:=True;

  LoadOrNot:=False;

  OldUpdateFile.LoadFromFile('Update.txt');



  IF GetInetFile('http://MySite.ru/Update.txt','Update.txt') then

     Begin

       NewUpdateFile.LoadFromFile('Update.txt');

       IF OldUpdateFile.Strings[0]<>NewUpdateFile.Strings[0] Then

         Begin

           LoadFileName:=NewUpdateFile.Strings[1];

           FileOnNet:='http://primokna.ru/'+LoadFileName;

           LocalFileName:='Update.exe';

           SizeDownLoadFile:=StrToFloat(GetUrlInfo(HTTP_QUERY_CONTENT_LENGTH, 'http://primokna.ru/'+LoadFileName));

           Label2.Caption:=FloatToStrF(SizeDownLoadFile/1048576,ffFixed,10000,2)+' мб';

           ProgressBar1.Max:=Round(SizeDownLoadFile);

           ProgressBar1.Step:=Round(1024)-1;

         End

       Else

         Begin

           Label2.Caption:='0 мб';

           Button1.Enabled:=False;

         End;

     End

  Else

     ShowMessage('Произошла ошибка!');

  NewUpdateFile.Free;

  CanLoad:=False;

end;



function TForm1.GetInetFile(const fileURL, FileName: String): boolean;

const BufferSize =1024;

var hSession, hURL: HInternet;

Buffer: array[1..BufferSize] of Byte;

BufferLen: DWORD;

f: File;

sAppName: string;

begin

   Label3.Visible:=True;

   Label3.Caption:='Идет загрузка файла: '+LoadFileName;

   Result:=False;

   sAppName := ExtractFileName(Application.ExeName);

   hSession := InternetOpen(PChar(sAppName), INTERNET_OPEN_TYPE_PRECONFIG,

         nil, nil, 0);

   try

      hURL := InternetOpenURL(hSession, PChar(fileURL),nil,0,0,0);

      try

         AssignFile(f, FileName);

         Rewrite(f,1);

         repeat

           IF CanLoad=False Then

             Begin

               Label3.Caption:='Загрузка файла прервана!!!';

               Exit;

             End;



         

            InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);

            BlockWrite(f, Buffer, BufferLen);

            ProgressBar1.StepIt;

            Application.ProcessMessages;

         until BufferLen = 0;

         Label3.Caption:='Создание локальной версий файла '+LoadFileName;

         CloseFile(f);



         Result:=True;

      finally



      InternetCloseHandle(hURL);

      end

   finally

   InternetCloseHandle(hSession) ;

   end;

end;



function TForm1.GetUrlInfo(const dwInfoLevel: DWORD; const FileURL: string): string;

var

  hSession, hFile: hInternet;

  dwBuffer: Pointer;

  dwBufferLen, dwIndex: DWORD;

begin

  Result := '';

  hSession := InternetOpen('STEROID Download', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

  if Assigned(hSession) then begin

    hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0, INTERNET_FLAG_RELOAD, 0);

    dwIndex  := 0;

    dwBufferLen := 20;

    if HttpQueryInfo(hFile, dwInfoLevel, @dwBuffer, dwBufferLen, dwIndex)

      then Result := PChar(@dwBuffer);

    if Assigned(hFile) then InternetCloseHandle(hFile);

    InternetCloseHandle(hsession);

  end;



end;



end.

<-TzX->

05.11.2009 17:18

Ответ: Progressbar и Winnet

Спасибо. Изучаю

<-TzX->

05.11.2009 18:58

Ответ: Progressbar и Winnet

С прогресс баром разобрался, теперь созрел еще один вопрос:
При загрузке файла, моя форма полностью "замирает", ну кроме прогресс бара, и приложение получается как бы полузависшим. Как прикрутить что то типа антифриза к winnet?

ViNT	05.11.2009 19:10

Ответ: Progressbar и Winnet

С этим кодом зависает?
Application.ProcessMessages должен предотвращать зависание. Если этот код зависает, то странно.

<-TzX->

05.11.2009 19:48

Ответ: Progressbar и Winnet

Спасибо. Проблема решена. Просто использовал не этот код, а только одну функцию спер =)

WaReZ_MEN

05.11.2009 22:45

Ответ: Progressbar и Winnet

ViNT, полностью прав. Application.ProcessMessages спасчет...
А вообще смотри потоки :) Дельфа по дефолту шпарит все в одном потоке поетому и подобные проблемы...

<-TzX->

12.11.2009 20:17

Ответ: Progressbar и Winnet

Может кто нибудь подкинуть процедурку для получения рамера файла перед загрузкой? А то реализованная тут не очень подходит в моем случае.

ViNT	12.11.2009 21:01

Ответ: Progressbar и Winnet

Цитата:

Сообщение от <-TzX-> (Сообщение 124475)

Может кто нибудь подкинуть процедурку для получения рамера файла перед загрузкой? А то реализованная тут не очень подходит в моем случае.

А почему не очень подходит?
Что-то другое придумать врядли удастся, это самый оптимальный вариант.

<-TzX->

12.11.2009 22:51

Ответ: Progressbar и Winnet

Функция GetUrlInfo как то коряво мне размер файла передает. Только первые 4 или 5 цифр, а потом пробелы. Если файл меньше 10 мегобайт, то норм, а если больше, то сами понимаете.

WaReZ_MEN

17.11.2009 19:14

Ответ: Progressbar и Winnet

Цитата:

Сообщение от <-TzX-> (Сообщение 124552)

Функция GetUrlInfo как то коряво мне размер файла передает. Только первые 4 или 5 цифр, а потом пробелы. Если файл меньше 10 мегобайт, то норм, а если больше, то сами понимаете.

Код давай у меня все нормально работает.

Часовой пояс GMT +4, время: 21:17.

vBulletin® Version 3.6.5.
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Перевод: zCarot