
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.