Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Аватара для Johny777

Ветеран


Сообщения: 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;


надеюсь не накосячил
и ещё есть поддержка юникодной инно и кнопка отмены

Последний раз редактировалось Johny777, 14-05-2013 в 00:30. Причина: кач-кач теперь можно отменить!

Это сообщение посчитали полезным следующие участники:

Отправлено: 21:32, 13-05-2013 | #443