const
Archives = '{src}\Rise of the Argonauts [Rus].arc';
BackGround=6;
Timer=16;
Indent=25;
type
HSTREAM=DWORD;
TTimerProc=procedure(uTimerID,uMessage:UINT;dwUser,dw1,dw2:DWORD);
PAnsiChar=PChar;
TMyMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path: string; Size: Extended; end;
var
MP3List:TStringList;
CurrentMP3:integer;
hMP3:HWND;
TimerID:LongWord;
function PeekMessage(var lpMsg: TMyMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMyMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMyMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
const
PM_REMOVE = 1;
procedure AppProcessMessage;
var
Msg: TMyMsg;
begin
while PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
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';
var
ProgressBar: TNewProgressBar;
ExtractFile: TNewStaticText;
Button1: TButton;
Cancel: Integer;
n: Integer; Arcs: array of TArc; m: Extended;
function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
Function NumToStr(Float: Extended): String;
Begin
Result:= Format('%.3n', [Float]); StringChange(Result, ',', '.');
while (Pos('.', Result) > 0) and ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.'))
do SetLength(Result, Length(Result)-1);
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;
procedure Button1OnClick(Sender: TObject);
begin
Cancel := -127;
end;
function FindArcs(dir: string): Extended;
var
FSR: TFindRec;
Begin
if FindFirst(ExpandConstant(dir), FSR) then
try
repeat
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE
n:= GetArrayLength(Arcs)
SetArrayLength(Arcs, n +1)
Arcs[n].Path:= ExtractFilePath(ExpandConstant(Archives)) + FSR.Name
Arcs[n].Size:= Size64(FSR.SizeHigh, FSR.SizeLow)
Result:= Result + Arcs[n].Size;
until not FindNext(FSR);
finally
FindClose(FSR);
end;
End;
function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var percents: Integer;
begin
if string(what)='filename' then
else if (string(what)='progress') and (sizeArc>0) then begin
percents:= (Mb*1000) div sizeArc;
ProgressBar.Position:= percents;
ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(Mb), IntToStr(sizeArc), Format('%.1n', [Abs(percents/10)]), IntToStr(n+1), IntToStr(GetArrayLength(Arcs)) ]);
WizardForm.ProgressGauge.Position:= WizardForm.ProgressGauge.Tag + round(ProgressBar.Position * m)
percents:= (WizardForm.ProgressGauge.Position-WizardForm.ProgressGauge.Min)/((WizardForm.ProgressGauge.Max - WizardForm.ProgressGauge.Min)/1000)
WizardForm.FileNameLabel.Caption:= FmtMessage(cm('AllProgress'), [Format('%.1n', [Abs(percents/10)])]);
end;
AppProcessMessage;
Result := Cancel;
end;
function ExtractFreeArcArchive(arcname, destpath: String): Integer;
var callback: longword;
begin
Cancel:= 0;
AppProcessMessage;
callback:= WrapFreeArcCallback(@FreeArcCallback,4);
try
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp'+destpath, '--', arcname, '', '', '', '', '');
if Result = 0 then Result:= Cancel;
except
Result:= -63;
end;
end;
function UnPack(Archives: string): Integer;
var allSize: Extended; FreeMB, TotalMB: Cardinal; mes: string;
begin
Button1.Show
WizardForm.ProgressGauge.Position:= 0;
WizardForm.ProgressGauge.Max:= 1000
allSize:= FindArcs(Archives)
for n:= 0 to GetArrayLength(Arcs) -1 do begin
m:= Arcs[n].Size/allSize
WizardForm.ProgressGauge.Tag:= WizardForm.ProgressGauge.Position
Result:= ExtractFreeArcArchive(Arcs[n].Path, ExpandConstant('{app}'));
if Result <> 0 then begin
mes:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
GetSpaceOnDisk(ExtractFileDrive(ExpandConstant('{app}')), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < 32 then mes:= SetupMessage(msgDiskSpaceWarningTitle)
else mes:= mes + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Arcs[n].Path)]);
-127: mes:= cm('ArcBreak');
-63: mes:= cm('ArcFail');
end;
MsgBox(mes, mbInformation, MB_OK);
Log(mes);
Break;
end;
end;
Button1.visible:= false;
end;
function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall delayload';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall';
function isxbb_AddImage(Image: PChar; Flags: Cardinal): integer; external 'isxbb_AddImage@files:isxbb.dll stdcall delayload';
function isxbb_Init(hWnd: Integer): integer; external 'isxbb_Init@files:isxbb.dll stdcall delayload';
function isxbb_StartTimer(Seconds: Integer; Flags: Cardinal): integer; external 'isxbb_StartTimer@files:isxbb.dll stdcall';
function isxbb_KillTimer(Flags: Cardinal): integer; external 'isxbb_KillTimer@files:isxbb.dll stdcall';
procedure ShowSplashScreen(p1:HWND;p2:string;p3,p4,p5,p6,p7:integer;p8:boolean;p9:Cardinal;p10:integer); external 'ShowSplashScreen@files:isgsg.dll stdcall delayload';
function GetSystemMetrics(nIndex:Integer):integer; external 'GetSystemMetrics@user32.dll stdcall delayload';
function SetTimer(hWnd:HWND;nIDEvent,uElapse:UINT;lpTimerFunc:LongWord{TFNTimerProc}):UINT; external 'SetTimer@user32.dll stdcall delayload';
function KillTimer(hWnd:HWND;uIDEvent:UINT):BOOL; external 'KillTimer@user32.dll stdcall delayload';
function BASS_ChannelIsActive(Handle:HWND):DWORD; external 'BASS_ChannelIsActive@files:bass.dll stdcall';
function BASS_SetConfig(Option,Value:DWORD):DWORD; external 'BASS_SetConfig@files:bass.dll stdcall';
function BASS_Init(Device:integer;Freq,Flags:DWORD;Win:HWND;CLSID:integer):boolean; external 'BASS_Init@files:bass.dll stdcall delayload';
function BASS_StreamCreateFile(Mem:BOOL;f:PChar;Offset:DWORD;Length:DWORD;Flags:DWORD):HSTREAM; external 'BASS_StreamCreateFile@files:bass.dll stdcall';
function BASS_StreamFree(Handle:HWND):boolean; external 'BASS_StreamFree@files:bass.dll stdcall';
function BASS_ChannelPlay(Handle:HWND;Restart:boolean):boolean; external 'BASS_ChannelPlay@files:bass.dll stdcall';
function BASS_Start: Boolean; external 'BASS_Start@files:bass.dll stdcall';
function BASS_Stop: Boolean; external 'BASS_Stop@files:bass.dll stdcall';
function BASS_Free: Boolean; external 'BASS_Free@files:bass.dll stdcall delayload';
function WrapTimerProc(CallBack:TTimerProc;ParamCount:integer):LongWord; external 'wrapcallback@files:innocallback.dll stdcall';
procedure TimerTick(uTimerID,uMessage:UINT;dwUser,dw1,dw2:DWORD);
begin
if BASS_ChannelIsActive(hMP3)=0 then begin
BASS_Stop;
BASS_StreamFree(hMP3);
hMP3:=BASS_StreamCreateFile(False,PChar(MP3List.Strings[CurrentMP3]),0,0,0);
BASS_Start;
if hMP3<>0 then
if BASS_ChannelPlay(hMP3,True) then begin
CurrentMP3:=CurrentMP3+1;
if CurrentMP3>MP3List.Count-1 then CurrentMP3:=0;
end;
end;
end;
function InitializeSetup:boolean;
begin
ExtractTemporaryFile('01. Rise Of The Argonauts.mp3');
ExtractTemporaryFile('02. Broken Union.mp3');
ExtractTemporaryFile('03. The Purge.mp3');
MP3List:=TStringList.Create;
MP3List.Add(ExpandConstant('{tmp}')+'\01. Rise Of The Argonauts.mp3');
MP3List.Add(ExpandConstant('{tmp}')+'\02. Broken Union.mp3');
MP3List.Add(ExpandConstant('{tmp}')+'\03. The Purge.mp3');
CurrentMP3:=0;
Result:=True;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then UnPack(Archives);
if CurStep=ssInstall then begin
ExtractTemporaryFile('01.jpg');
isxbb_AddImage(ExpandConstant('{tmp}')+'\01.jpg',BackGround or Timer);
ExtractTemporaryFile('02.jpg');
isxbb_AddImage(ExpandConstant('{tmp}')+'\02.jpg',BackGround or Timer);
ExtractTemporaryFile('03.jpg');
isxbb_AddImage(ExpandConstant('{tmp}')+'\03.jpg',BackGround or Timer);
ExtractTemporaryFile('04.jpg');
isxbb_AddImage(ExpandConstant('{tmp}')+'\04.jpg',BackGround or Timer);
ExtractTemporaryFile('06.jpg');
isxbb_AddImage(ExpandConstant('{tmp}')+'\06.jpg',BackGround or Timer);
isxbb_Init(StrToInt(ExpandConstant('{hwnd}')));
isxbb_StartTimer(10,BackGround)
MainForm.Visible:=True;
end;
if CurStep=ssPostInstall then begin
MainForm.Visible:=False;
isxbb_KillTimer(BackGround);
end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID=wpInstalling then begin
WizardForm.MainPanel.Visible:=False;
WizardForm.Bevel1.Visible:=False;
WizardForm.Width:=ScaleX(395);
WizardForm.Height:=ScaleY(200);
WizardForm.Left:=ScaleX(MainForm.Width-WizardForm.Width-Indent);
WizardForm.Top:=ScaleY(MainForm.Height-WizardForm.Height-Indent);
WizardForm.InnerNotebook.Left:=ScaleX(10);
WizardForm.InnerNotebook.Top:=ScaleY(10);
WizardForm.InnerNotebook.Width:=ScaleX(370);
WizardForm.StatusLabel.Left:=ScaleX(0);
WizardForm.StatusLabel.Top:=ScaleY(0);
WizardForm.StatusLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.FileNameLabel.Left:=ScaleX(0);
WizardForm.FileNameLabel.Top:=ScaleY(20);
WizardForm.FileNameLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.ProgressGauge.Top:=ScaleY(40);
WizardForm.ProgressGauge.Width:=WizardForm.InnerNotebook.Width;
WizardForm.CancelButton.Left:=ScaleX(154);
WizardForm.CancelButton.Top:=ScaleY(80);
end;
if CurPageID=wpFinished then begin
WizardForm.Visible:=False;
WizardForm.Width:=502;
WizardForm.Height:=392;
WizardForm.Left:=(MainForm.Width-WizardForm.Width) div 2;
WizardForm.Top:=(MainForm.Height-WizardForm.Height) div 2;
WizardForm.Visible:=True;
end;
end;
procedure DeinitializeSetup;
begin
KillTimer(0,TimerID);
BASS_Stop;
BASS_Free;
MP3List.Free;
end;
var
PageNameLabel, PageDescriptionLabel: TLabel;
DesktopIcon: TCheckBox;
LogoImage:TBitmapImage;
LogoPanel: TPanel;
LogoLabel: TLabel;
procedure LogoLabelOnClick(Sender: TObject);
var
ErrorCode: Integer;
begin
ShellExec('open', 'http://www.vgtorrent.ru/forum/index.php', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode)
end;
type
TProc=procedure(HandleW, msg, idEvent, TimeSys: LongWord);
var
pfunc: LongWord;
Label1:tlabel;
procedure InitializeWizard();
begin
ProgressBar := TNewProgressBar.Create(WizardForm);
ExtractFile := TNewStaticText.Create(WizardForm);
with WizardForm.ProgressGauge do
begin
ProgressBar.SetBounds(Left, Top + ScaleX(55), Width, Height)
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 1000;
ProgressBar.Position := 0;
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width := Width;
ExtractFile.top:=Top + ScaleX(35);
ExtractFile.caption:=cm('ArcTitle');
end;
Button1:=TButton.create(WizardForm);
Button1.parent:=WizardForm;
Button1.SetBounds(260, WizardForm.cancelbutton.top, 135, WizardForm.cancelbutton.Height);
Button1.caption:=cm('ArcCancel');
Button1.OnClick:=@Button1OnClick;
Button1.Hide;
SetWindowLong(MainForm.Handle,-16,GetWindowLong(MainForm.Handle,-16) and not $C40000);
MainForm.Width:=GetSystemMetrics(0);
MainForm.Height:=GetSystemMetrics(1)+1;
MainForm.Top:=-1;
MainForm.Left:=0;
ExtractTemporaryFile('4.jpg');
ShowSplashScreen(WizardForm.Handle,ExpandConstant('{tmp}')+'\4.jpg',1000,3000,1000,0,255,False,$FFFFFF,10);
TimerID:=SetTimer(0,0,500,WrapTimerProc(@TimerTick,5));
BASS_Init(-1,44100,0,0,0);
BASS_SetConfig(5,100);
BASS_SetConfig(6,100);
LogoPanel := TPanel.Create(WizardForm);
with LogoPanel do
begin
Parent := WizardForm;
Left := ScaleX(0);
Top := ScaleY(313);
Width := ScaleX(231);
Height := ScaleY(85);
BevelOuter := bvNone;
end;
LogoImage := TBitmapImage.Create(WizardForm);
with LogoImage do
begin
Parent := LogoPanel;
Left := ScaleX(0);
Top := ScaleY(0);
AutoSize:=true;
ReplaceColor:=clFuchsia;
ReplaceWithColor:=clBtnFace;
ExtractTemporaryFile('logo.bmp');
Bitmap.LoadFromFile(ExpandConstant('{tmp}\logo.bmp'));
end;
LogoLabel := TLabel.Create(WizardForm);
with LogoLabel do
begin
Parent := LogoPanel;
Width := LogoPanel.Width;
Height := LogoPanel.Height;
Transparent:=True;
Cursor := crHand;
OnClick:=@LogoLabelOnClick;
end;
end; |
