Ветеран
Сообщения: 1273
Благодарности: 1030
|
Профиль
|
Отправить PM
| Цитировать
Цитата FrozenProtector:
|
подскажите аналогичные загрузчики файлов через интернет. »
|
FrozenProtector, в один поток без докачки.
читать дальше »
Код:  [code]
const
INTERNET_OPEN_TYPE_PRECONFIG = 0;
INTERNET_FLAG_NO_CACHE_WRITE = $4000000;
INTERNET_FLAG_NEED_FILE = $10;
INTERNET_FLAG_NO_AUTO_REDIRECT = $200000;
HTTP_QUERY_LOCATION = 33;
FILE_END = 2;
INVALID_SET_FILE_POINTER = $FFFFFFFF;
var
ProgressPage: TOutputProgressWizardPage;
DownSpeedLabel, PercentLabel, PassedLabel, RemainLabel: TLabel;
StartDownload: DWORD;
FStream: TFileStream;
fSize: DWORD;
fName: String;
Timer: TTimer;
LastSize, CurrentTimerEvent, LastTimerEvent: DWORD;
function InternetOpen(lpszAgent: String; dwAccessType: DWORD; lpszProxyName, lpszProxyBypass: String; dwFlags: DWORD): Integer; external 'InternetOpenA@wininet.dll stdcall';
function InternetOpenUrl(hInternet: Integer; lpszUrl, lpszHeaders: String; dwHeadersLength, dwFlags: DWORD; dwContext: DWORD_PTR): Integer; external 'InternetOpenUrlA@wininet.dll stdcall';
function InternetSetFilePointer(hFile: Integer; lDistanceToMove: Longint; lpDistanceToMoveHigh: Variant; dwMoveMethod, dwContext: DWORD): DWORD; external 'InternetSetFilePointer@wininet.dll stdcall';
function InternetReadFile(hFile: Integer; var lpBuffer: Char; dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; external 'InternetReadFile@wininet.dll stdcall';
function InternetQueryDataAvailable(hFile: Integer; var lpdwNumberOfBytesAvailable: DWORD; dwFlags: DWORD; dwContext: DWORD_PTR): Boolean; external 'InternetQueryDataAvailable@wininet.dll stdcall';
function InternetCloseHandle(hInternet: Integer): BOOL; external 'InternetCloseHandle@wininet.dll stdcall';
function DeleteUrlCacheEntry(lpszUrlName: String): BOOL; external 'DeleteUrlCacheEntryA@wininet.dll stdcall';
function HttpQueryInfo(hRequest: Integer; dwInfoLevel: DWORD; var lpvBuffer: Char; var lpdwBufferLength, lpdwIndex: DWORD): BOOL; external 'HttpQueryInfoA@wininet.dll stdcall';
function GetTickCount: DWORD; external 'GetTickCount@kernel32.dll stdcall';
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';
function StrFromTimeInterval(var pszOut: Char; cchMax: UINT; dwTimeMS: DWORD; digits: Byte): Integer; external 'StrFromTimeIntervalA@shlwapi.dll stdcall';
////////////////////////////////////////////
function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of Char;
begin
try
Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
except end;
end;
function TicksToTime(Ticks: DWORD): String;
var
i: Byte;
arr: array [0..31] of Char;
begin
for i := 0 to StrFromTimeInterval(arr[0], sizeof(arr), Ticks, 8)-1 do Result := Result + arr[i];
end;
function RoundDword(dwValue: DWORD): DWORD;
begin
dwValue := dwValue or (dwValue shr 1);
dwValue := dwValue or (dwValue shr 2);
dwValue := dwValue or (dwValue shr 4);
dwValue := dwValue or (dwValue shr 8);
dwValue := dwValue or (dwValue shr 16);
Result := dwValue - (dwValue shr 1);
end;
procedure DownloadProgress(Sender: TObject);
begin
try
CurrentTimerEvent := GetTickCount;
ProgressPage.SetText('Файл: '#9#9 + fName, 'Загружено: '#9 + BytesToSize(FStream.Size) + ' из ' + BytesToSize(fSize));
PassedLabel.Caption := 'Прошло: '#9 + TicksToTime(CurrentTimerEvent-StartDownload);
RemainLabel.Caption := 'Осталось: '#9 + TicksToTime(StrToInt(FormatFloat('0',(fSize-FStream.Size)*(CurrentTimerEvent-StartDownload)/FStream.Size)));
with PercentLabel do
begin
Caption := FormatFloat('0.#0 %', (FStream.Size*100)/fSize);
if Left <= (ProgressPage.ProgressBar.Width - Width) then
Left := StrToInt(FormatFloat('0', FStream.Size*ProgressPage.ProgressBar.Width/fSize));
end;
if CurrentTimerEvent - LastTimerEvent >= 1000 then
begin
DownSpeedLabel.Caption := 'Скорость: '#9 + BytesToSize(FStream.Size-LastSize) + '/сек';
LastTimerEvent := CurrentTimerEvent;
LastSize := FStream.Size;
end;
finally
end;
end;
procedure DownloadFile(urlFilename: String);
var
i: SmallInt;
lpBuffer: array of Char;
lpdwNumberOfBytesRead, lpdwNumberOfBytesAvailable, lpdwBufferLength, lpdwIndex: DWORD;
hInt, hRedir, hFile: Integer;
fBuf: String;
begin
try
hInt := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, '', '', 0);
if hInt <> 0 then
try
//Get file name and size
hRedir := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE or INTERNET_FLAG_NO_AUTO_REDIRECT, 0);
if hRedir = 0 then Exit;
try
SetArrayLength(lpBuffer, 1024);
fSize := InternetSetFilePointer(hRedir, 0, NULL, FILE_END, 0);
if fSize = INVALID_SET_FILE_POINTER then
begin
lpdwBufferLength := GetArrayLength(lpBuffer);
lpdwIndex := 0;
HttpQueryInfo(hRedir, HTTP_QUERY_LOCATION, lpBuffer[0], lpdwBufferLength, lpdwIndex);
urlFilename := '';
for i := 0 to lpdwBufferLength-1 do urlFilename := urlFilename + lpBuffer[i];
hFile := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE, 0);
if hFile <> 0 then
try
fSize := InternetSetFilePointer(hFile, 0, NULL, FILE_END, 0);
finally
InternetCloseHandle(hFile);
DeleteUrlCacheEntry(urlFilename);
end;
end;
finally
fName := ExtractFileName(urlFilename);
InternetCloseHandle(hRedir);
DeleteUrlCacheEntry(urlFilename);
end;
//
hFile := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE, 0);
if hFile <> 0 then
begin
if GetSaveFileName('Сохранить как...', fName, '', '*' + ExtractFileExt(fName), ExtractFileExt(fName)) then
try
DeleteFile(fName);
FStream := TFileStream.Create(fName, fmCreate);
ProgressPage.SetProgress(0, fSize);
ProgressPage.Show;
StartDownload := GetTickCount();
while (InternetQueryDataAvailable(hFile, lpdwNumberOfBytesAvailable, 0, 0) and (lpdwNumberOfBytesAvailable > 0)) do
begin
SetArrayLength(lpBuffer, RoundDword(lpdwNumberOfBytesAvailable));
InternetReadFile(hFile, lpBuffer[0], GetArrayLength(lpBuffer), lpdwNumberOfBytesRead);
ProgressPage.SetProgress(FStream.Size + lpdwNumberOfBytesRead, fSize);
fBuf := '';
for i := 0 to GetArrayLength(lpBuffer)-1 do fBuf := fBuf + lpBuffer[i];
FStream.WriteBuffer(fBuf, lpdwNumberOfBytesRead);
FStream.Seek(0, soFromEnd);
Timer.Enabled := FStream.Size <> fSize;
end;
finally
Timer.Enabled := False;
FStream.Free;
ProgressPage.Hide;
end;
end;
finally
InternetCloseHandle(hFile);
DeleteUrlCacheEntry(urlFilename);
end;
finally
InternetCloseHandle(hInt);
end;
end;
procedure CreateDownloadProgressPage;
begin
ProgressPage := CreateOutputProgressPage('Загрузка файла', '');
ProgressPage.ProgressBar.Top := ProgressPage.ProgressBar.Top + ProgressPage.ProgressBar.Height div 2;
PercentLabel := TLabel.Create(WizardForm);
with PercentLabel do
begin
Parent := ProgressPage.Surface;
Top := ProgressPage.ProgressBar.Top - Height - ScaleY(2);
Transparent := True;
end;
DownSpeedLabel := TLabel.Create(WizardForm);
with DownSpeedLabel do
begin
Parent := ProgressPage.Surface;
Top := ProgressPage.ProgressBar.Top + ScaleY(30);
Transparent := True;
end;
PassedLabel := TLabel.Create(WizardForm);
with PassedLabel do
begin
Parent := ProgressPage.Surface;
Top := DownSpeedLabel.Top + ScaleY(15);
Transparent := True;
end;
RemainLabel := TLabel.Create(WizardForm);
with RemainLabel do
begin
Parent := ProgressPage.Surface;
Top := PassedLabel.Top + ScaleY(15);
Transparent := True;
end;
Timer := TTimer.Create(WizardForm);
with Timer do
begin
Interval := 100;
OnTimer := @DownloadProgress;
Enabled := False;
end;
end;
//
procedure InitializeWizard();
begin
CreateDownloadProgressPage;
end;
//
function NextButtonClick(CurPageID: Integer): Boolean;
begin
if CurPageID = wpWelcome then
begin
DownloadFile('http://mse.dlservice.microsoft.com/download/7/6/0/760B9188-4468-4FAD-909E-4D16FE49AF47/ruRU/x86/mseinstall.exe');
Result := True;
end;
Result := True;
end;
P.S. Требуется расширенная версия Inno. |
