Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Программы » Inno Setup (создание инсталяционных пакетов)

Модерирует : gyra, Maz

Widok (10-08-2009 22:13): Лимит страниц. Продолжаем здесь.  Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

   

SotM



Advanced Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору

Код:
;[English]
;Example of using unarc.dll for decompression of FreeArc archives with displaying of progress indicator in Inno Setup window
;
;[Russian]
;Пример распаковки FreeArc архива при помощи unarc.dll, с отображением прогресс бара в окне Inno Setup.
;Один архив можно слить с инсталятором, если их общий размер не более 2Гб, через "copy /b setup.exe+xxx.arc newsetup.exe" и указать в коде Archives = '{srcexe}'
;
; Изменения от Victor_Dobrov, 02-07-2009
;   - Кнопка инсталлятора в панели задач отображает время до завершения обработки всех архивов и общий процент распаковки.
;   - в Unicode-версиях инсталлятора правильно отображаются имена файлов.
;
; Изменения от CTACKo & SotM'а. 01-07-2009
;   - Правильно создаются папки, если в пути установки встречаются русские буквы
;   - При компиляции определяется использование PAnsiChar/PChar. Можно использовать как обычную так и UNICODE версию с установленным препроцессором.
;
; Изменения от SotM'а. 23-06-2009
;   - Нижний прогресс бар сместил чуть-чуть вниз, чтобы было видно имя распаковываемого файла.
;   - Русские имена файлов теперь правильно отображаются.
;   - При нажатии "отмены" при распаковке теперь появляется запрос на подтверждение отмены.
;   - Переименовал некоторые переменные, чтобы их имена несли больше информации.
;   - Немного переформатировал сам исходный код для более удобного и понятного чтения.
;   - Исправил пару сообщений на английском языке.
 
; Изменения от Victor_Dobrov, 15-06-2009
;   - оптимизация и локализация скрипта, более подробная строка статуса, общий прогресс-бар, при неудачной распаковке выполняется откат (деинсталляция) и показывается текст ошибки.
 
; Bulat Ziganshin, 13-06-2009
;   - создание библиотеки unarc.dll и скрипта распаковки freearc_example.iss.
 
[Setup]
AppName=FreeArc Example
AppVerName=FreeArc Example 1.2
DefaultDirName={pf}\FreeArc Example
UsePreviousAppDir=false
DirExistsWarning
=no
ShowLanguageDialog=auto
OutputBaseFilename=FreeArcExample
OutputDir=.
VersionInfoCopyright=Bulat Ziganshin, Victor Dobrov, SotM, CTACKo
 
[Languages]
Name: eng; MessagesFile: compiler:Default.isl
Name: rus; MessagesFile: compiler:Languages\Russian.isl
 
[CustomMessages]
eng.ArcCancel=Cancel installation
eng.ArcBreak=Installation cancelled!
eng.ArcInfo=Extracted %1 Mb of %2 Mb (%3%%). Archive: %4 of %5.
eng.ArcTitle=Extracting FreeArc archive
eng.ArcError=Decompression failed with error code %1
eng.ArcFail=Decompression failed!
eng.AllProgress=Overall extraction progress: %1%%
eng.ArcBroken=Archive %1 is damaged%nor not enough free space.
eng.Extracting=Extracting: %1
eng.remains=%1%%, %2 elapsed
eng.LongTime=at no time
eng.ending=ending
 
rus.ArcCancel=Отменить распаковку
rus.ArcBreak=Установка прервана!
rus.ArcInfo=Распаковано %1 Мб из %2 Мб (%3%%). Архив: %4 из %5.
rus.ArcTitle=Распаковка архивов FreeArc
rus.ArcError=Распаковщик FreeArc вернул код ошибки: %1
rus.ArcFail=Распаковка не завершена!
rus.AllProgress=Общий прогресс распаковки: %1%%
rus.ArcBroken=Возможно, архив %1 повреждён%nили недостаточно места на диске назначения.
rus.Extracting=Распаковывается: %1
rus.remains=%1%%, жди %2
rus.LongTime=вечно
rus.ending=завершение
 
[Files]
;Source: *.arc; DestDir: {app}; Flags: nocompression
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy deleteafterinstall
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
 
[UninstallDelete]
Type: filesandordirs; Name: {app}
 
[Code]
const
   
Archives = '{src}\*.arc';    // укажите расположение архивов FreeArc; для внешних файлов строку в [Files] добавлять необязательно
 
   
PM_REMOVE = 1;
    CP_ACP = 0; CP_UTF8 = 65001;
 
type
#ifdef UNICODE  ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup
    #define A "W"
#else
    #define
A "A"  ; точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
    PAnsiChar = PChar;  // Required for Inno Setup 5.3.0 and higher. (требуется для Inno Setup версии 5.3.0 и ниже)
#endif
#if
Ver < 84018176
    AnsiString = String; // There is no need for this line in Inno Setup 5.2.4 and below (для Inno Setup версий 5.2.4 и выше эта строка не нужна)
#endif
 
   
TMyMsg = record
        hwnd: HWND;
        message: UINT;
        wParam: Longint;
        lParam: Longint;
        time: DWORD;
        pt: TPoint;
    end;
 
    TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
    TArc = record Path: string; Size: Extended; end;
 
var
   
ProgressBar: TNewProgressBar;
    ExtractFile: TNewStaticText;
    lblExtractFileName: TLabel;
    btnCancelUnpacking:    TButton;
    CancelCode, n, UnPackError, StartInstall: Integer;
    Arcs: array of TArc;
    msgError: string;
    m: Extended;
 
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: string; cbMultiByte: integer; lpWideCharStr: string; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: string; cchWideChar: integer; lpMultiByteStr: string; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';
 
function PeekMessage(var lpMsg: TMyMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMyMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMyMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
 
Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
 
function GetTickCount: DWord; external 'GetTickCount@kernel32';
function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl';
 
procedure AppProcessMessage;
var
   
Msg: TMyMsg;
begin
    while
PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin
       
TranslateMessage(Msg);
        DispatchMessage(Msg);
    end;
end;
 
Function NumToStr(Float: Extended): String; {Перевод числа в строку с точностью 3 знака (%.3n) с округлением дробной части, если она есть}
Begin
   
Result:= Format('%.3n', [Float]); StringChange(Result, ',', '.'); while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Length(Result) > 1) do SetLength(Result, Length(Result)-1);
End;
 
function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
 
Function Size64(Hi, Lo: Integer): Extended;
Begin
   
Result:= Lo; if Lo< 0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2; for Hi:= Hi-1 Downto 0 do Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;
 
// OnClick event function for btnCancel
procedure btnCancelUnpackingOnClick(Sender: TObject);
begin
    if
MsgBox( SetupMessage( msgExitSetupMessage ), mbInformation, MB_YESNO ) = IDYES then
       
CancelCode:= -127;
end;
 
// Scans the specified folders for archives and add them to list
function FindArcs(dir: string): Extended;
var
   
FSR: TFindRec;
Begin
    if
FindFirst(ExpandConstant(dir), FSR) then
    try
        repeat
           
// Skip everything but the folders
           
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
            n:= GetArrayLength(Arcs);
            // Expand the folder list
           
SetArrayLength(Arcs, n +1);
            Arcs[n].Path:= ExtractFilePath(ExpandConstant(Archives)) + FSR.Name;
            Arcs[n].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
            Result:= Result + Arcs[n].Size;
        until not FindNext(FSR);
    finally
       
FindClose(FSR);
    end;
End;
 
// Converts OEM encoded string into ANSI
// Преобразует OEM строку в ANSI кодировку
function OemToAnsiStr( strSource: AnsiString): AnsiString;
var
   
nRet : longint;
begin
   
SetLength( Result, Length( strSource ) );
    nRet:= OemToChar( strSource, Result );
end;
 
// Converts ANSI encoded string into UTF-8
// Преобразует строку из ANSI в UTF-8 кодировку
function AnsiToUtf8( strSource: string ): string;
var
   
nRet : integer;
    WideCharBuf: string;
    MultiByteBuf: string;
begin
   
strSource:= strSource + chr(0);
    SetLength( WideCharBuf, Length( strSource ) * 2 );
    SetLength( MultiByteBuf, Length( strSource ) * 2 );
 
    nRet:= MultiByteToWideChar( CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf) );
    nRet:= WideCharToMultiByte( CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
 
    Result:= MultiByteBuf;
end;
 
// Sets the TaskBar title
Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
   
h:= GetWindowLong(MainForm.Handle, -8); if h <> 0 then SetWindowText(h, Title);
End;
 
// Converts milliseconds to standart time
Function TicksToTime(Ticks: DWord; detail: Boolean): String; Begin {милисекунды в стандартное время}
    if detail or (Ticks/3600 >= 1000) {hour} then if Ticks/3600000 > 23 then Result:= cm('LongTime') else Result:= PADZ(IntToStr(Ticks/3600000), 2) +':'+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +':'+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2)  else if Ticks/60 < 1000 {min} then Result:= IntToStr(Ticks/1000) +'.'+ NumToStr(trunc((Ticks/1000 - trunc(Ticks/1000))*10)) +'s' else Result:= IntToStr(Ticks/60000) +'m '+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2) +'s';
End;
 
// The main callback function for unpacking FreeArc archives
function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
   
percents, Elapsed: Integer;
begin
    if string
(what)='filename' then
       
// Update FileName label
       
lblExtractFileName.Caption:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
    else
        if
(string(what)='progress') and (sizeArc>0) then
           
// Update progress bar with additional info
           
with WizardForm.ProgressGauge do
            begin
               
// Calculate current percents
               
percents:= (Mb*1000) div sizeArc;
                ProgressBar.Position:= percents;
                ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(Mb), IntToStr(sizeArc), Format('%.1n', [Abs(percents/10)]), IntToStr(n+1), IntToStr(GetArrayLength(Arcs)) ]);
                Position:= Tag + round(ProgressBar.Position * m)
                 
                percents:= (Position-Min)/((Max - Min)/1000)
                WizardForm.FileNameLabel.Caption:= FmtMessage(cm('AllProgress'), [Format('%.1n', [Abs(percents/10)])]);
                if position > 0 then Elapsed:= trunc((GetTickCount - StartInstall) * Abs((max - position)/position)) else Elapsed:= 0;
                // Update the taskbar title
               
if Elapsed = 0 then SetTaskBarTitle(cm('ending')) else SetTaskBarTitle(FmtMessage(cm('remains'), [IntToStr(percents/10), TicksToTime(Elapsed, false)]));
            end;
    AppProcessMessage;
    Result:= CancelCode;
end;
 
// Extracts all found archives
function UnPack(Archives: string): Integer;
var
   
allSize: Extended;
    callback: longword;
    FreeMB, TotalMB: Cardinal;
begin
   
// Show the 'Cancel unpacking' button and set it as default button
   
btnCancelUnpacking.Show;
    WizardForm.ActiveControl:= btnCancelUnpacking;
    WizardForm.ProgressGauge.Position:= 0;
    WizardForm.ProgressGauge.Max:= 1000;
    // Get the size of all archives
   
allSize:= FindArcs(Archives);
 
    for n:= 0 to GetArrayLength(Arcs) -1 do
    begin
       
m:= Arcs[n].Size/allSize;    // Size of the current archive (объём текущего архива)
       
WizardForm.ProgressGauge.Tag:= WizardForm.ProgressGauge.Position;
        CancelCode:= 0;
        AppProcessMessage;
        callback:= WrapFreeArcCallback(@FreeArcCallback,4);   //FreeArcCallback has 4 arguments
       
try
           
// Pass the specified arguments to 'unarc.dll'
           
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', Arcs[n].Path, '', '', '', '', '');
            if Result = 0 then Result:= CancelCode;
        except
           
Result:= -63;  //    ArcFail
       
end;
 
        // Error occured
       
if Result <> 0 then
        begin
           
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
            GetSpaceOnDisk(ExtractFileDrive(ExpandConstant('{app}')), True, FreeMB, TotalMB);
            case Result of
               
-1: if FreeMB < 32 {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
                    else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Arcs[n].Path)]);
                -127:   msgError:= cm('ArcBreak');    //Cancel button
               
-63:    msgError:= cm('ArcFail');
            end;
//          MsgBox(msgError, mbInformation, MB_OK);    //сообщение показывается на странице завершения
           
Log(msgError);
            Break;    //прервать цикл распаковки
       
end;
    end;
    // Hide the button
   
btnCancelUnpacking.visible:= false;
end;
 
procedure CurStepChanged(CurStep: TSetupStep);
begin
    if
CurStep = ssInstall then StartInstall:= GetTickCount;    {время начала распаковки}
    if CurStep = ssPostInstall then
    begin
       
UnPackError:= UnPack(Archives)
        if UnPackError = 0 then
           
SetTaskBarTitle(SetupMessage(msgSetupAppTitle))
        else
        begin
           
// Error occured, uninstall it then
           
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n);    //откат установки из-за ошибки unarc.dll
           
SetTaskBarTitle(SetupMessage(msgErrorTitle))
            WizardForm.Caption:= SetupMessage(msgErrorTitle) +' — '+ cm('ArcBreak')
        end;
    end;
end;
 
//    стандартный способ отката (не нужна CurPageChanged), но архивы распаковываются до извлечения файлов инсталлятора
//    if CurStep = ssInstall then
//      if UnPack(Archives) <> 0 then Abort;
 
Procedure CurPageChanged(CurPageID: Integer);
Begin
    if
(CurPageID = wpFinished) and (UnPackError <> 0) then
    begin
// распаковщик вернул ошибку
       
WizardForm.FinishedLabel.Font.Color:= $0000C0;    //красный
       
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
        WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + msgError;
    end;
End;
 
procedure InitializeWizard();
begin
   
ProgressBar:= TNewProgressBar.Create(WizardForm);
    ExtractFile:=TNewStaticText.Create(WizardForm);
    lblExtractFileName:= TLabel.Create( WizardForm );
    with WizardForm.ProgressGauge do
    begin
       
// Create a label to show current FileName being extracted
       
lblExtractFileName.parent:=WizardForm.InstallingPage;
        lblExtractFileName.autosize:=false;
        lblExtractFileName.Width:= Width;
        lblExtractFileName.top:=Top + ScaleY(35);
        lblExtractFileName.Caption:= '';
 
        // Create a label to show percentage
       
ExtractFile.parent:=WizardForm.InstallingPage;
        ExtractFile.autosize:=false;
        ExtractFile.Width:= Width;
        ExtractFile.top:=lblExtractFileName.Top + ScaleY(16);
        ExtractFile.caption:=cm('ArcTitle');
 
        // Create a separate progress bar
       
ProgressBar.SetBounds(Left, ExtractFile.Top + ScaleY(16), Width, Height);
        ProgressBar.Parent:= WizardForm.InstallingPage;
        ProgressBar.max:= 1000;
        ProgressBar.Position:= 0;
    end;
 
    // Create a 'Cancel unpacking' button and hide it for now.
   
btnCancelUnpacking:=TButton.create(WizardForm);
    btnCancelUnpacking.Parent:= WizardForm;
    btnCancelUnpacking.SetBounds(260, WizardForm.cancelbutton.top, 135, WizardForm.cancelbutton.Height);
    btnCancelUnpacking.OnClick:= @btnCancelUnpackingOnClick;
    btnCancelUnpacking.Caption:= cm('ArcCancel');
    btnCancelUnpacking.Hide;
end;
 

Всего записей: 965 | Зарегистр. 28-11-2006 | Отправлено: 12:47 02-07-2009 | Исправлено: SotM, 10:14 03-07-2009
   

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Программы » Inno Setup (создание инсталяционных пакетов)
Widok (10-08-2009 22:13): Лимит страниц. Продолжаем здесь.


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.Board
© Ru.Board 2000-2020

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru