Inno Setup (создание инсталяционных пакетов) - [1648] :: Программы

Код:

Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: string; cbMultiByte: integer;
lpWideCharStr: string; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: string; cchWideChar: integer;
lpMultiByteStr: string; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

const
Archives = '{src}\SupremeCommanderForgedAlliance.arc'; // укажите расположение архивов FreeArc; для внешних файлов строку в Files добавлять необязательно
PM_REMOVE = 1;

CP_ACP = 0;
CP_UTF8 = 65001;

type
#ifndef UNICODE
PAnsiChar = PChar;
#endif

TMyMsg = record
hwnd: HWND;
message: UINT;
wParam: Longint;
lParam: Longint;
time: DWORD;
pt: TPoint;
end;

TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record
Path: string;
Size: Extended;
end;

var
ProgressBar: TNewProgressBar;
ExtractFile: TNewStaticText;
lblExtractFileName: TLabel;
btnCancelUnpacking: TButton;
CancelCode: Integer;
n: Integer;
Arcs: array of TArc;
m: Extended;
UnpackingAborted: Boolean;
msgError: string;
PageNameLabel, PageDescriptionLabel: TLabel;
DesktopIcon: TCheckBox;
LogoImage:TBitmapImage;
LogoPanel: TPanel;
LogoLabel: TLabel;

function PeekMessage(var lpMsg: TMyMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMyMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMyMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';

Function OemToChar(lpszSrc: String; lpszDst: String): longint; external 'OemToCharA@user32.dll stdcall';
Function CharToOem(lpszSrc: String; lpszDst: String): longint; external 'CharToOemA@user32.dll stdcall';

function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl';

procedure AppProcessMessage;
var
Msg: TMyMsg;
begin
while PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;

function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;

Function NumToStr(Float: Extended): String; {Перевод числа в строку с точностью 3 знака (%.3n) с округлением дробной части, если она есть}
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 btnCancelUnpackingOnClick(Sender: TObject);
begin
if MsgBox( SetupMessage( msgExitSetupMessage ), mbInformation, MB_YESNO ) = IDYES then
CancelCode := -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;

// Преобразует OEM строку в ANSI кодировку
function OemToAnsiStr( strSource: string): string;
var
nRet : longint;
begin
SetLength( Result, Length( strSource ) );
nRet := OemToChar( strSource, Result );
end;

// Преобразует строку из ANSI в UTF-8 кодировку
function AnsiToUtf8( strSource: string ): string;
var
nRet : integer;
WideCharBuf: string;
MultiByteBuf: string;
begin
strSource := strSource + chr(0);
SetLength( WideCharBuf, Length( strSource ) * 2 );
SetLength( MultiByteBuf, Length( strSource ) * 2 );

nRet := MultiByteToWideChar( CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf) );
nRet := WideCharToMultiByte( CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);

Result := MultiByteBuf;
end;

function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
percents: Integer;
begin
if string(what)='filename' then
lblExtractFileName.Caption:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
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 := CancelCode;
end;

function UnPack(Archives: string): Integer;
var
allSize: Extended;
callback: longword;
FreeMB, TotalMB: Cardinal;
begin
btnCancelUnpacking.Show;
WizardForm.ActiveControl:= btnCancelUnpacking;
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;
CancelCode:= 0;
AppProcessMessage;
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
try
Result := FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', Arcs[n].Path, '', '', '', '', '');
if Result = 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;

if Result <> 0 then
begin
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
GetSpaceOnDisk(ExtractFileDrive(ExpandConstant('{app}')), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < 32 {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Arcs[n].Path)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
// MsgBox(msgError, mbInformation, MB_OK); //сообщение показывается на странице завершения
Log(msgError);
Break; //прервать цикл распаковки
end;
end;
btnCancelUnpacking.visible:= false;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
if UnPack(Archives) <> 0 then
begin
UnpackingAborted:= true; //замена текста на странице wpFinished
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n);
end;
end;

// стандартный способ отката (не нужна CurPageChanged), но архивы распаковываются до извлечения файлов инсталлятора
// if CurStep = ssInstall then
// if UnPack(Archives) <> 0 then Abort;

Procedure CurPageChanged(CurPageID: Integer);
Begin
if (CurPageID = wpFinished) and UnpackingAborted then
begin
WizardForm.FinishedLabel.Font.Color:= $0000C0; //красный
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
WizardForm.FinishedLabel.Caption:= SetupMessage(msgSetupAborted) + #13#10#13#10 + msgError;
end;
End;

procedure LogoLabelOnClick(Sender: TObject);
var
ErrorCode: Integer;
begin
ShellExec('open', 'http://megatorrents.kz/forum', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode)
end;
type
TProc=procedure(HandleW, msg, idEvent, TimeSys: LongWord);
var
TimerID: LongWord;
pfunc: LongWord;
Label1:tlabel;
const
NeedSize = 4136; //Прописать, сколько мегабайт необходимо

DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVEABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;

function GetLogicalDrives: DWORD;
external 'GetLogicalDrives@kernel32.dll stdcall';

function GetDriveType(nDrive: String): Longint;
external 'GetDriveTypeA@kernel32.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';

procedure InitializeWizard();
var b:string;
Path: String;
FreeMB, TotalMB: Cardinal;
ListBox: TListBox;
drives: DWORD;
i: integer;
begin
begin
with WizardForm do begin
with MainPanel do
Height := Height - 1;
with WizardSmallBitmapImage do begin
Left := 0;
Top := 0;
Height := 58; //Размер рисунка
Width := 497; //
end;
with PageNameLabel do begin
Width := Width - 497; //Поставьте здесь значения на 0, если хотите вернуть текст
Left := Left + 497; //
end;
with PageDescriptionLabel do begin
Width := Width - 497; //Поставьте здесь значения на 0, если хотите вернуть текст
Left := Left + 497; //
end;
end;
end;
begin
ExtractTemporaryFile('splash.bmp');
ShowSplashScreen(WizardForm.Handle,ExpandConstant('{tmp}')+'\splash.bmp',1000,3000,1000,0,255,False,$FFFFFF,10);
end;

begin
ListBox:= TListBox.Create(WizardForm);
ListBox.Top:= 120;
ListBox.Width:= 300;
ListBox.Height:= ScaleY(90);
ListBox.Parent:= WizardForm.SelectDirPage;

drives:= GetLogicalDrives();
for i:= 0 to 31 do
begin
if (drives and (1 shl i)) > 0 then
begin
Path:= chr(ord('A')+i)+':';
if GetDriveType(Path) = DRIVE_FIXED then
begin
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
ListBox.Items.Add(Path + ' - Всего: ' + IntToStr(TotalMB) +
'Мб - Свободно: ' + IntToStr(FreeMB) + 'Мб');
end;
end;
end;
end;

begin
ExtractTemporaryFile('BitmapImage2.bmp')
b:=ExpandConstant('{tmp}\BitmapImage2.bmp')
with WizardForm do
begin
WizardBitmapImage.Width:=WizardForm.ClientWidth;
WelcomeLabel1.Visible:=False;
WelcomeLabel2.Visible:=False;
WizardBitmapImage2.Bitmap.LoadFromFile(b);
WizardBitmapImage2.Width:=WizardForm.ClientWidth;
FinishedLabel.Visible:=False;
FinishedHeadingLabel.Visible:=False;
end;
end;
begin
LogoPanel := TPanel.Create(WizardForm);
with LogoPanel do
begin
Parent := WizardForm;
Left := ScaleX(0);
Top := ScaleY(315);
Width := ScaleX(231);
Height := ScaleY(83);
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;
ProgressBar := TNewProgressBar.Create(WizardForm);
ExtractFile:=TNewStaticText.Create(WizardForm);
lblExtractFileName := TLabel.Create( WizardForm );
with WizardForm.ProgressGauge do
begin
lblExtractFileName.parent:=WizardForm.InstallingPage;
lblExtractFileName.autosize:=false;
lblExtractFileName.Width := Width;
lblExtractFileName.top:=Top + ScaleY(35);
lblExtractFileName.Caption := '';

ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width := Width;
ExtractFile.top:=lblExtractFileName.Top + ScaleY(16);
ExtractFile.caption:=cm('ArcTitle');

ProgressBar.SetBounds(Left, ExtractFile.Top + ScaleY(16), Width, Height);
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 1000;
ProgressBar.Position := 0;
end;

btnCancelUnpacking:=TButton.create(WizardForm);
with btnCancelUnpacking do
begin
parent := WizardForm;
SetBounds(260, WizardForm.cancelbutton.top, 135, WizardForm.cancelbutton.Height);
caption := cm('ArcCancel');
OnClick := @btnCancelUnpackingOnClick;
Hide;
end;
end;
function NextButtonClick(CurPageID: Integer): Boolean;
var
Path: String;
FreeMB, TotalMB: Cardinal;
begin
Result:= True;
if CurPageID = wpSelectDir then
begin
Path:= ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB < NeedSize then
begin
MsgBox('Недостаточно места на диске!', mbInformation, MB_OK)
Result:= False;
end;
end;
end;

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