Ветеран
Сообщения: 1133
Благодарности: 581
|
Профиль
|
Отправить PM
| Цитировать
Цитата A1EXXX:
разобрался, да не совсем ))) »
|
Переделал вам скрипт, с учётом расширенной версии. Прогрессбар при распаковке, показывает реальные значения, попробуйте:
Пример
Код: 
#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;
|