[Setup]
AppName=test
AppVerName=test
OutputDir=.
DefaultDirName={tmp}
DirExistsWarning=no
Uninstallable=no
CreateUninstallRegKey=no
[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl
[CustomMessages]
ru.FAProgressInfo=Распаковка архива %1 (%2 из %3)...
ru.FAProgressInfoDesc=%nПрогресс:%nСкорость:%nПрошло:%nОсталось:
ru.FAProgressInfoValues=%n%1%% (%2 из %3)%n%4/сек%n%5%n%6
ru.FAOverwriteFiles=Нажмите «Да», чтобы больше не спрашивать и перезаписать все файлы или «Нет», чтобы больше не спрашивать и не перезаписывать файлы.
ru.FAPromptPasswordCaption=Пароль на архив
ru.FAPromptPassword=Введите пароль на архив:
ru.FAReadInfoStarted=[FREEARC]: INFO: Получение информации из архива %1 начато.
ru.FAReadInfoFilesCount=[FREEARC]: INFO: Количество файлов в архиве: %1
ru.FAReadInfoUncompressedSize=[FREEARC]: INFO: Суммарный исходный (несжатый) размер файлов в архиве: %1
ru.FAReadInfoCompressedSize=[FREEARC]: INFO: Суммарный сжатый размер файлов в архиве: %1
ru.FAReadInfoCompleted=[FREEARC]: INFO: Получение информации из архива %1 завершено.
ru.FAExtractPackageStarted=[FREEARC]: INFO: Распаковка архива %1 начата.
ru.FAPackageSize=[FREEARC]: INFO: Размер архива: %1
ru.FAExtractFile=[FREEARC]: INFO: Распаковка файла %1 размером %2.
ru.FAExtractedSize=[FREEARC]: INFO: Распаковано: %1
ru.FAExtractPackageCompleted=[FREEARC]: INFO: Распаковка архива %1 закончена.
ru.FAError=[FREEARC]: %1
[Files]
Source: unarc.dll; Flags: dontcopy
#ifndef IS_ENHANCED
#if VER < 0x06000000
; https://web.archive.org/web/20150510131335if_/http://restools.hanzify.org/inno/callbackctrl/InnoCallbackCtrl_V1.1.zip
Source: CallbackCtrl.dll; Flags: dontcopy
#endif
#endif
[Code]
const
GWL_STYLE = -16;
WS_CLIPSIBLINGS = $04000000;
WS_VISIBLE = $10000000;
WS_CHILDWINDOW = $40000000;
SS_RIGHT = $2;
WM_QUIT = $0012;
PM_REMOVE = $1;
MSGF_SLEEPMSG = $5300;
NO_ERROR = 0;
CREDUI_FLAGS_DO_NOT_PERSIST = $00002;
CREDUI_FLAGS_ALWAYS_SHOW_UI = $00080;
CREDUI_FLAGS_PASSWORD_ONLY_OK = $00200;
CREDUI_FLAGS_GENERIC_CREDENTIALS = $40000;
CREDUI_FLAGS_KEEP_USERNAME = $100000;
FREEARC_OK = 0; { ALL RIGHT }
FREEARC_ERRCODE_OPERATION_TERMINATED = -10; { Operation terminated by user }
CP_UTF8 = 65001;
type
TFreeArcCallback = function(what: PAnsiChar; int1, int2: Integer; str: LongWord): Integer;
TFreeArcPackage = record
FileName: string; // путь к архиву
DestDir: string; // папка распаковки
TotalSize: Double; // размер несжатых данных архива
end;
TFreeArcPackages = array of TFreeArcPackage;
TFreeArcData = record
CallbackProc: LongWord;
ErrMsg: AnsiString;
Packages: TFreeArcPackages;
StartTime: Cardinal;
CurrentIndex: Integer; // индекс текущего архива
CurrentFileName: AnsiString; // имя текущего файла из архива
CurrentSize: Double; // размер распакованных данных текущего архива
Size: Double; // текущий размер распакованных данных архивов
TotalSize: Double; // размер несжатых данных
end;
#ifndef IS_ENHANCED
TMsg = record
hwnd: HWND;
message: LongWord;
wParam: Longint;
lParam: Longint;
time: LongWord;
pt: TPoint;
end;
#endif
TCredUIInfoA = record
cbSize: DWORD;
hwndParent: HWND;
pszMessageText: AnsiString;
pszCaptionText: AnsiString;
hbmBanner: HBITMAP;
end;
var
FreeArcProgressContainer: TPanel;
FreeArcProgressInfoDesc, FreeArcProgressInfoValues: TNewStaticText;
FreeArcProgressBar: TNewProgressBar;
FreeArcData: TFreeArcData;
// Unicode and Character Set Functions
function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: string;
cchWideChar: Integer; lpMultiByteStr: AnsiString; cbMultiByte, lpDefaultChar: Integer;
lpUsedDefaultChar: Longint): Integer; external 'WideCharToMultiByte@kernel32.dll stdcall';
function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: AnsiString;
cbMultiByte: Integer; lpWideCharStr: string; cchWideChar: Integer): Integer; external 'MultiByteToWideChar@kernel32.dll stdcall';
// Window Class Functions
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLongW@user32.dll stdcall';
// Time Functions
function GetTickCount: DWORD; external 'GetTickCount@kernel32.dll stdcall';
// Message Functions
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageW@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpmsg: TMsg): LongWord; external 'DispatchMessageW@user32.dll stdcall';
procedure PostQuitMessage(nExitCode: Integer); external 'PostQuitMessage@user32.dll stdcall';
// Hook Functions
function CallMsgFilter(lpMsg: TMsg; nCode: Integer): BOOL; external 'CallMsgFilterW@user32.dll stdcall';
// Shell Lightweight Utility Functions
function StrFromTimeInterval(pszOut: string; cchMax: UINT; dwTimeMS: DWORD; digits: Byte): Integer; external 'StrFromTimeIntervalW@shlwapi.dll stdcall';
function StrFormatByteSize64A(qdw: Currency; pszBuf: LongWord; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';
function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; external 'MulDiv@kernel32.dll stdcall';
// String Functions
function lstrlenA(const lpString: PAnsiChar): Integer; external 'lstrlenA@kernel32.dll stdcall';
function lstrcpyA(lpStringDest: PAnsiChar; lpStringSrc: LongWord): LongWord; external 'lstrcpyA@kernel32.dll stdcall';
// Credentials Functions
function CredUIPromptForCredentialsA(var pUiInfo: TCredUIInfoA; const pszTargetName: AnsiString;
pContext: LongWord; dwAuthError: DWORD; pszUserName: AnsiString; ulUserNameBufferSize: LongWord;
pszPassword: LongWord; ulPasswordBufferSize: LongWord; var pfSave: BOOL; dwFlags: DWORD): DWORD; external 'CredUIPromptForCredentialsA@credui.dll stdcall';
// FreeArc Functions
function FreeArcExtract(Callback: LongWord; Command: AnsiString;
Arg0, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9: AnsiString): Integer; external 'FreeArcExtract@files:unarc.dll cdecl';
// CallbackCtrl.dll Functions
#ifndef IS_ENHANCED
#if VER < 0x06000000
function WrapFreeArcExtractProc(Callback: TFreeArcCallback; ParamCount: Integer): LongWord; external 'wrapcallbackaddr@files:callbackctrl.dll stdcall';
#endif
#endif
function UTF8Encode(const Value: string): AnsiString;
var
Len: Integer;
begin
if Value = '' then Exit;
Len := WideCharToMultiByte(CP_UTF8, 0, Value, -1, '', 0, 0, 0);
if Len = 0 then Exit;
Result := StringOfChar(#0, Len - 1);
if WideCharToMultiByte(CP_UTF8, 0, Value, -1, Result, Len, 0, 0) = 0 then Exit;
end;
function UTF8Decode(const Value: AnsiString): string;
var
Len: Integer;
begin
if Value = '' then Exit;
Len := MultiByteToWideChar(CP_UTF8, 0, Value, -1, '', 0);
if Len = 0 then Exit;
Result := StringOfChar(#0, Len - 1);
if MultiByteToWideChar(CP_UTF8, 0, Value, -1, Result, Len) = 0 then Exit;
end;
function BytesToSize(ABytes: Double): AnsiString;
var
LBuf: string;
begin
LBuf := StringOfChar(#0, 30);
Result := StrFormatByteSize64A(ABytes div 1E4, CastStringToInteger(LBuf), Length(LBuf));
end;
function TicksToTime(ATicks: DWORD): string;
begin
Result := StringOfChar(#0, StrFromTimeInterval(Result, 0, ATicks, 8));
StrFromTimeInterval(Result, Length(Result) + 1, ATicks, 8);
end;
function CastPtrToAnsiString(APtr: LongWord; IsOEM: Boolean): AnsiString;
begin
Result := StringOfChar(#0, 1024);
lstrcpyA(Result, APtr);
SetLength(Result, lstrlenA(Result));
if IsOEM then
OemToCharBuff(Result);
end;
function FreeArcIntToDouble(AMBytes, ABytes: Integer): Double;
begin
if AMBytes < 2048 then
Result := ABytes else
Result := 4.294967296E9 + ABytes;
end;
function ProcessMessages: Boolean;
var
Msg: TMsg;
begin
Result := True;
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
if Msg.Message = WM_QUIT then
begin
PostQuitMessage(Msg.wParam);
Result := False;
Exit;
end;
if not CallMsgFilter(Msg, MSGF_SLEEPMSG) then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end;
function FreeArcCallbackProc(what: PAnsiChar; int1, int2: Integer; str: LongWord): Integer;
var
LCredUIInfo: TCredUIInfoA;
LProgress, LElapsed, LRemaining: Cardinal;
LSave: BOOL;
LErrMsg: string;
begin
case string(what) of
'total_files':
Log(FmtMessage(CustomMessage('FAReadInfoFilesCount'), [IntToStr(int1)]));
'origsize':
begin
FreeArcData.Packages[FreeArcData.CurrentIndex].TotalSize := FreeArcIntToDouble(int1, int2);
FreeArcData.TotalSize := FreeArcData.TotalSize + FreeArcData.Packages[FreeArcData.CurrentIndex].TotalSize;
Log(FmtMessage(CustomMessage('FAReadInfoUncompressedSize'), [BytesToSize(FreeArcData.Packages[FreeArcData.CurrentIndex].TotalSize)]));
end;
'compsize':
Log(FmtMessage(CustomMessage('FAReadInfoCompressedSize'), [BytesToSize(FreeArcIntToDouble(int1, int2))]));
'total':
Log(FmtMessage(CustomMessage('FAPackageSize'), [BytesToSize(FreeArcIntToDouble(int1, int2))]));
'password?':
begin
LSave := False;
LCredUIInfo.cbSize := SizeOf(LCredUIInfo);
LCredUIInfo.pszMessageText := CustomMessage('FAPromptPassword');
LCredUIInfo.pszCaptionText := CustomMessage('FAPromptPasswordCaption');
case CredUIPromptForCredentialsA(LCredUIInfo, '', 0, 0, 'FreeArc', Length('FreeArc') + 1, str, int1, LSave,
CREDUI_FLAGS_KEEP_USERNAME or CREDUI_FLAGS_GENERIC_CREDENTIALS or
CREDUI_FLAGS_PASSWORD_ONLY_OK or CREDUI_FLAGS_ALWAYS_SHOW_UI or CREDUI_FLAGS_DO_NOT_PERSIST) of
NO_ERROR:
Result := Ord('y');
else
Result := Ord('q');
end;
end;
'overwrite?':
begin
case MsgBox(CustomMessage('FAOverwriteFiles'), mbConfirmation, MB_YESNO or MB_DEFBUTTON2) of
IDYES: Result := Ord('a');
IDNO: Result := Ord('s');
end;
end;
'write':
begin
FreeArcData.Size := FreeArcData.Size + (FreeArcIntToDouble(int1, int2) - FreeArcData.CurrentSize);
FreeArcData.CurrentSize := FreeArcIntToDouble(int1, int2);
{ Общий прогресс. }
WizardForm.FilenameLabel.Caption := MinimizePathName(FreeArcData.CurrentFileName,
WizardForm.FilenameLabel.Font, WizardForm.FilenameLabel.Width);
LProgress := Round(FreeArcData.Size / FreeArcData.TotalSize * 100);
WizardForm.ProgressGauge.Max := 100;
WizardForm.ProgressGauge.Position := LProgress;
{ Прогресс текущего архива. }
LElapsed := GetTickCount - FreeArcData.StartTime;
LProgress := Round(FreeArcData.CurrentSize / FreeArcData.Packages[FreeArcData.CurrentIndex].TotalSize * 100);
if FreeArcProgressBar.Visible then
FreeArcProgressBar.Position := LProgress;
LRemaining := MulDiv((100 - LProgress), LElapsed, LProgress);
FreeArcProgressInfoValues.Caption := FmtMessage(CustomMessage('FAProgressInfoValues'), [
IntToStr(LProgress),
BytesToSize(FreeArcData.CurrentSize),
BytesToSize(FreeArcData.Packages[FreeArcData.CurrentIndex].TotalSize),
BytesToSize(FreeArcData.CurrentSize / (LElapsed + 1) * 1000),
TicksToTime(LElapsed),
TicksToTime(LRemaining)
]);
Log(FmtMessage(CustomMessage('FAExtractedSize'), [BytesToSize(FreeArcData.CurrentSize)]));
end;
'filename':
begin
FreeArcData.CurrentFileName := CastPtrToAnsiString(str, True);
WizardForm.FilenameLabel.Caption := MinimizePathName(FreeArcData.CurrentFileName,
WizardForm.FilenameLabel.Font, WizardForm.FilenameLabel.Width);
Log(FmtMessage(CustomMessage('FAExtractFile'), [FreeArcData.CurrentFileName, BytesToSize(FreeArcIntToDouble(int1, int2))]));
end;
'error':
begin
Result := int1;
LErrMsg := Format('%s (%d)', [UTF8Decode(CastPtrToAnsiString(str, False)), Result]);
FreeArcData.ErrMsg := FreeArcData.ErrMsg + #13#10 + LErrMsg;
Log(FmtMessage(CustomMessage('FAError'), [LErrMsg]));
end;
end;
if not ProcessMessages then
Result := FREEARC_ERRCODE_OPERATION_TERMINATED;
end;
procedure FreeArcAddPackage(const AFileName, ADestDir: string);
var
I: Integer;
begin
if not FileExists(AFileName) then Exit;
Log(FmtMessage(CustomMessage('FAReadInfoStarted'), [ExtractFileName(AFileName)]));
I := Length(FreeArcData.Packages);
FreeArcData.CurrentIndex := I;
SetLength(FreeArcData.Packages, I + 1);
FreeArcData.Packages[I].FileName := AFileName;
FreeArcData.Packages[I].DestDir := ADestDir;
FreeArcData.ErrMsg := '';
if FreeArcExtract(FreeArcData.CallbackProc, 'l',
UTF8Encode(FreeArcData.Packages[I].FileName),
'', '', '', '', '', '', '', '', '') < FREEARC_OK then
RaiseException(FreeArcData.ErrMsg);
Log(FmtMessage(CustomMessage('FAReadInfoCompleted'), [ExtractFileName(AFileName)]));
end;
procedure FreeArcExtractPackage(AIndex: Integer);
var
LFileName: string;
begin
if (AIndex < 0) or (AIndex > Length(FreeArcData.Packages) - 1) or
not FileExists(FreeArcData.Packages[AIndex].FileName) then Exit;
LFileName := FreeArcData.Packages[AIndex].FileName;
Log(FmtMessage(CustomMessage('FAExtractPackageStarted'), [ExtractFileName(LFileName)]));
WizardForm.StatusLabel.Caption := FmtMessage(CustomMessage('FAProgressInfo'), [
ExtractFileName(LFileName), IntToStr(AIndex + 1),
IntToStr(Length(FreeArcData.Packages))]);
FreeArcData.ErrMsg := '';
FreeArcData.CurrentIndex := AIndex;
FreeArcData.CurrentSize := 0;
FreeArcData.StartTime := GetTickCount;
if FreeArcExtract(FreeArcData.CallbackProc, 'x',
'-o+', UTF8Encode(LFileName),
'-dp' + UTF8Encode(FreeArcData.Packages[AIndex].DestDir),
'', '', '', '', '', '', '') < FREEARC_OK then
RaiseException(FreeArcData.ErrMsg);
Log(FmtMessage(CustomMessage('FAExtractPackageCompleted'), [ExtractFileName(LFileName)]));
end;
procedure FreeArcAddPackages;
begin
// тут может быть какое-либо условие
//if IsWin64 then
// FreeArcAddPackage(ExpandConstant('{src}\testавм.arc'), '111');
// а этот распаковывается всегда
//FreeArcAddPackage(ExpandConstant('{src}\testавм2.arc'), '111');
end;
procedure FreeArcExtractPackages;
var
I: Integer;
begin
if Length(FreeArcData.Packages) > 0 then
FreeArcProgressBar.Visible := Length(FreeArcData.Packages) > 1
else Exit;
FreeArcData.Size := 0;
for I := 0 to Length(FreeArcData.Packages) - 1 do
FreeArcExtractPackage(I);
SetLength(FreeArcData.Packages, 0);
end;
procedure FreeArcMainProc;
begin
try
#ifdef IS_ENHANCED
FreeArcData.CallbackProc := CallbackAddr('FreeArcCallbackProc');
#elif VER >= 0x06000000
FreeArcData.CallbackProc := CreateCallback(@FreeArcCallbackProc);
#else
FreeArcData.CallbackProc := WrapFreeArcExtractProc(@FreeArcCallbackProc, 4);
#endif
FreeArcAddPackages;
FreeArcExtractPackages;
except
ShowExceptionMessage;
end;
end;
procedure CreateInstallingPage;
begin
{ FreeArcProgressContainer. }
FreeArcProgressContainer := TPanel.Create(WizardForm);
with FreeArcProgressContainer do
begin
Parent := WizardForm.InstallingPage;
Align := alBottom;
BevelOuter := bvNone;
Height := Parent.ClientHeight - WizardForm.ProgressGauge.Top - WizardForm.ProgressGauge.Height - ScaleY(5);
end;
{ FreeArcProgressBar. }
FreeArcProgressBar := TNewProgressBar.Create(WizardForm);
with FreeArcProgressBar do
begin
Parent := FreeArcProgressContainer;
Align := alTop;
Max := 100;
end;
{ FreeArcProgressInfoDesc. }
FreeArcProgressInfoDesc := TNewStaticText.Create(WizardForm);
with FreeArcProgressInfoDesc do
begin
Parent := FreeArcProgressContainer;
Align := alClient;
Caption := CustomMessage('FAProgressInfoDesc');
end;
{ FreeArcProgressInfoValues. }
FreeArcProgressInfoValues := TNewStaticText.Create(WizardForm);
with FreeArcProgressInfoValues do
begin
Parent := FreeArcProgressInfoDesc;
Align := alRight;
AutoSize := False;
Width := Parent.ClientWidth div 2;
SetWindowLong(Handle, GWL_STYLE, WS_CHILDWINDOW or WS_VISIBLE or WS_CLIPSIBLINGS or SS_RIGHT);
end;
end;
procedure CloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := False;
if ExitSetupMsgBox then
PostMessage(WizardForm.Handle, WM_QUIT, 0, 0);
end;
procedure InitializeWizard;
begin
CreateInstallingPage;
WizardForm.OnCloseQuery := @CloseQuery;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
case CurStep of
ssInstall:
begin
FreeArcMainProc;
end;
end;
end;
