Скрипт распаковщика
; Script generated by the Inno Script Studio Wizard.
; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES!
#define MyAppName "Space Engineers Dev"
#define MyAppVersion "01.146.007"
#define MyAppVerName StringChange(MyAppName+" v"+MyAppVersion, " ", "_")
#define MyAppPublisher "Trackeroc.Ru"
#define MyAppURL "http://trackeroc.ru/viewtopic.php?t=90"
#define Archives "{src}\game.bin;DestDir:{app};Disk:1;Components:Main"
#define Archives Archives + "|" + "{src}\textures.bin;DestDir:{app}\Content;Disk:1;Components:Textures"
#define Archives Archives + "|" + "{src}\_CommonRedist.bin;DestDir:{app};Disk:1;Components:redist"
#define Archives Archives + "|" + "{src}\crack.bin;DestDir:{app};Disk:1;Components:NoSteam"
[Setup]
; NOTE: The value of AppId uniquely identifies this application.
; Do not use the same AppId value in installers for other applications.
; (To generate a new GUID, click Tools | Generate GUID inside the IDE.)
AppId={{3594A6E7-A539-4E08-BC95-47DBE6D49679}
AppName={#MyAppName}
AppVersion={#MyAppVersion}
;AppVerName={#MyAppName} v{#MyAppVersion}
AppPublisher={#MyAppPublisher}
AppPublisherURL={#MyAppURL}
AppSupportURL={#MyAppURL}
AppUpdatesURL={#MyAppURL}
DefaultDirName={pf64}\{#MyAppName}
DefaultGroupName={#MyAppName}
AllowNoIcons=yes
OutputDir=D:\Downloads\Space Engineers\Space_Engineers_Dev\
OutputBaseFilename={#MyAppVerName}_setup
SetupIconFile=D:\Downloads\Space Engineers\SpaceEngineers.ico
Compression=lzma2/ultra64
SolidCompression=yes
ShowTasksTreeLines=True
AlwaysShowGroupOnReadyPage=True
AlwaysShowDirOnReadyPage=True
EnableDirDoesntExistWarning=True
UninstallDisplayIcon={uninstallexe}
InternalCompressLevel=ultra64
MinVersion=0,6.1
; DiskSpanning=True
; DiskSliceSize=2000000000
ChangesAssociations=True
UsePreviousAppDir=False
UsePreviousGroup=False
VersionInfoCopyright=DDayver
VersionInfoVersion={#MyAppVersion}
VersionInfoCompany={#MyAppPublisher}
VersionInfoDescription={#MyAppName} v{#MyAppVersion}
VersionInfoTextVersion={#MyAppVersion}
VersionInfoProductName={#MyAppName}
AppCopyright=DDayver
[Languages]
Name: "english"; MessagesFile: "compiler:Default.isl"
Name: "brazilianportuguese"; MessagesFile: "compiler:Languages\BrazilianPortuguese.isl"
Name: "catalan"; MessagesFile: "compiler:Languages\Catalan.isl"
Name: "corsican"; MessagesFile: "compiler:Languages\Corsican.isl"
Name: "czech"; MessagesFile: "compiler:Languages\Czech.isl"
Name: "danish"; MessagesFile: "compiler:Languages\Danish.isl"
Name: "dutch"; MessagesFile: "compiler:Languages\Dutch.isl"
Name: "finnish"; MessagesFile: "compiler:Languages\Finnish.isl"
Name: "french"; MessagesFile: "compiler:Languages\French.isl"
Name: "german"; MessagesFile: "compiler:Languages\German.isl"
Name: "greek"; MessagesFile: "compiler:Languages\Greek.isl"
Name: "hebrew"; MessagesFile: "compiler:Languages\Hebrew.isl"
Name: "hungarian"; MessagesFile: "compiler:Languages\Hungarian.isl"
Name: "italian"; MessagesFile: "compiler:Languages\Italian.isl"
Name: "japanese"; MessagesFile: "compiler:Languages\Japanese.isl"
Name: "norwegian"; MessagesFile: "compiler:Languages\Norwegian.isl"
Name: "polish"; MessagesFile: "compiler:Languages\Polish.isl"
Name: "portuguese"; MessagesFile: "compiler:Languages\Portuguese.isl"
Name: "russian"; MessagesFile: "compiler:Languages\Russian.isl"
Name: "scottishgaelic"; MessagesFile: "compiler:Languages\ScottishGaelic.isl"
Name: "serbiancyrillic"; MessagesFile: "compiler:Languages\SerbianCyrillic.isl"
Name: "serbianlatin"; MessagesFile: "compiler:Languages\SerbianLatin.isl"
Name: "slovenian"; MessagesFile: "compiler:Languages\Slovenian.isl"
Name: "spanish"; MessagesFile: "compiler:Languages\Spanish.isl"
Name: "turkish"; MessagesFile: "compiler:Languages\Turkish.isl"
Name: "ukrainian"; MessagesFile: "compiler:Languages\Ukrainian.isl"
[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"
Name: "quicklaunchicon"; Description: "{cm:CreateQuickLaunchIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked; OnlyBelowVersion: 0,6.1
Name: "clearinstall"; Description: "{cm:clear}"; GroupDescription: "{cm:AdditionalIcons}"
[Components]
Name: "Main"; Description: "{cm:main_files}"; ExtraDiskSpaceRequired: 3355107426; Types: full custom compact; Flags: fixed
Name: "Textures"; Description: "{cm:textures}"; ExtraDiskSpaceRequired: 4129061767; Types: full custom compact; Flags: fixed
Name: "redist"; Description: "{cm:redist}"; ExtraDiskSpaceRequired: 221064185; Types: full
Name: "NoSteam"; Description: "{cm:crack}"; ExtraDiskSpaceRequired: 705765; Types: full custom
[Files]
Source: "D:\Downloads\ic.ico"; DestDir: "{app}"
Source: "D:\Downloads\Space Engineers\mods\package.ico"; DestDir: "{app}"
Source: "D:\Downloads\Inno\unarc.dll"; DestDir: {tmp}; Flags: dontcopy
Source: "D:\Downloads\Inno\InnoCallback.dll"; DestDir: {tmp}; Flags: dontcopy
; Source: "E:\Games\{#MyAppVerName}\*"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs 64bit; Check: IsWin64
; NOTE: Don't use "Flags: ignoreversion" on any shared system files
[Icons]
Name: "{group}\{#MyAppName}"; Filename: "{app}\Bin64\SpaceEngineers.exe"; WorkingDir: "{app}\Bin64\"; IconFilename: "{app}\Bin64\SpaceEngineers.exe"; Comment: "{#MyAppName} v{#MyAppVersion}"; Check: IsWin64
Name: "{group}\{cm:ProgramOnTheWeb,{#MyAppName}}"; Filename: "{#MyAppURL}"; IconFilename: "{app}\ic.ico"; IconIndex: 0; Comment: "{#MyAppPublisher}"
Name: "{group}\ModPack and IngamescriptPack for {#MyAppName}"; Filename: "http://space-engineers.rigma.biz/"; IconFilename: "{app}\package.ico"; Comment: "Space-Engineers.Rigma.Biz"
Name: "{group}\{cm:UninstallProgram,{#MyAppName}}"; Filename: "{uninstallexe}"; IconFilename: "{uninstallexe}"
Name: "{commondesktop}\{cm:ProgramOnTheWeb,{#MyAppName}}"; Filename: "{#MyAppURL}"; IconFilename: "{app}\ic.ico"; IconIndex: 0; Comment: "{#MyAppPublisher}"; Tasks: desktopicon
Name: "{commondesktop}\ModPack and IngamescriptPack for {#MyAppName}"; Filename: "http://space-engineers.rigma.biz/"; IconFilename: "{app}\package.ico"; Comment: "Space-Engineers.Rigma.Biz"; Tasks: desktopicon
Name: "{commondesktop}\{#MyAppName}"; Filename: "{app}\Bin64\SpaceEngineers.exe"; WorkingDir: "{app}\Bin64\"; IconFilename: "{app}\Bin64\SpaceEngineers.exe"; Comment: "{#MyAppName} v{#MyAppVersion}"; Tasks: desktopicon; Check: IsWin64
Name: "{userappdata}\Microsoft\Internet Explorer\Quick Launch\{#MyAppName}"; Filename: "{app}\Bin64\SpaceEngineers.exe"; WorkingDir: "{app}\Bin64\"; IconFilename: "{app}\Bin64\SpaceEngineers.exe"; Comment: "{#MyAppName} v{#MyAppVersion}"; Tasks: quicklaunchicon; Check: IsWin64
[Run]
Filename: "{app}\Bin64\SpaceEngineers.exe"; WorkingDir: "{app}\Bin64\"; Flags: nowait postinstall skipifsilent 64bit; Description: "{cm:LaunchProgram,{#StringChange(MyAppName, '&', '&&')}}"; Check: IsWin64
[InstallDelete]
Type: filesandordirs; Name: "{app}\Bin\*"
Type: filesandordirs; Name: "{app}\DedicatedServer\*"
Type: dirifempty; Name: "{app}\Bin\"
Type: dirifempty; Name: "{app}\DedicatedServer\"
Type: filesandordirs; Name: "{group}\{#MyAppName}-32.lnk"
Type: filesandordirs; Name: "{group}\{#MyAppName}-64.lnk"
Type: filesandordirs; Name: "{commondesktop}\{#MyAppName}-32.lnk"
Type: filesandordirs; Name: "{commondesktop}\{#MyAppName}-64.lnk"
Type: filesandordirs; Name: "{userdesktop}\{#MyAppName}-32.lnk"
Type: filesandordirs; Name: "{userdesktop}\{#MyAppName}-64.lnk"
Type: filesandordirs; Name: "{userappdata}\Microsoft\Internet Explorer\Quick Launch\{#MyAppName}-32.lnk"
Type: filesandordirs; Name: "{userappdata}\Microsoft\Internet Explorer\Quick Launch\{#MyAppName}-64.lnk"
Type: files; Name: "{app}\Bin64\294617824.sbm_LaserTurretFiller"
Type: files; Name: "{app}\Bin64\605086856.sbm_Holo"
Type: files; Name: "{app}\Bin64\648332129.sbm_DrillUpgrade"
Type: files; Name: "{app}\Bin64\648332129.sbm_GyroUpgrade"
Type: files; Name: "{app}\Bin64\Holo_Holo"
Type: files; Name: "{app}\Bin64\Holographic_Radar_Holo"
Type: files; Name: "{app}\Bin64\KEEN_Upgrade_Modules_Fix_DrillUpgrade"
Type: files; Name: "{app}\Bin64\KEEN_Upgrade_Modules_Fix_GyroUpgrade"
Type: filesandordirs; Name: "{app}\*"; Tasks: clearinstall
[UninstallDelete]
Type: filesandordirs; Name: "{app}\_CommonRedist\"
Type: filesandordirs; Name: "{app}\Backup_NoSteam\"
Type: filesandordirs; Name: "{app}\Bin64\"
Type: filesandordirs; Name: "{app}\Content\"
Type: filesandordirs; Name: "{app}\DedicatedServer64\"
Type: filesandordirs; Name: "{app}\NoSteam\"
Type: filesandordirs; Name: "{app}\Tools\"
Type: filesandordirs; Name: "{app}\eula.txt"
Type: filesandordirs; Name: "{app}\postbuild.txt"
Type: filesandordirs; Name: "{app}\PrepareScriptMod.bat"
Type: filesandordirs; Name: "{app}\steam_appid.txt"
[CustomMessages]
clear=Clean install
ArcBreak=Installation cancelled!
ArcError=Decompression failed with error code %1
ErrorUnknownError=Error occured while extracting archives. Please contact the author of this program.
ErrorCompressMethod=Compression method "%1" of the acrhive "%2" is not supported by the current version of unarc.dll.
ErrorOutBlockSize=Output block is too small for the archive "%1".
ErrorNotEnoughRAMMemory=Not enough memory to unpack "%1" archive.
ErrorReadData=Archive "%1" data read error.
ErrorBadCompressedData=Data can't be extracted from the archive "%1".
ErrorNotImplement=Required action isn't supported by the current version of unarc.dll.
ErrorDataAlreadyDecompress=Data block of the archive "%1" is already decompressed.
ErrorUnpackTerminated=User cancelled the operation.
ErrorWriteData=Error occured while processing the archive "%1".
ErrorBadCRC=Bad CRC in the archive "%1".
ErrorBadPassword=Applied password for archive "%1" isn't correct.
ErrorBadHeader=Header of the archive "%1" is corrupted.
ErrorCodeException=Raised a code exception. Please contact the author of this program.
ErrorNotEnoughFreeSpace=Not enough free space to unpack "%1".
ArcTitle=Extracting FreeArc archives...
StatusInfo=Files: %1%2, progress %3%%, remaining time %4
ArcInfo=Disk %1 of %2, archive %3 of %4, %5%% of archive processed
ArcFinish=Unpacked archives: %1, received files: %2 [%3]
InsertDisk=Please insert disk № %1 with file "%2" and press OK.
taskbar=%1%%, %2 remains
ending=Ending
hour= hours
min= mins
sec= secs
main_files=Main game files
textures=Textures game files
redist=Common Redist
crack=Crack SKIDROW
with_crack=Cracked version
russian.clear=Чистая установка
russian.main_files=Файлы игры
russian.textures=Текстуры игры
russian.redist=Общие файлы
russian.crack=Лекарство от SKIDROW
russian.with_crack=Взломанная версия
russian.ArcBreak=Установка прервана!
russian.ArcError=Распаковщик FreeArc вернул код ошибки: %1.
russian.ErrorUnknownError=Ошибка при распаковке архивов. Пожалуйста, обратитесь к разработчику программы.
russian.ErrorCompressMethod=Метод сжатия "%1" данного архива "%2" не поддерживается данной версией unarc.dll.
russian.ErrorOutBlockSize=Выходной блок данных архива "%1" слишком мал.
russian.ErrorNotEnoughRAMMemory=Недостаточно свободной оперативной памяти для распаковки архива "%1".
russian.ErrorReadData=Ошибка чтения данных архива "%1".
russian.ErrorBadCompressedData=Данные из архива "%1" не могут быть распакованы.
russian.ErrorNotImplement=Запрошенное действие не поддерживается данной версией unarc.dll.
russian.ErrorDataAlreadyDecompress=Запрошенный блок данных архива "%1" уже распакован.
russian.ErrorUnpackTerminated=Операция прервана пользователем.
russian.ErrorWriteData=Ошибка записи данных из архива "%1".
russian.ErrorBadCRC=Ошибка данных CRC в архиве "%1".
russian.ErrorBadPassword=Пароль введенный для данного архива "%1" неверен.
russian.ErrorBadHeader=Заголовок архива "%1" поврежден.
russian.ErrorCodeException=Ошибка выполнения программы установки. Пожалуйста, обратитесь к разработчику программы.
russian.ErrorNotEnoughFreeSpace=Недостаточно свободного места на диске назначения для распаковки архива "%1".
russian.ArcTitle=Распаковка FreeArc-архивов...
russian.StatusInfo=Файлов: %1%2, %3%% выполнено, осталось ждать %4
russian.ArcInfo=Диск %1 из %2, архив %3 из %4, архив обработан на %5%%
russian.ArcFinish=Распаковано архивов: %1, получено файлов: %2 [%3]
russian.InsertDisk=Пожалуйста, вставьте диск № %1, содержащий файл "%2" и нажмите кнопку ОК.
russian.taskbar=%1%%, жди %2
russian.ending=Завершение
russian.hour= часов
russian.min= мин
russian.sec= сек
ukrainian.clear=Чисте встановлення
ukrainian.main_files=Файли гри
ukrainian.redist=Загальні файли
ukrainian.textures=Текстури гри
ukrainian.crack=Ліки від SKIDROW
ukrainian.with_crack=Зламана версія
german.ArcBreak=Installation abgebrochen!
german.ArcError=Entpacken brach mit dem Fehlercode %1 ab.
german.ErrorUnknownError=Ein Fehler trat beim Entpacken auf. Kontaktieren sie den Autor des Programms.
german.ErrorCompressMethod=Die Kompressions-Methode "%1" des Archivs "%2" wird von der aktuellen Version von unarc.dll nicht unterstutzt.
german.ErrorOutBlockSize=Ausgabe-Block ist zu klein fur das Archiv "%1"
german.ErrorNotEnoughRAMMemory=Nicht genug freier Speicher um das Archiv "%1" zu entpacken.
german.ErrorReadData=Archiv "%1" Daten-Lese-Fehler
german.ErrorBadCompressedData=Daten konnten nicht aus dem Archiv "%1" entpackt werden.
german.ErrorNotImplement=Die benotigte Funktion wird noch nicht von unarc.dll unterstutzt.
german.ErrorDataAlreadyDecompress=Daten-Block des Archivs "%1" ist bereits entpackt.
german.ErrorUnpackTerminated=Abbruch durch Benutzer.
german.ErrorWriteData=Ein Fehler ereignete sich beim Bearbeiten des Archivs "%1"
german.ErrorBadCRC=Falsche CRC-Prufsumme in Archiv "%1"
german.ErrorBadPassword=Passwort fur Archiv "%1" ist falsch.
german.ErrorBadHeader=Header des Archivs "%1" ist beschadigt.
german.ErrorCodeException=Code-Ausnahme erkannt. Kontaktieren sie den Autor des Programms.
german.ErrorNotEnoughFreeSpace=Nicht genug freier Speicher um "%1" zu entpacken!
german.ArcTitle=Entpacke FreeArc-Archive...
german.StatusInfo=Dateien: %1%2, Fortschritt %3%%, verbleibende Zeit %4
german.ArcInfo=Disk %1 von %2, Archiv %3 von %4, %5%% des Archivs bearbeitet.
german.ArcFinish=Entpackte Archive: %1, erhaltene Dateien: %2 [%3]
german.InsertDisk=Bitte legen Sie Disk # %1 mit der Datei "%2" ein und drucken Sie OK.
german.taskbar=%1%%, %2 verbleibend
german.ending=Fertigstellen
german.hour= Stunden
german.min= Minuten
german.sec= Sekunden
[ISToolPreCompile]
#define isFalse(any S) (S = LowerCase(Str(S))) == "no" || S == "false" || S == "off" ? "true" : "false"
[Code]
type
#ifdef UNICODE
#define A "W"
#else
#define A "A" ;// точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
#if Ver < 84084736
PAnsiChar = PChar; // Required for Inno Setup 5.3.0 and lower. (требуется для Inno Setup версии 5.3.0 и ниже)
#endif
#endif
#if Ver < 84018176
AnsiString = String; // There is no need for this line in Inno Setup 5.2.4 and above (для Inno Setup версий 5.2.4 и выше эта строка не нужна)
#endif
TMessage = record hWnd: HWND; msg, wParam: Word; lParam: LongWord; Time: TFileTime; pt: TPoint; end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path, Dest, comp, task, pass: string; allMb: Integer; Disks: Integer; UnPack, UnPacked: Boolean; end;
TBarInfo = record stage, name: string; size: Extended; perc: Integer; end;
TFAProgressInfo = record DiskSize, CurPos, LastPos, AllPos, FilesCount: Integer; LastSize, AllSize: Extended; end;
TFADiskStatus = record LastMaxCount, MaxCount, CurDisk, NextArc, RemainsArc: Integer; end;
TCWPSTRUCT = record lParam: LongWord; wParam: Word; Msg: LongWord; hwnd: HWnd; end;
TCWPSTRUCTProc = procedure(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
TTimerProc = procedure(HandleW, Msg, idEvent, TimeSys: LongWord);
var
StatusLabel, FileNameLabel, ExtractFile, StatusInfo: TLabel;
ProgressBar: TNewProgressBar;
CancelCode, n, ArcInd, UnPackError, StartInstall, LastTimerEvent, lastMb, baseMb: Integer;
FreeMB, TotalMB: Cardinal;
WndHookID, TimerID: LongWord;
Arcs, AllArchives: array of TArc;
msgError, CompressMethod: string;
Status: TBarInfo; Progress: TFAProgressInfo; DS: TFADiskStatus;
FreezeTimer, SuspendUpdate: Boolean;
origsize: Integer; // total uncompressed size of archive data in mb
const
CP_ACP = 0; CP_UTF8 = 65001;
oneMB=1024*1024;
Period = 250; // частота обновления кнопки таскбара и строки статуса
VK_ESCAPE = 27;
HC_ACTION = 0;
WM_PAINT = $F;
CancelDuringInstall = {#isFalse(SetupSetting("AllowCancelDuringInstall"))};
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';
Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external '
[email protected] stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external '
[email protected] stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external '
[email protected] stdcall';
function PeekMessage(var lpMsg: TMessage; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external '
[email protected] stdcall';
function TranslateMessage(const lpMsg: TMessage): BOOL; external '
[email protected] stdcall';
function DispatchMessage(const lpMsg: TMessage): Longint; external '
[email protected] stdcall';
function GetTickCount: DWord; external 'GetTickCount@kernel32';
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 GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
function GetCurrentThreadID: LongWord; external 'GetCurrentThreadId@kernel32 stdcall delayload';
function CallNextWNDPROC(idHook: LongWord; Code: Integer; wParam: Word; lParam: TCWPSTRUCT): LongWord; external 'CallNextHookEx@user32 stdcall delayload';
function SetWindowsHookEx(idHook: LongWord; callback: LongWord; hMod: LongWord; dwThreadID: HWND): LongWord; external 'SetWindowsHookExW@user32 stdcall delayload';
function UnhookWindowsHookEx(idHook: LongWord): LongWord; external 'UnhookWindowsHookEx@user32 stdcall delayload';
function WrapCWPSTRUCTProc(callback:TCWPSTRUCTProc; paramcount:integer): longword; external 'wrapcallback@files:innocallback.dll';
function WrapTimerProc(callback: TTimerProc; Paramcount: Integer): longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): longword; external 'SetTimer@user32';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32 stdcall delayload';
procedure AppProcessMessage;
var Msg: TMessage;
begin
if not PeekMessage(Msg, 0, 0, 0, 1) then Exit;
TranslateMessage(Msg); DispatchMessage(Msg);
end;
Function FreeArcCmd(callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer;
Begin
CancelCode:= 0; AppProcessMessage;
try
Result:= FreeArcExtract(callback, cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10); // Pass the specified arguments to 'unarc.dll'
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;
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;
// Перевод числа в строку с точностью 2 знака (%.2n) с округлением дробной части, если она есть
Function NumToStr(Float: Extended): String;
Begin
Result:= Format('%.2n', [Float]); StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do
SetLength(Result, Length(Result)-1);
End;
Function ByteOrTB(Bytes: Extended; noMB: Boolean): String; {Перевод числа в значение бт/Кб/Мб/Гб/Тб (до 2х знаков после запятой)}
Begin
if not noMB then Result:= NumToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= NumToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= NumToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= NumToStr(round(Bytes/oneMB*100)/100) +' Mb' else
If Bytes/oneMB/1000 < 1024 then Result:= NumToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb' else
Result:= NumToStr(round(Bytes/oneMB/oneMB*1000)/1000) +' Tb';
End;
Function StringToArray(Text, Cut: String): array of String; var i, k: Integer; // поместить строки текста в элементы массив. шаблон перевода строк может быть любым. шаблон в начале/конце текста игнорируются
Begin
SetArrayLength(Result, 0); if Cut = '' then Cut:= #1310; //если шаблон пуст, считаем переводы строк
Repeat k:= Pos(Cut,Text);
if k = 1 then begin Delete(Text, 1, Length(Cut)); CONTINUE
end;
SetArrayLength(Result, GetArrayLength(Result) +1); i:= GetArrayLength(Result) -1;
if k = 0 then
Result
:=Text
else begin
Result:= Copy(Text, 1, k -1); Delete(Text, 1, Length(Result) + Length(Cut));
end;
Until Length(Text) * k = 0;
End;
Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer; Prefs: TObject): TLabel;
Begin
Result:=TLabel.Create(Parent); Result.parent:= Parent;
if Prefs <> Nil then begin
Top:= TWinControl(Prefs).Top; Left:= TWinControl(Prefs).Left; Width:= TWinControl(Prefs).Width; Height:= TWinControl(Prefs).Height;
end;
if Top > 0 then result.Top:=Top; if Left > 0 then result.Left:= Left; if Width > 0 then result.Width:= Width; if Height > 0 then result.Height:= Height;
if FontName <> '' then result.Font.Name:= FontName; if FontColor > 0 then result.Font.Color:= FontColor; if FontStyle <> [] then result.Font.Style:= FontStyle;
result.AutoSize:= AutoSize; result.WordWrap:= WordWrap; result.Transparent:=Transparent; result.ShowHint:= true;
End;
// Converts milliseconds to human-readable time
// Конвертирует милисекунды в человеко-читаемое изображение времени
Function TicksToTime(Ticks: DWord; h,m,s: String; detail: Boolean): String;
Begin
if detail then {hh:mm:ss format}
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/3600 >= 1000 then {more than hour}
Result:= IntToStr(Ticks/3600000) +h+' '+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +m
else if Ticks/60 >= 1000 then {1..60 minutes}
Result:= IntToStr(Ticks/60000) +m+' '+ IntToStr(Ticks/1000 - Ticks/1000/60*60) +s
else Result:= Format('%.1n', [Abs(Ticks/1000)]) +s {less than one minute}
End;
Function ExpandENV(string: String): String; var n: UINT; Begin // ExpandConstant + развёртывание DOS-переменных типа %SystemRoot%
if Pos('{',string) * Pos('}',string) = 0 then Result:= String else Result:= ExpandConstant(String); n:= Pos('%',result); if n = 0 then Exit;
Delete(result, n,1); Result:= Copy(Result,1, n-1) + ExpandConstant('{%'+Copy(Result, n, Pos('%',result) -n) +'}') + Copy(Result, Pos('%',result) +1, Length(result))
End;
Function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
Function LoWord(lw: LongWord): LongWord; Begin Result:= lw shr 16; End;
// Converts OEM encoded string into ANSI (Преобразует OEM строку в ANSI кодировку)
function OemToAnsiStr(strSource: AnsiString): AnsiString;
begin
SetLength(Result, Length(strSource));
OemToChar(strSource, Result);
end;
// Converts ANSI encoded string into UTF-8 (Преобразует строку из ANSI в UTF-8 кодировку) by CTAC-Ko
function AnsiToUtf8(strSource: string): string;
var
nRet, nRet2: integer; WideCharBuf, MultiByteBuf: AnsiString;
begin
SetLength(WideCharBuf, Length(strSource) * 2);
SetLength(MultiByteBuf, Length(strSource) * 2);
nRet:= MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
nRet2:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
//nRet2 возвращает число обработанных знаков (исключая различный мусор в конце строки)
MultiByteBuf:=Copy(MultiByteBuf, 1, nRet2); //Вот мы и обрубаем строку до этого числа знаков
Result:= MultiByteBuf;
end;
// ArcInd - текущий архив, счёт с 0
// baseMb - записано из пред. архива на диск
// lastMb - извлечено из тек. архива на диск
// Status.mb - позиция в текущем архиве
// Status.allsize - объём всех архивов
// Status.size - всего извлечено Мб на текущий момент
// totalUncompressedSize - точный объём данных в архивах
// общий прогресс нарастает по мере записи данных из архива на диск (точка 'write')
// прогресс архивов двигается в соответствии с позицией в текущем архиве (точка 'read')
Procedure UpdateStatus(Flags: Integer); // выполняется с периодичностью, заданной константой Period
var
Remaining, p: Integer; i, t: string;
Begin
if Flags and $1 > 0 then FreezeTimer:= Flags and $2 = 0; // bit 0 = 1 change start/stop, bit 1 = 0 stop, bit 1 = 1 start
if (Flags and $4 > 0) or (Status.size <> baseMb+lastMb) then LastTimerEvent:= 0; // bit 2 = 1 UpdateNow // обновить по флагу или записи из архива на диск
if (FreezeTimer=True)or(GetTickCount - LastTimerEvent <= Period)or(SuspendUpdate=True) then Exit else LastTimerEvent:= GetTickCount;
Status.size := baseMb+lastMb; // извлечено на текущий момент
Progress.Allsize:= Progress.LastSize + lastMb; //Извлечено всего
with WizardForm.ProgressGauge do begin
if Progress.DiskSize > 0 then begin
Progress.CurPos:= round(Max * Status.size/Progress.DiskSize);
if Progress.CurPos > Progress.LastPos then begin
Progress.AllPos:= Progress.AllPos + ((Progress.CurPos-Progress.LastPos)/DS.MaxCount);
Progress.LastPos:=Progress.CurPos
end;
Position:= Progress.AllPos
end;
n:= (Max - Min)/1000; if n > 0 then Status.perc:= (Position-Min)/n; // 1000 процентов
#ifndef External
// к сожалению, этот код иногда сбоит на очень больших архивах, созданных с использованием внешних упаковщиков
if Position > 0 then Remaining:= ((Max-Position)*(GetTickCount-StartInstall))/Position else
#endif
Remaining:= 0; t:= cm('ending'); i:= AnsiLowerCase(t);
if Remaining > 0 then begin
t:= FmtMessage(cm('taskbar'), [IntToStr(Status.perc/10), TicksToTime(Remaining, 'h', 'm', 's', false)])
i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)
end;
end;
SetTaskBarTitle(t); // проценты и оставшееся время на кнопке инсталлятора
StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(Progress.FilesCount), ' ['+ ByteOrTB(Progress.Allsize*oneMB, true) +']', Format('%.1n', [Abs(Status.perc/10)]), i]);
// второй прогрессбар движется по мере считывания текущего архива
if (Status.stage = cm('ArcTitle')) and (GetArrayLength(Arcs) > 0) then begin
if (Arcs[ArcInd].allMb > 0) then p:= ((LastMb*100)/Arcs[ArcInd].AllMb);
ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(DS.CurDisk), IntToStr(DS.MaxCount), IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), IntToStr(p)]);
ProgressBar.Position:= LastMb;
end;
End;
Procedure MyTimerProc(h, msg, idevent, dwTime: Longword);
Begin
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0);
End;
Procedure OnWndHook(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
Begin
if (Code = HC_ACTION) and (LoWord(lParam.msg) = WM_PAINT) then begin // подготовка данных для последующего отображения по таймеру
if (Status.name <> WizardForm.FileNameLabel.Caption) and (WizardForm.FileNameLabel.Caption <> '') then begin // имя файла, названия ярлыка и прочее
FileNameLabel.Caption:= WizardForm.FileNameLabel.Caption;
Status.name:= WizardForm.FileNameLabel.Caption; // начало извлечения или распаковки очередного файла
Case Status.stage of
SetupMessage(msgStatusExtractFiles): // этап извлечения файлов инсталлятором
Progress.FilesCount:= Progress.FilesCount +1; // кол-во файлов
End;
end;
if (Status.stage <> WizardForm.StatusLabel.Caption) and (WizardForm.StatusLabel.Caption <> '') then begin
StatusLabel.Caption:= WizardForm.StatusLabel.Caption;
Status.stage:= WizardForm.StatusLabel.Caption; // текущий этап установки
if Status.stage = SetupMessage(msgStatusRollback) then begin
WizardForm.StatusLabel.Hide; WizardForm.FileNameLabel.Hide; StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;
end;
UpdateStatus(0);
end;
CallNextWNDPROC(WndHookID, Code, wParam, lParam) {освобождение события}
End;
// compsize: в Mb объём архива
// total_files: в int2 ? число файлов в архиве
// origsize: в Mb общий объём данных в архиве
// write: в Mb число записанных (распакованных из архива) на диск мегабайт
// read: в Mb число обработанных мегабайт, в int2 размер текущего архива
// filename: вызывается перед обработкой каждого файла
// The main callback function for unpacking FreeArc archives
function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer; // вызывается не менее 100 раз в секунду, что заменяет вызов по таймеру
begin
case string(what) of
'origsize': origsize:= Mb; // данных в тек. архиве (при распаковке не вызывается)
'total_files': Null;
'filename': begin // Update FileName label
WizardForm.FileNameLabel.Caption:= OemToAnsiStr(str); // извлекаемый файл, их имена пишутся в журнал установки
Progress.FilesCount:= Progress.FilesCount + 1; // кол-во файлов, этап распаковки
end;
'read': Null; // позиция в текущем архиве
'write': lastMb:= Mb; // Assign to Mb *total* amount of data extracted to the moment from all archives
'quit': if (Mb = -2) then CompressMethod:= str;
end;
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0); // обновить страницу установки, не сбрасывая таймер
if (GetKeyState(VK_ESCAPE) < 0) and not CancelDuringInstall then
WizardForm.Close; // опрашиваем Cancel (если разрешена отмена установки)
AppProcessMessage;
Result:= CancelCode;
end;
Function DeleteChars(S, Char: String): String; begin if (Pos(Char, S)>0) then
begin while (Pos(Char, S)>0) do StringChange(S, Char, ''); end; Result:=S; end;
Function CutStr(var S: String; Index, Length: Integer): String; var str: string;
begin str:= Copy(S, Index, Length); Delete(S, Index, Length); Result:=Str; end;
Function CutStrEx(var S: String; Code: String): String;
var str: string; pos1, pos2: integer; begin pos1:= Pos(Code, S); If (pos1>0) then begin
pos2:=pos1; while S[pos2]<>';' do if pos2<>length(S) then pos2:=pos2+1; str:=cutStr(S, pos1, (pos2-pos1)+1);
StringChange(str, Code, ''); if str[Length(str)]=';' then Setlength(str, Length(str)-1); end; Result:=str; end;
Function ArcDecode(Line: String): array of TArc; // разбор строки Archives
var tmp: array of String; cut: string; i, n: integer;
begin
SetArrayLength(Result, 0); If Line = '' then Exit;
tmp:= StringToArray(Line, '|');
for n:=0 to GetArrayLength(tmp)-1 do begin
i:= GetArrayLength(Result); SetArrayLength(Result, i+1); cut:=tmp[n]+';';
if (Pos('Tasks:', cut)>0) then Result.task:= DeleteChars(CutStrEx(cut, 'Tasks:'), ';');
if (Pos('Components:', cut)>0) then Result.comp:= DeleteChars(CutStrEx(cut, 'Components:'), ';');
if (Pos('Password:', cut)>0) then Result.pass:= DeleteChars(CutStrEx(cut, 'Password:'), ';');
if (Pos('Disk:', cut)>0) then Result.disks:= StrToInt(DeleteChars(CutStrEx(cut, 'Disk:'), ';')) else Result.disks:=1;
if (Pos('DestDir:', cut)>0) then Result.dest:= DeleteChars(CutStrEx(cut, 'DestDir:'), ';');
cut:=DeleteChars(cut, ';');
if (ExtractFileDrive(ExpandEnv(cut)) = '')and(ExpandEnv(cut) = cut) then
Result.Path:= '{src}\'+cut else Result.Path:= cut;
Result.Dest:= ExpandENV(result.Dest); Result.Path:= ExpandENV(result.Path);
end;
end;
// Scans the specified folders for archives and add them to list
function AddArcs(File: TArc; var ErrCode: Integer): Integer; // добавление архивов в общий список и подсчёт объёма распакованных данных
var i: integer; Password: string;
Begin
if FileExists(File.Path) then begin
Result:= 0; i:= GetArrayLength(Arcs);
if File.pass <> '' then Password:= '-p'+AnsiToUtf8(File.pass) else Password:= '';
SetArrayLength(Arcs, i +1); Arcs:=File;
if Password <> '' then
ErrCode:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4),'l',Password,'--',AnsiToUtf8(Arcs.Path),'','','','','','')
else
ErrCode:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4),'l','--',AnsiToUtf8(Arcs.Path),'','','','','','',''); // код ошибки
if ErrCode >= 0 then begin Arcs.allMb:= origsize; result:= Arcs.allMb; origsize:=0; end;// размер распакованных данных успешно считан
end;
End;
function DispatchError(ErrorCode: Integer; Arc: TArc): String;
var ArcFile: String;
begin
ArcFile:= ExtractFilename(Arc.Path);
if (ErrorCode = -2) then StringChange(CompressMethod, 'ERROR: unsupported compression method ', '');
case ErrorCode of
-1: Result:= cm('ErrorUnknownError');
-2: Result:= FmtMessage(cm('ErrorCompressMethod'), [CompressMethod, ArcFile]);
-3: Null;
-4: Result:= FmtMessage(cm('ErrorOutBlockSize'), [ArcFile]);
-5: Result:= FmtMessage(cm('ErrorNotEnoughRAMMemory'), [ArcFile]);
-6: Result:= FmtMessage(cm('ErrorReadData'), [ArcFile]);
-7: Result:= FmtMessage(cm('ErrorBadCompressedData'), [ArcFile]);
-8: Result:= cm('ErrorNotImplement');
-9: Result:= FmtMessage(cm('ErrorDataAlreadyDecompress'), [ArcFile]);
-10: Result:= cm('ErrorUnpackTerminated');
-11: Result:= FmtMessage(cm('ErrorWriteData'), [ArcFile]);
-12: Result:= FmtMessage(cm('ErrorBadCRC'), [ArcFile]);
-13: Result:= FmtMessage(cm('ErrorBadPassword'), [ArcFile]);
-14: Result:= FmtMessage(cm('ErrorBadHeader'), [ArcFile]);
-15: Null;
-63: Result:= cm('ErrorCodeException');
-112: Result:= FmtMessage(cm('ErrorNotEnoughFreeSpace'), [ArcFile]);
end;
end;
function UnPackArchive(Archive: TArc): Integer;
var callback: longword; Password: String;
Begin
// если отмена установки разрешена, кнопка Cancel станет доступна
WizardForm.CancelButton.Enabled:= not CancelDuringInstall;
if Archive.pass <> '' then Password:= '-p'+AnsiToUtf8(Archive.pass) else Password:= '';
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
if Password <> '' then
Result:= FreeArcCmd(callback,'x','-o+','-dp'+AnsiToUtf8(Archive.Dest),'-w'+AnsiToUtf8(Archive.Dest),Password,'--',AnsiToUtf8(Archive.Path),'','','')
else // код ошибки
Result:= FreeArcCmd(callback,'x','-o+','-dp'+AnsiToUtf8(Archive.Dest),'-w'+AnsiToUtf8(Archive.Dest),'--',AnsiToUtf8(Archive.Path),'','','','');
// Error occured
if Result = 0 then Exit;
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
WizardForm.StatusLabel.Caption:= msgError;
WizardForm.FileNameLabel.Caption:= ExtractFileName(Archive.Path);
GetSpaceOnDisk(ExtractFileDrive(Archive.Dest), True, FreeMB, TotalMB);
if FreeMB < (Archive.allMb-lastMb) then Result:= -112;
MsgError:= msgError+#13#10#13+DispatchError(Result, Archive)
Log(msgError); // записываем ошибку в лог, а также показываем её текст на странице завершения
End;
procedure SetUnpacked(File: TArc); var i: integer; begin
for i:=0 to GetArrayLength(AllArchives)-1 do begin
if(File.Path=AllArchives.Path)and(File.Dest=AllArchives.Dest)
then begin AllArchives.UnPacked:=True; Break; end; end; end;
function UpdateArcsList(): Integer;
var m, ErrorCode: integer; begin
AppProcessMessage; SetArrayLength(Arcs,0); Progress.DiskSize:=0; for m:=0 to (GetArrayLength(AllArchives)-1) do try
if (AllArchives[m].UnPack)and(AllArchives[m].UnPacked=False) then Progress.DiskSize:= Progress.DiskSize + AddArcs(AllArchives[m], ErrorCode);
if (ErrorCode < 0) then begin Result:=ErrorCode; Break; end; Except Result:=-63; end; end;
// Extracts all found archives
function UnPack(): Integer;
begin
Progress.CurPos:=0; Progress.LastPos:=0; baseMb:= 0; // обнулить полученные мегабайты, если ранее вёлся подсчёт объёма файлов инсталлятора
if (DS.LastMaxCount<>DS.MaxCount)and(DS.CurDisk>1) then begin
Progress.AllPos:= (WizardForm.ProgressGauge.Max/(DS.MaxCount))*(DS.CurDisk-1); end;
UpdateStatus(7); // немедленно обновить строку статуса
for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin // архивы в текущей папке, константы раскрыты в ArcDecode
lastMb:= 0; SuspendUpdate:=False; //отключаем паузу автоапдейта по таймеру на время распаковки
ProgressBar.Max:=Arcs[ArcInd].allMb;
Result:= UnPackArchive(Arcs[ArcInd]); // код ошибки
Progress.LastSize:= Progress.AllSize; SetUnPacked(Arcs[ArcInd]);
SuspendUpdate:=True; //ставим автоапдейт по таймеру на паузу - распаковка окончена (возможно временно)
if Result <> 0 then Break; // прервать цикл распаковки
baseMb:= baseMb + lastMb; // общий объём распакованных файлов
// отработанный архив автоматически удаляется, если находится в папке {app} или {tmp}
if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) or (Pos(AnsiLowercase(ExpandConstant('{tmp}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) then
DeleteFile(Arcs[ArcInd].Path);
end;
end;
Function CheckBools(Bools: array of Boolean): Integer;
var c,l: integer; begin Result:=0; for l:=0 to GetArrayLength(Bools)-1 do begin
if (Bools[l] = True) then c:=c+1; end; if (c=(GetArrayLength(Bools)))then Result:=1;end;
function GetRemainArcs(): integer;
var c: integer; Begin Result:=0; for c:=0 to GetArrayLength(AllArchives)-1 do begin
If (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked)then Result:=Result+1; end; end;
Function GetNextArc(): Integer;
var c: Integer; Begin Result:=0; for c:=0 to GetArrayLength(AllArchives)-1 do begin
if (AllArchives[c].UnPack)and(not AllArchives[c].UnPacked) then begin Result:=c; Exit; end; end; end;
Function GetUnpackedArcs(): Integer;
var c: Integer; Begin Result:=0; for c:=0 to GetArrayLength(AllArchives)-1 do begin
if (AllArchives[c].UnPack)and(AllArchives[c].UnPacked) then Result:=Result+1; end; Result:=Result+1; end;
Function SetStatus(Value: String): Boolean;
begin WizardForm.StatusLabel.Caption:=Value; StatusLabel.Caption:=Value; Status.stage:=Value; end;
Function UnPackWithPrompts(Archives: string): Integer;
var MsBox, MaxArcs: Integer; FADiskMessage: string;
TmpArc: array of TArc; z, f, q, k, x, LastDisk: Integer; OneDisk, DiskCheck: Boolean;
begin
AppProcessMessage; SetStatus(cm('ArcTitle')) // начало этапa распаковки
ExtractFile.Show; ProgressBar.Show; StatusInfo.Show;
Progress.FilesCount:=0; MsBox:=IDOK; z:=0; OneDisk:=False;
AllArchives:= ArcDecode(Archives); DS.LastMaxCount:=DS.MaxCount;
MaxArcs:= GetArrayLength(AllArchives)-1; LastDisk:=1; q:=0; k:=0; x:=0;
DS.CurDisk:=1; DS.MaxCount:= AllArchives[MaxArcs].disks; DiskCheck:=False;
WizardForm.ProgressGauge.Position:=0; UpdateStatus(7); SuspendUpdate:=True;
WizardForm.ProgressGauge.Max:= 100000;
//инициализация параметров архивов
for f:=0 to MaxArcs do begin
AllArchives[f].UnPack:=True; AllArchives[f].UnPacked:=False; //Сначала активируем все архивы
if (AllArchives[f].comp<>'')and(not IsComponentSelected(AllArchives[f].comp)) then AllArchives[f].UnPack:=False; //Если компонент не выбран то деактивируем этот архив
if (AllArchives[f].task<>'')and(not IsTaskSelected(AllArchives[f].task)) then Allarchives[f].UnPack:=False; //То же что и выше, только с задачей (Task)
z:=z+CheckBools([FileExists(AllArchives[f].Path)]); k:=k+CheckBools([AllArchives[f].UnPack]);
x:=x+CheckBools([AllArchives[f].UnPack, FileExists(AllArchives[f].Path)]);
end;
if (z=(MaxArcs+1)) then begin DS.LastMaxCount:=DS.MaxCount; DS.MaxCount:=DS.CurDisk; OneDisk:=True; end;
if (x=k) then begin DS.LastMaxCount:=DS.MaxCount; DS.MaxCount:=DS.CurDisk; OneDisk:=True; end;
DS.NextArc:= GetNextArc; DS.RemainsArc:= GetRemainArcs;
//распаковка архивов на дисках
while (Result = 0) and (DS.RemainsArc>0) do begin
if (not OneDisk) then begin x:=0;
//проверка если на текущем диске находятся все требующиеся архивы (исключая уже распакованные)
for f:= DS.NextArc to MaxArcs do begin
x:=x+CheckBools([(AllArchives[f].UnPack), FileExists(AllArchives[f].Path)]);
if (x=((MaxArcs+1)-DS.NextArc)) then begin DS.LastMaxCount:=DS.MaxCount; DS.MaxCount:=DS.CurDisk; end; end;
end;
while (msBox=IDOK)and(not(FileExists(AllArchives[DS.NextArc].Path))and(AllArchives[DS.NextArc].UnPack)) do begin
FADiskMessage:= FmtMessage(cm('InsertDisk'),[IntToStr(DS.CurDisk), ExtractFilename(AllArchives[DS.NextArc].Path)])
MsBox:= MsgBox(FADiskMessage, mbConfirmation, MB_OKCANCEL)
end;
//Отмена распаковки
if MsBox = IDCANCEL then Result:= -10;
//Проверка числа дисков
if (not OneDisk) then begin
//Если на n-ом диске находтся архивы привязанные к одному компоненту и этот компонент не выбран (проверяется один раз)
if (DS.MaxCount>1)and(DS.CurDisk<>DS.MaxCount)and(not DiskCheck) then begin
while (LastDisk<=DS.MaxCount)and(q<(MaxArcs+1)) do begin
SetArraylength(TmpArc, 0); k:=0;
for z:=q to GetArrayLength(AllArchives)-1 do begin
if AllArchives[z].disks=LastDisk then begin SetArrayLength(TmpArc, GetArrayLength(TmpArc)+1); TmpArc[GetArrayLength(TmpArc)-1]:= AllArchives[z]; end; end;
for z:=0 to GetArrayLength(tmpArc)-1 do begin if (not TmpArc[z].Unpack) then k:=k+1; end;
if k=GetArrayLength(tmpArc) then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount-1; q:=q+GetArrayLength(TmpArc) end;
LastDisk:=LastDisk+1; end;
DiskCheck:=True; end;
//Если на текущем диске должен быть архив а его нет
if (DS.CurDisk=DS.MaxCount) then begin
SetArraylength(TmpArc, 0); k:=0;
for z:=DS.NextArc to GetArrayLength(AllArchives)-1 do begin
if AllArchives[z].disks=DS.CurDisk then begin SetArrayLength(TmpArc, GetArrayLength(TmpArc)+1); TmpArc[GetArrayLength(TmpArc)-1]:= AllArchives[z]; end; end;
for z:=0 to GetArrayLength(tmpArc)-1 do begin if (TmpArc[z].UnPack)and(FileExists(TmpArc[z].Path)) then k:=k+1 end;
if k<GetArrayLength(TmpArc)then begin DS.LastMaxCount:= DS.MaxCount; DS.MaxCount:= DS.MaxCount+1; end;
end;
end;
//Сама распаковка
if (MsBox<>IDCANCEL)and(DS.RemainsArc>0) then begin Result:=UpdateArcsList; Result:= UnPack(); DS.CurDisk:= DS.CurDisk+1; DS.NextArc:= GetNextArc; DS.RemainsArc:= GetRemainArcs; end;
end;
//Конец распаковки, скрытие надписей и прогрессбара
if (Result = 0) then begin WizardForm.StatusLabel.Caption:= FmtMessage(cm('ArcFinish'), [IntToStr(GetUnpackedArcs), IntToStr(Progress.FilesCount), ByteOrTB(Progress.AllSize*oneMB, true)]);
StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide; end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then begin
StartInstall:= GetTickCount {время начала извлечения файлов}
WndHookID:= SetWindowsHookEx(4, WrapCWPSTRUCTProc(@OnWndHook, 3), 0, GetCurrentThreadID); {установка SendMessage хука}
TimerID:= SetTimer(0, 0, 500 {полсекунды}, WrapTimerProc(@MyTimerProc, 4)); {установка таймера}
end;
if CurStep = ssPostInstall then
begin
StartInstall:= GetTickCount {время начала распаковки}
UnPackError:= UnPackWithPrompts('{#Archives}')
if UnPackError <> 0 then begin // Error occured, uninstall it then
if not {#isFalse(SetupSetting("Uninstallable"))} then // деинсталляция разрешёна
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); // откат установки из-за ошибки unarc.dll
WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
SetTaskBarTitle(SetupMessage(msgErrorTitle))
end else
SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
end;
end;
#ifdef Texture
#include "FATexture.iss"
#endif
Procedure CurPageChanged(CurPageID: Integer);
Begin
#ifdef Texture
SetTexture(CurPageID)
#endif
if (CurPageID = wpFinished) and (UnPackError <> 0) then
begin // Extraction was unsuccessful (распаковщик вернул ошибку)
// Show error message
WizardForm.FinishedLabel.Font.Color:= $0000C0; // red (красный)
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + msgError;
end;
End;
procedure WizardClose(Sender: TObject; var Action: TCloseAction);
Begin
Action:= caNone; // так надо
if Status.stage = cm('ArcTitle') then begin // распаковка на этапе ssPostInstall
UpdateStatus(1); // остановить таймер
if MsgBox(SetupMessage(msgExitSetupMessage), mbInformation, MB_YESNO) = IDYES then
CancelCode:= -10; // прервать распаковку
UpdateStatus(7); // обновить информацию
end else
MainForm.Close; // стандартное нажатие кнопки закрытия окна, отмены или Escape.
End;
Procedure InitializeWizard();
Begin
// Create controls to show extended info
StatusLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.StatusLabel);
FileNameLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.FileNameLabel);
WizardForm.StatusLabel.Top:= WizardForm.ProgressGauge.Top; WizardForm.FileNameLabel.Top:= WizardForm.ProgressGauge.Top; // прячем под прогрессбар, тогда все события WM_PAINT перехватываются
with WizardForm.ProgressGauge do begin
StatusInfo:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, Top + ScaleY(32), Width, 0, Nil);
ProgressBar := TNewProgressBar.Create(WizardForm);
ProgressBar.SetBounds(Left, StatusInfo.Top + StatusInfo.Height + ScaleY(16), Width, Height);
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 65536;
ProgressBar.Hide; // будет показан при обработке нескольких архивов
ExtractFile:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, ProgressBar.Top + ScaleY(32), Width, 0, Nil);
end;
WizardForm.OnClose:= @WizardClose // позволяет прервать распаковку архивов стандартными способами
#ifdef Texture
CreateTexture();
#endif
End;
Procedure DeInitializeSetup;
Begin
KillTimer(0, TimerID) {удаление таймера}
UnhookWindowsHookEx(WndHookID) {удаление SendMessage хука}
End;
![[Цитировать]](./templates/default/images/lang_russian/icon_quote.gif "Ответить с цитатой"){kind=icon}
![[Профиль]](./templates/default/images/lang_russian/icon_profile.gif "Посмотреть профиль"){kind=icon}
![[ЛС]](./templates/default/images/lang_russian/icon_pm.gif "Отправить ЛС"){kind=icon}
ставлю перепаковывать с другими настройками.
После переустановки опять работает нормально.
