Показать сообщение отдельно
Старый 05.11.2009, 16:43   #3
WaReZ_MEN
Модератор
 
Регистрация: 20.06.2006
Сообщений: 363
Написано 24 полезных сообщений
(для 44 пользователей)
Ответ: 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.
(Offline)
 
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо WaReZ_MEN за это полезное сообщение:
<-TzX-> (05.11.2009), Freez (13.11.2009)