Ветеран
Сообщения: 649
Благодарности: 444
|
Профиль
|
Отправить PM
| Цитировать
by_gangster, El Sanchez,
позволил себе изменить немного процедуру скачивания:
procedure DownloadFile(интернет_ссылка_на_файл, имя_файла_сохранения, указатель_на_каллбэк_процедуру);
упростил немного код, благодаря каллбэку избавился от глобальных переменных и вынес конвертацию массива символов в строку в отдельную функцию и таким макаром избавился от некоторых действий
процедуры скачивания и теперь в функцию передаются не переменные, а const ссылки (так лучше)
пример скачивания и работы каллбэка ниже:
читать дальше »
Код:  [Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
OutputDir=.
Compression=lzma2/ultra
InternalCompressLevel=ultra
SolidCompression=yes
[code ]
#ifdef UNICODE
#define A "W"
#define UCHAR "AnsiChar"
#else
#define A "A"
#define UCHAR "Char"
#endif
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;
DOWNLOAD_START = -1;
DOWNLOADING = 1;
DOWNLOAD_END = 0;
type
_DOWNLOAD_CALLBACK = function(const StatusMessage, sFileNameAddr, dwFileSize, dwPosition: Longint): Boolean;
HINTERNET = Longint;
var
StopDownload: Boolean;
StopDownloadBtn: TButton;
function InternetOpen(lpszAgent: String; dwAccessType: DWORD; lpszProxy, lpszProxyBypass: String; dwFlags: DWORD): HINTERNET; external 'InternetOpen{#A}@wininet.dll stdcall';
function InternetOpenUrl(hInet: HINTERNET; lpszUrl, lpszHeaders: String; dwHeadersLength, dwFlags, dwContext: DWORD): HINTERNET; external 'InternetOpenUrl{#A}@wininet.dll stdcall';
function InternetSetFilePointer(hFile: HINTERNET; lDistanceToMove, pReserved: Longint; dwMoveMethod, dwContext: DWORD): DWORD; external 'InternetSetFilePointer@wininet.dll stdcall';
function InternetReadFile(hFile: HINTERNET; var lpBuffer: {#UCHAR}; dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; external 'InternetReadFile@wininet.dll stdcall';
function InternetQueryDataAvailable(hFile: HINTERNET; var lpdwNumberOfBytesAvailable: DWORD; dwFlags, dwContext: DWORD): Boolean; external 'InternetQueryDataAvailable@wininet.dll stdcall';
function InternetCloseHandle(hInet: HINTERNET): BOOL; external 'InternetCloseHandle@wininet.dll stdcall';
function DeleteUrlCacheEntry(lpszUrlName: String): BOOL; external 'DeleteUrlCacheEntryA@wininet.dll stdcall';
function HttpQueryInfo(hRequest: HINTERNET; dwInfoLevel: DWORD; var lpvBuffer: {#UCHAR}; var lpdwBufferLength, lpdwReserved: DWORD): BOOL; external 'HttpQueryInfo{#A}@wininet.dll stdcall';
function StrFormatByteSize64(qdw: Currency; var pszBuf: {#UCHAR}; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64{#A}@shlwapi.dll stdcall';
function StrFromTimeInterval(var pszOut: {#UCHAR}; cchMax: UINT; dwTimeMS: DWORD; digits: Byte): Integer; external 'StrFromTimeInterval{#A}@shlwapi.dll stdcall';
function GetTickCount(): DWORD; external 'GetTickCount@kernel32.dll stdcall';
////////////////////////////////////////////
function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of {#UCHAR};
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 {#UCHAR};
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 CancelDownloadOnClick(Sender: TObject);
begin
StopDownload := True;
end;
function DownloadProgress(const StatusMessage, sFileNameAddr, dwFileSize, dwPosition: Longint): Boolean;
begin
case StatusMessage of
DOWNLOAD_START:
begin
WizardForm.ProgressGauge.Max := dwFileSize;
StopDownloadBtn := TButton.Create(WizardForm)
with StopDownloadBtn do
begin
Parent := WizardForm;
SetBounds(WizardForm.CancelButton.Left, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width, WizardForm.CancelButton.Height);
Caption := WizardForm.CancelButton.Caption;
OnClick := @CancelDownloadOnClick;
end;
WizardForm.CancelButton.Hide;
end;
DOWNLOADING:
begin
WizardForm.ProgressGauge.Position := dwPosition;
WizardForm.StatusLabel.Caption := Format( 'FileName:' #32 '%s' #32 'FileSize:' #32 '%s', [CastIntegerToString(sFileNameAddr), BytesToSize(Extended(dwFileSize))] );
WizardForm.FilenameLabel.Caption := Format( 'Downloaded:' #32 '%s' #32 'Ready:' #32 '%s', [BytesToSize(Extended(dwPosition)), FormatFloat('0.#0 %', (dwPosition*100)/dwFileSize)] );
Application.ProcessMessages;
end;
DOWNLOAD_END:
begin
WizardForm.CancelButton.Show;
if StopDownloadBtn <> nil then StopDownloadBtn.Free;
end;
end;
// Result := True;
Result := StopDownload;
end;
function CharArrayToString(const cArray: array of Char): String;
var
i: Integer;
begin
for i := 0 to GetArrayLength(cArray)-1 do Result := Result + cArray[i];
end;
procedure DownloadFile(const urlFilename, DestFileName: String; const CallBack: _DOWNLOAD_CALLBACK);
var
lpdwNumberOfBytesRead, lpdwNumberOfBytesAvailable, lpdwBufferLength, lpdwIndex: DWORD;
hInt, hRedir, hFile: HINTERNET;
dStop: Boolean;
lpBuffer: array of {#UCHAR};
fStream: TFileStream;
fSize: DWORD;
begin
hInt := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, '', '', 0);
if hInt <> 0 then
try
//Get file size
hRedir := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE or INTERNET_FLAG_NO_AUTO_REDIRECT, 0);
if hRedir <> 0 then
try
SetArrayLength(lpBuffer, 1024);
fSize := InternetSetFilePointer(hRedir, 0, 0, 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);
hFile := InternetOpenUrl(hInt, CharArrayToString(lpBuffer), '', 0, INTERNET_FLAG_NEED_FILE, 0);
if hFile <> 0 then
try
fSize := InternetSetFilePointer(hFile, 0, 0, FILE_END, 0);
finally
InternetCloseHandle(hFile);
DeleteUrlCacheEntry(urlFilename);
end;
end;
finally
InternetCloseHandle(hRedir);
DeleteUrlCacheEntry(urlFilename);
end;
// download
if FileExists(DestFileName) then if not DeleteFile(DestFileName) then
begin
InternetCloseHandle(hInt);
Exit;
end;
if not DirExists(ExtractFileDir(DestFileName)) then if not ForceDirectories(ExtractFileDir(DestFileName)) then
begin
InternetCloseHandle(hInt);
Exit;
end;
hFile := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE, 0);
if hFile <> 0 then
try
fStream := TFileStream.Create(DestFileName, fmCreate);
if CallBack <> nil then dStop := CallBack( DOWNLOAD_START, CastStringToInteger(DestFileName), Longint(fSize), 0);
while (InternetQueryDataAvailable(hFile, lpdwNumberOfBytesAvailable, 0, 0) and (lpdwNumberOfBytesAvailable > 0)) and not dStop do
begin
SetArrayLength(lpBuffer, RoundDword(lpdwNumberOfBytesAvailable));
InternetReadFile(hFile, lpBuffer[0], GetArrayLength(lpBuffer), lpdwNumberOfBytesRead);
fStream.WriteBuffer(CharArrayToString(lpBuffer), lpdwNumberOfBytesRead);
fStream.Seek(0, soFromEnd);
if CallBack <> nil then dStop := CallBack(DOWNLOADING, CastStringToInteger(DestFileName), Longint(fSize), Longint(fStream.Size + lpdwNumberOfBytesRead));
end;
finally
fStream.Free;
InternetCloseHandle(hFile);
DeleteUrlCacheEntry(urlFilename);
if CallBack <> nil then dStop := CallBack( DOWNLOAD_END, CastStringToInteger(DestFileName), Longint(fSize), 0);
if dStop then DeleteFile(DestFileName);
end;
finally
InternetCloseHandle(hInt);
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then DownloadFile('http://mse.dlservice.microsoft.com/download/7/6/0/760B9188-4468-4FAD-909E-4D16FE49AF47/ruRU/x86/mseinstall.exe', ExpandConstant('{app}\File.exe'), @DownloadProgress); // ..., nil); - no Callback
end;
надеюсь не накосячил
и ещё есть поддержка юникодной инно и кнопка отмены
|
