[архив] Скрипты Inno Setup. Помощь и советы [часть 2]

[Raf-9600]

Ктонить может объединить эти коды?

Запрет установки в папку Windows
Function NextButtonClick(CurPageID: Integer): Boolean; Begin
Result:= True
if (CurPageID = wpSelectDir) and (Pos(Uppercase(ExpandConstant('{win}')), Uppercase(ExpandConstant('{app}'))) > 0) then Result:= MessageBox(StrToInt(ExpandConstant('{wizardhwnd}')), ExpandConstant('{cm:SysDirSelect}'), 'Установка в системную папку', MB_YESNO or $30) = idYes;
End;

Описания компонентов
function enabledesc(ComponentsListHandle: HWND; DescLabelHandle: HWND; DescStrings: PChar): BOOL; external 'enabledesc@files:descctrl.dll stdcall';

function disabledesc(): BOOL; external 'disabledesc@files:descctrl.dll stdcall';

var
Info: TNewStaticText;
InfoCaption: TNewStaticText;
InfoPanel: TPanel;

procedure DeinitializeSetup();
begin
disabledesc();
end;

procedure InitializeWizard();
begin
WizardForm.TYPESCOMBO.Visible:= false;
WizardForm.ComponentsList.Height := WizardForm.ComponentsList.Height + WizardForm.ComponentsList.Top - WizardForm.TYPESCOMBO.Top;
WizardForm.ComponentsList.Top := WizardForm.TYPESCOMBO.Top;
WizardForm.ComponentsList.Width := ScaleX(200);
InfoPanel := TPanel.Create(WizardForm);
InfoPanel.Parent := WizardForm.SelectComponentsPage;
InfoPanel.Caption := '';
InfoPanel.Top := WizardForm.ComponentsList.Top;
InfoPanel.Left := ScaleX(216);
InfoPanel.Width := ScaleX(200);
InfoPanel.Height := WizardForm.ComponentsList.Height;
InfoPanel.BevelInner := bvRaised;
InfoPanel.BevelOuter := bvLowered;
InfoCaption := TNewStaticText.Create(WizardForm);
InfoCaption.Parent := WizardForm.SelectComponentsPage;
InfoCaption.Caption := 'ГиКц';
InfoCaption.Left := ScaleX(224);
InfoCaption.Top := InfoPanel.Top - ScaleY(5);
InfoCaption.Font.Color := clActiveCaption;
Info := TNewStaticText.Create(WizardForm);
Info.Parent := InfoPanel;
Info.AutoSize := False;
Info.Left := ScaleX(6);
Info.Width := ScaleX(188);
Info.Top := ScaleY(12);
Info.Height := WizardForm.ComponentsList.Height - ScaleY(18);
Info.Caption := 'Переместите ваш указатель мыши на компоненты чтобы увидеть их описание.';
Info.WordWrap := true;
enabledesc(WizardForm.ComponentsList.Handle,Info.Handle,
'Английская озвучка;'+ // SoundUnit\eng
'Французская озвучка;'+ // SoundUnit\fra
'Немецкая озвучка;'+ // SoundUnit\deu
'Итальянская озвучка;'+ // SoundUnit\ita
'Испанская озвучка;' // SoundUnit\spa
);
end;

Сколько есть, и требуеться для установки
var
NeedSize:Integer;
FreeMB, TotalMB: Cardinal;
NeedSpaceLabel: TLabel;
n: Integer;
VolumeName, FileSystemName: String;
VolumeSerialNo, MaxComponentLength, FileSystemFlags: Longint;
ListBox: TListBox;
StartMenuTreeView: TStartMenuFolderTreeView;

procedure GetFreeSpaceCaption(Sender: TObject);
var
Path: String;
begin
Path := ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB < NeedSize then
WizardForm.NextButton.Enabled := False else
WizardForm.NextButton.Enabled := True; end;

procedure GetNeedSpaceCaption;
begin
if NeedSize > 1024 then
NeedSpaceLabel.Caption := 'Требуется как минимум '+ FloatToStr(round(NeedSize/1024*100)/100) + ' Гб свободного дискового пространства.' else
NeedSpaceLabel.Caption := 'Требуется как минимум '+ IntToStr(NeedSize)+ ' Мб свободного дискового пространства.';end;

const oneMB= 1024*1024;
function GetLogicalDrives: DWord; external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(nDrive: String): Longint; external 'GetDriveTypeA@kernel32.dll stdcall';
function GetVolumeInformation(PathName,VolumeName: PChar; VolumeNameSize,VolumeSerialNumber,MaxComponentLength,FileSystemFlags: Longint; FileSystemName: PChar; FileSystemNameSize: Longint): Longint; external 'GetVolumeInformationA@kernel32.dll stdcall';
function MessageBox(hWnd: Integer; lpText, lpCaption: String; uType: Cardinal): Integer; external 'MessageBoxA@user32.dll stdcall';

Function ByteOrTB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб/Тб (до 3х знаков после запятой)}
Begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Мб' else
if Bytes < 1024 then Result:= FloatToStr(Int(Bytes)) +' Бт' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Кб' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Мб' else
If Bytes/oneMB/1000 < 1024 then Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Гб' else
Result:= FloatToStr(round(Bytes/oneMB/oneMB*1000)/1000) +' Тб'
StringChange(Result, ',', '.')
End;

Function DelSP(String: String): String; { Удаление начальных, конечных и повторных пробелов }
Begin while (Pos(' ', String) > 0) do Delete(String, Pos(' ', String), 1); Result:= Trim(String); End;

Function CutString(String: String; MaxLength: Longint): String; { Обрезать строку до заданного кол-ва символов}
Begin
if Length(String) > MaxLength then Result:= Copy(String, 1, 6) +'...'+ Copy(String, Length(String) - MaxLength +9, MaxLength)
else Result:= String;
End;

Procedure GetDiskInfo(Disk: String);
Begin
FileSystemName:= StringOfChar(' ', 32); VolumeName:= StringOfChar(' ', 256);
GetVolumeInformation(Disk, VolumeName, 255, VolumeSerialNo, MaxComponentLength, FileSystemFlags, FileSystemName, 31);
FileSystemName:= DelSp(FileSystemName); VolumeName:= DelSp(VolumeName); if VolumeName='' then VolumeName:='без метки';
End;

Procedure ListBoxRefresh; var FreeB, TotalB: Cardinal; Path, String: string; Begin
ListBox.Items.Clear
for n:= 1 to 31 do // диск 'А' пропустить
if (GetLogicalDrives and (1 shl n)) > 0 then
if (GetDriveType(Chr(ord('A') + n) +':\') = 2) or (GetDriveType(Chr(ord('A') + n) +':\') = 3) then
if GetSpaceOnDisk(Chr(ord('A') + n) +':\', True, FreeMB, TotalMB) then ListBox.Items.Add(Chr(ord('A') + n) +':');
for n:= 0 to ListBox.Items.Count -1 do begin
Path:= Copy(ListBox.Items[n],1,2) +'\' { если в накопителе нет диска, пропустить обновление }
if GetSpaceOnDisk(Path, False, FreeB, TotalB) and GetSpaceOnDisk(Path, True, FreeMB, TotalMB) then begin GetDiskInfo(Path);
if FreeB >= $7FFFFFFF then String:= PadL(ByteOrTB(FreeMB*oneMB, true),10) else String:= PadL(ByteOrTB(FreeB, true),10);
if TotalB >= $7FFFFFFF then begin TotalB:= TotalMB; FreeB:= FreeMB; String:= PadL(ByteOrTB(TotalMB*oneMB, true),11) +' всего -'+ String end else String:= PadL(ByteOrTB(TotalB, true),11) +' всего| '+ String;
ListBox.Items[n]:= Copy(Path,1,2) + String + PadL(FloatToStr(round(FreeB/TotalB*100)),3)+ '% своб|'+ PadL(FileSystemName,5)+ '| '+ CutString(VolumeName,9); end; end;
End;

Procedure ObjectOnClick(Sender: TObject); Begin
Case TObject(Sender) of
ListBox: for n:= 0 to ListBox.Items.Count-1 do if ListBox.Selected[n] then WizardForm.DirEdit.Text:= Copy(ListBox.Items[n],1,1) +Copy(WizardForm.DirEdit.Text, 2, Length(WizardForm.DirEdit.Text))
StartMenuTreeView: if StartMenuTreeView.Directory <> '' then WizardForm.GroupEdit.Text:= StartMenuTreeView.Directory else WizardForm.GroupEdit.Text:= '{#SetupSetting("DefaultGroupName")}'
WizardForm.NoIconsCheck: begin WizardForm.GroupEdit.Enabled:= not(WizardForm.GroupEdit.Enabled); StartMenuTreeView.Enabled:= WizardForm.GroupEdit.Enabled; WizardForm.GroupBrowseButton.Enabled:= WizardForm.GroupEdit.Enabled end;
end; End;

procedure InitializeWizard();
begin
NeedSize := 6100; //Здесь указывается место для приложения
WizardForm.DiskSpaceLabel.Hide;
NeedSpaceLabel := TLabel.Create(WizardForm);
with NeedSpaceLabel do
begin
Parent := WizardForm.SelectDirPage;
Left := ScaleX(0);
Top := ScaleY(220);
Width := ScaleX(209);
Height := ScaleY(13);
end;
ListBox:= TListBox.Create(WizardForm)
ListBox.SetBounds(WizardForm.DirEdit.Left, WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + 8, WizardForm.DirBrowseButton.Left + WizardForm.DirBrowseButton.Width - WizardForm.DirEdit.Left, WizardForm.DiskSpaceLabel.Top - (WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + 12))
ListBox.Font.Size:= 9
ListBox.Font.Style:= []
ListBox.Font.Name:= 'Courier New';
ListBox.OnClick:= @ObjectOnClick;
ListBox.Parent:= WizardForm.SelectDirPage;
WizardForm.DirEdit.OnChange := @GetFreeSpaceCaption;
WizardForm.DirEdit.Text := WizardForm.DirEdit.Text + #0;
end;

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

Слайд-шоу рандомно (в окне инсталляции)
const
n=21; //количество слайдов
type
TProc = procedure(HandleW, msg, idEvent, TimeSys: LongWord);
TRandNumbers = array[1..N] of byte;

function WrapTimerProc(callback:TProc; paramcount:integer):longword;
external 'wrapcallback@files:InnoCallback.dll stdcall';

function SetTimer(hWnd: LongWord; nIDEvent, uElapse: LongWord; lpTimerFunc: LongWord): LongWord;
external 'SetTimer@user32.dll stdcall';

function KillTimer(hWnd: LongWord; nIDEvent: LongWord): LongWord;
external 'KillTimer@user32.dll stdcall';

function get_unique_random_number(X:byte):TRandNumbers;
var
A,b,c: string;
i,j,k:byte;
begin
For i:=1 to X do A:=A+chr(i);
B:='';
For i:=1 to X do begin
j:=Random(Length(A)-1)+1;
C:='';
B:=B + A[j];
for k:=1 to Length(A) do
if k<>j then C:=C+A[k];
A:=C;
end;
for i:=1 to X do Result[i]:=ord(B[i]);
end;

var
TimerID: LongWord;
currTime: Integer;
SplashImage: TBitmapImage;
StatusMessages: TNewStaticText;
bmp: TRandNumbers;
z:byte;

procedure OnTimer(HandleW, msg, idEvent, TimeSys: LongWord);
begin
currTime := currTime + 1;
if (currTime mod {#TIME_FOR_VIEW} = 0)
then begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_'+inttostr(bmp[currTime/{#TIME_FOR_VIEW}])+'.bmp'));
if (currTime/{#TIME_FOR_VIEW} = N) then currTime:=0;
end;
end;


procedure InitializeWizard;
begin
bmp:=get_unique_random_number(N);
ExtractTemporaryFile('Image_'+inttostr(bmp[1])+'.bmp');

currTime := 0;

WizardForm.ProgressGauge.Parent := WizardForm;
WizardForm.ProgressGauge.Top := WizardForm.CancelButton.Top + ScaleY(12);
WizardForm.ProgressGauge.Left := ScaleX(10);
WizardForm.ProgressGauge.Width := WizardForm.MainPanel.Width - ScaleX(20);
WizardForm.ProgressGauge.Height := 16;
WizardForm.ProgressGauge.Hide;

WizardForm.StatusLabel.Parent := WizardForm;
WizardForm.StatusLabel.Top := WizardForm.ProgressGauge.Top - ScaleY(18);
WizardForm.StatusLabel.Left := ScaleX(10);
WizardForm.StatusLabel.Width := ScaleX(397);
WizardForm.StatusLabel.Hide;

SplashImage := TBitmapImage.Create(WizardForm);
SplashImage.Top := 0;
SplashImage.Left := 0;
SplashImage.Width := WizardForm.MainPanel.Width;
SplashImage.Height := WizardForm.Bevel.Top;
SplashImage.Parent := WizardForm.InnerPage;
SplashImage.Stretch := True;
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_'+inttostr(bmp[1])+'.bmp'));
SplashImage.Hide;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then
begin
WizardForm.StatusLabel.Caption := 'Распаковка слайдов ...';
for z:=2 to N do ExtractTemporaryFile('Image_'+inttostr(bmp[z])+'.bmp');
end;
end;

procedure CurPageChanged(CurPageID: Integer);
var
pfunc: LongWord;
begin
if (CurPageID = wpInstalling) then
begin
pfunc := WrapTimerProc(@OnTimer, 5);
TimerID := SetTimer(0, 0, 1000, pfunc);
WizardForm.PageNameLabel.Visible := False;
WizardForm.PageDescriptionLabel.Visible := False;
WizardForm.InnerNotebook.Hide;
WizardForm.Bevel1.Hide;
WizardForm.MainPanel.Hide;
WizardForm.PageNameLabel.Hide;
WizardForm.PageDescriptionLabel.Hide;
WizardForm.ProgressGauge.Show;
WizardForm.StatusLabel.Show;
SplashImage.Show;
WizardForm.CancelButton.Enabled := True;
WizardForm.CancelButton.Top := WizardForm.Bevel.Top + ScaleY(100);
end else
begin
WizardForm.ProgressGauge.Hide;
SplashImage.Hide;
WizardForm.FileNameLabel.Hide;
WizardForm.StatusLabel.Hide;
if (CurPageID > wpInstalling) and (CurPageID < wpFinished) then
begin
WizardForm.InnerNotebook.Show;
WizardForm.Bevel1.Show;
WizardForm.MainPanel.Show;
WizardForm.PageNameLabel.Show;
WizardForm.PageDescriptionLabel.Show;
end;
If CurPageID = wpFinished then
end;
end;

procedure DeInitializeSetup();
begin
KillTimer(0, TimerID);
end;


Улучшенный деинсталлятор
function ShouldSkipPage(CurPage: Integer): Boolean;
begin
if Pos('/SP-', UpperCase(GetCmdTail)) > 0 then
case CurPage of
wpLicense, wpPassword, wpInfoBefore, wpUserInfo,
wpSelectDir, wpSelectProgramGroup, wpInfoAfter:
Result := True;
end;
end;

const
WM_LBUTTONDOWN = 513;
WM_LBUTTONUP = 514;

procedure InitializeWizard();
begin
if (Pos('/SP-', UpperCase(GetCmdTail)) > 0) then
begin
PostMessage(WizardForm.NextButton.Handle,WM_LBUTTONDOWN,0,0);
PostMessage(WizardForm.NextButton.Handle,WM_LBUTTONUP,0,0);
end;
end;

procedure CurPageChanged(CurPageID: Integer);
begin
if (Pos('/SP-', UpperCase(GetCmdTail)) > 0) and
(CurPageID = wpSelectComponents) then
WizardForm.BackButton.Visible := False;
end;


//Ïðîâåðêà íà îñòàâøûåñÿ ôàéëû
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
Res: Integer;
begin
case CurUninstallStep of
usPostUninstall:
begin
if DirExists(ExpandConstant('{app}')) then
if ExpandConstant('{language}') = 'ua' then
case MsgBox('Ïàïêà "' + ExpandConstant('{app}') + '" íå ïîðîæíÿ.'#13#13 +
'"Òàê" – ïîâíå âèäàëåííÿ âñ³õ ôàéë³â ó ïàïö³, âêëþ÷àþ÷è ñàìó ïàïêó.' #13#13 +
'"ͳ" – â³äêðèòè ïàïêó â ïðîâ³äíèêó, ùîá âðó÷íó âèäàëèòè ôàéëè.'#13#13 +
'"Ñêàñóâàòè" – í³÷îãî íå ðîáèòè, âèäàëèòè ïàïêó ï³çí³øå ñàìîñò³éíî.', mbInformation, MB_YESNOCANCEL) of

IDYES:
if not DelTree(ExpandConstant('{app}'), True, True, True) then
MsgBox('Ïàïêà íå âèäàëåíà.' #13#13 'Ïàïêà àáî îäèí ç ôàéë³â ó í³é çàä³ÿí³ ³íøîþ ïðîãðàìîþ.', mbError, MB_OK);

IDNO:
if not ShellExec('open', ExpandConstant('{app}'), '', '', SW_SHOWMAXIMIZED, ewNoWait, Res) then
MsgBox('Ïîìèëêà â³äêðèòòÿ.' #13#13 'Ïàïêà íå çíàéäåíà.', mbError, MB_OK);

IDCANCEL:;
end
else
if ExpandConstant('{language}') = 'ru' then
case MsgBox('Ïàïêà "' + ExpandConstant('{app}') + '" íå ïóñòà.'#13#13 +
'"Äà" – ïîëíîå óäàëåíèå âñåõ ôàéëîâ â ïàïêå, âêëþ÷àÿ ñàìó ïàïêó.' #13#13 +
'"Íåò" – îòêðûòü ïàïêó â ïðîâîäíèêå, ÷òîáû âðó÷íóþ óäàëèòü ôàéëû.'#13#13 +
'"Îòìåíà" – íè÷åãî íå äåëàòü, óäàëèòü ïàïêó ïîçæå ñàìîñòîÿòåëüíî.', mbInformation, MB_YESNOCANCEL) of

IDYES:
if not DelTree(ExpandConstant('{app}'), True, True, True) then
MsgBox('Ïàïêà íå óäàëåíà.' #13#13 'Ïàïêà èëè îäèí èç ôàéëîâ â íåé çàäåéñòâîâàíû äðóãèì ïðèëîæåíèåì.', mbError, MB_OK);

IDNO:
if not ShellExec('open', ExpandConstant('{app}'), '', '', SW_SHOWMAXIMIZED, ewNoWait, Res) then
MsgBox('Îøèáêà îòêðûòèÿ.' #13#13 'Ïàïêà íå íàéäåíà.', mbError, MB_OK);

IDCANCEL:;
end
else
case MsgBox('Directory "' + ExpandConstant('{app}') + '" is not empty.'#13#13 +
'"Yes" to delete all of the files in the directory, including the directory itself.' #13#13 +
'"No" to open the directory with explorer to delete the files manually.'#13#13 +
'"Cancel" to do nothing and delete the directory later manually.', mbInformation, MB_YESNOCANCEL) of

IDYES:
if not DelTree(ExpandConstant('{app}'), True, True, True) then
MsgBox('Directory is not deleted.' #13#13 'Directory or one of the files are used by the other application.', mbError, MB_OK);

IDNO:
if not ShellExec('open', ExpandConstant('{app}'), '', '', SW_SHOWMAXIMIZED, ewNoWait, Res) then
MsgBox('Error opening the directory.' #13#13 'Directory is not found.', mbError, MB_OK);

IDCANCEL:;
end
end
end
end;


Реализация рисунка 497х58 в верху инсталлятора
procedure InitializeWizard();
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;

[serg aka lain]

создавать файл каждый раз вручную надоедает »
Ну, можно положить в установочный пакет готовый "desktop.ini",
насколько мне извесно, винде не важно точное расположение иконки в папке
(Serega, думаю меня поправит, или опровергнет), посему его можно заполнить сразу, и добавить в пакет установки.

[.ShellClassInfo]
IconResource=MyProg.exe
IconIndex=0

и использовать такой код:


[Setup]
AppName=My Program
AppVerName=My Program
DefaultDirName={pf}\My Program
OutputDir=userdocs:My Program.

[Dirs]
Name: "{app}"; Attribs: "readonly";

[Files]
Source: "compiler:Examples\MyProg.exe"; DestDir: "{app}"; Flags: ignoreversion;
Source: "desktop.ini"; Attribs: "system hidden"; DestDir: "{app}"; Flags: ignoreversion;

Или вариант без таскания за собой готового desktop.ini, создать его во время установки:

[Setup]
AppName=My Program
AppVerName=My Program
DefaultDirName={pf}\My Program
OutputDir=userdocs:My Program.

[Files]
Source: "compiler:Examples\MyProg.exe"; DestDir: "{app}"; Flags: ignoreversion;

[Code]
procedure CurStepChanged(CurStep: TSetupStep);
var
ErrorCode: Integer;
begin
if CurStep = ssPostInstall then
begin
SetIniString('.ShellClassInfo', 'IconResource',
ExpandConstant('{app}\MyProg.exe') + #13#10 'IconIndex=0', ExpandConstant('{app}\desktop.ini'));
Exec('attrib', ' +r ' + '"' + ExpandConstant('{app}') + '"', '', SW_HIDE, ewWaitUntilTerminated, ErrorCode);
Exec('attrib', ' +h +s ' + '"' + ExpandConstant('{app}\desktop.ini') + '"', '', SW_HIDE, ewWaitUntilTerminated, ErrorCode);
end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
if CurUninstallStep = usUninstall then
DeleteFile(ExpandConstant('{app}\desktop.ini'));
end;

[A1EXXX]

serg aka lain, первый код я вроде как пометил "альтернативкой", т.е. использование готового Desktop.ini (ну или создавать и подключать через [Files]). А второй код как раз оно :)
Но меня больше интересует избавление от ewWaitUntilTerminated в скрипте FreeArc...

Raf-9600, а ISS Joiner'ом не пробовал??

[Raf-9600]

A1EXXX, Пробовал - некатит.

[serg aka lain]

А второй код как раз оно »
Ну, хоть это радует.
меня больше интересует избавление от ewWaitUntilTerminated в скрипте FreeArc...
Понятия не имею, но, думаю придёт Serega, и обязательно поможет.

[Serega]

не знаю, как применить это в моём случае... »
Вы какую версию Inno используете? Дело в том, что для обычной версии (пробовал на 5.3.5 ansi) не получается, в момент установки вылетает ошибка, а для Restools - без проблем...
но создавать файл каждый раз вручную надоедает »
Все скрипты приходится писать руками... :)

винде не важно точное расположение иконки в папке »
Только если она расположена в корне самой папки, а не её подпапках. ;)
Serega, думаю меня поправит »
Всё правильно, я в своё время использовал все эти методы...

[A1EXXX]

Serega, у меня последняя от Restools. Для моего случая нужно использовать весь пример скрипта или этого куска достаточно? [Code]
var
ResultCode: Integer;

function IsProgRunning(ProgName: string): Boolean;
// функция определяет, запущенно ли приложение
var
Size: Integer;
begin
Result:= False;
Exec('cmd', '/c tasklist /fi "IMAGENAME eq ' + ProgName + '" >"' +
ExpandConstant('{tmp}\RunList"'), '', SW_HIDE, ewWaitUntilTerminated, ResultCode);
if FileSize(ExpandConstant('{tmp}\RunList'), Size) then
if Size > 0 then Result:= True;
end; если достаточно, то как задать задержку 200-300 мс и связать с arc.exe моего скрипта... :(

[Serega]

у меня последняя от Restools. »
Написал на основе .dll'ки, т.к. при частом запуске cmd для проверки процесса, не всегда удаётся нажать на кнопку Отмена в момент распаковки.

#define MyAppName "Test"
#define MyAppVerName "Test"
#define MyAppExeName "Test.exe"

[Setup]
AppName={#MyAppName}
AppVerName={#MyAppName}
DefaultDirName={pf}\{#MyAppName}
DirExistsWarning=no
;DisableReadyPage=true
ShowLanguageDialog=auto
OutputBaseFilename=setup
OutputDir=.
UninstallDisplayIcon={app}\{#MyAppExeName}
DefaultGroupName={#MyAppName}
InternalCompressLevel=none
Compression=none

[UninstallDelete]
Name: {app}; Type: filesandordirs

[Languages]
Name: eng; MessagesFile: compiler:Default.isl
Name: rus; MessagesFile: compiler:Languages\Russian.isl

[Files]
; измените на своё место расположение dll'ки, у меня она расположена
; C:\Program Files\Inno Setup 5\Libraries\*
Source: C:\Program Files\Inno Setup 5\Libraries\ISTask.dll; Flags: dontcopy
Source: C:\Program Files\FreeArc\bin\Arc.exe; Flags: dontcopy

[CustomMessages]
ExtrError=Произошла ошибка во время извлечения данных. Установка будет прервана.

[Code]
function RunTaskA(FileName: string; bFullpath: Boolean): Boolean;
external 'RunTask@files:ISTask.dll stdcall delayload setuponly';
function KillTaskA(ExeFileName: string): Integer;
external 'KillTask@files:ISTask.dll stdcall delayload setuponly';

// запускает указанный файл, с параметрами указанными в CmdShow
function WinExec(lpCmdLine: PChar; uCmdShow: Cardinal): Cardinal;
external 'WinExec@kernel32.dll stdcall';

var
SecondProgressBar: TNewProgressBar;
ExtractAllArc: Boolean;

procedure InitializeWizard();
begin
WizardForm.FileNameLabel.Hide;
WizardForm.StatusLabel.Top:=ScaleY(81);
WizardForm.StatusLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.StatusLabel.Width:=ScaleX(262);
WizardForm.ProgressGauge.Top:=ScaleY(100);
WizardForm.ProgressGauge.Left:=ScaleX(155);
WizardForm.ProgressGauge.Width:=ScaleX(262);

SecondProgressBar := TNewProgressBar.Create(WizardForm);
with SecondProgressBar do
begin
Parent := WizardForm.InstallingPage;
Left := ScaleX(0);
Top := ScaleY(100);
Width := ScaleX(150);
Height := ScaleY(21);
Min := 0;
Max := 13; //задается как (кол-во распаковываемых архивов * 3) + 1
end;
end;

procedure WaitProgUntilTerminated;
var
i: Integer;
begin
// проверим запустился ли файл, если нет, то
if not RunTaskA('Arc.exe', False) then
for i:= 0 to 500 do
// подождём пока файл запустится
if not RunTaskA('Arc.exe', False) then
begin
Sleep(10); // ждём максимум 5 сек.
Application.ProcessMessages;
end
else Break;
// если запущен, то ждём завершения
while RunTaskA('Arc.exe', False) do
begin
Sleep(10);
Application.ProcessMessages;
end;
end;

procedure PlsInsertNextDisk(num: Integer; CheckedFile: string);
var
Capt: string;
begin
CheckedFile:= ExpandConstant(CheckedFile);
if not FileExists(CheckedFile) then
begin
Capt:= 'Пожалуйста, вставьте диск %n, содержащий файл %f и нажмите ОК для продолжения установки.';
StringChange(Capt, '%n', inttostr(num));
StringChange(Capt, '%f', ExtractFileName(CheckedFile));
MsgBox(Capt, mbInformation, MB_OK);
PlsInsertNextDisk(num, CheckedFile);
end;
end;

procedure ExtractArc(arcArchName, arcDestDir:string);
var
ResultCode: Integer;
begin
WizardForm.StatusLabel.Caption:= SetupMessage(msgStatusExtractFiles);
// запускаем файл
ResultCode:= WinExec(AddQuotes(ExpandConstant('{tmp}\arc.exe')) + ' x ' +
AddQuotes(ExpandConstant(arcArchName)) + ' -y -dp' +
AddQuotes(ExpandConstant(arcDestDir)), SW_HIDE);

if (ResultCode < 33) then
begin
MsgBox(ExpandConstant('{cm:ExtrError}'), mbCriticalError, MB_OK);
SecondProgressBar.Hide;
if RunTaskA('Arc.exe', False) then KillTaskA('Arc.exe');
DelTree(ExpandConstant('{app}'), True, True, True);
Abort;
end
else
begin
SecondProgressBar.Position:= SecondProgressBar.Position + 3;
WaitProgUntilTerminated;
end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then
begin
WizardForm.StatusLabel.Caption:= SetupMessage(msgStatusExtractFiles);
ExtractTemporaryFile('arc.exe');
SecondProgressBar.Position:= SecondProgressBar.Position + 1;

ExtractArc('{src}\Project.arc','{app}');
ExtractArc('{src}\data-2.arc','{app}');

PlsInsertNextDisk(2, '{src}\data-3.arc'); //если data4.arc не найден в корне диска, просим второй диск
ExtractArc('{src}\data-3.arc','{app}');
ExtractArc('{src}\data-4.arc','{app}');
PlsInsertNextDisk(1, '{src}\data-1.arc'); //снова просим первый диск

ExtractAllArc:= True; // сообщим, что все архивы распаковали
end;
end;

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
if CurPageID = wpInstalling then
if ExtractAllArc then
Cancel:= True
else
if ExitSetupMsgBox then
begin
if RunTaskA('Arc.exe', False) then KillTaskA('Arc.exe');
DelTree(ExpandConstant('{app}'), True, True, True);
KillTaskA(ChangeFileExt(ExtractFileName(ParamStr(0)), '.tmp'));
end
else
Cancel:= False;
end;

[A1EXXX]

Serega, :rupor:, огромное спасибо! :up Мегареспект!!!

[JohnDes]

Добрые и знающие люди помогите пожалуйста.
Напишите скрипт в котором осуществляется проверка ип адресса компьютера и если он есть в списке, установка закрывается с ошибкой "Вам запрещено устанавливать данный продукт"
Ип чтобы был на подобии 192.168.11.22.
И их могло быть несколько. И чтобы была кнопка обратиться к администрации (кнопка вела на сайт).
Помогите пожалуйста.
Или вообще такое возможно ?

[A1EXXX]

Serega, ещё один скромный вопросик: как только начинается распаковка, прогресс-бар сразу заполняется почти наполовину http://img134.imageshack.us/img134/5907/20091123232951.th.jpg (http://img134.imageshack.us/i/20091123232951.jpg/), а до этого заполнение
было в два раза меньше :(
Это поправимо? :blush:
[hr]
Кажется разобрался :) else
begin
SecondProgressBar.Position:= SecondProgressBar.Position + 3;
WaitProgUntilTerminated;
end;
end; здесь +3 заменил на +1

[A1EXXX]

Serega, разобрался, да не совсем ))) Начинается распаковка с приемлемым заполнением, а заполняется дальше просто ужасно.... Не знаю, как тут разрулить... И ещё: можно сделать так, чтобы при нажатии "Отмена" в инсталле надпись менялась, типа "Откат изменений" или нечто подобное??? А то создаётся впечатление, что установщик завис :)
Пробовал добавить WizardForm.StatusLabel.Caption:= 'Откат изменений...'; после DelTree(ExpandConstant('{app}'), True, True, True); - если много распаковано, - не работает :(

[Serega]

разобрался, да не совсем ))) »
Переделал вам скрипт, с учётом расширенной версии. Прогрессбар при распаковке, показывает реальные значения, попробуйте:

#define MyAppName "Test"
#define MyAppVerName "Test"
#define MyAppExeName "Test.exe"

[Setup]
AppName={#MyAppName}
AppVerName={#MyAppName}
DefaultDirName={pf}\{#MyAppName}
DirExistsWarning=no
;DisableReadyPage=true
ShowLanguageDialog=auto
OutputBaseFilename=setup
OutputDir=.
UninstallDisplayIcon={app}\{#MyAppExeName}
DefaultGroupName={#MyAppName}
InternalCompressLevel=none
Compression=none

[UninstallDelete]
Name: {app}; Type: filesandordirs

[Languages]
Name: eng; MessagesFile: compiler:Default.isl
Name: rus; MessagesFile: compiler:Languages\Russian.isl

[Files]
; измените на своё место расположение dll'ки, у меня она расположена
; C:\Program Files\Inno Setup 5\Libraries\*
Source: C:\Program Files\Inno Setup 5\Libraries\ISTask.dll; Flags: dontcopy
Source: C:\Program Files\FreeArc\bin\Arc.exe; Flags: dontcopy

[CustomMessages]
ExtrError=Произошла ошибка во время извлечения данных. Установка будет прервана.

[Code]
function RunTaskA(FileName: string; bFullpath: Boolean): Boolean;
external 'RunTask@files:ISTask.dll stdcall delayload setuponly';
function KillTaskA(ExeFileName: string): Integer;
external 'KillTask@files:ISTask.dll stdcall delayload setuponly';

// запускает указанный файл, с параметрами указанными в CmdShow
function WinExec(lpCmdLine: PChar; uCmdShow: Cardinal): Cardinal;
external 'WinExec@kernel32.dll stdcall';

////////////////////////////////////////////////////////////////////////////////////
const
CountArc = 4; // количество архивов

var
SecondProgressBar: TNewProgressBar;
ExtractAllArc: Boolean;
StartPos: Integer;

procedure InitializeWizard();
begin
WizardForm.FileNameLabel.Hide;
WizardForm.StatusLabel.Top:= ScaleY(81);
WizardForm.StatusLabel.Width:= WizardForm.InnerNotebook.Width;
WizardForm.StatusLabel.Width:= ScaleX(262);
WizardForm.ProgressGauge.Top:= ScaleY(100);
WizardForm.ProgressGauge.Left:= ScaleX(155);
WizardForm.ProgressGauge.Width:= ScaleX(262);

SecondProgressBar:= TNewProgressBar.Create(WizardForm);
with SecondProgressBar do
begin
Parent:= WizardForm.InstallingPage;
SetBounds(0, 100, 150, 21);
Min:= 0;
Max:= 100;
Position:= 0;
end;
end;

procedure ParserLog;
var
in_File, out_File, S, S1: string;
i, j, n: Integer;
begin
in_File := ExpandConstant('{tmp}\in_log');
out_File := ExpandConstant('{tmp}\out_log');
// ProgressBar.Show;
// ProgressLabel.Show;
// если файла нет, то подождём... ;)
if FileExists(in_File) = False then
repeat
Application.ProcessMessages; // необходима расширенная версия от Restools
n:= n + 1;
Sleep(500); // ждём полсекунды и повторяем цикл
until (FileExists(in_File) = True) or (n = 10); // максимально повторяем цикл 10 раз, что составит 5 секунд...
// если всё же файла нет, то выходим
if FileExists(in_File) = False then Exit;
// если файл существует, то обрабатываем его
repeat
FileCopy(in_File, out_File, False); // копируем файл, чтоб можно было открыть out_File для чтения
LoadStringFromFile(out_File, S); // если попытаться загрузить in_File, то ничего не выйдет, пока в него пишет Arc.exe...
Application.ProcessMessages; // необходима расширенная версия от Restools
if Pos('%', S) > 0 then
begin
S1:= Copy(S, Length(S) - 4, (Length(S) - 2) - (Length(S) - 4));
StringChange(S1, ' ', ''); // удаляем пробелы
for i:= 0 to 100 do
if S1 = IntToStr(i) then
begin
j:= StrToInt(S1);
SecondProgressBar.Position:= StartPos + (j/CountArc);
WizardForm.StatusLabel.Caption:= 'Распаковка файлов, ждите... ' +
IntToStr(SecondProgressBar.Position)+'%';
Application.ProcessMessages; // необходима расширенная версия от Restools
end;
end;
until (Pos('Extracted', S) or Pos('ERROR', S)) > 0;
StartPos:= SecondProgressBar.Position;
// удаляем временные файлы
DelayDeleteFile(in_File, 4);
DelayDeleteFile(out_File, 4);
end;

procedure ExtractArc(arcArchName, arcDestDir:string);
var
ResultCode: Integer;
begin
// WizardForm.StatusLabel.Caption:= SetupMessage(msgStatusExtractFiles);
// запускаем файл
ResultCode:= WinExec('cmd.exe /c ' + AddQuotes(ExpandConstant('{tmp}\arc.exe')) + ' x ' +
AddQuotes(ExpandConstant(arcArchName)) + ' -y -s2 -dp' +
AddQuotes(ExpandConstant(arcDestDir)) + ' >' +
AddQuotes(ExpandConstant('{tmp}\in_log')), SW_HIDE);

if (ResultCode < 33) then
begin
MsgBox(ExpandConstant('{cm:ExtrError}'), mbCriticalError, MB_OK);
SecondProgressBar.Position:= 0;
if RunTaskA('Arc.exe', False) then KillTaskA('Arc.exe'); // теоретически не нужно, но всё же...
if DirExists(ExpandConstant('{app}')) then DelTree(ExpandConstant('{app}'), True, True, True);
Abort;
end
else ParserLog;
end;

procedure CloseSetup;
begin
WizardForm.StatusLabel.Caption:= 'Откат изменений...';
SecondProgressBar.Position:= 0;
if RunTaskA('Arc.exe', False) then KillTaskA('Arc.exe');
DelTree(ExpandConstant('{app}'), True, True, True);
// при убиваниии процесса остаётся одна папка в Temp, поэтому решил её удалить батником
SaveStringToFile(ExpandConstant('{tmp}\del.bat'), 'rd /s /q ' +
AddQuotes(ExpandConstant('{tmp}')), False);
WinExec(ExpandConstant('{tmp}\del.bat'), SW_HIDE);
KillTaskA(ChangeFileExt(ExtractFileName(ParamStr(0)), '.tmp'));
end;

procedure PlsInsertNextDisk(num: Integer; CheckedFile: string);
var
Capt: string;
begin
CheckedFile:= ExpandConstant(CheckedFile);
if not FileExists(CheckedFile) then
begin
Capt:= Format('Пожалуйста, вставьте диск №%d и нажмите ОК для продолжения установки.' + #13 +
'Если Вы нажмёте Отмена, то дальнейшая установка %s будет невозможна.', [num, '{#MyAppName}']);
// конечно для красоты лучше делать отдельную форму в виде сообщения, чтоб текст был по центру,
// но так самое простое...
if MsgBox(Capt, mbInformation, MB_OKCANCEL) = IDOK then
PlsInsertNextDisk(num, CheckedFile)
else CloseSetup;
end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then
begin
ExtractTemporaryFile('arc.exe');

ExtractArc('{src}\data-1.arc','{app}');
ExtractArc('{src}\data-2.arc','{app}');

PlsInsertNextDisk(2, '{src}\data-3.arc'); //если data3.arc не найден в корне диска, просим второй диск
ExtractArc('{src}\data-3.arc','{app}');
ExtractArc('{src}\data-4.arc','{app}');
PlsInsertNextDisk(1, '{src}\data-1.arc'); //снова просим первый диск

ExtractAllArc:= True; // сообщим, что все архивы распаковали
end;
end;

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
if CurPageID = wpInstalling then
if ExtractAllArc then
Cancel:= True
else
if ExitSetupMsgBox then
CloseSetup
else
Cancel:= False;
end;

[A1EXXX]

Serega, ваще от души!!! :up Всех зайцев убили )) Прям Рождественское чудо средь бела дня :yahoo: :)
Ещё и проценты?!!! Бомба!!! Респектище Вам за Ваши труды ;)
[hr]
Странная вещь... из двух архивов распаковался первый и запросило 2-й диск... :(

[Habetdin]

A1EXXX, //если data3.arc не найден в корне диска, просим второй диск »

[A1EXXX]

Habetdin, я понимаю, но data2.arc ещё не распаковался! + решил удовлетворить инсталл и вставил диск 2 - ничё не распаковал :( и сразу запросил 1-й...
Причиной не может быть то, что я arc'и маскирую под cab'ы? в скрипте приписать не забыл...

[Serega]

из двух архивов распаковался первый »
Поправил скрипт в предыдущем сообщении, попробуйте.

[STRELOK]

Народ как это реализовать??? Сколько не пробовал всегда траблы выходили.
http://imageban.ru/out/2009/11/24/1eb9b162026fcf085256925375fbd9a5.jpg

[Serega]

Сколько не пробовал всегда траблы выходили »
Что конкретно не получается?

[STRELOK]

Serega,
всё не получается. :-((((((((