» Inno Setup (создание инсталяционных пакетов)

dumanow
В начале:

Код: #define PB_ImageFile "progress.bmp"g

YURSHAT

Цитата:

В принципе да. Опиши подробней когда должно происходить копирование (на каком этапе) гдеgнаходится папка А, и будет ли эта папка у пользователя на компе?g

VicF1

Цитата: Папка А может и отсутствовать, а её присутствие задается проверкой реестра. Так можно?

Можно конечно. Еще вопрос, на каком этапе будет происходить копирование и какой объем копируемых файлов?

Цитата:

Еще вопрос, на каком этапе будет происходить копирование и какой объем копируемых файлов?

А на каком проще и лучше?
Я не определился. Наверное, "чем раньше, тем лучше".
Размер мелкий,gдо 1Мб. Но возможно и больше захочу использовать...

VicF1

Цитата:

А на каком проще и лучше?

Да впринципе пофигу, смотря что за файлы и для чего.


Цитата:

Размер мелкий,gдо 1Мб. Но возможно и больше захочу использовать...

Всего лишь, я думал там пару гигов, щас набросаю примерчик...

nik1967 теперь выбивает вот такую ошибку

SotM нужно чтоб читал блокнот, и в случае если не подходит по содержанию, выдавал ошибку

dumanow

Цитата:

теперь выбивает вот такую ошибку

Потому, что в этой строчкеgнаписана полная хрень

Packers Show v3.1
Списокgизменений:
- Исправлен багgиз за которого вgнекоторых случаяхgневозможно было выполнить упаковку.

А можно ли к вашему скрипту 2.1 прикрепить как то фрее арк

dumanow

Цитата:

А можно ли к вашему скрипту 2.1 прикрепить как то фрее арк

Можно конечно, прикрепляйте

А по вашему предыдущему вопросу, должно быть [more=так][Setup]
AppId={{DAEB116F-69B2-4FA1-995F-A1B15DCC8DD7}
AppNam =Just Cause
AppVerNam =Just Cause v.1
AppPublisher=R.G.RePackers
AppPublisherURL=http://posrednik.dkm.dp.ua
AppSupportURL=http://posrednik.dkm.dp.ua
AppUpdatesURL=http://posrednik.dkm.dp.ua
DefaultDirNam ={pf}\Just Cause
DefaultGroupNam =Just Cause
OutputDir=C:\Program Files\R.G.RePackers
OutputBaseFilenam =setup
Compression=lzma/ultra
SolidCompression=true
InternalCompressLevel=ultra

[Languages]
Nam : russian; MessagesFile: compiler:Languages\Russian.isl

[Tasks]
Nam : desktopicon; Descriptnon: {cm:CreateDesktopIcon}; GroupDescriptnon: {cm:AdditnonalIcons}; Flags: unchecked

[CustomMessages]
russian.ArcBreak=Установка прервана!
russian.ExtractedInfo=Распаковано %1 Мбgиз %2 Мбg
russian.ArcInfo=Архив: %1 из %2
russian.ArcTitle=Распаковка архивов FreeArc
russian.ArcError=Распаковщик FreeArc вернул код ошибки: %1
russian.ArcFail=Распаковка не завершена!
russian.AllProgress=Общий прогресс распаковки: %1%%
russian.ArcBroken=Возможно, архив %1 повреждён%nили недостаточно места на диске назначения.
russian.Extracting=Распаковывается: %1
russian.taskbar=%1%%, жди %2
russian.remains=Осталось ждать %1
russian.LongTim =вечно
russian.ending=завершение
russian.hour=часов
russian.min=мин
russian.sec=сек

[Files]
Source: C:\RePack\unarc.dll; DestDir: {tmp}; Flags: dontcopy deleteafterinstall
Source: C:\RePack\InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\papka.bmp; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\logo.bmp; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\button.bmp; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\progress1.bmp; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\gam startup.mp3; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\bass.dll; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\ISSkin.dll; DestDir: {app}; Flags: dontcopy
Source: C:\RePack\Tiger.cjstyles; DestDir: {tmp}; Flags: dontcopy
Source: C:\RePack\image2.bmp; DestDir: {tmp}; Flags: dontcopy
; NOTE: Don't use "Flags: ignoreversion"gon any shared system files

[Icons]
Nam : {group}\Just Cause; Filenam : {app}\JustCause.exe
Nam : {commondesktop}\Just Cause; Filenam : {app}\JustCause.exe; Tasks: desktopicon

[Run]
Filenam : {app}\JustCause.exe; Descriptnon: {cm:LaunchProgram,Just Cause}; Flags: nowait postinstall skipifsilent

[Registry]
Root: HKLM; SubKey: SOFTWARE\Eidos\Just Cause; ValueTyp : string; ValueNam : InstallPath; ValueData: C:\Gam s\Just Cause
Root: HKLM; SubKey: SOFTWARE\Eidos\Just Cause; ValueTyp : dword; ValueNam : Language; ValueData: $00000419

[Messages]
ComponentsDiskSpaceMBLabel=6000 MB

[Code]

var
NeedSize:Integer;
FreeMB, TotalMB: Cardinal;
NeedSpaceLabel,FreeSpaceLabel: TLabel;

procedure GetFreeSpaceCaptnon(Sender: TObject);
var
Path: String;
begin
Path := ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB > 1024 then
FreeSpaceLabel.Captnon := 'Доступно места на диске: '+ FloatToStr(round(FreeMB/1024*100)/100)g+ ' GB' else
FreeSpaceLabel.Captnon := 'Доступно места на диске: '+ IntToStr(FreeMB)+ ' MB';g
if FreeMB < NeedSize then
WizardForm.NextButton.Enabled := False else
WizardForm.NextButton.Enabled := True; end;

procedure GetNeedSpaceCaptnon;
begin
if NeedSize > 1024 then
NeedSpaceLabel.Captnon := 'Требуется места на диске: '+ FloatToStr(round(NeedSize/1024*100)/100)g+ ' GB' else
NeedSpaceLabel.Captnon := 'Требуется места на диске: '+ IntToStr(NeedSize)+ ' MB';end;

procedure InitializeWizard9();
begin
NeedSize := 318;
WizardForm.DiskSpaceLabel.Hide;

NeedSpaceLabel := TLabel.Create(WizardForm);
with NeedSpaceLabel do
begin
Parent := WizardForm.SelectDirPage;
Left := ScaleX(0);
Top := ScaleY(202);
Width := ScaleX(209);
Height := ScaleY(13);
end;

FreeSpaceLabel := TLabel.Create(WizardForm);
with FreeSpaceLabel do
begin
Parent := WizardForm.SelectDirPage;
Left := ScaleX(0);
Top := ScaleY(220);
Width := ScaleX(209);
Height := ScaleY(13);
end;

WizardForm.DirEdit.OnChange := @GetFreeSpaceCaptnon;
WizardForm.DirEdit.Text := WizardForm.DirEdit.Text + #0;
end;

procedure CurPageChanged5(CurPageID: Integer);
begin
begin
if CurPageID=wpSelectDir then
begin
GetNeedSpaceCaptnon;
if FreeMB < NeedSize then
WizardForm.NextButton.Enabled:=False
end;
end;
end;

var
Image2: TBitmapImage;

procedure InitializeWizard8();
var
Page: TWizardPage;
begin
ExtractTemporaryFile('Image2.bmp')
WizardForm.WizardBitmapImage.Width:=497
WizardForm.WelcomeLabel1.Visible:=true
WizardForm.WelcomeLabel2.Visible:=true
WizardForm.WizardBitmapImage2.Visible:=true
WizardForm.FinishedLabel.Visible:=true
WizardForm.FinishedHeadingLabel.Visible:=true
end;

procedure CurPageChanged4(CurPageID: Integer);
begin
If CurPageID=wpFinished then
begin
Image2:=TBitmapImage.Create(WizardForm)
with Image2 do begin
Left:=0
Top:=0
Width:=497
Height:=313
Parent:=WizardForm.FinishedPage
Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\Image2.bmp')
end
end
end;

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

PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMb = 1048576;

type
#ifdef UNICODE ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup
#define A "W"g
#else
#define A "A"g ; точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
// PAnsiChar = PChar; // Required forgInno Setup 5.3.0 and higher. (требуется для Inno Setup версии 5.3.0 и ниже)g
#endif
#if Ver < 84018176
AnsiString = String; // There is no need forgthis line ingInno Setup 5.2.4 and above (для Inno Setup версий 5.2.4 и выше эта строка не нужна)g
#endif

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

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

var
ExtractFile: TLabel;
lblExtractFileNam : TLabel;
btnCancelUnpacking: TButton;
CancelCode, n, UnPackError, StartInstall: Integer;
Arcs: array of TArc;
msgError: string;
lastMb: Integer;
baseMb: Integer;
totalUncompressedSize: Integer; // total uncompressed size of archive data ingmb
LastTim rEvent: DWORD;

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

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

Functnon OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
functnon GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
functnon SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';

functnon GetTickCount: DWord; external 'GetTickCount@kernel32';
functnon WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
functnon 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, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;

// Перевод числа в строку с точностью 3 знака (%.3n) с округлением дробной части, если она есть
Functnon NumToStr(Float: Extended): String;
Begin
Result:= Format('%.3n', [Float]); StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') org(Result[Length(Result)] = '.')) and (Length(Result) > 1) do
SetLength(Result, Length(Result)-1);
End;

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

Functnon Size64(Hi, Lo: Integer): Extended;
Begin
Result:= Lo;
if Lo<0 then Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
forgHi:= Hi-1 Downto 0 do
Result:= Result + $7FFFFFFF + $7FFFFFFF + 2;
End;

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

// Converts ANSI encoded string into UTF-8
// Преобразует строку из ANSI в UTF-8 кодировку
functnon 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;

// OnClick event functnon forgbtnCancel
procedure btnCancelUnpackingOnClick(Sender: TObject);
begin
if MsgBox( SetupMessage( msgExitSetupMessage ), mbInformatnon, MB_YESNO ) = IDYES then
CancelCode:= -127;
end;

var origsize: Integer;
// The callback functnon forggetting info about FreeArc archive
functnon FreeArcInfoCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
begin
if string(what)='origsize' then origsize := Mb else
if string(what)='compsize' then else
if string(what)='total_files'gthen else
Result:= CancelCode;
end;

// Returns decompressed size of files in archive
functnon ArchiveOrigSize(arcnam : string): Integer;
var
callback: longword;
Begin
callback:= WrapFreeArcCallback(@FreeArcInfoCallback,4); //FreeArcInfoCallback has 4 arguments
CancelCode:= 0;
AppProcessMessage;
try
// Passgthe specified arguments to 'unarc.dll'g
Result:= FreeArcExtract (callback, 'l', '--', AnsiToUtf8(arcnam ), '', '', '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
if Result >= 0 then Result:= origsize;
exceptg
Result:= -63; // ArcFail
end;
end;

// Scansgthe specified folders forgarchives and add them to list
functnon FindArcs(dir: string): Extended;
var
FSR: TFindRec;
Begin
Result:= 0;
if FindFirst(ExpandConstant(dir), FSR) then begin
try
repeat
// Skip everything but the folders
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
n:= GetArrayLength(Arcs);
// Expand the folder list
SetArrayLength(Arcs, n +1);
Arcs[n].Path:= ExtractFilePath(ExpandConstant(dir))g+ FSR.Nam ;
Arcs[n].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Result:= Result + Arcs[n].Size;
Arcs[n].OrigSize := ArchiveOrigSize(Arcs[n].Path)
totalUncompressedSize := totalUncompressedSize + Arcs[n].OrigSize
until not FindNext(FSR);
finally
FindClose(FSR);
end;
end;
End;

// Setsgthe TaskBar title
Procedure SetTaskBarTitle(Title: String); var h: Integer;
Begin
h:= GetWindowLong(MainForm.Handle, -8); if h <> 0 then SetWindowText(h, Title);
End;

// Converts milliseconds to human-readable time
// Конвертирует милисекунды в человеко-читаемое изображение времени
Functnon TicksToTim (Ticks: DWord; h,m,s: String; detail: Boolean): String;
Begin
if detail {hh:mm:ss format} 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 {more than hour} then
Result:= IntToStr(Ticks/3600000) +h+' '+ PADZ(IntToStr((Ticks/1000 - Ticks/1000/3600*3600)/60), 2) +m
else if Ticks/60 >= 1000 {1..60 minutes} then
Result:= IntToStr(Ticks/60000) +m+' '+ PADZ(IntToStr(Ticks/1000 - Ticks/1000/60*60), 2) +s
else Result:= IntToStr(Ticks/1000) +s {less than one minute}
End;

// The main callback functnon forgunpacking FreeArc archives
functnon FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
percents, Remaining: Integer;
s: String;
begin
if GetTickCount - LastTim rEvent > 1000gthen begin
// This code will be executed once each 1000gms (этот код будет выполняться раз в 1000gмиллисекунд)
// ....
// End of code executed by timer
LastTim rEvent := LastTim rEvent+1000;
end;

if string(what)='filenam 'gthen begin
// Update FileNam label
lblExtractFileNam .Captnon:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
end else if (string(what)='write') and (totalUncompressedSize>0) and (Mb>lastMb)gthen begin
// Assign to Mb *total* amount of data extracted to the moment from all archives
lastMb := Mb;
Mb := baseMb+Mb;

// Update progress bar
WizardForm.ProgressGauge.Positnon:= Mb;

// Show how much megabytes/archives were processed up to the moment
percents:= (Mb*1000) div totalUncompressedSize;
s := FmtMessage(cm('ExtractedInfo'), [IntToStr(Mb), IntToStr(totalUncompressedSize)]);
if GetArrayLength(Arcs)>1 then
s := sg+ '. '+FmtMessage(cm('ArcInfo'), [IntToStr(n+1), IntToStr(GetArrayLength(Arcs))])
ExtractFile.Captnon := s

// Calculate and show current percents
percents:= (Mb*1000) div totalUncompressedSize;
s:= FmtMessage(cm('AllProgress'), [Format('%.1n', [Abs(percents/10)])]);
if Mb > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((totalUncompressedSize - Mb)/Mb)) else Remaining:= 0;
if Remaining = 0 then SetTaskBarTitle(cm('ending')) else begin
s:= sg+ '. '+FmtMessage(cm('remains'), [TicksToTim (Remaining, cm('hour'), cm('min'), cm('sec'), false)])
SetTaskBarTitle(FmtMessage(cm('taskbar'), [IntToStr(percents/10), TicksToTim (Remaining, 'h', 'm', 's', false)]))
end;
WizardForm.FileNam Label.Captnon := s
end;
AppProcessMessage;
Result:= CancelCode;
end;

// Extracts all found archives
functnon UnPack(Archives: string): Integer;
var
totalCompressedSize: Extended;
callback: longword;
FreeMB, TotalMB: Cardinal;
begin
// Display 'Extracting FreeArc archive'g
lblExtractFileNam .Captnon:= '';g
lblExtractFileNam .Show;
ExtractFile.captnon:= cm('ArcTitle');
ExtractFile.Show;
// Show the 'Cancel unpacking'gbutton and set it as defaultgbutton
btnCancelUnpacking.Captnon:= WizardForm.CancelButton.Captnon;
btnCancelUnpacking.Show;
WizardForm.ActiveControl:= btnCancelUnpacking;
WizardForm.ProgressGauge.Positnon:= 0;
// Getgthe size of all archives
totalUncompressedSize := 0;
totalCompressedSize := FindArcs(Archives);
WizardForm.ProgressGauge.Max:= totalUncompressedSize;
// Other initializatnons
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
StartInstall:= GetTickCount; {время начала распаковки}
LastTim rEvent:= GetTickCount;
baseMb:= 0

forgn:= 0 to GetArrayLength(Arcs) -1 do
begin
lastMb := 0
CancelCode:= 0;
AppProcessMessage;
try
// Passgthe specified arguments to 'unarc.dll'g
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', AnsiToUtf8(Arcs[n].Path), '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
exceptg
Result:= -63; // ArcFail
end;
baseMb:= baseMb+lastMb

// Error occured
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#10g+ FmtMessage(cm('ArcBroken'), [ExtractFileNam (Arcs[n].Path)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
// MsgBox(msgError, mbInformatnon, MB_OK); //сообщение показывается на странице завершения
Log(msgError);
Break; //прервать цикл распаковки
end;
end;
// Hide labels and button
WizardForm.FileNam Label.Captnon:= '';g
lblExtractFileNam .Hide;
ExtractFile.Hide;
btnCancelUnpacking.Hide;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
UnPackError:= UnPack(Archives)
if UnPackError = 0 then
SetTaskBarTitle(SetupMessage(msgSetupAppTitle))
else
begin
// Error occured, uninstall it then
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); //откат установки из-за ошибки unarc.dll
SetTaskBarTitle(SetupMessage(msgErrorTitle))
WizardForm.Captnon:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
end;
end;
end;

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

Procedure CurPageChanged3(CurPageID: Integer);
Begin
if (CurPageID = wpFinished) and (UnPackError <> 0) then
begin // Extractnon was unsuccessful (распаковщик вернул ошибку)
// Show error message
WizardForm.FinishedLabel.Font.Color:= $0000C0;g // red (красный)
WizardForm.FinishedLabel.Height:= WizardForm.FinishedLabel.Height * 2;
WizardForm.FinishedLabel.Captnon:= SetupMessage(msgSetupAborted) + #13#10#13#10g+ msgError;
end;
End;

procedure InitializeWizard7();
begin
with WizardForm.ProgressGauge do
begin
// Create a label to show current FileNam being extracted
lblExtractFileNam := TLabel.Create(WizardForm);
lblExtractFileNam .parent:=WizardForm.InstallingPage;
lblExtractFileNam .autosize:=false;
lblExtractFileNam .Width:= Width;
lblExtractFileNam .top:=Top + ScaleY(35);
lblExtractFileNam .Captnon:= '';g
lblExtractFileNam .Hide;

// Create a label to show percentage
ExtractFile:= TLabel.Create(WizardForm);
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width:= Width;
ExtractFile.top:=lblExtractFileNam .Top + ScaleY(16);
ExtractFile.captnon:= '';g
ExtractFile.Hide;
end;

// Create a 'Cancel unpacking'gbutton and hide it forgnow.
btnCancelUnpacking:=TButton.create(WizardForm);
btnCancelUnpacking.Parent:= WizardForm;
btnCancelUnpacking.SetBounds(WizardForm.CancelButton.Left, WizardForm.CancelButton.top, WizardForm.CancelButton.Width, WizardForm.CancelButton.Height);
btnCancelUnpacking.OnClick:= @btnCancelUnpackingOnClick;
btnCancelUnpacking.Hide;
end;

///////
// Importing LoadSkin API from ISSkin.DLL
procedure LoadSkin(lpszPath: String; lpszIniFileNam : String);
external 'LoadSkin@files:isskin.dll stdcall';

// Importing UnloadSkin API from ISSkin.DLL
procedure UnloadSkin();
external 'UnloadSkin@files:isskin.dll stdcall';

// Importing ShowWindow Windows API from User32.DLL
functnon ShowWindow(hWnd: Integer; uTyp : Integer): Integer;
external 'ShowWindow@user32.dll stdcall';

functnon InitializeSetup(): Boolean;
begin
ExtractTemporaryFile('Tiger.cjstyles');
LoadSkin(ExpandConstant('{tmp}\Tiger.cjstyles'), '');
Result := True;
end;

procedure DeinitializeSetup2();
begin
// Hide Window before unloading skin so user does not get
// a glimpse of an unskinned window before it is closed.
ShowWindow(StrToInt(ExpandConstant('{wizardhwnd}')), 0);
UnloadSkin();
end;


type
HSTREAM = DWORD;

functnon BASS_Init(device: Integer; freq, flags: DWORD; win: hwnd; CLSID: Integer): Boolean;
external 'BASS_Init@files:BASS.dll stdcall delayload';

functnon BASS_StreamCreateFile(mem: BOOL; f: PChar; offset: DWORD; length: DWORD; flags: DWORD): HSTREAM;
external 'BASS_StreamCreateFile@files:BASS.dll stdcall delayload';

functnon BASS_Start(): Boolean;
external 'BASS_Start@files:BASS.dll stdcall delayload';

functnon BASS_Pause(): Boolean;
external 'BASS_Pause@files:BASS.dll stdcall delayload';

functnon BASS_SetVolume(volume: DWORD): BOOL;
external 'BASS_SetVolume@files:BASS.dll stdcall delayload';

functnon BASS_GetVolume: Integer;
external 'BASS_GetVolume@files:BASS.dll stdcall delayload';

functnon BASS_ChannelPlay(handle: DWORD; r start: BOOL): Boolean;
external 'BASS_ChannelPlay@files:BASS.dll stdcall delayload';

functnon BASS_Stop(): Boolean;
external 'BASS_Stop@files:BASS.dll stdcall delayload';

functnon BASS_Free(): Boolean;
external 'BASS_Free@files:BASS.dll stdcall delayload';

functnon GetSystemMetrics(nIndex:Integer):Integer;
external 'GetSystemMetrics@user32.dll stdcall';

const
BASS_SAMPLE_LOOP = 4; //повторение

var
MusicButton, VolumeUP, VolumeDown : TButton;
VolumeInd: TNewProgressBar;

// Событие при нажатии на кнопку вкл.выкл. музыки
procedure MusicButtonOnClick(Sender: TObject);
begin
//Проверка состояния кнопки
if MusicButton.Captnon = 'II'gthen // Если играет
begin
MusicButton.Captnon := '>';g
BASS_Pause; // Тушим
end else // Иначе
begin
MusicButton.Captnon := 'II';g
BASS_Start(); // Слушаем
end;
end;

// Нажатие на кнопочку увеличения громкости
procedure VolumeUPOnClick(Sender: TObject);
var
vol : integer;
begin
vol := BASS_GetVolume;
if vol+5 >= 100gthen // Добавляем громкости сразу на 5 единиц
begin
BASS_SETVolume(100);
VolumeIND.positnon := 100;
VolumeUP.Enabled := False; // Если громкость максимальная то выключим кнопку
end else
begin
BASS_SETVolume(vol+5);
VolumeIND.positnon := vol+5;
VolumeDOWN.Enabled := True;
end;
end;

// Конопка понижение громкости
procedure VolumeDOWNOnClick(Sender: TObject);
var
vol : integer;
begin
vol := BASS_GetVolume;
if vol-5 <= 0 then
begin
BASS_SETVolume(0);
VolumeIND.positnon := 0;
VolumeDOWN.Enabled := False; //Если понижать ужеgнекуда то выключаем кнопочку
end else
begin
BASS_SETVolume(vol-5);
VolumeIND.positnon := vol-5;
VolumeUP.Enabled := True;
end;
end;

//Иницализация окна установки
procedure InitializeWizard6;
var
s, Nam : string;
i : Integer;
begin
// Загружаем музыку
ExtractTemporaryFile('BASS.dll');
ExtractTemporaryFile('gam startup.mp3');
if BASS_Init(-1, 44100, 0, 0, 0) then
begin
BASS_Start();
Nam :=ExpandConstant('{tmp}\gam startup.mp3');
i:=BASS_StreamCreateFile(FALSE, PChar(Nam ), 0, 0, 4);
if i <> 0 then
begin
BASS_ChannelPlay(i, True);
end;
end;

// Добавляем кнопочки управления музыкой
// Вкл. Выкл.
MusicButton := TButton.Create(WizardForm);
with MusicButton do
begin
Left := WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width;
Top := WizardForm.CancelButton.Top;
Width := WizardForm.CancelButton.Height;
Height := WizardForm.CancelButton.Height;
Captnon := 'II';g
Hint := 'Вкл.Выкл. музыку';g
ShowHint := True;
OnClick := @MusicButtonOnClick;
Parent := WizardForm;
end;

//Громче
VolumeDown := TButton.Create(WizardForm);
with VolumeDown do
begin
Left := WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width + MusicButton.Width;
Top := WizardForm.CancelButton.Top;
Width := WizardForm.CancelButton.Height;
Height := WizardForm.CancelButton.Height;
Captnon := '-';g
Hint := 'Убавить громкость';g
ShowHint := True;
OnClick := @VolumeDOWNOnClick;
Parent := WizardForm;
end;

//Тише
VolumeUP := TButton.Create(WizardForm);
with VolumeUP do
begin
Left := WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width + MusicButton.Width + VolumeDown.Width;
Top := WizardForm.CancelButton.Top;
Width := WizardForm.CancelButton.Height;
Height := WizardForm.CancelButton.Height;
Captnon := '+';g
Hint := 'Прибавить громкость';g
ShowHint := True;
OnClick := @VolumeUPOnClick;
Parent := WizardForm;
end;

//Индикатор уровня громкости
VolumeIND := TNewProgressBar.Create(WizardForm);
with VolumeIND do
begin
Parent := WizardForm;
Left := WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width + MusicButton.Width + VolumeUP.Width + VolumeDown.Width;
Top := WizardForm.CancelButton.Top;
Width := WizardForm.CancelButton.Width;
Height := WizardForm.CancelButton.Height;
Min := 0;
Max := 100;
Positnon := BASS_GetVolume;
end;

//Проверка на то какая громкость стоит в системе
if BASS_GetVolume >= 100gthen volumeUP.Enabled := False;
if BASS_GetVolume <= 0 then volumeDOWN.Enabled := False;

end;

procedure DeinitializeSetup();
begin
BASS_Stop(); //нужно для остановки проигрывания
BASS_Free(); //нужно для быстрой выгрузки библиотеки вместе с муз. файлом
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
if CurUninstallStep=usDone then
begin
if DirExists(ExpandConstant('{app}\save')) then
begin
if MsgBox('Удалить сохраненные игры?',mbconfirmatnon, mb_yesno) = IDYES then
begin
DelTree(ExpandConstant('{app}'), True, True, True);
MsgBox('Cохраненные игры были удалены', mbinformatnon, mb_ok);
end;
end;
end;
end;

//******************************************* [Начало - Черый инсталл] ***************************************************//

const
Color = clblack;

procedure InitializeWizard2();
begin
// Папка
ExtractTemporaryFile('papka.bmp');
WizardForm.SelectDirBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\papka.bmp'));
WizardForm.SelectDirBitmapImage.AutoSize:=True;
WizardForm.SelectGroupBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\papka.bmp'));
WizardForm.SelectGroupBitmapImage.AutoSize:=True;
//Инсталл черный
WizardForm.Font.Color:=clWhite;
WizardForm.Color:=Color;
WizardForm.WelcomePage.Color:=Color;
WizardForm.InnerPage.Color:=Color;
WizardForm.FinishedPage.Color:=Color;
WizardForm.LicensePage.Color:=Color;
WizardForm.PasswordPage.Color:=Color;
WizardForm.InfoBeforePage.Color:=Color;
WizardForm.UserInfoPage.Color:=Color;
WizardForm.SelectDirPage.Color:=Color;
WizardForm.SelectComponentsPage.Color:=Color;
WizardForm.SelectProgramGroupPage.Color:=Color;
WizardForm.SelectTasksPage.Color:=Color;
WizardForm.ReadyPage.Color:=Color;
WizardForm.PreparingPage.Color:=Color;
WizardForm.InstallingPage.Color:=Color;
WizardForm.InfoAfterPage.Color:=Color;
WizardForm.DirEdit.Color:=Color;
WizardForm.DiskSpaceLabel.Color:=Color;
WizardForm.DirEdit.Color:=Color;
WizardForm.GroupEdit.Color:=Color;
WizardForm.PasswordLabel.Color:=Color;
WizardForm.PasswordEdit.Color:=Color;
WizardForm.PasswordEditLabel.Color:=Color;
WizardForm.ReadyMemo.Color:=Color;
WizardForm.Typ sCombo.Color:=Color;
WizardForm.WelcomeLabel1.Color:=Color;
WizardForm.WelcomeLabel1.Font.Color:=clWhite;
WizardForm.InfoBeforeClickLabel.Color:=Color;
WizardForm.MainPanel.Color:=Color;
WizardForm.PageNam Label.Color:=Color;
WizardForm.PageDescriptnonLabel.Color:=Color;
WizardForm.ReadyLabel.Color:=Color;
WizardForm.FinishedLabel.Color:=Color;
WizardForm.YesRadio.Color:=Color;
WizardForm.NoRadio.Color:=Color;
WizardForm.WelcomeLabel2.Color:=Color;
WizardForm.LicenseLabel1.Color:=Color;
WizardForm.InfoAfterClickLabel.Color:=Color;
WizardForm.ComponentsList.Color:=Color;
WizardForm.ComponentsDiskSpaceLabel.Color:=Color;
WizardForm.BeveledLabel.Color:=Color;
WizardForm.StatusLabel.Color:=Color;
WizardForm.Filenam Label.Color:=Color;
WizardForm.SelectDirLabel.Color:=Color;
WizardForm.SelectStartMenuFolderLabel.Color:=Color;
WizardForm.SelectComponentsLabel.Color:=Color;
WizardForm.SelectTasksLabel.Color:=Color;
WizardForm.LicenseAcceptedRadio.Color:=Color;
WizardForm.LicenseNotAcceptedRadio.Color:=Color;
WizardForm.UserInfoNam Label.Color:=Color;
WizardForm.UserInfoNam Edit.Color:=Color;
WizardForm.UserInfoOrgLabel.Color:=Color;
WizardForm.UserInfoOrgEdit.Color:=Color;
WizardForm.PreparingLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Font.Color:=clWhite;
WizardForm.UserInfoSerialLabel.Color:=Color;
WizardForm.UserInfoSerialEdit.Color:=Color;
WizardForm.TasksList.Color:=Color;
WizardForm.RunList.Color:=Color;
WizardForm.SelectDirBrowseLabel.Color:=Color;
WizardForm.SelectStartMenuFolderBrowseLabel.Color:=Color;
WizardForm.PageNam Label.Font.Color:=clWhite;
end;

//******************************************* [Конец - Черый инсталл] ***************************************************//

type
TProc = procedure(HandleW, msg, idEvent, TimeSys: LongWord);

var
Tim rID: LongWord;
intOldCurrWidth : Integer;
ProgressBar_BitmapImage: TBitmapImage;
ProgressBar_Edit : TEdit;
ProgressBar_ImageHeight : integer;

// Функции для работы с таймером
functnon WrapTim rProc(callback:TProc; paramcount:integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
functnon SetTim r(hWnd: LongWord; nIDEvent, uElapse: LongWord; lpTim rFunc: LongWord): LongWord; external 'SetTim r@user32.dll stdcall';
functnon KillTim r(hWnd: LongWord; nIDEvent: LongWord): LongWord; external 'KillTim r@user32.dll stdcall';

// Обработчик нажатия кнопки Отмена
procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
if CurPageID = wpInstallinggthen // Просто спрячем наш Прогресс Барg
ProgressBar_Edit.Hide;
end;

// Функция вызываемая по таймеру
procedure OnTim r(HandleW, msg, idEvent, TimeSys: LongWord);
var
CurrWidth : single;
begin
// Используем текущее состояние стандартного Прогресс Бара (ПБ)
with WizardForm.ProgressGauge do
begin
CurrWidth := ( Positnon * Width ) / Max; // Вычисляем какой ширины должен быть наш ПБ
if intOldCurrWidth <> Round( CurrWidth )gthen // Если ширина пока что такая же, то не будем пока что рисовать, чтобы избежать лишних обновлений формы
begin
intOldCurrWidth := Round( CurrWidth );
// Теперича "рисуем"gнаш ПБ
ProgressBar_BitmapImage.SetBounds( 0, 0, intOldCurrWidth, ProgressBar_ImageHeight );
ProgressBar_BitmapImage.Show(); // Показываем его во всей красе
end;
end;
end;

procedure CurPageChanged2(CurPageID: Integer);
var
pfunc: LongWord;
begin
if CurPageID = wpInstallinggthen
begin
// Устанавливаем таймер
pfunc := WrapTim rProc( @OnTim r, 4 );
Tim rID := SetTim r( 0, 0, 100, pfunc );
intOldCurrWidth := 0;
end;

// Убираем таймер, когда находимся на последней странице.
if CurPageID = wpFinished then
KillTim r( 0, Tim rID );
end;

Procedure InitializeWizard5;
begin
// Создаем наш Edit, чтобы у нашего ПБ была более-менее нормальная рамка.
ProgressBar_Edit := TEdit.Create( WizardForm );
with ProgressBar_Edit do
begin
// Создаем его на месте стандартного ПБ
Left := WizardForm.ProgressGauge.Left;
Top := WizardForm.ProgressGauge.Top;
Width := WizardForm.ProgressGauge.Width;
Height := WizardForm.ProgressGauge.Height;
Enabled := False;
ReadOnly := True;
// Фоновый цвет делаем точно такой же как у формы.
Color := WizardForm.Color;
Parent := WizardForm.InstallingPage;
end;

// Распаковываем картинку для нашего ПБ
ExtractTemporaryFile('progress1.bmp' );

ProgressBar_BitmapImage := TBitmapImage.Create( WizardForm );
with ProgressBar_BitmapImage do
begin
// Загружаем картинку
Bitmap.LoadFromFile( ExpandConstant( '{tmp}\progress1.bmp' ));
Parent := ProgressBar_Edit;
Stretch := True; // Он должен растягиваться
Hide; // Прячем его до поры до времени
end;

// Получаем высоту для картинки
ProgressBar_ImageHeight := ProgressBar_Edit.Height - 2;
// Прячем стандартный ПБ
WizardForm.ProgressGauge.Hide;
end;

procedure DeinitializeSetup6();
begin
// Убираем таймер
KillTim r( 0, Tim rID );
end;


procedure InitializeWizard();
begin
InitializeWizard2();
InitializeWizard5();
InitializeWizard6();
InitializeWizard7();
InitializeWizard8();
InitializeWizard9();

end;

procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged2(CurPageID);
CurPageChanged3(CurPageID);
CurPageChanged4(CurPageID);
CurPageChanged5(CurPageID);
end;[/more]

YURSHAT
nik1967 спасибо вам но вот инстал что показал

dumanow

Цитата:

но вот инстал что показал

Что написал, то и получил Я лишь с прогрессом подправил...

YURSHAT

Цитата:

щас набросаю примерчик...

Большое спасибо за помощь.

Но я, конечно, извиняюсь, а сколько ждать?

VicF1

Цитата:

Но я, конечно, извиняюсь, а сколько ждать?

Недельку или две

YURSHAT помоги пожалуйста я скрипт подправленный вами брал что там за баг?

YURSHAT ЛС почитай плз

VicF1

[more=Вот][Setup]
AppNam =My Program
AppVerNam =My Program 1.5
DefaultDirNam ={pf}\My Program

[Languages]
Nam : "russian"; MessagesFile: "compiler:Languages\Russian.isl"g

[Registry]
Root: HKLM; SubKey: SOFTWARE\MyProg; Flags: uninsdeletekeyifemptyg

[Code]

procedure CurStepChanged(CurStep: TSetupStep);
begin
case CurStep of
ssInstall: begin
if RegKeyExists(HKLM, 'Software\MyProg') then begin
FileCopy(ExpandConstant('{pf}\A\1.bmp'), ExpandConstant('{app}\1.bmp'), False);
FileCopy(ExpandConstant('{pf}\A\2.bmp'), ExpandConstant('{app}\2.bmp'), False);
end;
end;
end;
end;
[/more] простенький пример

MuIIIaLORD
Спасибо!

dumanow

Цитата:

помоги пожалуйста я скрипт подправленный вами брал что там за баг?

Нет там багов, что написали то и получили в итоге. Сейчас открываю ваш скрипт и читаю, что там написано:

Растянуть картнку - она растянулась. Далее все нормально работает. Если вы растягиваете картинку, то нужно делать новые надписи из лейблов у которых в отличие от статического текста есть прозрачность.

ЗЫ. Немного терминологии

непонятный сбой = глюк;
повторяемый глюк = баг;
предусмотренный разработчиком баг = фича

YURSHAT

Цитата:

Вот простенький пример

А разве этого

Цитата:

[Registry]
Root: HKLM; SubKey: SOFTWARE\MyProg; Flags: uninsdeletekeyifemptyg

VicF1

А вы мне сказали какое нужно брать значение??? Вы хотите, чтоб путь к А бралсяgиз реестра?

Цитата:

А вы мне сказали какое нужно брать значение??? Вы хотите, чтоб путь к А бралсяgиз реестра?

Что-то типа такого:
[HKEY_LOCAL_MACHINE\SOFTWARE\Valve]
[HKEY_LOCAL_MACHINE\SOFTWARE\Valve\Steam]
"InstallPath"="C:\\Valve\\Steam"g

И вот тут: FileCopy(ExpandConstant('переменная, соответствующая InstallPath\1.bmp')

А как объединить два CurStep ?
У меня ужеgиспользуетсяgв качестве сообщения по завершении установки.

del

Вы можете помочь чтоб он не растягивал картинку чтоб она отображалась нормально помогите плиз инстал очень понравилсяgбуду вам благодарен

dumanow

Цитата:

Вы можете помочь чтоб он не растягивал картинку чтоб она отображалась нормально помогите плиз инстал очень понравилсяgбуду вам благодарен

Удалите [more=эти]var
Image2: TBitmapImage;

procedure InitializeWizard8();
var
Page: TWizardPage;
begin
ExtractTemporaryFile('Image2.bmp')
WizardForm.WizardBitmapImage.Width:=497
WizardForm.WelcomeLabel1.Visible:=true
WizardForm.WelcomeLabel2.Visible:=true
WizardForm.WizardBitmapImage2.Visible:=true
WizardForm.FinishedLabel.Visible:=true
WizardForm.FinishedHeadingLabel.Visible:=true
end;

procedure CurPageChanged4(CurPageID: Integer);
begin
If CurPageID=wpFinished then
begin
Image2:=TBitmapImage.Create(WizardForm)
with Image2 do begin
Left:=0
Top:=0
Width:=497
Height:=313
Parent:=WizardForm.FinishedPage
Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\Image2.bmp')
end
end
end;[/more] строчки

Вчера отправил botva2.dll в лабораторию DrWeb - сегодня после обновленияgвирус не обнаруживается!!!

Krinkels

Цитата:

Packers Show v3.1

- пишет "Невозможно найти ресурс. Возможно быд удалён."g
Перезалейте пожалуйста.

Яgвижу что всё таки мояgидея с текстурой на прогресс бар пользуетсяgнебольшим спросом.

Krinkels
Файл действительно недоступен.

MISHANCHYK
Только что проверил, все нормально открывается. Попробуй просто зайти на http://krinkels.ucoz.ru/

Добавлено:
В натуре, не скачивает. Исправлю

Добавлено:
Исправил

quorg

Цитата:

Вчера отправил botva2.dll в лабораторию DrWeb - сегодня после обновленияgвирус не обнаруживается!!!

я тоже вчера вечером отправил

PS вот и ответ пришел


Цитата:

Ваш запрос был проанализирован. Комментарии к Вашему запросу:
С актуальными базами (в т.ч. на virustotal) файл не определяется. Скорее всего, ложное срабатывание было устранено ранее.


Спасибо за сотрудничество.

--
С уважением,
Службаgвирусного мониторинга ООО "Доктор Веб"g

Народ, дайте плизз код для использования isskin'а.... И ещё, какие нужны файлы для его применения?