[El Sanchez]

помогите пожалуйста портировать код »

Johny777, у тебя в архиве устаревшая версия библиотеки 7-zip.dll - 4.42. Скачай отсюда версию поновее, там прогресс доработан. Тепер, собственно порт:

читать дальше »

Код:

[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program

[Files]
Source: 7-zip32.dll; Flags: dontcopy

[code]
#define A = (Defined UNICODE) ? "W" : "A"

const
    SZ_ERROR = 1;
    SZ_DLLERROR = 3;
    ARCEXTRACT_INPROCESS = 1;
    WM_USER = $400;
    PBM_SETPOS = (WM_USER + 2);
    PBM_SETRANGE32 = (WM_USER + 6);

type
    EXTRACTINGINFO = record
        dwFileSize: DWORD;                                  
        dwWriteSize: DWORD;                                 
        szSourceFileName: array [0..512] of Char;
        dummy1: array [0..2] of Byte;
        szDestFileName: array [0..512] of Char;
        dummy: array [0..2] of Byte;
    end;

function SevenZip(const hwnd: HWND; szCmdLine: PAnsiChar; szOutput: AnsiString; const dwSize: DWORD): Integer; external 'SevenZip@files:7-zip32.dll stdcall';
function SevenZipSetOwnerWindowEx(_hwnd: HWND; _lpArcProc: Longint): BOOL; external 'SevenZipSetOwnerWindowEx@files:7-zip32.dll stdcall';
function SevenZipKillOwnerWindowEx(_hwnd: HWND): BOOL; external 'SevenZipKillOwnerWindowEx@files:7-zip32.dll stdcall';
//
function RtlMoveMemory(var Destination: EXTRACTINGINFO; const Source: Longint; len: Integer): Integer; external 'RtlMoveMemory@kernel32.dll stdcall';
function SetWindowText(hWnd: HWND; lpString: String): BOOL; external 'SetWindowText{#A}@user32.dll stdcall';
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';
function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: String; cbMultiByte: Integer; lpWideCharStr: String; cchWideChar: Integer): Integer; external 'MultiByteToWideChar@kernel32.dll stdcall';


var
    ei: EXTRACTINGINFO;
    ProgressPage: TOutputProgressWizardPage;
    hProgress, hMsg1Label, hMsg2Label: HWND;

//////////////////////////////////////////////////////////
function CharArrayToString(cArray: array of Char): String;
begin
    Result := '';
    while cArray[Length(Result)] <> #0 do Insert(cArray[Length(Result)], Result, Length(Result)+1);
end;

//////////////////////////////////////////////
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 ArchiverCallbackProc(hwnd: HWND; uMsg, nState: UINT; lpEis: Longint): BOOL;
begin
    Result := True;
    case nState of
        ARCEXTRACT_INPROCESS: begin
            RtlMoveMemory(ei, lpEis, SizeOf(ei));
            PostMessage(hwnd, PBM_SETRANGE32, 0, 100);
            PostMessage(hwnd, PBM_SETPOS, Round(ei.dwWriteSize*100/ei.dwFileSize), 0);
            SetWindowText(hMsg1Label, Format('Файл: %s'#13#10'Общий размер: %s'#13#10'Текущий размер: %s', [CharArrayToString(ei.szSourceFileName), BytesToSize(ei.dwFileSize), BytesToSize(ei.dwWriteSize)]));
            SetWindowText(hMsg2Label, FormatFloat('Прогресс: 0.#0 %', (ei.dwWriteSize*100)/ei.dwFileSize));
        end;
    end;
end;

/////////////////////////////////////
procedure CreateSevenZipProgressPage;
begin
    ProgressPage := CreateOutputProgressPage('7-zip', '');
    ProgressPage.Msg1Label.Height := ScaleY(50);
    ProgressPage.Msg2Label.Top := ProgressPage.Msg1Label.Top + ProgressPage.Msg1Label.Height + ScaleY(5);
    ProgressPage.ProgressBar.Top := ProgressPage.Msg2Label.Top + ProgressPage.Msg2Label.Height + ScaleY(5);
end;

///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function SevenZipCommand(const hWnd: HWND; szParams: String; const lpArchiverCallback: Longint): Longint;
begin
    Result := SZ_ERROR;
    case szParams[1] of
        'a': ProgressPage.Description := 'Создание архива';
        'b': ProgressPage.Description := 'Тестирование производительности';
        'd': ProgressPage.Description := 'Удаление файлов из архива';
        'e': ProgressPage.Description := 'Извлечение файлов из архива';
        'l': ProgressPage.Description := 'Список файлов архива';
        't': ProgressPage.Description := 'Тестирование файлов архива';
        'u': ProgressPage.Description := 'Обновление файлов в архиве';
        'x': ProgressPage.Description := 'Извлечение файлов из архива с полными путями';
    end;
    if lpArchiverCallback <> 0 then szParams := Format('%s -hide', [szParams]);
    CharToOemBuff(szParams);
    try
        if lpArchiverCallback <> 0 then
        begin
            hMsg1Label := ProgressPage.Msg1Label.Handle;
            hMsg2Label := ProgressPage.Msg2Label.Handle;
            //show progress page
            ProgressPage.Show;
            ProgressPage.ProgressBar.Show;
            //set callback
            SevenZipSetOwnerWindowEx(hWnd, lpArchiverCallback);
        end;
        Result := SevenZip(hWnd, szParams, '', 0);
    finally
        if lpArchiverCallback <> 0 then
        begin
            ProgressPage.Hide;
            SevenZipKillOwnerWindowEx(hWnd);
        end;
    except
        Result := SZ_DLLERROR;
    end;
end;

/////////////////////////////
procedure InitializeWizard();
begin
    CreateSevenZipProgressPage;
end;

//////////////////////////////////////////////////////
function NextButtonClick(CurPageID: Integer): Boolean;
begin
    if CurPageID = wpWelcome then
    begin
        // compress with callback
        SevenZipCommand(ProgressPage.ProgressBar.Handle, Format('a "%s" "%s"', ['d:\123.7z', 'd:\Firefox Setup 19.0.2.exe']), CallbackAddr('ArchiverCallbackProc'));

        // compress without callback
        //SevenZipCommand(ProgressPage.ProgressBar.Handle, Format('a "%s" "%s"', ['d:\123.7z', 'd:\Firefox Setup 19.0.2.exe']), 0);

        // extract with callback
        //SevenZipCommand(ProgressPage.ProgressBar.Handle, Format('x "%s" "%s" -y', ['d:\123.7z', 'd:\']), CallbackAddr('ArchiverCallbackProc'));

        // extract without callback
        //SevenZipCommand(ProgressPage.ProgressBar.Handle, Format('x "%s" "%s" -y', ['d:\123.7z', 'd:\']), 0);
        Result := True;
    end;
end;

P.S. С функцией обратного вызова для отрисовки своего прогресса пока ничего, обходись пока встроенным в библиотеку прогрессом.
UPD: Реализовал callback. Мусор удален.
UPD2: No problemo с кириллицей.
UPD3: к черту неиспользуемые функции