dumanow
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
[Setup]
AppName=F.E.A.R-The Original Game [R.G.RePacKers]
AppVerName=F.E.A.R-The Original Game v.1
AppPublisher=R.G.RePackers
DefaultDirName={pf}\R.G.RePackers\F.E.A.R
DefaultGroupName=R.G.RePackers\F.E.A.R
WizardImageFile=WizardImage.bmp
WizardSmallImageFile=WizardSmallImage.bmp
OutputDir=C:\RePack\Output
OutputBaseFilename=setup
Compression=lzma/ultra64
SolidCompression=true
InternalCompressLevel=ultra64
[Languages]
Name: rus; MessagesFile: compiler:Languages\Russian.isl
[Messages]
DiskSpaceMBLabel=Требуется как минимум 4,5 Гб свободного дискового пространства.
[CustomMessages]
rus.FinishedLabel=Программа {#SetupSetting("F.E.A.R")} установлена на Ваш компьютер. Приложение можно запустить с помощью соответствующего значка.%n%nНажмите «Завершить», чтобы выйти из программы установки.
rus.AdditionalTasks=Системные задачи:
rus.UpdateDirect=Обновить DirectX
rus.ArcBreak=Установка прервана!
rus.ArcError=Распаковщик FreeArc вернул код ошибки: %1
rus.ArcBroken=Возможно, архив <%1> повреждён или недостаточно места на диске назначения.
rus.ArcFail=Распаковка не завершена!
rus.ArcTitle=Распаковка файлов...
rus.StatusInfo=файлов: %1%2, %3%% выполнено, осталось ждать %4
rus.ArcInfo=Архив %1 из %2, объём %3 из %5, %4%% обработано
rus.ArcFinish=Распаковано файлов: %1, получено файлов: %2 [%3]
rus.taskbar=%1%%, жди %2
rus.ending=завершение
rus.hour=часов
rus.min=мин
rus.sec=сек
[_ISToolPreCompile]
#sub ShowErr
#pragma error Str(void)
#endsub
#define Break(any S = "Empty") void = S, ShowErr
#ifndef Archives
#define Archives ""
#endif
#define LastLine
#define Current AddBackslash(GetEnv("TEMP")) + GetDateTimeString('dd/mm-hh:nn', '-', '-') +'.iss'
#sub GetLastLine
#expr SaveToFile(Current)
#for {faAnyFile = FileOpen(Current); !FileEof(faAnyFile); LastLine = FileRead(faAnyFile)} NULL
#expr FileClose(faAnyFile)
#endsub
#define TrimEx(str S = "", str T = " "); \
; Pos(T,S) == 1 ? S = Copy(S,2,Len(S)) : S, Copy(S,Len(S)) == T ? S = Copy(S,1,Len(S)-1) : S, Pos(T,S) == 1 || Copy(S,Len(S)) == T ? TrimEx(S,T) : S
#define SkipText(str S = "", str T = ";", int F = 1); \
; Local[0] = Pos(T, S), Local[0] > 0 ? (F == 0 ? Copy(S, Local[0]) : (F < 0 ? Copy(S,,Local[0] -1) : Copy(S, Local[0] + Len(T)))) : S
#define Find2Cut(str S, str B, str E = ";"); \
; S = LowerCase(S), B = LowerCase(B),: ; \
; (Local[0] = Pos(B, S)) > 0 ? (Local[1] = Copy(S, Local[0]+Len(B)), (Local[0] = Pos(E, Local[1])) > 0 ? (Copy(Local[1],, Local[0]-1)) : "Local[1]) : """""
#define SourceToProgress() GetLastLine,; \
; Local[0] = Find2Cut(LastLine,"UnArc(",")"), Local[0] == "" ? Local[0] = Find2Cut(LastLine,"UnZip(",")") : "void, Local[0] != """" && Pos(""dontcopy"", Find2Cut(LastLine,""Flags:"")) == 0 ? Local[5] = ""?"" : void,"; \
; Local[1] = TrimEx(TrimEx(SkipText(Local[0],"',",-1)),"'"), Local[2] = TrimEx(TrimEx(SkipText(Local[0],"',")),"'"), Local[1] == "" ? Local[1] = TrimEx(Find2Cut(LastLine,"Source:")) : "void, Local[2] == """" ? Local[2] = TrimEx(Find2Cut(LastLine,""DestDir:"")) : void,"; \
; Local[3] = TrimEx(Find2Cut(LastLine,"Components:")), Local[3] == "" ? void : "(Local[3] = ""<""+ Local[3], void), Local[4] = TrimEx(Find2Cut(LastLine,""Tasks:"")), Local[4] == """" ? void : (Local[4] = "">""+ Local[4], void),"; \
; Local[1] == "" ? Break('Previous line must be in [Files] section') : "(Local[0] = Local[1] +""/""+ Local[2] + Local[3] + Local[4] + Local[5]), TrimEx(Archives) == """" ? Archives = Local[0] : (Archives = Archives +""|""+ Local[0]), void"
#define isFalse(any S) (S = LowerCase(Str(S))) == "no" || S == "false" || S == "off" ? "true" : "false"
[Components]
Name: rus; Description: Русская локализация; Flags: exclusive
[Tasks]
Name: desktopicon; Description: {cm:CreateDesktopIcon}; GroupDescription: {cm:AdditionalIcons}; Flags: unchecked
Name: quicklaunchicon; Description: {cm:CreateQuickLaunchIcon}; GroupDescription: {cm:AdditionalIcons}; Flags: unchecked
Name: directx; Description: {cm:UpdateDirect}; GroupDescription: {cm:AdditionalTasks}
[Files]
Source: C:\Program Files\Inno Setup 5\Examples\MyProg.exe; DestDir: {app}; Flags: ignoreversion
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: DirBitmap.bmp; DestDir: {tmp}; Flags: dontcopy
Source: GroupBitmap.bmp; DestDir: {tmp}; Flags: dontcopy
Source: Logo.bmp; DestDir: {tmp}; Flags: dontcopy
Source: button.bmp; DestDir: {tmp}; Flags: dontcopy
Source: Logo.bmp; DestDir: {app}; Attribs: hidden system
Source: WizardSmallImage.bmp; DestDir: {app}; Attribs: hidden system
Source: {src}\*.arc; DestDir: {app}; Flags: external dontcopy
{#SourceToProgress}:
[Icons]
Name: {group}\FEAR; Filename: {app}\FEAR.exe
Name: {group}\{cm:UninstallProgram,FEAR}; Filename: {uninstallexe}
Name: {commondesktop}\FEAR; Filename: {app}\FEAR.exe; Tasks: desktopicon
Name: {userappdata}\Microsoft\Internet Explorer\Quick Launch\FEAR; Filename: {app}\FEAR.exe; Tasks: quicklaunchicon
[UninstallDelete]
Type: filesandordirs; Name: {app}
[Code]
type
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#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: string; allMb, Files: Integer; Size: Extended; end;
TBarInfo = record stage, name: string; size, allsize: Extended; count, perc, pos, mb, time: 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);
const
Color = clBlack;
ButtonWidth = 80;
ButtonHeight = 23;
bidBack = 0;
bidNext = 1;
bidCancel = 2;
bidDirBrowse = 3;
bidGroupBrowse = 4;
PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMB=1024*1024;
Period = 250;
VK_ESCAPE = 27;
HC_ACTION = 0;
WH_CALLWNDPROC = 4;
WM_PAINT = $F;
CancelDuringInstall = {#isFalse(SetupSetting("AllowCancelDuringInstall"))};
var
LogoImage: TBitmapImage;
ButtonPanel: array [0..4] of TPanel;
ButtonImage: array [0..4] of TBitmapImage;
ButtonLabel: array [0..4] of TLabel;
StatusLabel, FileNameLabel, ExtractFile, StatusInfo, FinishedLabel: TLabel;
ProgressBar: TNewProgressBar;
CancelCode, n, ArcInd, UnPackError, StartInstall, LastTimerEvent, lastMb, baseMb: Integer;
FreeMB, TotalMB: Cardinal;
WndHookID, TimerID: LongWord;
Arcs, Records: array of TArc;
msgError: string;
Status: TBarInfo;
FreezeTimer: Boolean;
totalUncompressedSize, origsize: Integer;
Texture2, Texture: TBitmapImage;
//************************************************ [Начало - Вн. вид инсталла] ***************************************************//
procedure RepaintInstall();
begin
ExtractTemporaryFile('button.bmp')
ExtractTemporaryFile('DirBitmap.bmp');
ExtractTemporaryFile('GroupBitmap.bmp');
ExtractTemporaryFile('Logo.bmp');
WizardForm.WizardBitmapImage.Width := ScaleX(530);
WizardForm.WizardBitmapImage2.Width := ScaleX(224);
WizardForm.PageNameLabel.Width:=ScaleX(300);
WizardForm.PageDescriptionLabel.Hide;
WizardForm.Font.Color:=clWhite;
WizardForm.Color:=Color;
WizardForm.WelcomePage.Color:=Color;
WizardForm.InnerPage.Color:=Color;
WizardForm.FinishedPage.Color:=Color;
WizardForm.SelectDirPage.Color:=Color;
WizardForm.SelectComponentsPage.Color:=Color;
WizardForm.SelectProgramGroupPage.Color:=Color;
WizardForm.SelectTasksPage.Color:=Color;
WizardForm.ReadyPage.Color:=Color;
WizardForm.InstallingPage.Color:=Color;
WizardForm.PageNameLabel.Color:=Color;
WizardForm.PageNameLabel.Font.Color:=ClWhite;
WizardForm.MainPanel.Color:=Color;
WizardForm.WelcomeLabel1.Hide;
WizardForm.WelcomeLabel2.Hide;
WizardForm.SelectDirLabel.Color:=Color;
WizardForm.SelectDirBrowseLabel.Color:=Color;
WizardForm.DirEdit.Color:=Color;
WizardForm.DiskSpaceLabel.Color:=Color;
WizardForm.ComponentsList.Color:=Color;
WizardForm.SelectComponentsLabel.Color:=Color;
WizardForm.TypesCombo.Hide;
WizardForm.ComponentsDiskSpaceLabel.Hide;
WizardForm.GroupEdit.Color:=Color;
WizardForm.SelectStartMenuFolderLabel.Color:=Color;
WizardForm.SelectStartMenuFolderBrowseLabel.Color:=Color;
WizardForm.SelectTasksLabel.Color:=Color;
WizardForm.TasksList.Color:=Color;
WizardForm.ReadyMemo.Color:=Color;
WizardForm.ReadyMemo.ScrollBars:= ssNone
WizardForm.ReadyLabel.Color:=Color;
WizardForm.StatusLabel.Color:=Color;
WizardForm.FilenameLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Hide;
WizardForm.FinishedLabel.Hide;
WizardForm.SelectDirBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\DirBitmap.bmp'));
WizardForm.SelectDirBitmapImage.AutoSize:=true;
WizardForm.SelectGroupBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\GroupBitmap.bmp'));
WizardForm.SelectGroupBitmapImage.AutoSize:=true;
LogoImage := TBitmapImage.Create(WizardForm);
with LogoImage do
begin
SetBounds(ScaleX(10), ScaleY(320), ScaleX(175), ScaleY(40));
Bitmap.LoadFromFile(ExpandConstant('{tmp}\Logo.bmp'));
Parent := WizardForm;
end;
with WizardForm.WizardSmallBitmapImage do
begin
SetBounds(ScaleX(335), ScaleY(2), ScaleX(160), ScaleY(50));
end;
with WizardForm.ComponentsList do
begin
Top:=ScaleY(50);
Height:=ScaleY(150);
end;
with TLabel.Create(WizardForm) do begin
AutoSize:=WizardForm.WelcomeLabel1.AutoSize;
Left:=WizardForm.WelcomeLabel1.Left;
Top:=WizardForm.WelcomeLabel1.Top
Width:=WizardForm.WelcomeLabel1.Width
Height:=WizardForm.WelcomeLabel1.Height
WordWrap:=WizardForm.WelcomeLabel1.WordWrap;
Font.Name:=WizardForm.WelcomeLabel1.Font.Name;
Font.Size:=WizardForm.WelcomeLabel1.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.WelcomeLabel1.Font.Style;
Caption:=WizardForm.WelcomeLabel1.Caption;
Parent:=WizardForm.WelcomeLabel1.Parent
Transparent:=True
end;
with TLabel.Create(WizardForm) do begin
AutoSize:=WizardForm.WelcomeLabel2.AutoSize;
Left:=WizardForm.WelcomeLabel2.Left;
Top:=WizardForm.WelcomeLabel2.Top
Width:=WizardForm.WelcomeLabel2.Width
Height:=WizardForm.WelcomeLabel2.Height
WordWrap:=WizardForm.WelcomeLabel2.WordWrap;
Font.Name:=WizardForm.WelcomeLabel2.Font.Name;
Font.Size:=WizardForm.WelcomeLabel2.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.WelcomeLabel2.Font.Style;
Caption:=WizardForm.WelcomeLabel2.Caption;
Parent:=WizardForm.WelcomeLabel2.Parent
Transparent:=True
end;
with TLabel.Create(WizardForm) do begin
AutoSize:=WizardForm.FinishedHeadingLabel.AutoSize;
Left:=WizardForm.FinishedHeadingLabel.Left;
Top:=WizardForm.FinishedHeadingLabel.Top
Width:=WizardForm.FinishedHeadingLabel.Width
Height:=WizardForm.FinishedHeadingLabel.Height
WordWrap:=WizardForm.FinishedHeadingLabel.WordWrap;
Font.Name:=WizardForm.FinishedHeadingLabel.Font.Name;
Font.Size:=WizardForm.FinishedHeadingLabel.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.FinishedHeadingLabel.Font.Style;
Caption:=WizardForm.FinishedHeadingLabel.Caption;
Parent:=WizardForm.FinishedHeadingLabel.Parent
Transparent:=True
end;
FinishedLabel:= TLabel.Create(WizardForm)
with FinishedLabel do begin
AutoSize:=WizardForm.FinishedLabel.AutoSize;
Left:=WizardForm.FinishedLabel.Left;
Top:=WizardForm.FinishedLabel.Top
Width:=WizardForm.FinishedLabel.Width;
Height:=WizardForm.FinishedLabel.Height+50;
WordWrap:=WizardForm.FinishedLabel.WordWrap;
Font.Name:=WizardForm.FinishedLabel.Font.Name;
Font.Size:=WizardForm.FinishedLabel.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.FinishedLabel.Font.Style;
Caption:=ExpandConstant('{cm:FinishedLabel}');
Parent:=WizardForm.FinishedLabel.Parent
Transparent:=True
end;
end;
procedure InitializeUninstallProgressForm;
begin
FileCopy(ExpandConstant('{app}\WizardSmallImage.bmp'), ExpandConstant('{tmp}\WizardSmallImage.bmp'), False);
FileCopy(ExpandConstant('{app}\Logo.bmp'), ExpandConstant('{tmp}\Logo.bmp'), False);
UninstallProgressForm.Color:=Color;
UninstallProgressForm.InnerPage.Color:=Color;
UninstallProgressForm.MainPanel.Color:=Color;
UninstallProgressForm.PageNameLabel.Color:=Color;
UninstallProgressForm.PageDescriptionLabel.Hide;
UninstallProgressForm.PageNameLabel.Font.Color:=clWhite;
UninstallProgressForm.PageNameLabel.Width:=ScaleX(300);
UninstallProgressForm.StatusLabel.Color:=Color;
UninstallProgressForm.StatusLabel.Font.Color:=clWhite;
LogoImage := TBitmapImage.Create(UninstallProgressForm);
with LogoImage do
begin
SetBounds(ScaleX(10), ScaleY(320), ScaleX(175), ScaleY(40));
Bitmap.LoadFromFile(ExpandConstant('{tmp}\Logo.bmp'));
Parent := UninstallProgressForm;
end;
with UninstallProgressForm.WizardSmallBitmapImage do
begin
Bitmap.LoadFromFile(ExpandConstant('{tmp}\WizardSmallImage.bmp'));
SetBounds(ScaleX(335), ScaleY(2), ScaleX(200), ScaleY(50));
end;
end;
//************************************************ [Конец - Вн. вид инсталла] ***************************************************//
//************************************************ [Начало - Кнопки] ***************************************************//
procedure ButtonLabelClick(Sender: TObject);
var
Button: TButton;
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
case TLabel(Sender).Tag of
bidBack: Button:=WizardForm.BackButton
bidNext: Button:=WizardForm.NextButton
bidCancel: Button:=WizardForm.CancelButton
bidDirBrowse: Button:=WizardForm.DirBrowseButton
bidGroupBrowse: Button:=WizardForm.GroupBrowseButton
else
Exit
end
Button.OnClick(Button)
end;
procedure ButtonLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ButtonLabel[TLabel(Sender).Tag].Enabled then
ButtonImage[TLabel(Sender).Tag].Left:=-ButtonWidth
end;
procedure ButtonLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
end;
procedure LoadButtonImage(AButton: TButton; AButtonIndex: integer);
var
Image: TBitmapImage;
Panel: TPanel;
Labl: TLabel;
begin
Panel:=TPanel.Create(WizardForm)
Panel.Left:=AButton.Left
Panel.Top:=AButton.Top
Panel.Width:=AButton.Width
Panel.Height:=AButton.Height
Panel.Tag:=AButtonIndex
Panel.Parent:=AButton.Parent
ButtonPanel[AButtonIndex]:=Panel
Image:=TBitmapImage.Create(WizardForm)
Image.Width:=160
Image.Height:=23
Image.Enabled:=False
Image.Bitmap.LoadFromFile(ExpandConstant('{tmp}\button.bmp'))
Image.Parent:=Panel
ButtonImage[AButtonIndex]:=Image
with TLabel.Create(WizardForm) do begin
Tag:=AButtonIndex
Parent:=Panel
Width:=Panel.Width
Height:=Panel.Height
Transparent:=True
OnClick:=@ButtonLabelClick
OnDblClick:=@ButtonLabelClick
OnMouseDown:=@ButtonLabelMouseDown
OnMouseUp:=@ButtonLabelMouseUp
end
Labl:=TLabel.Create(WizardForm)
Labl.Left:=23
Labl.Top:=5
Labl.Autosize:=True
Labl.Alignment:=taCenter
Labl.Tag:=AButtonIndex
Labl.Transparent:=True
Labl.Font.Color:=clWhite
Labl.Caption:=AButton.Caption
Labl.OnClick:=@ButtonLabelClick
Labl.OnDblClick:=@ButtonLabelClick
Labl.OnMouseDown:=@ButtonLabelMouseDown
Labl.OnMouseUp:=@ButtonLabelMouseUp
Labl.Parent:=Panel
ButtonLabel[AButtonIndex]:=Labl
end;
procedure UpdateButton(AButton: TButton;AButtonIndex: integer);
begin
ButtonLabel[AButtonIndex].Caption:=AButton.Caption
ButtonPanel[AButtonIndex].Visible:=AButton.Visible
ButtonLabel[AButtonIndex].Enabled:=Abutton.Enabled
end;
procedure LicenceAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=True
end;
procedure LicenceNotAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=False
end;
procedure UpdateButtons(CurPageID: Integer);
begin
UpdateButton(WizardForm.BackButton,bidBack)
UpdateButton(WizardForm.NextButton,bidNext)
UpdateButton(WizardForm.CancelButton,bidCancel)
ButtonLabel[bidBack].Left := (ButtonPanel[bidBack].Width / 2 - ButtonLabel[bidBack].Width / 2);
ButtonLabel[bidNext].Left := (ButtonPanel[bidNext].Width / 2 - ButtonLabel[bidNext].Width / 2);
ButtonLabel[bidCancel].Left := (ButtonPanel[bidCancel].Width / 2 - ButtonLabel[bidCancel].Width / 2);
ButtonLabel[bidDirBrowse].Left := (ButtonPanel[bidDirBrowse].Width / 2 - ButtonLabel[bidDirBrowse].Width / 2);
ButtonLabel[bidGroupBrowse].Left := (ButtonPanel[bidGroupBrowse].Width / 2 - ButtonLabel[bidGroupBrowse].Width / 2);
end;
procedure ButtonTextures();
begin
WizardForm.BackButton.Width:=ButtonWidth
WizardForm.BackButton.Height:=ButtonHeight
WizardForm.NextButton.Width:=ButtonWidth
WizardForm.NextButton.Height:=ButtonHeight
WizardForm.CancelButton.Width:=ButtonWidth
WizardForm.CancelButton.Height:=ButtonHeight
WizardForm.DirBrowseButton.Left:=337
WizardForm.DirBrowseButton.Width:=ButtonWidth
WizardForm.DirBrowseButton.Height:=ButtonHeight
WizardForm.GroupBrowseButton.Left:=337
WizardForm.GroupBrowseButton.Width:=ButtonWidth
WizardForm.GroupBrowseButton.Height:=ButtonHeight
WizardForm.LicenseAcceptedRadio.OnClick:=@LicenceAcceptedRadioOnClick
WizardForm.LicenseNotAcceptedRadio.OnClick:=@LicenceNotAcceptedRadioOnClick
LoadButtonImage(WizardForm.BackButton,bidBack)
LoadButtonImage(WizardForm.NextButton,bidNext)
LoadButtonImage(WizardForm.CancelButton,bidCancel)
LoadButtonImage(WizardForm.DirBrowseButton,bidDirBrowse)
LoadButtonImage(WizardForm.GroupBrowseButton,bidGroupBrowse)
end;
//************************************************ [Конец - Кнопки] ***************************************************//
//************************************************ [Начало - FreeArc] ***************************************************//
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 'OemToCharA@user32.dll stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';
function PeekMessage(var lpMsg: TMessage; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMessage): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMessage): Longint; external 'DispatchMessageA@user32.dll 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 MulDiv(Number, Numerator, Denominator: Integer): Integer; external 'MulDiv@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, PM_REMOVE) 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;
end;
End;
Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
h:= GetWindowLong(MainForm.Handle, -8); if h <> 0 then SetWindowText(h, Title);
End;
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;
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[i]:=Text
else begin
Result[i]:= Copy(Text, 1, k -1); Delete(Text, 1, Length(Result[i]) + 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;
Function TicksToTime(Ticks: DWord; h,m,s: String; detail: Boolean): String;
Begin
if detail then
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
Result:= IntToStr(Ticks/3600000) +h+' '+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +m
else if Ticks/60 >= 1000 then
Result:= IntToStr(Ticks/60000) +m+' '+ IntToStr(Ticks/1000 - Ticks/1000/60*60) +s
else Result:= Format('%.1n', [Abs(Ticks/1000)]) +s
End;
Function ExpandENV(string: String): String; var n: UINT; Begin
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;
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;
function OemToAnsiStr(strSource: AnsiString): AnsiString;
var
nRet : longint;
begin
SetLength(Result, Length(strSource));
nRet:= OemToChar(strSource, Result);
end;
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);
if nRet * nRet2 = 0 then Result:= strSource else Result:= MultiByteBuf;
end;
Procedure UpdateStatus(Flags: Integer);
var
Remaining: Integer; i, t, s: string;
Begin
if Flags and $1 > 0 then FreezeTimer:= Flags and $2 = 0;
if (Flags and $4 > 0) or (Status.size <> baseMb+lastMb) then LastTimerEvent:= 0;
if FreezeTimer or (GetTickCount - LastTimerEvent <= Period) then Exit else LastTimerEvent:= GetTickCount;
Status.size := baseMb+lastMb; // извлечено на текущий момент
if totalUncompressedSize > 0 then with WizardForm.ProgressGauge do begin
Position:= round(Max * Status.size/totalUncompressedSize)
end;
with WizardForm.ProgressGauge do begin
#ifndef precomp
if position > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((max - position)/position)) else
#endif
Remaining:= 0;
t:= cm('ending'); i:= 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);
if Status.size > 0 then
s:= ' ['+ ByteOrTB(Status.size*oneMB, true) +']';
StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(Status.count +ord(Status.count < 0)), s, Format('%.1n', [Abs(Status.perc/10)]), i]);
if (Status.stage = cm('ArcTitle')) and (GetArrayLength(Arcs) > 0) then begin
ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), ByteOrTB(Arcs[ArcInd].Size, true), Format('%.0n', [Status.mb/(Arcs[ArcInd].Size/oneMB)*100]), ByteOrTB(Status.allsize, true)])
ProgressBar.Position:= round(ProgressBar.Max * Status.mb/trunc(Arcs[ArcInd].Size/oneMB))
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):
Status.count:= Status.count +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;
with WizardForm.ProgressGauge do begin
n:= (Max - Min)/1000
if n > 0 then Status.perc:= (Position-Min)/n;
end;
UpdateStatus(0);
end;
CallNextWNDPROC(WndHookID, Code, wParam, lParam)
End;
function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer;
begin
case string(what) of
'origsize': origsize:= Mb;
'total_files': Null;
'filename': begin
WizardForm.FileNameLabel.Caption:= OemToAnsiStr(str);
FileNameLabel.Caption:= OemToAnsiStr(str);
Status.count:= Status.count + 1;
end;
'read':
Status.mb:= Mb;
'write':
lastMb:= Mb;
end;
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0);
if (GetKeyState(VK_ESCAPE) < 0) and not CancelDuringInstall then
WizardForm.Close;
AppProcessMessage;
Result:= CancelCode;
end;
Function ArcDecode(Line: string): array of TArc;
var tmp, cut: array of String; n, i: integer;
Begin
SetArrayLength(result,0); if Line <> '' then tmp:= StringToArray(Line,'|') else Exit;
for n:= 0 to GetArrayLength(tmp) - 1 do begin
if tmp[n][Length(tmp[n])] = '?' then Continue;
SetArrayLength(result, GetArrayLength(result) +1); i:= GetArrayLength(result) -1;
cut:= StringToArray(tmp[n],'>')
if GetArrayLength(cut) > 1 then result[i].task:= cut[1];
cut:= StringToArray(cut[0],'<')
if GetArrayLength(cut) > 1 then result[i].comp:= cut[1];
cut:= StringToArray(cut[0],'/')
if GetArrayLength(cut) > 1 then result[i].Dest:= cut[1] else result[i].Dest:= '{app}';
if (ExtractFileDrive(ExpandENV(cut[0])) = '') and (ExpandENV(cut[0]) = cut[0]) then
result[i].Path:= '{src}\'+ cut[0] else result[i].Path:= cut[0];
result[i].Dest:= ExpandENV(result[i].Dest); result[i].Path:= ExpandENV(result[i].Path);
end;
End;
function AddArcs(files, target: string): Integer;
var FSR: TFindRec; i: integer;
Begin
Result:= 0; if FindFirst(ExpandENV(files), FSR) then
try
repeat
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
i:= GetArrayLength(Arcs); SetArrayLength(Arcs, i +1);
Arcs[i].Dest:= target;
Arcs[i].Path:= ExtractFilePath(ExpandENV(files)) + FSR.Name;
Arcs[i].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Status.allsize:= Status.allsize + Arcs[i].Size;
Arcs[i].allMb:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4),'l','--',AnsiToUtf8(Arcs[i].Path),'','','','','','','');
if Arcs[i].allMb >= 0 then begin
Arcs[i].allMb:= origsize; result:= result + Arcs[i].allMb;
end;
until not FindNext(FSR);
finally
FindClose(FSR);
end;
End;
function UnPackArchive(Source, Destination: string; allMb, Mode: Integer): Integer;
var
callback: longword;
Begin
WizardForm.CancelButton.Enabled:= not CancelDuringInstall;
callback:= WrapFreeArcCallback(@FreeArcCallback,4);
Result:= FreeArcCmd(callback,'x','-o+','-dp'+AnsiToUtf8(Destination),'--',AnsiToUtf8(Source),'','','','',''); // код ошибки
if Result = 0 then Exit;
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
WizardForm.StatusLabel.Caption:= msgError;
WizardForm.FileNameLabel.Caption:= ExtractFileName(Source);
GetSpaceOnDisk(ExtractFileDrive(Destination), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < allMb then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Source)]);
-127: msgError:= cm('ArcBreak');
-63: msgError:= cm('ArcFail');
end;
Log(msgError);
End;
function UnPack(Archives: string): Integer;
begin
Records:= ArcDecode(Archives); SetArrayLength(Arcs,0); Status.allsize:= 0;
for n:= 0 to GetArrayLength(Records) -1 do
if (not IsTaskSelected(Records[n].task) and (Records[n].task <>'')) and (not IsComponentSelected(Records[n].comp) and (Records[n].comp <>'')) then Continue
else totalUncompressedSize:= totalUncompressedSize + AddArcs(Records[n].Path, Records[n].Dest);
WizardForm.StatusLabel.Caption:= cm('ArcTitle');
ExtractFile.Show; ProgressBar.Show;
baseMb:= 0; lastMb:= 0; Status.mb:= 0;
Status.count:= 0;
UpdateStatus(7);
for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin
Result:= UnPackArchive(Arcs[ArcInd].Path, Arcs[ArcInd].Dest, Arcs[ArcInd].allMb, 0);
if Result <> 0 then Break;
baseMb:= baseMb + lastMb; lastMb:= 0; Status.mb:= 0;
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;
if Result = 0 then WizardForm.StatusLabel.Caption:= FmtMessage(cm('ArcFinish'), [IntToStr(GetArrayLength(Arcs)), IntToStr(Status.count), ByteOrTB(Status.size*oneMB, true)]);
StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then begin
StartInstall:= GetTickCount
WndHookID:= SetWindowsHookEx(WH_CALLWNDPROC, WrapCWPSTRUCTProc(@OnWndHook, 3), 0, GetCurrentThreadID);
TimerID:= SetTimer(0, 0, 500 , WrapTimerProc(@MyTimerProc, 4));
if not {#isFalse(SetupSetting("Uninstallable"))} then Status.count:= -1;
end;
if CurStep = ssPostInstall then
begin
StartInstall:= GetTickCount
UnPackError:= UnPack('{#Archives}')
if UnPackError <> 0 then begin
if not {#isFalse(SetupSetting("Uninstallable"))} then
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n);
WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
SetTaskBarTitle(SetupMessage(msgErrorTitle))
end else
SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
end;
end;
Procedure ShowErrorMessage(CurPageID: Integer);
Begin
if (CurPageID = wpFinished) and (UnPackError <> 0) then
begin
FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
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
UpdateStatus(1);
if MsgBox(SetupMessage(msgExitSetupMessage), mbInformation, MB_YESNO) = IDYES then
CancelCode:= -127;
UpdateStatus(7);
end else
MainForm.Close;
End;
Procedure CreateArchivesInfoElements();
Begin
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;
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
End;
Procedure DeInitializeSetup;
Begin
KillTimer(0, TimerID)
UnhookWindowsHookEx(WndHookID)
End;
//************************************************ [Конец - FreeArc] ***************************************************//
procedure InitializeWizard();
begin
RepaintInstall();
ButtonTextures();
CreateArchivesInfoElements();
end;
Procedure CurPageChanged(CurPageID: Integer);
Begin
UpdateButtons(CurPageID);
ShowErrorMessage(CurPageID);
end;
[Run]
Filename: {app}\FEAR.exe; Description: {cm:LaunchProgram,fea}; Flags: nowait postinstall skipifsilent
|
