Ru-Board.club
← Вернуться в раздел «Программы»

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

Автор: Widok
Дата сообщения: 12.04.2010 10:44
Inno Setup часть 10
(часть 1, часть 2, часть 3, часть 4, часть 5, часть 6, часть 7, часть 8, часть 9)

Это мощное бесплатное средство для создания установочных пакетов (дистрибутивов) программ. Поддерживается шифрование, установка пароля, различные задачи по завершении установки.
По сравнению с NSIS (основной конкурент на бесплатной основе) проще в настройке, имеет более понятную структуру скрипта, но генерит на 200-300 кб больший инсталятор. На данный момент он конкурирует и даже превосходит многие коммерческие установщики по функциональности и стабильности.

Последний стабильный релиз: 5.3.10 [11.06.2010]
Последний стабильный Unicode релиз: 5.3.10 [11.06.2010]
Что нового? | Все сборки

Inno Setup Compiler 5.3.10 build 100707 Final - расширенная версия от ResTools (зеркало)
Inno ISCmplr Setup 5.3.10 build 100625
Добавляет списку компонентов возможность сворачивать дочерние элементы. Содержит более удобный редактор, кроме того, компилятор имеет множество других возможностей и новых функций. На сайте автора также есть дополнительные библиотеки.

Русификатор версии 5.3.10 от vadimsva

Русская справка к версии 5.0.x, автор перевода BagIra (зеркало) | cкачать в .chm формате



[more=Документация, FAQ, и различные примеры для Inno Setup]

[b]Offline InnoSetup
0.1 - Архивы веток посвященных InnoSetup форума Ru-board. Автор SotM
Предлагаю вашему вниманию оффлайн версии (в формате CHM) веток форума Inno Setup с 1-ой по 10-ую часть (незаконченная).
Для формирования этих файлов я использовал самописную свою программу (она еще в глубокой разработке). Это пока первая альфа версия. Возможно вы найдете ошибки/недочеты внутри CHM.
Часть 1 (1.2 Mb)
Часть 2 (1.2 Mb)
Часть 3 (1.6 Mb)
Часть 4 (2.3 Mb)
Часть 5 (2.6 Mb)
Часть 6 (7.2 Mb)
Часть 7 (7.3 Mb)
Часть 8 (9.0 Mb)
Часть 9 (8.8 Mb)
Часть 10 (15.3 Mb)

Inno Setup Scripting 5.1 - Руководство по расширенным возможностям Inno Setup от Kindly
Скачать


Inno Setup Extensions Knowledge Base (содержит ответы на многие вопросы) | старая chm-версия

Коллекция скриптов и Сборник вопросов, собранных из этой и предыдущих частей топика от Victor_Dobrov.

Пост с различными скриптами - Собрание различных скриптов

Сборник скриптов - Сборник скриптов от Krinkels в формате CHM.
Скачать (100 Kb)
[/more][/b] - Здесь можно найти различную документацию, примеры и т.д.

[more=Дополнительные библиотеки для Inno Setup]

[b]bass.dll
2.4.6 [09.07.2010] - библиотека для воспроизведения звука.
Описание с офф. сайта:
Цитата:
BASS is an audio library for use in Windows and Mac OSX software. Its purpose is to provide developers with powerful and efficient sample, stream (MP3, MP2, MP1, OGG, WAV, AIFF, custom generated, and more via add-ons), MOD music (XM, IT, S3M, MOD, MTM, UMX), MO3 music (MP3/OGG compressed MODs), and recording functions. All in a tiny DLL, under 100KB in size.

Внимание! У новой bass.dll измененный API, и поэтому она не работает с существующими скриптами, которые писались под версию 2.3. Вашему вниманию предлагается новый скрипт для воспроизведения музыки, который работает с новой bass.dll.
Скачать bass.dll (740 Kb) | Зеркало (560 Kb)

InnoTools Downloader 0.3.5 [15.10.2008] от Sherlock Software
Это скрипт и DLL, которые позволяют вам скачивать файлы с HTTP или FTP из вашей инсталяционной программы.
Скачать (400 Kb) | Что нового?

isSlideShow v1.02 [16.05.2010] от ExpeditorR
Это dll для показа слайд-шоу с эффектами переходов в окне Inno Setup.
В новой версии добавлена возможность выбора эффекта перехода, возможно 12 вариантов (подробнее смотрите readme.rtf). В архиве имеются два примера использования, и подробное описание. isSlideShow.dll может работать в любой версии Windows.
Скачать | Зеркало | | (список изменений)

isProgressBar v1.00 [07.12.2009] от ExpeditorR
Эта библиотека предназначена для отображения прогресс бара для длительных процессов, в которых невозможно показать прогресс бар.
В первую очередь, я думаю, она заинтересует тех, кто занимается репаками игр и использует precomp и другие программы.
Возможны 4 варианта анимации (см. пример в архиве). Так же прекрасно дружит с ISSkin.
Скачать | Зеркало

ISDone v0.4.1 [03.07.2010] от Profrager
Библиотека, включающая в себя все необходимое для распаковки и подготовки файлов с помощью прекомпрессоров посредством инсталлятора InnoSetup, с равномерным отображением всех идущих операций на одном прогрессбаре. Поддерживаются arc, 7zip, rar, pcf, srep архивы. Так же реализован запрос на необходимость вставить следующий диск. На будущее планируется добавить некоторые необходимые функции, а так же возможность параллелизации операций на многоядерных системах.
Скачать | Зеркало

is7z v1.01 [18.12.2008] от ExpeditorR
Библиотека для распаковки 7zip архивов с отображением прогресс бара в окне Inno Setup.
Скачать

isPrecomp v0.7 [15.01.2010] от Vo1T
Библиотека для отображения процентов распаковки Precomp'a в Inno Setup.
Скачать

ISWin7 v0.4.2 [04.04.2010] от Vo1T
Это плагин позволит вам сделать прозрачными края или всё окно целиком.
Работает ТОЛЬКО в Windows 7. Проверенно на всех системах.
В Windows XP и Windows Vista он пропускает инициализацию что не мешает работоспособности сетапника в этих операционных системах.
Скачать

botva2 v 0.9.2 [31.05.2010] от htuos
Библиотека для вставки изображений в инсталлятор (jpg, png, gif, tif, bmp). Присутствует возможность создания кнопок имеющих 8 состояний, а также множество разнообразных функций и процедур для работы с изображениями. В архиве (1.2 Мб) dll + примеры использования.
Ахтунг! Не работает под win9x/me/2k.
Скачать

ISFlash v 0.0.2 [17.03.2010] от Vo1T
Это плагин позволит вам добавить поддержку Adobe Flash (отображать swf файлы) в Inno Setup.
Скачать

Restools Plugins - Коллекция Restools-плагинов (16 штук) от John_White. В архиве dll + примеры использования.
Скачать (950 Kb)

Коллекция DLL файлов для Inno Setup [24.06.2010] - Содержит коллекцию DLL файлов.
Скачать (1.7 Mb) | Зеркало
В коллекцию входят следующие файлы:

Цитата:
bass.dll
bassmidi.dll
BASSMOD.dll
CallNSIS2.dll
CallWndProc.dll (удален)
ESSvcControl.dll
FirewallInstallHelper.dll
GameuxInstallHelper.dll
get_hw_caps.dll
ImgGdiPlus.dll
InnoCallback.dll
is7z.dll
ISCrypt.dll
isgsg.dll
ISHint.dll
IsProgressBar.dll
ISSkin.dll
ISSkinU.dll
isSlideShow.dll
issplash.dll (удален)
IssProc.dll
IssSurvey.dll
ISTask.dll
isxbb.dll
isxdl.dll
itdownload.dll
ittray.dll
psvince.dll
unarc.dll


Модуль распаковки архивов FreeArc от Bulat_Ziganshin | Тема FreeArc

Скрипт распаковки архивов FreeArc от Shegorat
Скачать

Тот же скрипт только немного исправленный от nik1967
Скачать

Скрипт распаковки архивов FreeArc с запросом следующего диска (FreeArcExtract+DiskPromts) v 2.6 [04.07.2010] от Shegorat
Скачать
[/more][/b] - InnoTools Downloader, коллекция DLL файлов, распаковка архивов 7-zip и FreeArc и т.д.

[more=Дополнительные утилиты для Inno Setup]
[b]Inno Setup Form Designer

Можно создавать свои собственные страницы для Inno Setup с кнопочками, списками и т.д.
К сожалению, офф. сайт (http://isfd.kaju74.de) Inno Setup Form Designer более не доступен.
Страница с зеркалами

ISTool

Мощная надстройка для Inno Setup, при помощи которой создавать свои инсталляторы становится очень просто.

Последний релиз: 5.3.0.1 [29.09.2009]
Скачать (1.2 Mb) | Русификатор (зеркало)

GameScript Generator

Простой мастер создания скрипта для установки одной или нескольких игр. В инсталлятор можно встроить музыку, слайдшоу и фоновый рисунок. Для специалистов созданный скрипт, возможно, будет неплохой заготовкой для дальнейшей модернизации.

Inno Script Generator

Прежнее название ScriptMaker. Удобная оболочка для облегчения написания скриптов установки для Inno Setup. Обладает некоторыми полезными функциями, которых нет ни у самого Inno Setup, ни у ISTool.

Последний релиз: 1.0.3.1 [23.03.2008]
Скачать | обновить (нужен QuickStartPack 5.2.3)

Inno Setup Unpacker

Распаковщик инсталляторов, созданных с помощью Inno Setup, начиная с версии 2.0.18 по 5.3.10. Извлекает ресурсы и скрипт установки (без секции Code). К Total Commander или FAR подключается с помощью MultiArc плагинов.

Последний релиз: 0.33 [05.07.2010]
Скачать

Inno Setup Unpacker, расширенная версия

Распаковщик инсталляторов Inno Setup c расширенными возможностями. Поддерживает версии Inno Setup с 2.0.8 по 5.3.10. Работает с версиями ANSI и UNICODE. Русифицирован. В архиве удобная GUI-оболочка, встраиваемая в контекстное меню.

Последний релиз: 0.33 [07.07.2010]
Скачать

InnoUnPacker

Еще один вариант распаковщика под названием InnoUnpacker. Здесь на форуме он уже пробегал, примерно в апреле 2008 г. Одна из возможностей этой программы заключается в том, что можно просмотреть содержание CompiledCode.bin в псевдоассемблерном виде.

Последний релиз: 2.6b3 от valeron87
Зеркало
Скорей всего автор больше не поддерживает данный продукт, по крайней мере можно просмотреть содержание архивов созданных в Inno Setup версии 5.2.4.

ISSkin

Программа для создания и добавления в инсталлятор кастомных скинов. Изменить можно практически любой элемент окна.
Инструкция по добавлению нужных кусков кода в скрипт (английский язык).

Последний релиз: 3.0.0.0 [19.01.2010]
Скачать

Converter REG to Inno Setup

Программа для конвертации reg-файлов в формат Inno Setup.
Поддерживаются все ключи реестра. Поддерживается удаление веток и параметров (записи вида [-ветка] и "параметр"=-).
В отличии от ISTool, ключи реестра, которые не поддерживаются в Inno Setup, записываются не как тип string, а записываются в секцию кода. Конвертируются в читаемый вид HEX данные ключей REG_EXPAND_SZ (expandsz) и REG_MULTI_SZ (multisz).

Последний релиз: 0.1.4 [12.03.2010] от Serega0675
Скачать (19 кб).

InnoSetup Script Joiner

Программа для объединения нескольких скриптов InnoSetup в один.

Примечание: Небольшие утилиты не совсем связанные с Inno Setup, но также могут пригодиться:

•    RegShot, автор Белогорохов Юрий Павлович - используется для того, чтобы узнать какие ключи реестра изменились той или иной программой.
Скачать 2.1.1.63 (230 Кb)
•    MD5 Калькулятор, автор Максименко Александр - используется для проверки внешнего файла через сумму MD5 (который описан в 5 версии руководства от Kindly) для запуска инсталлятора.
•    Калькулятор сумм MD5, SHA-256, CRC32, автор Петр Каньковски - можно вычислить хэши MD5, SHA-256, контрольную сумму CRC32 любого файла.
Скачать (15 Kb)

[/more][/b] - сюда входят различные распаковщики, надстройки над Inno Setup, различные генераторы скриптов, утилита объединения скриптов и т.д.

[more=Скрипты инсталляторов для игр]


[b]|
Скачать (зеркало) | Скриншот | Описание | Старая версия || InnoSetup Upgrade || Слайд-шоу |
Обложка для Inno Setup. Сделает инсталлятор более симпатичным и добавляет расширения: Проверка минимальных требований. Расширенный прогрессбар. Расчёт времени до завершения распаковки. Список дисков. Слайдшоу или AVI-файл в фоновом окне. Компактный режим установки. Деинсталляция неучтённых файлов. Экран справки/скриншота. Медиаплеер и многое другое...

Need for Speed™ Undercover.iss v 2.2 [Final] от YURSHAT

| Зеркало1 | | Зеркало2 | | Описание |
Вставка фоновых изображений (.jpg, .png ), встоенный AutoRun, текстурирование кнопок и прогрессБара, слайд-шоу во время установки, проверка минимальных системных требований, информация о выбранном жестком диске, проигрывание МР3 музыки, озвучка кнопок при наведении и нажатии, установка временного шрифта, распаковка архивов FreeArc, процент распаковки и оставшееся время до завершения установки, удаление игровых сохранений. Деинсталлятор также выполнен в стиле установщика (текстурированный прогрессБар, процент удаления и т.д.)

Need for Speed™ Undercover.iss v 2.6 от YURSHAT
- распаковка архивов FreeArc с запросом следующего диска (FreeArcExtract+DiskPromts).
Скачать | Зеркало

Need for Speed™ Undercover.iss v 2.2 [Final] + ISDone от YURSHAT, Profrager

| Скачать |
Добавлен Isdone. Блочная система. Главный скрипт: Need for Speed™ Undercover.iss. Обязательные скрипты: PB.iss, Messages.iss, botva2.iss. По желанию: AutoRun.iss, FreeArc.iss, ISDone.iss. В создании участвовали nik1967, K9000
[/more][/b] - В этом разделе можно найти различные обложки и скрипты инсталляторов для игр.


Родственные темы:


Inno Setup плюс внешние упаковщики - обсуждение FreeArc+Inno, Precomp+Inno, 7zip+Inno и Inno+остальные внешние упаковщики.

Пережатиe/Pекомпрессия/Oптимизация файлов для лучшего сжатия - обсуждение того, какими утилитами/способами лучше сжимать, чтобы получить как можно меньший размер инсталятора.


Примечание для всех участников

Перед тем, как задать вопрос: Первый вариант: загрузите "версию для печати" (ссылка справа вверху, над номерами страниц) и попробуйте поискать средствами браузера (ctrl+F). Второй вариант: для экономии трафика и для более удобного поиска, скачайте оффлайн версию форума для просмотра в разделе Документация.
Большинство типовых задач уже решались, причем неоднократно!

ВНИМАНИЕ!

Текст всех программ обязательно заключайте в теги [no][code][/code][/no].
Большие тексты (более 10 строк) обязательно прячутся в [no][more][/no]ВАШ ТЕКСТ и/или Ваш КОД[no][/more][/no]
Автор: molot76
Дата сообщения: 12.04.2010 11:43
Поздравляю всех с открытием 10-ой части!!!
Автор: dumanow
Дата сообщения: 12.04.2010 12:21
Вернуськ тому же риторическому вопросу скажите пожалуйста почему в скрипте Юры у меня вылазиет такая ошибка в параметре PChar это ветвь музыка что это параметр unknown
Автор: alex2605
Дата сообщения: 12.04.2010 13:01
dumanow
перед строчкой PChar поставь //


может кто-нибудь скинуть готовый срипт freearc + isprecomp?
Автор: SotM
Дата сообщения: 12.04.2010 14:17
alex2605

Цитата:
может кто-нибудь скинуть готовый срипт freearc + isprecomp?

Я думаю что с этим вопросом лучше обращаться в другую ветку форума.
Автор: Dimon2394
Дата сообщения: 12.04.2010 14:44
Как убрать вот эти строчки чтоб было просто расспаковка архивов и все.Убираю а выводит ошибку вот скрипт
http://rghost.ru/1361979
Помогите
Автор: B16
Дата сообщения: 12.04.2010 16:19
Вопросик: Собрал инсталлятор патча на Bad Company 2, с прекомпом(можете думать, что я болван, но выписывал кучу файлов), пакетной обработке ещё не научился. Так вот, хочется, что бы путь прописывался сам.
В справке нашёл:
Вопрос: Мне нужно, чтобы инсталлятор искал в реестре ключ, копировал оттуда значение пути, а потом просто устанавливал этот путь как "корневой" для установочных файлов. Окно выбора папки для установки при этом выводиться ВООБЩЕ не должно (если значения в реестре нет - инсталлятор просто завершает работу).
Ответ: [Setup]
DefaultDirName={reg:HKLM\Software\My Program, Path}

где будет браться путь из HKLM\Software\My Program , где ключ обозван Path , где в ключе Path хранится путь до того, что тебе надо.
Вот как отключить окно выбора пути установки:

[Setup]
DefaultDirName={pf}\My Program
DisableDirPage=yes

Если же тебе надо, чтобы при отсутствии пути в реестре установка отменялась, то тебе надо задать проверку в реестре наличия ключа Path. Хотя я допускаю, что возможно, если установка не найдет этот ключ в реестре, то она в любом случае отменит сама себя.
----------------------------------
Вот, что у меня: HKLM\SOFTWARE\Electronic Arts\Battlefield Bad Company 2 ключ реестра, это - DefaultDirName={reg:HKLM\SOFTWARE\Electronic Arts\Battlefield Bad Company 2, 'Install Dir'} не пашет. Путь совершенно пустой.
Я пока не хочу отключать панель выбора пути. Хотя бы так разобраться.
Автор: GhoSt_1616
Дата сообщения: 12.04.2010 16:21
Люди, наконец-то написал рабчий скрипт (пока что только с Фриарком) есть небольшая проблема:

1 Деинсталяция почему-то выбивает ошибку

2 Как сделать так, чтобы галочка установки доп ПО была активна по умолчанию. Вот скрин

Вот http://rapidshare.com/files/374992324/____ASSASSIN.rar.html собственно сам скрипт+доп файлы, помогите пожалуйста, побыстрее. Репак должен быть готов сегодня к 20:00 по Москве
Автор: Betauser RC
Дата сообщения: 12.04.2010 17:12

Inno Setup Unpacker 0.30
[more=release history]
Цитата:
Fixed issue with password processing for Unicode versions.
Added support for IS versions 5.3.9 (both ANSI and Unicode).
Added support for LZMA2 compression, introduced in 5.3.9.
[/more]
Автор: vint56
Дата сообщения: 12.04.2010 18:10
GhoSt_1616
Деинсталяция вот так должно быть
Source: Files\ISSkin.dll; DestDir: {app}; Flags: ignoreversion;
Source: Files\Tiger.cjstyles; DestDir: {app}; Flags: ignoreversion;
найди четбокс который отвечает за доб по и поменяй значение
False на True
пример где менять
Checked:=True;
end;
Автор: skeptik_vdm
Дата сообщения: 12.04.2010 18:14
B16
Так пойдет?
[more=Код][Setup]
AppName=GetDeviceInfo
AppVerName=GetDeviceInfo
DefaultDirName={code:GetInstallDir}

[Code]
Function GetInstallDir( AppID: String ): String; var dir: String;
begin
if not RegQueryStringValue(HKLM, 'SOFTWARE\Company\ProgramNamePro', 'InstallLocation', dir) then
    RegQueryStringValue(HKLM, 'SOFTWARE\Company\ProgramNameLight', 'InstallLocation', dir);
Result:= dir;
end;

function InitializeSetup(): Boolean;
begin
Result:= True;
if not RegKeyExists(HKLM, 'SOFTWARE\Company\ProgramNamePro') then
begin
if not RegKeyExists(HKLM, 'SOFTWARE\Company\ProgramNameLight') then
begin
MsgBox('Программа не найдена!', mberror, mb_ok);
Result:=False;
exit;
end
end
end;
[/more]
Автор: B16
Дата сообщения: 12.04.2010 18:37
skeptik_vdm Огромное спасибо.
Работает.
Автор: alex2605
Дата сообщения: 12.04.2010 19:12
GhoSt_1616
2)найди в своем скрипте вот этот код:

Код: DirectX:= TCheckBox.Create(WizardForm);
with DirectX do
begin
Parent:= WizardForm.SelectDirPage;
Left:= ScaleX(65);
Top:= ScaleY(340);
Width:= ScaleX(14);
Height:= ScaleY(14);
TabOrder:= 0;
Checked:= False;
end;
Автор: RKW
Дата сообщения: 12.04.2010 19:36
Ну помогите плиз!

Цитата:
Может кто-нибудь доработать [more=скрипт]
Код: #define AppRunningFile "{app}\MyGame.exe"
#define AppName "MyGame"
#define AppVerName "MyGame"
#define NeedSize "1000"
#define PB_ImageFile "progress1.bmp"
#ifdef UNICODE
#define PStr "AnsiString"
#else
#define PStr "String"
#endif


[Setup]
SourceDir=.
OutputDir=Setup
AppName={#AppName}
AppVerName={#AppVerName}
AllowNoIcons=yes
CreateUninstallRegKey=yes
Compression=none
FlatComponentsList=no
DefaultDirName={pf}\{#AppName}
DefaultGroupName=Packers\{#AppName}
DiskSpanning=yes
DiskSliceSize=300000000
OutputBaseFilename=setup
WindowVisible=no
WindowShowCaption=no
WindowResizable=no
SolidCompression=yes
SlicesPerDisk=1
Uninstallable=yes
WizardImageFile=WizardImage.bmp
WizardSmallImageFile=WizardSmallImage.bmp

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

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: button.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: black_folder.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: logo.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: background.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: progress1.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: compiler:unarc.dll; DestDir: {tmp}; Flags: dontcopy deleteafterinstall
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: compiler:Tiger.cjstyles; DestDir: {tmp}; Flags: dontcopy
Source: compiler:ISSkin.dll; DestDir: {app}; Flags: dontcopy

[UninstallDelete]
Type: filesandordirs; Name: {app}
Type: files; Name: "{commondesktop}\{#AppName}.lnk"

[Icons]
Name: {group}\{#AppName}; Filename: {#AppRunningFile}; WorkingDir: {app};
Name: {group}\Удалить '{#AppName}'; Filename: {uninstallexe}; WorkingDir: {app};
Name: {commondesktop}\{#AppName}; Filename: {#AppRunningFile}; WorkingDir: {app} Check: CreateIcons


[Run]
Filename: "{#AppRunningFile}"; Description: "{cm:LaunchProgram,{#AppName}}"; Flags: postinstall skipifsilent


[CustomMessages]
rus.BUT=Установить
rus.SPACE=Доступно места на диске:
rus.SPACE1=Требуется места на диске:
rus.ArcBreak=Установка прервана!
rus.ExtractedInfo=Распаковано %1 Мб из %2 Мб
rus.StatusInfo=Файлов: %1%2, %3%% выполнено, осталось ждать %4
rus.ArcInfo=Архив %1 из %2, объём %3 из %5, %4%% обработано
rus.ArcFinish=Распаковано архивов: %1, получено файлов: %2 [%3]
rus.ArcTitle=Установка...
rus.ArcError=Распаковщик FreeArc вернул код ошибки: %1
rus.ArcFail=Установка не завершена!
rus.AllProgress=Общий прогресс установки: %1%%
rus.ArcBroken=Возможно, архив %1 повреждён%nили недостаточно места на диске назначения.
rus.Extracting=Распаковывается: %1
rus.taskbar=%1%%, подождите %2
rus.remains=Осталось ждать %1
rus.ending=завершение
rus.hour= часов
rus.min= мин
rus.sec= сек

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

const
ButtonWidth = 80; //Указываем размер кнопок
ButtonHeight = 23;

bidBack = 0;
bidNext = 1;
bidCancel = 2;
bidDirBrowse = 3;
bidGroupBrowse = 4;
bidbtnCancelUnpacking = 5;

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

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

var
ButtonPanel: array [0..4] of TPanel;
ButtonImage: array [0..4] of TBitmapImage;
ButtonLabel: array [0..4] of TLabel;

TimerID: LongWord;
intOldCurrWidth : Integer;
ProgressBar_BitmapImage: TBitmapImage;
ProgressBar_Edit : TEdit;
ProgressBar_ImageHeight : integer;

btnCancelUnpacking: TButton;

LanguageLabel1: TLabel;
LanguageLabel2: TLabel;

rus: Boolean;
pnl_ru, pnl_us: TPanel;

PlayButton, PauseButton, StopButton: TPanel;
PlayImage, PauseImage: TBitmapImage;
PlayLabel, PauseLabel: TLabel;
MouseLabel: Tlabel;

Welcome, Parameters, StartMenu, Installing, Finish,

IconsLabel, NoIconsLabel, DirectXLabel, GroupLabel,
SelectDirLabel, SelectDirBrowseLabel,
PageNameLabel1, PageNameLabel2, PageNameLabel3,
PageDescriptionLabel1, PageDescriptionLabel2, PageDescriptionLabel3,
StatusLabel, FilenameLabel, NeedSpaceLabel,FreeSpaceLabel,
WelcomeLabel1, WelcomeLabel2, WelcomeLabel3,FinishedLabel, FinishedHeadingLabel,
SelectStartMenuFolderLabel, SelectStartMenuFolderBrowseLabel, ReadyLabel, NoIconsLabel: TLabel;
DirectX, Icons, NoIconsCheck, Group: TCheckBox;
NeedSize:Integer;
FreeMB, TotalMB: Cardinal;
BmpFile: TBitmapImage;


//************************************************ [Начало - Текстуры кнопок] ***************************************************//

procedure ButtonLabelClick(Sender: TObject);
var
Button: TButton;
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
case TLabel(Sender).Tag of
bidBack: Button:=WizardForm.BackButton
bidNext: Button:=WizardForm.NextButton
bidCancel: Button:=WizardForm.CancelButton
bidDirBrowse: Button:=WizardForm.DirBrowseButton
bidGroupBrowse: Button:=WizardForm.GroupBrowseButton
else
Exit
end
Button.OnClick(Button)
end;

procedure ButtonLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ButtonLabel[TLabel(Sender).Tag].Enabled then
ButtonImage[TLabel(Sender).Tag].Left:=-ButtonWidth
end;

procedure ButtonLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
end;

procedure LoadButtonImage(AButton: TButton; AButtonIndex: integer);
var
Image: TBitmapImage;
Panel: TPanel;
Labl: TLabel;

begin
Panel:=TPanel.Create(WizardForm)
Panel.Left:=AButton.Left
Panel.Top:=AButton.Top
Panel.Width:=AButton.Width
Panel.Height:=AButton.Height
Panel.Tag:=AButtonIndex
Panel.Parent:=AButton.Parent
ButtonPanel[AButtonIndex]:=Panel

Image:=TBitmapImage.Create(WizardForm) //Рисунок который ложится на кнопку
Image.Width:=160 //Обязательно прописать оригинальный размер рисунка
Image.Height:=23
Image.Enabled:=False
Image.Bitmap.LoadFromFile(ExpandConstant('{tmp}\button.bmp'))
Image.Parent:=Panel
ButtonImage[AButtonIndex]:=Image

with TLabel.Create(WizardForm) do begin
Tag:=AButtonIndex
Parent:=Panel
Width:=Panel.Width
Height:=Panel.Height
Transparent:=True
OnClick:=@ButtonLabelClick
OnDblClick:=@ButtonLabelClick
OnMouseDown:=@ButtonLabelMouseDown
OnMouseUp:=@ButtonLabelMouseUp
end

Labl:=TLabel.Create(WizardForm) //Текст кнопок
Labl.Left:=13 //Указываем положение текста
Labl.Top:=5
Labl.Autosize:=True
Labl.Alignment:=taCenter
Labl.Tag:=AButtonIndex
Labl.Transparent:=True
Labl.Font.Color:=clWhite //Цвет текста
Labl.Caption:=AButton.Caption
Labl.OnClick:=@ButtonLabelClick
Labl.OnDblClick:=@ButtonLabelClick
Labl.OnMouseDown:=@ButtonLabelMouseDown
Labl.OnMouseUp:=@ButtonLabelMouseUp
Labl.Parent:=Panel
ButtonLabel[AButtonIndex]:=Labl
end;

procedure UpdateButton(AButton: TButton;AButtonIndex: integer);
begin
ButtonLabel[AButtonIndex].Caption:=AButton.Caption
ButtonPanel[AButtonIndex].Visible:=AButton.Visible
ButtonLabel[AButtonIndex].Enabled:=Abutton.Enabled
end;

procedure LicenceAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=True
end;

procedure LicenceNotAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=False
end;

procedure CurPageChanged1(CurPageID: Integer);
begin
UpdateButton(WizardForm.BackButton,bidBack)
UpdateButton(WizardForm.NextButton,bidNext)
UpdateButton(WizardForm.CancelButton,bidCancel)
end;

procedure InitializeWizard1();
begin
WizardForm.BackButton.Width:=ButtonWidth
WizardForm.BackButton.Height:=ButtonHeight

WizardForm.NextButton.Width:=ButtonWidth
WizardForm.NextButton.Height:=ButtonHeight

WizardForm.CancelButton.Width:=ButtonWidth
WizardForm.CancelButton.Height:=ButtonHeight

WizardForm.DirBrowseButton.Left:=337
WizardForm.DirBrowseButton.Width:=ButtonWidth
WizardForm.DirBrowseButton.Height:=ButtonHeight

WizardForm.GroupBrowseButton.Left:=337
WizardForm.GroupBrowseButton.Width:=ButtonWidth
WizardForm.GroupBrowseButton.Height:=ButtonHeight

WizardForm.LicenseAcceptedRadio.OnClick:=@LicenceAcceptedRadioOnClick

WizardForm.LicenseNotAcceptedRadio.OnClick:=@LicenceNotAcceptedRadioOnClick

ExtractTemporaryFile('button.bmp')
LoadButtonImage(WizardForm.BackButton,bidBack)
LoadButtonImage(WizardForm.NextButton,bidNext)
LoadButtonImage(WizardForm.CancelButton,bidCancel)
LoadButtonImage(WizardForm.DirBrowseButton,bidDirBrowse)
LoadButtonImage(WizardForm.GroupBrowseButton,bidGroupBrowse)
end;

//************************************************ [Конец - Текстуры кнопок] ***************************************************//

//************************************************ [Начало - Чёрный инсталл] ***************************************************//
procedure InitializeWizard2();
begin
with WizardForm do begin
with MainPanel do
Height := Height - 1;
with WizardSmallBitmapImage do begin
Left := 0;
Top := 0;
Height := 55; //Размер рисунка
Width := 483; //
end;
with PageNameLabel do begin
Font.Name := 'Tahoma'
Width := Width - 483; //Поставьте здесь значения на 0, если хотите вернуть текст
Left := Left + 483; //
end;
with PageDescriptionLabel do begin
Font.Name := 'Tahoma'
Width := Width - 483; //Поставьте здесь значения на 0, если хотите вернуть текст
Left := Left + 483; //
end;
end;
end;

const
Color = clblack;

procedure InitializeWizard3();
begin
WizardForm.PageNameLabel.Font.Color:=clWhite;
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.TypesCombo.Color:=Color;
WizardForm.WelcomeLabel1.Color:=Color;
WizardForm.InfoBeforeClickLabel.Color:=Color;
WizardForm.MainPanel.Color:=Color;
WizardForm.PageNameLabel.Color:=Color;
WizardForm.PageDescriptionLabel.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.FilenameLabel.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.UserInfoNameLabel.Color:=Color;
WizardForm.UserInfoNameEdit.Color:=Color;
WizardForm.UserInfoOrgLabel.Color:=Color;
WizardForm.UserInfoOrgEdit.Color:=Color;
WizardForm.PreparingLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Color:=Color;
WizardForm.UserInfoSerialLabel.Color:=Color;
WizardForm.UserInfoSerialEdit.Color:=Color;
WizardForm.TasksList.Color:=Color;
WizardForm.RunList.Color:=Color;
WizardForm.SelectDirBrowseLabel.Color:=Color;
WizardForm.SelectStartMenuFolderBrowseLabel.Color:=Color;
end;

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

//************************************************ [Начало - Папка, лого, картинки] ***************************************************//
procedure InitializeWizard4();
begin
ExtractTemporaryFile('black_folder.bmp');
WizardForm.SelectDirBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\black_folder.bmp'));
WizardForm.SelectDirBitmapImage.AutoSize:=true;
WizardForm.SelectGroupBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\black_folder.bmp'));
WizardForm.SelectGroupBitmapImage.AutoSize:=true;
end;

var
LogoImage:TBitmapImage;
LogoLabel: TLabel;
LogoPanel: TPanel;

procedure LogoOnClick(Sender: TObject);
var ReturnCode: Integer;
begin
ShellExec('open', 'http://сайт.ру', '', '', SW_SHOWNORMAL, ewNoWait, ReturnCode)
end;

procedure InitializeWizard5();
begin
ExtractTemporaryFile('logo.bmp');
LogoPanel := TPanel.Create(WizardForm);
with LogoPanel do
begin
Parent := WizardForm;
Left := ScaleX(5);
Top := ScaleY(320);
Width := ScaleX(161);
Height := ScaleY(36);
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;
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:=@LogoOnClick;
end;
end;


procedure InitializeWizard6();
begin
ExtractTemporaryFile('background.bmp');

BmpFile:= TBitmapImage.Create(WizardForm);
BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\background.bmp'));
BmpFile.SetBounds(0, 0, 483, 313);
BmpFile.Stretch:= true
BmpFile.Parent:= WizardForm.WelcomePage;

with WizardForm do
begin
WelcomeLabel1.Hide;
WelcomeLabel2.hide;
end;

WelcomeLabel1:= TLabel.Create(WizardForm);
with WelcomeLabel1 do
begin
WelcomeLabel1.Alignment:=taCenter;
Left:= ScaleX(176);
Top:= ScaleY(66);
Width:= ScaleX(301);
Height:= ScaleY(71);
AutoSize:= false;
Transparent:= true;
WordWrap:= true;
Font.Name:='Arial'
Font.Size:= 12;
Font.Color:=ClWhite
Parent:= WizardForm.WelcomePage;
Caption:= WizardForm.WelcomeLabel1.Caption;
end;

WelcomeLabel2:=TLabel.Create(WizardForm);
with WelcomeLabel2 do
begin
WelcomeLabel2.Alignment:=taCenter;
Top:= ScaleY(136);
Left:= ScaleX(176);
Width:= ScaleX(301);
Height:= ScaleY(300);
AutoSize:= false;
WordWrap:= true;
Font.Color:=ClWhite
Font.Name:='Tahoma'
Transparent:= true;
Parent:= WizardForm.WelcomePage;
Caption:= WizardForm.WelcomeLabel2.Caption;
end;
end;

//************************************************ [Конец - Папка, лого, картинки] ***************************************************//

//************************************************ [Начало - Скин] ***************************************************//

procedure LoadSkin(lpszPath: {#PStr}; lpszIniFileName: {#PStr});
external 'LoadSkin@files:isskin.dll stdcall delayload setuponly';

procedure LoadSkinUninst(lpszPath: {#PStr}; lpszIniFileName: {#PStr});
external 'LoadSkin@{tmp}\isskin.dll stdcall delayload uninstallonly';

procedure UnloadSkin();
external 'UnloadSkin@files:isskin.dll stdcall delayload setuponly';

procedure UnloadSkinUninst();
external 'UnloadSkin@{tmp}\isskin.dll stdcall delayload uninstallonly';

function ShowWindow(hWnd: Integer; uType: Integer): Integer;
external 'ShowWindow@user32.dll stdcall';

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

function InitializeUninstall(): Boolean;
begin
FileCopy(ExpandConstant('{app}\isskin.dll'), ExpandConstant('{tmp}\isskin.dll'), True);
FileCopy(ExpandConstant('{app}\Tiger.cjstyles'), ExpandConstant('{tmp}\Tiger.cjstyles'), True);
LoadSkinUninst(ExpandConstant('{tmp}\Tiger.cjstyles'), '');
Result := True;
end;

procedure DeinitializeUninstall();
begin
UnloadSkinUninst();
end;

//************************************************ [Конец - Скин] ***************************************************//


//************************************************ [Начало - Прогресс бар] ***************************************************//

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';

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
if CurPageID = wpInstalling then
ProgressBar_Edit.Show;
end;

procedure OnTimer(HandleW, msg, idEvent, TimeSys: LongWord);
var
CurrWidth : single;
begin
with WizardForm.ProgressGauge do
begin
CurrWidth := ( Position * Width ) / Max;
if intOldCurrWidth <> Round( CurrWidth ) then
begin
intOldCurrWidth := Round( CurrWidth );
ProgressBar_BitmapImage.SetBounds( 0, 0, intOldCurrWidth, ProgressBar_ImageHeight );
ProgressBar_BitmapImage.Show();
end;
end;
end;

procedure CurPageChanged4(CurPageID: Integer);
var
pfunc: LongWord;
begin
if CurPageID = wpInstalling then
begin
pfunc := WrapTimerProc( @OnTimer, 4 );
TimerID := SetTimer( 0, 0, 100, pfunc );
intOldCurrWidth := 0;
end;

if CurPageID = wpFinished then
KillTimer( 0, TimerID );
end;

Procedure InitializeWizard7();
begin
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 := 10789024;
Parent := WizardForm.InstallingPage;
end;

ExtractTemporaryFile( '{#PB_ImageFile}' );
ProgressBar_BitmapImage := TBitmapImage.Create( WizardForm );
with ProgressBar_BitmapImage do
begin
Bitmap.LoadFromFile( ExpandConstant( '{tmp}\' ) + '{#PB_ImageFile}' );
Parent := ProgressBar_Edit;
Stretch := True;
Hide;
end;

ProgressBar_ImageHeight := ProgressBar_Edit.Height - 2;
WizardForm.ProgressGauge.Hide;
end;

procedure DeinitializeSetup();
begin
KillTimer( 0, TimerID );
ShowWindow(StrToInt(ExpandConstant('{wizardhwnd}')), 0);
UnloadSkin();

end;

//************************************************ [Конец - Прогресс бар] ***************************************************//

//************************************************ [Начало - FreeArc] ***************************************************//

type
#ifdef UNICODE ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup
#define A "W"
#else
#define A "A" ; точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
PAnsiChar = PChar; // Required for Inno Setup 5.3.0 and higher. (требуется для Inno Setup версии 5.3.0 и ниже)
#endif
#if Ver < 84018176
AnsiString = String; // There is no need for this line in Inno Setup 5.2.4 and above (для Inno Setup версий 5.2.4 и выше эта строка не нужна)
#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; OrigSize: Integer; Size: Extended; end;

var
FileNamelbl, ExtractFile: TLabel;
lblExtractFileName: TLabel;
CancelCode, n, UnPackError, StartInstall: Integer;
Arcs: array of TArc;
msgError: string;
lastMb: Integer;
baseMb: Integer;
totalUncompressedSize: Integer; // total uncompressed size of archive data in mb
LastTimerEvent: DWORD;

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';

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, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';

function GetTickCount: DWord; external 'GetTickCount@kernel32';
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, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;

function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') 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;

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

// OnClick event function for btnCancel
procedure btnCancelUnpackingOnClick(Sender: TObject);
begin
if MsgBox( SetupMessage( msgExitSetupMessage ), mbInformation, MB_YESNO ) = IDYES then
CancelCode:= -127;
end;

var origsize: Integer;
// The callback function for getting info about FreeArc archive
function 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' then else
Result:= CancelCode;
end;

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

// Scans the specified folders for archives and add them to list
function 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)) + FSR.Name;
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;

// Sets the 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
// Конвертирует милисекунды в человеко-читаемое изображение времени
Function TicksToTime(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 function for unpacking FreeArc archives
function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
percents, Remaining: Integer;
s: String;
begin
if GetTickCount - LastTimerEvent > 1000 then begin
// This code will be executed once each 1000 ms (этот код будет выполняться раз в 1000 миллисекунд)
// ....
// End of code executed by timer
LastTimerEvent := LastTimerEvent+1000;
end;

if string(what)='filename' then begin
// Update FileName label
lblExtractFileName.Caption:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
end else if (string(what)='write') and (totalUncompressedSize>0) and (Mb>lastMb) then 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.Position:= 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 := s + '. '+FmtMessage(cm('ArcInfo'), [IntToStr(n+1), IntToStr(GetArrayLength(Arcs))])
ExtractFile.Caption := 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:= s + '. '+FmtMessage(cm('remains'), [TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)])
SetTaskBarTitle(FmtMessage(cm('taskbar'), [IntToStr(percents/10), TicksToTime(Remaining, 'h', 'm', 's', false)]))
end;
FileNameLbl.Caption := s
end;
AppProcessMessage;
Result:= CancelCode;
end;

// Extracts all found archives
function UnPack(Archives: string): Integer;
var
totalCompressedSize: Extended;
callback: longword;
FreeMB, TotalMB: Cardinal;
begin
// Display 'Extracting FreeArc archive'
lblExtractFileName.Caption:= '';
lblExtractFileName.Show;
ExtractFile.caption:= cm('ArcTitle');
ExtractFile.Show;
FileNamelbl.Caption:= '';
FileNamelbl.Show;

// Show the 'Cancel unpacking' button and set it as default button
btnCancelUnpacking.Caption:= WizardForm.CancelButton.Caption;
btnCancelUnpacking.Show;
LoadButtonImage(btnCancelUnpacking,bidbtnCancelUnpacking);
ButtonLabel[bidbtnCancelUnpacking].Left := ButtonPanel[bidbtnCancelUnpacking].Width div 2 - ButtonLabel[bidbtnCancelUnpacking].Width div 2;
ButtonLabel[bidbtnCancelUnpacking].Top := ButtonPanel[bidbtnCancelUnpacking].Height div 2 - ButtonLabel[bidbtnCancelUnpacking].Height div 2;
WizardForm.ActiveControl:= btnCancelUnpacking;
WizardForm.ProgressGauge.Position:= 0;
// Get the size of all archives
totalUncompressedSize := 0;
totalCompressedSize := FindArcs(Archives);
WizardForm.ProgressGauge.Max:= totalUncompressedSize;
// Other initializations
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
StartInstall:= GetTickCount; {время начала распаковки}
LastTimerEvent:= GetTickCount;
baseMb:= 0

for n:= 0 to GetArrayLength(Arcs) -1 do
begin
lastMb := 0
CancelCode:= 0;
AppProcessMessage;
try
// Pass the specified arguments to 'unarc.dll'
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', AnsiToUtf8(Arcs[n].Path), '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
except
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#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;
// Hide labels and button
FileNamelbl.Hide;
lblExtractFileName.Hide;
ExtractFile.Hide;
btnCancelUnpacking.Hide;
ButtonPanel[bidbtnCancelUnpacking].Hide;
ButtonImage[bidbtnCancelUnpacking].Hide;
ButtonLabel[bidbtnCancelUnpacking].Hide;
end;

procedure CurStepChanged2(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then
begin
FileNameLabel.Hide
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.Caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
end;
end;
end;

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

Procedure CurPageChanged5(CurPageID: Integer);
Begin
if (CurPageID = wpFinished) and (UnPackError <> 0) then
begin // Extraction was unsuccessful (распаковщик вернул ошибку)
// Show error message
FinishedHeadingLabel.Caption:= ExpandConstant('{cm:Finished4}');
FinishedLabel.Caption:= SetupMessage(msgSetupAborted)+#13#13+ExpandConstant('{cm:Finished3}');
end;
End;

procedure InitializeWizard8();
begin
with WizardForm.ProgressGauge do
begin
// Create a label to show current FileName being extracted
lblExtractFileName:= TLabel.Create(WizardForm);
lblExtractFileName.parent:=WizardForm.InstallingPage;
lblExtractFileName.autosize:=false;
lblExtractFileName.Left:= ScaleX(65);
lblExtractFileName.Top:= ScaleY(510);
lblExtractFileName.Width:= ScaleX(625);
lblExtractFileName.Height:= ScaleY(20);
lblExtractFileName.Caption:= '';
lblExtractFileName.Transparent := True;
lblExtractFileName.Font.Name:= 'Georgia'
lblExtractFileName.Font.Size:= 9;
lblExtractFileName.Font.Style:= [fsBold, fsItalic];
lblExtractFileName.Hide;

// Create a label to show percentage
ExtractFile:= TLabel.Create(WizardForm);
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Left:= ScaleX(82);
ExtractFile.Top:= ScaleY(555);
ExtractFile.Width:= ScaleX(625);
ExtractFile.Height:= ScaleY(20);
ExtractFile.Alignment := taCenter;
ExtractFile.caption:= '';
ExtractFile.Transparent := True;
ExtractFile.Font.Name:= 'Georgia'
ExtractFile.Font.Size:= 9;
ExtractFile.Font.Style:= [fsBold, fsItalic];
ExtractFile.Hide;

FileNamelbl:= TLabel.Create(WizardForm);
FileNamelbl.parent:=WizardForm.InstallingPage;
FileNamelbl.autosize:=false;
FileNamelbl.Left:= ScaleX(82);
FileNamelbl.Top:= ScaleY(570);
FileNamelbl.Width:= ScaleX(625);
FileNamelbl.Height:= ScaleY(20);
FileNamelbl.Alignment := taCenter;
FileNamelbl.caption:= '';
FileNamelbl.Transparent := True;
FileNamelbl.Font.Name:= 'Georgia'
FileNamelbl.Font.Size:= 9;
FileNamelbl.Font.Style:= [fsBold, fsItalic];
FileNamelbl.Hide;
end;

// Create a 'Cancel unpacking' button and hide it for now.
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;

//************************************************ [Конец - FreeArc] ***************************************************//

procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged1(CurPageID);
CurPageChanged4(CurPageID);
CurPageChanged5(CurPageID);
end;

procedure InitializeWizard();
begin
InitializeWizard1();
InitializeWizard2();
InitializeWizard3();
InitializeWizard4();
InitializeWizard5();
InitializeWizard6();
InitializeWizard7();
InitializeWizard8();
end;
end.

[/more]? Убрать лишнее и сделать, чтобы ФриАрк архивы распаковывались. А то ни в какую не хотят А вроде бы должны, ведь скрипт нормальный, всё есть... Короче, помогите плиз
Автор: dumanow
Дата сообщения: 12.04.2010 20:03
помогите пожалста скрипт Юршата пишет внутреняя ошибка extract temporarey file :the file ru.bmp was not found это блок язык игры как это исправить и что это за картинка ru.bmp
Автор: alex2605
Дата сообщения: 12.04.2010 20:07
GhoSt_1616

Цитата:
Люди, наконец-то написал рабчий скрипт

ой, и не хорошо брать чужие скрипты и говорить, что их написал ты
Хочешь скажу, кто настоящий автор этого скрипта?

Добавлено:
dumanow
вот эти требуемые картинки:
http://sendfile.su/82053
их пропиши в секции FILE. примерно вот так:
Source: "ru.png"; Flags: dontcopy;
Source: "us.png"; Flags: dontcopy;

Автор: dumanow
Дата сообщения: 12.04.2010 20:20
alex2605 спасибо большое ты мне очень помогаешь

Автор: molot76
Дата сообщения: 12.04.2010 21:13

Цитата:
GhoSt_1616

Цитата:
Люди, наконец-то написал рабчий скрипт

ой, и не хорошо брать чужие скрипты и говорить, что их написал ты
Хочешь скажу, кто настоящий автор этого скрипта?

Присоединяюсь к посту alex2605, люди емейте совесть , скрипты вылаживаются в свободное пользование, пользуйтесь не жалко как говорится, но совсем уж наглеть не надо чужие заслуги к себе присваивать, я думаю что YURSHAT, htuos, vint56
skeptik_vdm и другие ребята и в принципе кто пишет скрипты на проф уровне не восторге будут от этого, "обидются" и будете потом "ЛАПУ СОСАТЬ"
и да GhoSt_1616 скрипт который якобы ты написал насамом деле это NFS Undercover v1.0 + FreeArc от YURSHAT правленый тобой и выданный за свой иначе бы ты не обращался сюда за помощью по этому скрипту и не спрашивал что это за ошибка и как её исправить...
Автор: B16
Дата сообщения: 12.04.2010 21:14
RKW Вроде должен работать:

[more=Глянь сюда][no]#define AppRunningFile "{app}\MyGame.exe"
#define AppName "MyGame"
#define AppVerName "MyGame"
#define NeedSize "1000"
#define PB_ImageFile "progress1.bmp"
#ifdef UNICODE
#define PStr "AnsiString"
#else
#define PStr "String"
#endif


[Setup]
SourceDir=.
OutputDir=Setup
AppName={#AppName}
AppVerName={#AppVerName}
AllowNoIcons=yes
CreateUninstallRegKey=yes
Compression=none
FlatComponentsList=no
DefaultDirName={pf}\{#AppName}
DefaultGroupName=Packers\{#AppName}
DiskSpanning=yes
DiskSliceSize=300000000
OutputBaseFilename=setup
WindowVisible=no
WindowShowCaption=no
WindowResizable=no
SolidCompression=yes
SlicesPerDisk=1
Uninstallable=yes
WizardImageFile=WizardImage.bmp
WizardSmallImageFile=WizardSmallImage.bmp

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

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: button.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: black_folder.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: logo.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: background.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: progress1.bmp; DestDir: "{tmp}"; Flags: dontcopy
Source: compiler:unarc.dll; DestDir: {tmp}; Flags: dontcopy deleteafterinstall
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: compiler:Tiger.cjstyles; DestDir: {tmp}; Flags: dontcopy
Source: compiler:ISSkin.dll; DestDir: {app}; Flags: dontcopy

// Касаемо файлов для фриарка надо это://
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy

#ifdef precomp
;если указано, что архивы созданы с PRECOMP, в инсталлятор включаются необходимые при распаковке файлы
Source: {#precomp}; DestDir: {sys}; Flags: deleteafterinstall
Source: {#GetEnv("ProgramFiles")}\FreeArc\bin\arc.ini; DestDir: c:\; Flags: deleteafterinstall
#endif
;эта строка демонстрирует показ сведений и времени завершения при обычном извлечении файлов
Source: {win}\help\*.hlp; DestDir: {tmp}; Flags: external
;строки распаковки архивов
Source: {src}\*.arc; DestDir: {app}\; Flags: external dontcopy
{#SourceToProgress}

/////////////////////////////////////////////////////////

[UninstallDelete]
Type: filesandordirs; Name: {app}
Type: files; Name: "{commondesktop}\{#AppName}.lnk"

[Icons]
Name: {group}\{#AppName}; Filename: {#AppRunningFile}; WorkingDir: {app};
Name: {group}\Удалить '{#AppName}'; Filename: {uninstallexe}; WorkingDir: {app};
Name: {commondesktop}\{#AppName}; Filename: {#AppRunningFile}; WorkingDir: {app} Check: CreateIcons


[Run]
Filename: "{#AppRunningFile}"; Description: "{cm:LaunchProgram,{#AppName}}"; Flags: postinstall skipifsilent


[CustomMessages]
rus.BUT=Установить
rus.SPACE=Доступно места на диске:
rus.SPACE1=Требуется места на диске:
rus.ArcBreak=Установка прервана!
rus.ExtractedInfo=Распаковано %1 Мб из %2 Мб
rus.StatusInfo=Файлов: %1%2, %3%% выполнено, осталось ждать %4
rus.ArcInfo=Архив %1 из %2, объём %3 из %5, %4%% обработано
rus.ArcFinish=Распаковано архивов: %1, получено файлов: %2 [%3]
rus.ArcTitle=Установка...
rus.ArcError=Распаковщик FreeArc вернул код ошибки: %1
rus.ArcFail=Установка не завершена!
rus.AllProgress=Общий прогресс установки: %1%%
rus.ArcBroken=Возможно, архив %1 повреждён%nили недостаточно места на диске назначения.
rus.Extracting=Распаковывается: %1
rus.taskbar=%1%%, подождите %2
rus.remains=Осталось ждать %1
rus.ending=завершение
rus.hour= часов
rus.min= мин
rus.sec= сек

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

const
ButtonWidth = 80; //Указываем размер кнопок
ButtonHeight = 23;

bidBack = 0;
bidNext = 1;
bidCancel = 2;
bidDirBrowse = 3;
bidGroupBrowse = 4;
bidbtnCancelUnpacking = 5;

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

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

var
ButtonPanel: array [0..4] of TPanel;
ButtonImage: array [0..4] of TBitmapImage;
ButtonLabel: array [0..4] of TLabel;

TimerID: LongWord;
intOldCurrWidth : Integer;
ProgressBar_BitmapImage: TBitmapImage;
ProgressBar_Edit : TEdit;
ProgressBar_ImageHeight : integer;

btnCancelUnpacking: TButton;

LanguageLabel1: TLabel;
LanguageLabel2: TLabel;

rus: Boolean;
pnl_ru, pnl_us: TPanel;

PlayButton, PauseButton, StopButton: TPanel;
PlayImage, PauseImage: TBitmapImage;
PlayLabel, PauseLabel: TLabel;
MouseLabel: Tlabel;

Welcome, Parameters, StartMenu, Installing, Finish,

IconsLabel, NoIconsLabel, DirectXLabel, GroupLabel,
SelectDirLabel, SelectDirBrowseLabel,
PageNameLabel1, PageNameLabel2, PageNameLabel3,
PageDescriptionLabel1, PageDescriptionLabel2, PageDescriptionLabel3,
StatusLabel, FilenameLabel, NeedSpaceLabel,FreeSpaceLabel,
WelcomeLabel1, WelcomeLabel2, WelcomeLabel3,FinishedLabel, FinishedHeadingLabel,
SelectStartMenuFolderLabel, SelectStartMenuFolderBrowseLabel, ReadyLabel, NoIconsLabel: TLabel;
DirectX, Icons, NoIconsCheck, Group: TCheckBox;
NeedSize:Integer;
FreeMB, TotalMB: Cardinal;
BmpFile: TBitmapImage;


//************************************************ [Начало - Текстуры кнопок] ***************************************************//

procedure ButtonLabelClick(Sender: TObject);
var
Button: TButton;
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
case TLabel(Sender).Tag of
bidBack: Button:=WizardForm.BackButton
bidNext: Button:=WizardForm.NextButton
bidCancel: Button:=WizardForm.CancelButton
bidDirBrowse: Button:=WizardForm.DirBrowseButton
bidGroupBrowse: Button:=WizardForm.GroupBrowseButton
else
Exit
end
Button.OnClick(Button)
end;

procedure ButtonLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ButtonLabel[TLabel(Sender).Tag].Enabled then
ButtonImage[TLabel(Sender).Tag].Left:=-ButtonWidth
end;

procedure ButtonLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
end;

procedure LoadButtonImage(AButton: TButton; AButtonIndex: integer);
var
Image: TBitmapImage;
Panel: TPanel;
Labl: TLabel;

begin
Panel:=TPanel.Create(WizardForm)
Panel.Left:=AButton.Left
Panel.Top:=AButton.Top
Panel.Width:=AButton.Width
Panel.Height:=AButton.Height
Panel.Tag:=AButtonIndex
Panel.Parent:=AButton.Parent
ButtonPanel[AButtonIndex]:=Panel

Image:=TBitmapImage.Create(WizardForm) //Рисунок который ложится на кнопку
Image.Width:=160 //Обязательно прописать оригинальный размер рисунка
Image.Height:=23
Image.Enabled:=False
Image.Bitmap.LoadFromFile(ExpandConstant('{tmp}\button.bmp'))
Image.Parent:=Panel
ButtonImage[AButtonIndex]:=Image

with TLabel.Create(WizardForm) do begin
Tag:=AButtonIndex
Parent:=Panel
Width:=Panel.Width
Height:=Panel.Height
Transparent:=True
OnClick:=@ButtonLabelClick
OnDblClick:=@ButtonLabelClick
OnMouseDown:=@ButtonLabelMouseDown
OnMouseUp:=@ButtonLabelMouseUp
end

Labl:=TLabel.Create(WizardForm) //Текст кнопок
Labl.Left:=13 //Указываем положение текста
Labl.Top:=5
Labl.Autosize:=True
Labl.Alignment:=taCenter
Labl.Tag:=AButtonIndex
Labl.Transparent:=True
Labl.Font.Color:=clWhite //Цвет текста
Labl.Caption:=AButton.Caption
Labl.OnClick:=@ButtonLabelClick
Labl.OnDblClick:=@ButtonLabelClick
Labl.OnMouseDown:=@ButtonLabelMouseDown
Labl.OnMouseUp:=@ButtonLabelMouseUp
Labl.Parent:=Panel
ButtonLabel[AButtonIndex]:=Labl
end;

procedure UpdateButton(AButton: TButton;AButtonIndex: integer);
begin
ButtonLabel[AButtonIndex].Caption:=AButton.Caption
ButtonPanel[AButtonIndex].Visible:=AButton.Visible
ButtonLabel[AButtonIndex].Enabled:=Abutton.Enabled
end;

procedure LicenceAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=True
end;

procedure LicenceNotAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=False
end;

procedure CurPageChanged1(CurPageID: Integer);
begin
UpdateButton(WizardForm.BackButton,bidBack)
UpdateButton(WizardForm.NextButton,bidNext)
UpdateButton(WizardForm.CancelButton,bidCancel)
end;

procedure InitializeWizard1();
begin
WizardForm.BackButton.Width:=ButtonWidth
WizardForm.BackButton.Height:=ButtonHeight

WizardForm.NextButton.Width:=ButtonWidth
WizardForm.NextButton.Height:=ButtonHeight

WizardForm.CancelButton.Width:=ButtonWidth
WizardForm.CancelButton.Height:=ButtonHeight

WizardForm.DirBrowseButton.Left:=337
WizardForm.DirBrowseButton.Width:=ButtonWidth
WizardForm.DirBrowseButton.Height:=ButtonHeight

WizardForm.GroupBrowseButton.Left:=337
WizardForm.GroupBrowseButton.Width:=ButtonWidth
WizardForm.GroupBrowseButton.Height:=ButtonHeight

WizardForm.LicenseAcceptedRadio.OnClick:=@LicenceAcceptedRadioOnClick

WizardForm.LicenseNotAcceptedRadio.OnClick:=@LicenceNotAcceptedRadioOnClick

ExtractTemporaryFile('button.bmp')
LoadButtonImage(WizardForm.BackButton,bidBack)
LoadButtonImage(WizardForm.NextButton,bidNext)
LoadButtonImage(WizardForm.CancelButton,bidCancel)
LoadButtonImage(WizardForm.DirBrowseButton,bidDirBrowse)
LoadButtonImage(WizardForm.GroupBrowseButton,bidGroupBrowse)
end;

//************************************************ [Конец - Текстуры кнопок] ***************************************************//

//************************************************ [Начало - Чёрный инсталл] ***************************************************//
procedure InitializeWizard2();
begin
with WizardForm do begin
with MainPanel do
Height := Height - 1;
with WizardSmallBitmapImage do begin
Left := 0;
Top := 0;
Height := 55; //Размер рисунка
Width := 483; //
end;
with PageNameLabel do begin
Font.Name := 'Tahoma'
Width := Width - 483; //Поставьте здесь значения на 0, если хотите вернуть текст
Left := Left + 483; //
end;
with PageDescriptionLabel do begin
Font.Name := 'Tahoma'
Width := Width - 483; //Поставьте здесь значения на 0, если хотите вернуть текст
Left := Left + 483; //
end;
end;
end;

const
Color = clblack;

procedure InitializeWizard3();
begin
WizardForm.PageNameLabel.Font.Color:=clWhite;
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.TypesCombo.Color:=Color;
WizardForm.WelcomeLabel1.Color:=Color;
WizardForm.InfoBeforeClickLabel.Color:=Color;
WizardForm.MainPanel.Color:=Color;
WizardForm.PageNameLabel.Color:=Color;
WizardForm.PageDescriptionLabel.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.FilenameLabel.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.UserInfoNameLabel.Color:=Color;
WizardForm.UserInfoNameEdit.Color:=Color;
WizardForm.UserInfoOrgLabel.Color:=Color;
WizardForm.UserInfoOrgEdit.Color:=Color;
WizardForm.PreparingLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Color:=Color;
WizardForm.UserInfoSerialLabel.Color:=Color;
WizardForm.UserInfoSerialEdit.Color:=Color;
WizardForm.TasksList.Color:=Color;
WizardForm.RunList.Color:=Color;
WizardForm.SelectDirBrowseLabel.Color:=Color;
WizardForm.SelectStartMenuFolderBrowseLabel.Color:=Color;
end;

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

//************************************************ [Начало - Папка, лого, картинки] ***************************************************//
procedure InitializeWizard4();
begin
ExtractTemporaryFile('black_folder.bmp');
WizardForm.SelectDirBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\black_folder.bmp'));
WizardForm.SelectDirBitmapImage.AutoSize:=true;
WizardForm.SelectGroupBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\black_folder.bmp'));
WizardForm.SelectGroupBitmapImage.AutoSize:=true;
end;

var
LogoImage:TBitmapImage;
LogoLabel: TLabel;
LogoPanel: TPanel;

procedure LogoOnClick(Sender: TObject);
var ReturnCode: Integer;
begin
ShellExec('open', 'http://сайт.ру', '', '', SW_SHOWNORMAL, ewNoWait, ReturnCode)
end;

procedure InitializeWizard5();
begin
ExtractTemporaryFile('logo.bmp');
LogoPanel := TPanel.Create(WizardForm);
with LogoPanel do
begin
Parent := WizardForm;
Left := ScaleX(5);
Top := ScaleY(320);
Width := ScaleX(161);
Height := ScaleY(36);
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;
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:=@LogoOnClick;
end;
end;


procedure InitializeWizard6();
begin
ExtractTemporaryFile('background.bmp');

BmpFile:= TBitmapImage.Create(WizardForm);
BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\background.bmp'));
BmpFile.SetBounds(0, 0, 483, 313);
BmpFile.Stretch:= true
BmpFile.Parent:= WizardForm.WelcomePage;

with WizardForm do
begin
WelcomeLabel1.Hide;
WelcomeLabel2.hide;
end;

WelcomeLabel1:= TLabel.Create(WizardForm);
with WelcomeLabel1 do
begin
WelcomeLabel1.Alignment:=taCenter;
Left:= ScaleX(176);
Top:= ScaleY(66);
Width:= ScaleX(301);
Height:= ScaleY(71);
AutoSize:= false;
Transparent:= true;
WordWrap:= true;
Font.Name:='Arial'
Font.Size:= 12;
Font.Color:=ClWhite
Parent:= WizardForm.WelcomePage;
Caption:= WizardForm.WelcomeLabel1.Caption;
end;

WelcomeLabel2:=TLabel.Create(WizardForm);
with WelcomeLabel2 do
begin
WelcomeLabel2.Alignment:=taCenter;
Top:= ScaleY(136);
Left:= ScaleX(176);
Width:= ScaleX(301);
Height:= ScaleY(300);
AutoSize:= false;
WordWrap:= true;
Font.Color:=ClWhite
Font.Name:='Tahoma'
Transparent:= true;
Parent:= WizardForm.WelcomePage;
Caption:= WizardForm.WelcomeLabel2.Caption;
end;
end;

//************************************************ [Конец - Папка, лого, картинки] ***************************************************//

//************************************************ [Начало - Скин] ***************************************************//

procedure LoadSkin(lpszPath: {#PStr}; lpszIniFileName: {#PStr});
external 'LoadSkin@files:isskin.dll stdcall delayload setuponly';

procedure LoadSkinUninst(lpszPath: {#PStr}; lpszIniFileName: {#PStr});
external 'LoadSkin@{tmp}\isskin.dll stdcall delayload uninstallonly';

procedure UnloadSkin();
external 'UnloadSkin@files:isskin.dll stdcall delayload setuponly';

procedure UnloadSkinUninst();
external 'UnloadSkin@{tmp}\isskin.dll stdcall delayload uninstallonly';

function ShowWindow(hWnd: Integer; uType: Integer): Integer;
external 'ShowWindow@user32.dll stdcall';

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

function InitializeUninstall(): Boolean;
begin
FileCopy(ExpandConstant('{app}\isskin.dll'), ExpandConstant('{tmp}\isskin.dll'), True);
FileCopy(ExpandConstant('{app}\Tiger.cjstyles'), ExpandConstant('{tmp}\Tiger.cjstyles'), True);
LoadSkinUninst(ExpandConstant('{tmp}\Tiger.cjstyles'), '');
Result := True;
end;

procedure DeinitializeUninstall();
begin
UnloadSkinUninst();
end;

//************************************************ [Конец - Скин] ***************************************************//


//************************************************ [Начало - Прогресс бар] ***************************************************//

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';

procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
if CurPageID = wpInstalling then
ProgressBar_Edit.Show;
end;

procedure OnTimer(HandleW, msg, idEvent, TimeSys: LongWord);
var
CurrWidth : single;
begin
with WizardForm.ProgressGauge do
begin
CurrWidth := ( Position * Width ) / Max;
if intOldCurrWidth <> Round( CurrWidth ) then
begin
intOldCurrWidth := Round( CurrWidth );
ProgressBar_BitmapImage.SetBounds( 0, 0, intOldCurrWidth, ProgressBar_ImageHeight );
ProgressBar_BitmapImage.Show();
end;
end;
end;

procedure CurPageChanged4(CurPageID: Integer);
var
pfunc: LongWord;
begin
if CurPageID = wpInstalling then
begin
pfunc := WrapTimerProc( @OnTimer, 4 );
TimerID := SetTimer( 0, 0, 100, pfunc );
intOldCurrWidth := 0;
end;

if CurPageID = wpFinished then
KillTimer( 0, TimerID );
end;

Procedure InitializeWizard7();
begin
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 := 10789024;
Parent := WizardForm.InstallingPage;
end;

ExtractTemporaryFile( '{#PB_ImageFile}' );
ProgressBar_BitmapImage := TBitmapImage.Create( WizardForm );
with ProgressBar_BitmapImage do
begin
Bitmap.LoadFromFile( ExpandConstant( '{tmp}\' ) + '{#PB_ImageFile}' );
Parent := ProgressBar_Edit;
Stretch := True;
Hide;
end;

ProgressBar_ImageHeight := ProgressBar_Edit.Height - 2;
WizardForm.ProgressGauge.Hide;
end;

procedure DeinitializeSetup();
begin
KillTimer( 0, TimerID );
ShowWindow(StrToInt(ExpandConstant('{wizardhwnd}')), 0);
UnloadSkin();

end;

//************************************************ [Конец - Прогресс бар] ***************************************************//

//************************************************ [Начало - FreeArc] ***************************************************//

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

TMessage = record hWnd: HWND; msg, wParam: Word; lParam: LongWord; Time: TFileTime; pt: TPoint; end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path, Dest, comp, task: string; allMb, Files: Integer; Size: Extended; end;
TBarInfo = record stage, name: string; size, allsize: Extended; count, perc, pos, mb, time: Integer; end;
TCWPSTRUCT = record lParam: LongWord; wParam: Word; Msg: LongWord; hwnd: HWnd; end;
TCWPSTRUCTProc = procedure(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
TTimerProc = procedure(HandleW, Msg, idEvent, TimeSys: LongWord);
var
StatusLabel, FileNameLabel, ExtractFile, StatusInfo: TLabel;
ProgressBar: TNewProgressBar;
CancelCode, n, ArcInd, UnPackError, StartInstall, LastTimerEvent, lastMb, baseMb: Integer;
FreeMB, TotalMB: Cardinal;
WndHookID, TimerID: LongWord;
Arcs, Records: array of TArc;
msgError: string;
Status: TBarInfo;
FreezeTimer: Boolean;
totalUncompressedSize, origsize: Integer; // total uncompressed size of archive data in mb
Texture2, Texture: TBitmapImage;
const
PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMB=1024*1024;
Period = 250; // частота обновления кнопки таскбара и строки статуса
BackColor = $fcfbfb; EndColor = $d8e9ec; // цвета подобраны для темы Луна
VK_ESCAPE = 27;
HC_ACTION = 0;
WH_CALLWNDPROC = 4;
WM_PAINT = $F;
CancelDuringInstall = {#isFalse(SetupSetting("AllowCancelDuringInstall"))};

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';

Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

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

function GetTickCount: DWord; external 'GetTickCount@kernel32';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
function GetCurrentThreadID: LongWord; external 'GetCurrentThreadId@kernel32 stdcall delayload';
function MulDiv(Number, Numerator, Denominator: Integer): Integer; external 'MulDiv@kernel32 stdcall delayload';

function CallNextWNDPROC(idHook: LongWord; Code: Integer; wParam: Word; lParam: TCWPSTRUCT): LongWord; external 'CallNextHookEx@user32 stdcall delayload';
function SetWindowsHookEx(idHook: LongWord; callback: LongWord; hMod: LongWord; dwThreadID: HWND): LongWord; external 'SetWindowsHookExW@user32 stdcall delayload';
function UnhookWindowsHookEx(idHook: LongWord): LongWord; external 'UnhookWindowsHookEx@user32 stdcall delayload';
function WrapCWPSTRUCTProc(callback:TCWPSTRUCTProc; paramcount:integer): longword; external 'wrapcallback@files:innocallback.dll';
function WrapTimerProc(callback: TTimerProc; Paramcount: Integer): longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): longword; external 'SetTimer@user32';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32 stdcall delayload';

procedure AppProcessMessage;
var
Msg: TMessage;
begin
if not PeekMessage(Msg, {WizardForm.Handle} 0, 0, 0, PM_REMOVE) then Exit;
TranslateMessage(Msg); DispatchMessage(Msg);
end;

Function FreeArcCmd(callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer;
Begin
CancelCode:= 0; AppProcessMessage;
try
Result:= FreeArcExtract(callback, cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10); // Pass the specified arguments to 'unarc.dll'
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;
End;

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

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

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

Function StringToArray(Text, Cut: String): array of String; var i, k: Integer; // поместить строки текста в элементы массив. шаблон перевода строк может быть любым. шаблон в начале/конце текста игнорируются
Begin
SetArrayLength(Result, 0); if Cut = '' then Cut:= #1310; //если шаблон пуст, считаем переводы строк
Repeat k:= Pos(Cut,Text);
if k = 1 then begin Delete(Text, 1, Length(Cut)); CONTINUE
end;
SetArrayLength(Result, GetArrayLength(Result) +1); i:= GetArrayLength(Result) -1;
if k = 0 then
Result[i]:=Text
else begin
Result[i]:= Copy(Text, 1, k -1); Delete(Text, 1, Length(Result[i]) + Length(Cut));
end;
Until Length(Text) * k = 0;
End;

Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer; Prefs: TObject): TLabel;
Begin
Result:=TLabel.Create(Parent); Result.parent:= Parent;
if Prefs <> Nil then begin
Top:= TWinControl(Prefs).Top; Left:= TWinControl(Prefs).Left; Width:= TWinControl(Prefs).Width; Height:= TWinControl(Prefs).Height;
end;
if Top > 0 then result.Top:=Top; if Left > 0 then result.Left:= Left; if Width > 0 then result.Width:= Width; if Height > 0 then result.Height:= Height;
if FontName <> '' then result.Font.Name:= FontName; if FontColor > 0 then result.Font.Color:= FontColor; if FontStyle <> [] then result.Font.Style:= FontStyle;
result.AutoSize:= AutoSize; result.WordWrap:= WordWrap; result.Transparent:=Transparent; result.ShowHint:= true;
End;

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

Function ExpandENV(string: String): String; var n: UINT; Begin // ExpandConstant + развёртывание DOS-переменных типа %SystemRoot%
if Pos('{',string) * Pos('}',string) = 0 then Result:= String else Result:= ExpandConstant(String); n:= Pos('%',result); if n = 0 then Exit;
Delete(result, n,1); Result:= Copy(Result,1, n-1) + ExpandConstant('{%'+Copy(Result, n, Pos('%',result) -n) +'}') + Copy(Result, Pos('%',result) +1, Length(result))
End;

Function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
Function LoWord(lw: LongWord): LongWord; Begin Result:= lw shr 16; 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;

Function RGB(r, g, b: Longint): Longint; Begin Result:= (r or (g shl 8) or (b shl 16)) End;
Function GetBValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 16) End;
Function GetGValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 8) End;
Function GetRValue(rgb: DWord): Byte; Begin Result:= Byte(rgb) End;

Procedure GradientFill(WorkBmp: TBitmapImage; BeginColor, FinishColor: Integer); var ColorBand: TRect; StartColor, i: Integer; Begin {если BeginColor < 0, то градиент горизонтальный}
WorkBmp.Bitmap.Width:= WorkBmp.Width; WorkBmp.Bitmap.Height:= WorkBmp.Height; StartColor:= trunc(Abs(BeginColor))
if BeginColor < 0 then n:= WorkBmp.Width else n:= WorkBmp.Height;
for i:=0 to n do begin if BeginColor < 0 then begin
ColorBand.Top:= 0; ColorBand.Bottom:= WorkBmp.Height;
ColorBand.Left:= MulDiv(i, WorkBmp.Width, n); ColorBand.Right:= MulDiv(i+1, WorkBmp.Width, n);
end else begin
ColorBand.Top:= MulDiv(i, WorkBmp.Height, n); ColorBand.Bottom:= MulDiv(i+1, WorkBmp.Height, n);
ColorBand.Left:= 0; ColorBand.Right:= WorkBmp.Width; end;
WorkBmp.Bitmap.Canvas.Brush.Color:= RGB(GetRValue(StartColor) + MulDiv(I, GetRValue(FinishColor) - GetRValue(StartColor), n-1), GetGValue(StartColor) + MulDiv(I, GetGValue(FinishColor) - GetGValue(StartColor), n-1), GetBValue(StartColor) + MulDiv(I, GetBValue(FinishColor) - GetBValue(StartColor), n-1));
WorkBmp.Bitmap.Canvas.FillRect(ColorBand); end;
End;

// Converts OEM encoded string into ANSI (Преобразует OEM строку в ANSI кодировку)
function 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 кодировку)
function AnsiToUtf8(strSource: string): string;
var
nRet, nRet2: integer; WideCharBuf, MultiByteBuf: AnsiString;
begin
SetLength(WideCharBuf, Length(strSource) * 2);
SetLength(MultiByteBuf, Length(strSource) * 2);
nRet:= MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
nRet2:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
if nRet * nRet2 = 0 then Result:= strSource else Result:= MultiByteBuf;
end;

// ArcInd - текущий архив, счёт с 0
// baseMb - записано из пред. архива на диск
// lastMb - извлечено из тек. архива на диск
// Status.mb - позиция в текущем архиве
// Status.allsize - объём всех архивов
// Status.size - всего извлечено Мб на текущий момент
// totalUncompressedSize - точный объём данных в архивах
// общий прогресс нарастает по мере записи данных из архива на диск (точка 'write')
// прогресс архивов двигается в соответствии с позицией в текущем архиве (точка 'read')

Procedure UpdateStatus(Flags: Integer); // выполняется с периодичностью, заданной константой Period
var
Remaining: Integer; i, t, s: string;
Begin
if Flags and $1 > 0 then FreezeTimer:= Flags and $2 = 0; // bit 0 = 1 change start/stop, bit 1 = 0 stop, bit 1 = 1 start
if (Flags and $4 > 0) or (Status.size <> baseMb+lastMb) then LastTimerEvent:= 0; // bit 2 = 1 UpdateNow // обновить по флагу или записи из архива на диск
if FreezeTimer or (GetTickCount - LastTimerEvent <= Period) then Exit else LastTimerEvent:= GetTickCount;
Status.size := baseMb+lastMb; // извлечено на текущий момент
if totalUncompressedSize > 0 then with WizardForm.ProgressGauge do begin // основной прогресс движется по мере записи данных на диск
Position:= round(Max * Status.size/totalUncompressedSize)
end;
with WizardForm.ProgressGauge do begin // оставшееся время
#ifndef precomp
// к сожалению, этот код иногда сбоит на очень больших архивах, созданных с использованием внешних упаковщиков
if position > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((max - position)/position)) else
#endif
Remaining:= 0;
t:= cm('ending'); i:= t;
if Remaining > 0 then begin
t:= FmtMessage(cm('taskbar'), [IntToStr(Status.perc/10), TicksToTime(Remaining, 'h', 'm', 's', false)])
i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)
end;
end;
SetTaskBarTitle(t); // проценты и оставшееся время на кнопке инсталлятора
if Status.size > 0 then
s:= ' ['+ ByteOrTB(Status.size*oneMB, true) +']'; // если сделать подсчёт размера папки {app} через CalcDirSize, то при частом пересчёте папки большого объёма это может замедлить работу
StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(Status.count +ord(Status.count < 0)), s, Format('%.1n', [Abs(Status.perc/10)]), i]);
// второй прогрессбар движется по мере считывания текущего архива
if (Status.stage = cm('ArcTitle')) and (GetArrayLength(Arcs) > 0) then begin
ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), ByteOrTB(Arcs[ArcInd].Size, true), Format('%.0n', [Status.mb/(Arcs[ArcInd].Size/oneMB)*100]), ByteOrTB(Status.allsize, true)])
ProgressBar.Position:= round(ProgressBar.Max * Status.mb/trunc(Arcs[ArcInd].Size/oneMB))
end;
End;

Procedure MyTimerProc(h, msg, idevent, dwTime: Longword);
Begin
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0);
End;

Procedure OnWndHook(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
Begin
if (Code = HC_ACTION) and (LoWord(lParam.msg) = WM_PAINT) then begin // подготовка данных для последующего отображения по таймеру
if (Status.name <> WizardForm.FileNameLabel.Caption) and (WizardForm.FileNameLabel.Caption <> '') then begin // имя файла, названия ярлыка и прочее
FileNameLabel.Caption:= WizardForm.FileNameLabel.Caption;
Status.name:= WizardForm.FileNameLabel.Caption; // начало извлечения или распаковки очередного файла
Case Status.stage of
SetupMessage(msgStatusExtractFiles): // этап извлечения файлов инсталлятором
Status.count:= Status.count +1; // кол-во файлов
End;
end;
if (Status.stage <> WizardForm.StatusLabel.Caption) and (WizardForm.StatusLabel.Caption <> '') then begin
StatusLabel.Caption:= WizardForm.StatusLabel.Caption;
Status.stage:= WizardForm.StatusLabel.Caption; // текущий этап установки
if Status.stage = SetupMessage(msgStatusRollback) then begin
WizardForm.StatusLabel.Hide; WizardForm.FileNameLabel.Hide; StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;
end;
with WizardForm.ProgressGauge do begin
n:= (Max - Min)/1000
if n > 0 then Status.perc:= (Position-Min)/n; // 1000 процентов
end;
UpdateStatus(0);
end;
CallNextWNDPROC(WndHookID, Code, wParam, lParam) {освобождение события}
End;

// compsize: в Mb объём архива
// total_files: в int2 ? число файлов в архиве
// origsize: в Mb общий объём данных в архиве
// write: в Mb число записанных (распакованных из архива) на диск мегабайт
// read: в Mb число обработанных мегабайт, в int2 размер текущего архива
// filename: вызывается перед обработкой каждого файла

// The main callback function for unpacking FreeArc archives
function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer; // вызывается не менее 100 раз в секунду, что заменяет вызов по таймеру
begin
case string(what) of
'origsize': origsize:= Mb; // данных в тек. архиве (при распаковке не вызывается)
'total_files': Null;
'filename': begin // Update FileName label
WizardForm.FileNameLabel.Caption:= OemToAnsiStr(str); // извлекаемый файл, их имена пишутся в журнал установки
FileNameLabel.Caption:= OemToAnsiStr(str); // извлекаемый файл, их имена пишутся в журнал установки
Status.count:= Status.count + 1; // кол-во файлов, этап распаковки
end;
'read': // позиция в текущем архиве
Status.mb:= Mb;
'write': // Assign to Mb *total* amount of data extracted to the moment from all archives
lastMb:= Mb; // извлечено из текущего архива
end;
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0); // обновить страницу установки, не сбрасывая таймер
if (GetKeyState(VK_ESCAPE) < 0) and not CancelDuringInstall then
WizardForm.Close; // опрашиваем Cancel (если разрешена отмена установки)
AppProcessMessage;
Result:= CancelCode;
end;

Function ArcDecode(Line: string): array of TArc; // разбор строки Archives
var tmp, cut: array of String; n, i: integer;
Begin
SetArrayLength(result,0); if Line <> '' then tmp:= StringToArray(Line,'|') else Exit;
for n:= 0 to GetArrayLength(tmp) - 1 do begin
if tmp[n][Length(tmp[n])] = '?' then Continue; // эта запись обрабатывается в AfterInstall: UnArc(...)
SetArrayLength(result, GetArrayLength(result) +1); i:= GetArrayLength(result) -1;
cut:= StringToArray(tmp[n],'>') // задачи, логика or and not наверное не будет работать
if GetArrayLength(cut) > 1 then result[i].task:= cut[1];
cut:= StringToArray(cut[0],'<') // компоненты
if GetArrayLength(cut) > 1 then result[i].comp:= cut[1];
cut:= StringToArray(cut[0],'/') // папка распаковки
if GetArrayLength(cut) > 1 then result[i].Dest:= cut[1] else result[i].Dest:= '{app}'; // по-умолчанию
if (ExtractFileDrive(ExpandENV(cut[0])) = '') and (ExpandENV(cut[0]) = cut[0]) then // строка вида Rus\*.arc
result[i].Path:= '{src}\'+ cut[0] else result[i].Path:= cut[0]; // остаток от исходной строки
result[i].Dest:= ExpandENV(result[i].Dest); result[i].Path:= ExpandENV(result[i].Path);
end;
End;

// Scans the specified folders for archives and add them to list
function AddArcs(files, target: string): Integer; // добавление архивов в общий список и подсчёт объёма распакованных данных
var FSR: TFindRec; i: integer;
Begin
Result:= 0; if FindFirst(ExpandENV(files), FSR) then
try
repeat
// Skip everything but the folders
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
// Expand the folder list
i:= GetArrayLength(Arcs); SetArrayLength(Arcs, i +1);
Arcs[i].Dest:= target; // путь распаковки для найденных по маске архивов
Arcs[i].Path:= ExtractFilePath(ExpandENV(files)) + FSR.Name;
Arcs[i].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Status.allsize:= Status.allsize + Arcs[i].Size; // зарезервировано для подсчёта прогресса распаковки 7-zip архивов (is7z.dll)
Arcs[i].allMb:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4),'l','--',AnsiToUtf8(Arcs[i].Path),'','','','','','',''); // код ошибки
if Arcs[i].allMb >= 0 then begin
Arcs[i].allMb:= origsize; result:= result + Arcs[i].allMb; // размер распакованных данных успешно считан
end;
until not FindNext(FSR);
finally
FindClose(FSR);
end;
End;

function UnPackArchive(Source, Destination: string; allMb, Mode: Integer): Integer;
var
callback: longword;
Begin
// если отмена установки разрешена, кнопка Cancel станет доступна
WizardForm.CancelButton.Enabled:= not CancelDuringInstall;
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
Result:= FreeArcCmd(callback,'x','-o+','-dp'+AnsiToUtf8(Destination),'--',AnsiToUtf8(Source),'','','','',''); // код ошибки
// Error occured
if Result = 0 then Exit;
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
WizardForm.StatusLabel.Caption:= msgError;
WizardForm.FileNameLabel.Caption:= ExtractFileName(Source);
GetSpaceOnDisk(ExtractFileDrive(Destination), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < allMb {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Source)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
Log(msgError); // записываем ошибку в лог, а также показываем её текст на странице завершения
End;

// Extracts all found archives
function UnPack(Archives: string): Integer;
begin
// UpdateStatus(1); // остановить таймер
Records:= ArcDecode(Archives); SetArrayLength(Arcs,0); Status.allsize:= 0; {общий объём}
for n:= 0 to GetArrayLength(Records) -1 do // Get the size of all archives
if (not IsTaskSelected(Records[n].task) and (Records[n].task <>'')) and (not IsComponentSelected(Records[n].comp) and (Records[n].comp <>'')) then Continue // компоненты и задачи не выбраны
else totalUncompressedSize:= totalUncompressedSize + AddArcs(Records[n].Path, Records[n].Dest); // создаём список архивов
// Other initializations
WizardForm.StatusLabel.Caption:= cm('ArcTitle'); // начало этапa распаковки
ExtractFile.Show; ProgressBar.Show;
baseMb:= 0; lastMb:= 0; Status.mb:= 0; // обнулить полученные мегабайты, если ранее вёлся подсчёт объёма файлов инсталлятора
Status.count:= 0; // не учитывать файлы, извлечённые инсталлятором
UpdateStatus(7); // немедленно обновить строку статуса
for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin // архивы в текущей папке, константы раскрыты в ArcDecode
Result:= UnPackArchive(Arcs[ArcInd].Path, Arcs[ArcInd].Dest, Arcs[ArcInd].allMb, 0); // код ошибки
if Result <> 0 then Break; // прервать цикл распаковки
baseMb:= baseMb + lastMb; lastMb:= 0; Status.mb:= 0; // общий объём распакованных файлов
// отработанный архив автоматически удаляется, если находится в папке {app} или {tmp}
if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) or (Pos(AnsiLowercase(ExpandConstant('{tmp}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) then
DeleteFile(Arcs[ArcInd].Path);
end;
if Result = 0 then WizardForm.StatusLabel.Caption:= FmtMessage(cm('ArcFinish'), [IntToStr(GetArrayLength(Arcs)), IntToStr(Status.count), ByteOrTB(Status.size*oneMB, true)]);
StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;

procedure CurStepChanged1(CurStep: TSetupStep);
begin
if CurStep = ssInstall then begin
StartInstall:= GetTickCount {время начала извлечения файлов}
WndHookID:= SetWindowsHookEx(WH_CALLWNDPROC, WrapCWPSTRUCTProc(@OnWndHook, 3), 0, GetCurrentThreadID); {установка SendMessage хука}
TimerID:= SetTimer(0, 0, 500 {полсекунды}, WrapTimerProc(@MyTimerProc, 4)); {установка таймера}
if not {#isFalse(SetupSetting("Uninstallable"))} then Status.count:= -1; // не считать файл unins000.exe
end;
if CurStep = ssPostInstall then
begin
StartInstall:= GetTickCount {время начала распаковки}
UnPackError:= UnPack('{#Archives}')
if UnPackError <> 0 then begin // Error occured, uninstall it then
if not {#isFalse(SetupSetting("Uninstallable"))} then // деинсталляция разрешёна
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); // откат установки из-за ошибки unarc.dll
WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
SetTaskBarTitle(SetupMessage(msgErrorTitle))
end else
SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
end;
end;


//************************************************ [Конец - FreeArc] ***************************************************//

procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged1(CurPageID);
CurPageChanged4(CurPageID);
CurPageChanged5(CurPageID);
end;

procedure InitializeWizard();
begin
InitializeWizard1();
InitializeWizard2();
InitializeWizard3();
InitializeWizard4();
InitializeWizard5();
InitializeWizard6();
InitializeWizard7();
InitializeWizard8();
end;
end.[/no][/more]
Автор: manuchu
Дата сообщения: 12.04.2010 21:16
Народ, плизз, нужна помощь....
Вопрос про precomp...
Вообще, я всё сделал, сделал файлы с расширением .pcf удалил оригинал из папки с игрой, создал инстал, но после установки, он мне распаковывает в папку с игрой и оригинал и тот же файл, с расширением .pcf((( Как это исправить??
Вот скрипт:
[more][Setup]
AppName=S.T.A.L.K.E.R. - &#199;&#238;&#226; &#207;&#240;&#232;&#239;&#255;&#242;&#232;
AppVerName=S.T.A.L.K.E.R. - &#199;&#238;&#226; &#207;&#240;&#232;&#239;&#255;&#242;&#232; [v1.6.02]
DefaultDirName={pf}\GSC World Publishing\S.T.A.L.K.E.R. - &#199;&#238;&#226; &#207;&#240;&#232;&#239;&#255;&#242;&#232;
DefaultGroupName=GSC World Publishing\S.T.A.L.K.E.R. - &#199;&#238;&#226; &#207;&#240;&#232;&#239;&#255;&#242;&#232;
WizardImageFile=WizardImage.bmp
WizardSmallImageFile=WizardSmallImage.bmp
OutputDir=E:\RePack'&#232; &#227;&#240;&#243;&#239;&#239;&#251; R.G.M&R\&#221;&#234;&#241;&#239;&#229;&#240;&#229;&#236;&#229;&#237;&#242;
Compression=lzma/ultra64
SolidCompression=yes


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

[Messages]
DiskSpaceMBLabel=&#210;&#240;&#229;&#225;&#243;&#229;&#242;&#241;&#255; &#234;&#224;&#234; &#236;&#232;&#237;&#232;&#236;&#243;&#236; 6,02 &#195;&#225; &#241;&#226;&#238;&#225;&#238;&#228;&#237;&#238;&#227;&#238; &#228;&#232;&#241;&#234;&#238;&#226;&#238;&#227;&#238; &#239;&#240;&#238;&#241;&#242;&#240;&#224;&#237;&#241;&#242;&#226;&#224;.

[CustomMessages]
rus.FinishedLabel=&#207;&#240;&#238;&#227;&#240;&#224;&#236;&#236;&#224; &#243;&#241;&#242;&#224;&#237;&#238;&#226;&#235;&#229;&#237;&#224; &#237;&#224; &#194;&#224;&#248; &#234;&#238;&#236;&#239;&#252;&#254;&#242;&#229;&#240;. &#207;&#240;&#232;&#235;&#238;&#230;&#229;&#237;&#232;&#229; &#236;&#238;&#230;&#237;&#238; &#231;&#224;&#239;&#243;&#241;&#242;&#232;&#242;&#252; &#241; &#239;&#238;&#236;&#238;&#249;&#252;&#254; &#241;&#238;&#238;&#242;&#226;&#229;&#242;&#241;&#242;&#226;&#243;&#254;&#249;&#229;&#227;&#238; &#231;&#237;&#224;&#247;&#234;&#224;.%n%n&#205;&#224;&#230;&#236;&#232;&#242;&#229; «&#199;&#224;&#226;&#229;&#240;&#248;&#232;&#242;&#252;», &#247;&#242;&#238;&#225;&#251; &#226;&#251;&#233;&#242;&#232; &#232;&#231; &#239;&#240;&#238;&#227;&#240;&#224;&#236;&#236;&#251; &#243;&#241;&#242;&#224;&#237;&#238;&#226;&#234;&#232;.
rus.AdditionalTasks=&#209;&#232;&#241;&#242;&#229;&#236;&#237;&#251;&#229; &#231;&#224;&#228;&#224;&#247;&#232;:
rus.UpdateDirect=&#206;&#225;&#237;&#238;&#226;&#232;&#242;&#252; DirectX
rus.ArcBreak=&#211;&#241;&#242;&#224;&#237;&#238;&#226;&#234;&#224; &#239;&#240;&#229;&#240;&#226;&#224;&#237;&#224;!
rus.StatusInfo=&#244;&#224;&#233;&#235;&#238;&#226;: %1%2, %3%% &#226;&#251;&#239;&#238;&#235;&#237;&#229;&#237;&#238;, &#238;&#241;&#242;&#224;&#235;&#238;&#241;&#252; &#230;&#228;&#224;&#242;&#252; %4
rus.taskbar=%1%%, &#230;&#228;&#232; %2
rus.ending=&#231;&#224;&#226;&#229;&#240;&#248;&#229;&#237;&#232;&#229;
rus.hour=&#247;&#224;&#241;&#238;&#226;
rus.min=&#236;&#232;&#237;
rus.sec=&#241;&#229;&#234;


[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked
Name: "quicklaunchicon"; Description: "{cm:CreateQuickLaunchIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked
Name: "directx"; Description: "{cm:UpdateDirect}"; GroupDescription: "{cm:AdditionalTasks}";


[Files]
Source: precomp.exe; DestDir: {tmp}; Flags: dontcopy
Source: packjpg_dll.dll; DestDir: {tmp}; Flags: dontcopy
Source: "E:\&#200;&#227;&#240;&#251;\Amazon Adventure\AmazonAdventure.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "E:\&#200;&#227;&#240;&#251;\Amazon Adventure\*"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: "DirBitmap.bmp"; DestDir: "{tmp}"; Flags: dontcopy
Source: "GroupBitmap.bmp"; DestDir: "{tmp}"; Flags: dontcopy
Source: "Logo.bmp"; DestDir: "{tmp}"; Flags: dontcopy
Source: "button.bmp"; DestDir: "{tmp}"; Flags: dontcopy
Source: "Logo.bmp"; DestDir: "{app}"; Attribs: hidden system;
Source: "WizardSmallImage.bmp"; DestDir: "{app}"; Attribs: hidden system;

Source: {src}\*.arc; DestDir: {app}; Flags: external dontcopy

[RUN]
Filename: {app}\&#193;&#224;&#242;&#237;&#232;&#234;.bat; WorkingDir: {app}; StatusMsg: &#208;&#224;&#241;&#239;&#224;&#234;&#238;&#226;&#234;&#224; &#228;&#224;&#237;&#237;&#251;&#245;..
Filename: {app}\bin\&#193;&#224;&#242;&#237;&#232;&#234;.bat; WorkingDir: {app}\bin; StatusMsg: &#208;&#224;&#241;&#239;&#224;&#234;&#238;&#226;&#234;&#224; &#228;&#224;&#237;&#237;&#251;&#245;..

[Icons]
Name: "{group}\My Program"; Filename: "{app}\MyProg.exe"
Name: "{group}\{cm:UninstallProgram,My Program}"; Filename: "{uninstallexe}"
Name: "{commondesktop}\My Program"; Filename: "{app}\MyProg.exe"; Tasks: desktopicon
Name: "{userappdata}\Microsoft\Internet Explorer\Quick Launch\My Program"; Filename: "{app}\MyProg.exe"; Tasks: quicklaunchicon

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

[_ISToolPreCompile]

Pos(T,S) == 1 ? S = Copy(S,2,Len(S)) : S, Copy(S,Len(S)) == T ? S = Copy(S,1,Len(S)-1) : S, Pos(T,S) == 1 || Copy(S,Len(S)) == T ? TrimEx(S,T) : S

Local[0] = Pos(T, S), Local[0] > 0 ? (F == 0 ? Copy(S, Local[0]) : (F < 0 ? Copy(S,,Local[0] -1) : Copy(S, Local[0] + Len(T)))) : S

S = LowerCase(S), B = LowerCase(B), \
(Local[0] = Pos(B, S)) > 0 ? (Local[1] = Copy(S, Local[0]+Len(B)), (Local[0] = Pos(E, Local[1])) > 0 ? (Copy(Local[1],, Local[0]-1)) : Local[1]) : ""

Local[0] = Find2Cut(LastLine,"UnArc(",")"), Local[0] == "" ? Local[0] = Find2Cut(LastLine,"UnZip(",")") : void, Local[0] != "" && Pos("dontcopy", Find2Cut(LastLine,"Flags:")) == 0 ? Local[5] = "?" : void, \
Local[1] = TrimEx(TrimEx(SkipText(Local[0],"',",-1)),"'"), Local[2] = TrimEx(TrimEx(SkipText(Local[0],"',")),"'"), Local[1] == "" ? Local[1] = TrimEx(Find2Cut(LastLine,"Source:")) : void, Local[2] == "" ? Local[2] = TrimEx(Find2Cut(LastLine,"DestDir:")) : void, \
Local[3] = TrimEx(Find2Cut(LastLine,"Components:")), Local[3] == "" ? void : (Local[3] = "<"+ Local[3], void), Local[4] = TrimEx(Find2Cut(LastLine,"Tasks:")), Local[4] == "" ? void : (Local[4] = ">"+ Local[4], void), \
Local[1] == "" ? Break('Previous line must be in [Files] section') : (Local[0] = Local[1] +"/"+ Local[2] + Local[3] + Local[4] + Local[5]), TrimEx(Archives) == "" ? Archives = Local[0] : (Archives = Archives +"|"+ Local[0]), void



[code]

type


TMessage = record hWnd: HWND; msg, wParam: Word; lParam: LongWord; Time: TFileTime; pt: TPoint; end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path, Dest, comp, task: string; allMb, Files: Integer; Size: Extended; end;
TBarInfo = record stage, name: string; size, allsize: Extended; count, perc, pos, mb, time: Integer; end;
TCWPSTRUCT = record lParam: LongWord; wParam: Word; Msg: LongWord; hwnd: HWnd; end;
TCWPSTRUCTProc = procedure(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
TTimerProc = procedure(HandleW, Msg, idEvent, TimeSys: LongWord);

const
Color = clBlack;
ButtonWidth = 80;
ButtonHeight = 23;

bidBack = 0;
bidNext = 1;
bidCancel = 2;
bidDirBrowse = 3;
bidGroupBrowse = 4;

PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMB=1024*1024;
Period = 250;
VK_ESCAPE = 27;
HC_ACTION = 0;
WH_CALLWNDPROC = 4;
WM_PAINT = $F;


var
LogoImage: TBitmapImage;

ButtonPanel: array [0..4] of TPanel;
ButtonImage: array [0..4] of TBitmapImage;
ButtonLabel: array [0..4] of TLabel;

StatusLabel, FileNameLabel, ExtractFile, StatusInfo, FinishedLabel: TLabel;
ProgressBar: TNewProgressBar;
CancelCode, n, ArcInd, UnPackError, StartInstall, LastTimerEvent, lastMb, baseMb: Integer;
FreeMB, TotalMB: Cardinal;
WndHookID, TimerID: LongWord;
Arcs, Records: array of TArc;
msgError: string;
Status: TBarInfo;
FreezeTimer: Boolean;
totalUncompressedSize, origsize: Integer;
Texture2, Texture: TBitmapImage;

//************************************************ [&#205;&#224;&#247;&#224;&#235;&#238; - &#194;&#237;. &#226;&#232;&#228; &#232;&#237;&#241;&#242;&#224;&#235;&#235;&#224;] ***************************************************//

procedure RepaintInstall();
begin
ExtractTemporaryFile('button.bmp')
ExtractTemporaryFile('DirBitmap.bmp');
ExtractTemporaryFile('GroupBitmap.bmp');
ExtractTemporaryFile('Logo.bmp');

WizardForm.WizardBitmapImage.Width := ScaleX(224);
WizardForm.WizardBitmapImage2.Width := ScaleX(224);
WizardForm.PageNameLabel.Width:=ScaleX(300);
WizardForm.PageDescriptionLabel.Hide;

WizardForm.Font.Color:=clWhite;

WizardForm.Color:=Color;
WizardForm.WelcomePage.Color:=Color;
WizardForm.InnerPage.Color:=Color;
WizardForm.FinishedPage.Color:=Color;
WizardForm.SelectDirPage.Color:=Color;
WizardForm.SelectComponentsPage.Color:=Color;
WizardForm.SelectProgramGroupPage.Color:=Color;
WizardForm.SelectTasksPage.Color:=Color;
WizardForm.ReadyPage.Color:=Color;
WizardForm.InstallingPage.Color:=Color;

WizardForm.PageNameLabel.Color:=Color;
WizardForm.PageNameLabel.Font.Color:=ClWhite;
WizardForm.MainPanel.Color:=Color;

WizardForm.WelcomeLabel1.Hide;
WizardForm.WelcomeLabel2.Hide;

WizardForm.SelectDirLabel.Color:=Color;
WizardForm.SelectDirBrowseLabel.Color:=Color;
WizardForm.DirEdit.Color:=Color;
WizardForm.DiskSpaceLabel.Color:=Color;

WizardForm.ComponentsList.Color:=Color;
WizardForm.SelectComponentsLabel.Color:=Color;
WizardForm.TypesCombo.Hide;
WizardForm.ComponentsDiskSpaceLabel.Hide;

WizardForm.GroupEdit.Color:=Color;
WizardForm.SelectStartMenuFolderLabel.Color:=Color;
WizardForm.SelectStartMenuFolderBrowseLabel.Color:=Color;

WizardForm.SelectTasksLabel.Color:=Color;
WizardForm.TasksList.Color:=Color;

WizardForm.ReadyMemo.Color:=Color;
WizardForm.ReadyMemo.ScrollBars:= ssNone
WizardForm.ReadyLabel.Color:=Color;

WizardForm.StatusLabel.Color:=Color;
WizardForm.FilenameLabel.Color:=Color;

WizardForm.FinishedHeadingLabel.Hide;
WizardForm.FinishedLabel.Hide;

WizardForm.SelectDirBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\DirBitmap.bmp'));
WizardForm.SelectDirBitmapImage.AutoSize:=true;

WizardForm.SelectGroupBitmapImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\GroupBitmap.bmp'));
WizardForm.SelectGroupBitmapImage.AutoSize:=true;

LogoImage := TBitmapImage.Create(WizardForm);
with LogoImage do
begin
SetBounds(ScaleX(10), ScaleY(320), ScaleX(175), ScaleY(40));
Bitmap.LoadFromFile(ExpandConstant('{tmp}\Logo.bmp'));
Parent := WizardForm;
end;

with WizardForm.WizardSmallBitmapImage do
begin
SetBounds(ScaleX(335), ScaleY(2), ScaleX(160), ScaleY(50));
end;

with WizardForm.ComponentsList do
begin
Top:=ScaleY(55);
Height:=ScaleY(150);
end;

with TLabel.Create(WizardForm) do begin
AutoSize:=WizardForm.WelcomeLabel1.AutoSize;
Left:=WizardForm.WelcomeLabel1.Left;
Top:=WizardForm.WelcomeLabel1.Top
Width:=WizardForm.WelcomeLabel1.Width
Height:=WizardForm.WelcomeLabel1.Height
WordWrap:=WizardForm.WelcomeLabel1.WordWrap;
Font.Name:=WizardForm.WelcomeLabel1.Font.Name;
Font.Size:=WizardForm.WelcomeLabel1.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.WelcomeLabel1.Font.Style;
Caption:=WizardForm.WelcomeLabel1.Caption;
Parent:=WizardForm.WelcomeLabel1.Parent
Transparent:=True
end;

with TLabel.Create(WizardForm) do begin
AutoSize:=WizardForm.WelcomeLabel2.AutoSize;
Left:=WizardForm.WelcomeLabel2.Left;
Top:=WizardForm.WelcomeLabel2.Top
Width:=WizardForm.WelcomeLabel2.Width
Height:=WizardForm.WelcomeLabel2.Height
WordWrap:=WizardForm.WelcomeLabel2.WordWrap;
Font.Name:=WizardForm.WelcomeLabel2.Font.Name;
Font.Size:=WizardForm.WelcomeLabel2.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.WelcomeLabel2.Font.Style;
Caption:=WizardForm.WelcomeLabel2.Caption;
Parent:=WizardForm.WelcomeLabel2.Parent
Transparent:=True
end;

with TLabel.Create(WizardForm) do begin
AutoSize:=WizardForm.FinishedHeadingLabel.AutoSize;
Left:=WizardForm.FinishedHeadingLabel.Left;
Top:=WizardForm.FinishedHeadingLabel.Top
Width:=WizardForm.FinishedHeadingLabel.Width
Height:=WizardForm.FinishedHeadingLabel.Height
WordWrap:=WizardForm.FinishedHeadingLabel.WordWrap;
Font.Name:=WizardForm.FinishedHeadingLabel.Font.Name;
Font.Size:=WizardForm.FinishedHeadingLabel.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.FinishedHeadingLabel.Font.Style;
Caption:=WizardForm.FinishedHeadingLabel.Caption;
Parent:=WizardForm.FinishedHeadingLabel.Parent
Transparent:=True
end;

FinishedLabel:= TLabel.Create(WizardForm)
with FinishedLabel do begin
AutoSize:=WizardForm.FinishedLabel.AutoSize;
Left:=WizardForm.FinishedLabel.Left;
Top:=WizardForm.FinishedLabel.Top
Width:=WizardForm.FinishedLabel.Width;
Height:=WizardForm.FinishedLabel.Height+50;
WordWrap:=WizardForm.FinishedLabel.WordWrap;
Font.Name:=WizardForm.FinishedLabel.Font.Name;
Font.Size:=WizardForm.FinishedLabel.Font.Size;
Font.Color:=clWhite;
Font.Style:=WizardForm.FinishedLabel.Font.Style;
Caption:=ExpandConstant('{cm:FinishedLabel}');
Parent:=WizardForm.FinishedLabel.Parent
Transparent:=True
end;
end;

procedure InitializeUninstallProgressForm;
begin
FileCopy(ExpandConstant('{app}\WizardSmallImage.bmp'), ExpandConstant('{tmp}\WizardSmallImage.bmp'), False);
FileCopy(ExpandConstant('{app}\Logo.bmp'), ExpandConstant('{tmp}\Logo.bmp'), False);

UninstallProgressForm.Color:=Color;
UninstallProgressForm.InnerPage.Color:=Color;
UninstallProgressForm.MainPanel.Color:=Color;
UninstallProgressForm.PageNameLabel.Color:=Color;
UninstallProgressForm.PageDescriptionLabel.Hide;
UninstallProgressForm.PageNameLabel.Font.Color:=clWhite;
UninstallProgressForm.PageNameLabel.Width:=ScaleX(300);
UninstallProgressForm.StatusLabel.Color:=Color;
UninstallProgressForm.StatusLabel.Font.Color:=clWhite;

LogoImage := TBitmapImage.Create(UninstallProgressForm);
with LogoImage do
begin
SetBounds(ScaleX(10), ScaleY(320), ScaleX(175), ScaleY(40));
Bitmap.LoadFromFile(ExpandConstant('{tmp}\Logo.bmp'));
Parent := UninstallProgressForm;
end;

with UninstallProgressForm.WizardSmallBitmapImage do
begin
Bitmap.LoadFromFile(ExpandConstant('{tmp}\WizardSmallImage.bmp'));
SetBounds(ScaleX(335), ScaleY(2), ScaleX(160), ScaleY(50));
end;
end;

//************************************************ [&#202;&#238;&#237;&#229;&#246; - &#194;&#237;. &#226;&#232;&#228; &#232;&#237;&#241;&#242;&#224;&#235;&#235;&#224;] ***************************************************//

//************************************************ [&#205;&#224;&#247;&#224;&#235;&#238; - &#202;&#237;&#238;&#239;&#234;&#232;] ***************************************************//

procedure ButtonLabelClick(Sender: TObject);
var
Button: TButton;
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
case TLabel(Sender).Tag of
bidBack: Button:=WizardForm.BackButton
bidNext: Button:=WizardForm.NextButton
bidCancel: Button:=WizardForm.CancelButton
bidDirBrowse: Button:=WizardForm.DirBrowseButton
bidGroupBrowse: Button:=WizardForm.GroupBrowseButton
else
Exit
end
Button.OnClick(Button)
end;

procedure ButtonLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if ButtonLabel[TLabel(Sender).Tag].Enabled then
ButtonImage[TLabel(Sender).Tag].Left:=-ButtonWidth
end;

procedure ButtonLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ButtonImage[TLabel(Sender).Tag].Left:=0
end;

procedure LoadButtonImage(AButton: TButton; AButtonIndex: integer);
var
Image: TBitmapImage;
Panel: TPanel;
Labl: TLabel;

begin
Panel:=TPanel.Create(WizardForm)
Panel.Left:=AButton.Left
Panel.Top:=AButton.Top
Panel.Width:=AButton.Width
Panel.Height:=AButton.Height
Panel.Tag:=AButtonIndex
Panel.Parent:=AButton.Parent
ButtonPanel[AButtonIndex]:=Panel

Image:=TBitmapImage.Create(WizardForm)
Image.Width:=160
Image.Height:=23
Image.Enabled:=False
Image.Bitmap.LoadFromFile(ExpandConstant('{tmp}\button.bmp'))
Image.Parent:=Panel
ButtonImage[AButtonIndex]:=Image

with TLabel.Create(WizardForm) do begin
Tag:=AButtonIndex
Parent:=Panel
Width:=Panel.Width
Height:=Panel.Height
Transparent:=True
OnClick:=@ButtonLabelClick
OnDblClick:=@ButtonLabelClick
OnMouseDown:=@ButtonLabelMouseDown
OnMouseUp:=@ButtonLabelMouseUp
end

Labl:=TLabel.Create(WizardForm)
Labl.Left:=23
Labl.Top:=5
Labl.Autosize:=True
Labl.Alignment:=taCenter
Labl.Tag:=AButtonIndex
Labl.Transparent:=True
Labl.Font.Color:=clWhite
Labl.Caption:=AButton.Caption
Labl.OnClick:=@ButtonLabelClick
Labl.OnDblClick:=@ButtonLabelClick
Labl.OnMouseDown:=@ButtonLabelMouseDown
Labl.OnMouseUp:=@ButtonLabelMouseUp
Labl.Parent:=Panel
ButtonLabel[AButtonIndex]:=Labl
end;

procedure UpdateButton(AButton: TButton;AButtonIndex: integer);
begin
ButtonLabel[AButtonIndex].Caption:=AButton.Caption
ButtonPanel[AButtonIndex].Visible:=AButton.Visible
ButtonLabel[AButtonIndex].Enabled:=Abutton.Enabled
end;

procedure LicenceAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=True
end;

procedure LicenceNotAcceptedRadioOnClick(Sender: TObject);
begin
ButtonLabel[bidNext].Enabled:=False
end;

procedure UpdateButtons(CurPageID: Integer);
begin
UpdateButton(WizardForm.BackButton,bidBack)
UpdateButton(WizardForm.NextButton,bidNext)
UpdateButton(WizardForm.CancelButton,bidCancel)
ButtonLabel[bidBack].Left := (ButtonPanel[bidBack].Width / 2 - ButtonLabel[bidBack].Width / 2);
ButtonLabel[bidNext].Left := (ButtonPanel[bidNext].Width / 2 - ButtonLabel[bidNext].Width / 2);
ButtonLabel[bidCancel].Left := (ButtonPanel[bidCancel].Width / 2 - ButtonLabel[bidCancel].Width / 2);
ButtonLabel[bidDirBrowse].Left := (ButtonPanel[bidDirBrowse].Width / 2 - ButtonLabel[bidDirBrowse].Width / 2);
ButtonLabel[bidGroupBrowse].Left := (ButtonPanel[bidGroupBrowse].Width / 2 - ButtonLabel[bidGroupBrowse].Width / 2);
end;

procedure ButtonTextures();
begin
WizardForm.BackButton.Width:=ButtonWidth
WizardForm.BackButton.Height:=ButtonHeight

WizardForm.NextButton.Width:=ButtonWidth
WizardForm.NextButton.Height:=ButtonHeight

WizardForm.CancelButton.Width:=ButtonWidth
WizardForm.CancelButton.Height:=ButtonHeight

WizardForm.DirBrowseButton.Left:=337
WizardForm.DirBrowseButton.Width:=ButtonWidth
WizardForm.DirBrowseButton.Height:=ButtonHeight

WizardForm.GroupBrowseButton.Left:=337
WizardForm.GroupBrowseButton.Width:=ButtonWidth
WizardForm.GroupBrowseButton.Height:=ButtonHeight

WizardForm.LicenseAcceptedRadio.OnClick:=@LicenceAcceptedRadioOnClick

WizardForm.LicenseNotAcceptedRadio.OnClick:=@LicenceNotAcceptedRadioOnClick

LoadButtonImage(WizardForm.BackButton,bidBack)
LoadButtonImage(WizardForm.NextButton,bidNext)
LoadButtonImage(WizardForm.CancelButton,bidCancel)
LoadButtonImage(WizardForm.DirBrowseButton,bidDirBrowse)
LoadButtonImage(WizardForm.GroupBrowseButton,bidGroupBrowse)
end;

//************************************************ [&#202;&#238;&#237;&#229;&#246; - &#202;&#237;&#238;&#239;&#234;&#232;] ***************************************************//


procedure InitializeWizard();
begin
RepaintInstall();
ButtonTextures();

end;

Procedure CurPageChanged(CurPageID: Integer);
Begin
UpdateButtons(CurPageID);

end;[/more]
А вот что я написал в батнике:
precomp -r AmazonAdventure.pcf
del "AmazonAdventure.pcf"


Извиняюсь за вопрос, не совсем относящийся к теме, но просто очень нужна ваша помощь
Автор: dumanow
Дата сообщения: 12.04.2010 22:02
Потдерживаю мы пользуюмся чужой работой за которой автор быть может просидел и сутки чтоб составить и выдавать за свое это через чур.Репаки ладно думаю можно что вы зделали а вот скрипты это НЕТ!
Автор: alex2605
Дата сообщения: 12.04.2010 22:05
manuchu
это обсуждается в другой теме - Inno Setup плюс внешние упаковщики
Автор: geroinnn one
Дата сообщения: 13.04.2010 14:14
Помогите пожалуйста,при запуске инсталятора вылезает ошибка
Скрипт:
[more]

Код:
[Setup]
WizardImageFile=D:\gameinformer_01.bmp
AppName=Assassin's Creed 2
AppVerName=Assassin's Creed 2
AppPublisher=Repack by Bittorrents Repack Studio
AppPublisherURL=http://bit-torrents.ru/
AppSupportURL=http://bit-torrents.ru/
AppUpdatesURL=http://bit-torrents.ru/
DefaultDirName=D:\Assassin's Creed II
DefaultGroupName=R.G.geroinnn\Assassin's Creed 2
OutputDir=D:\Инсталяторы\Assassin's Creed 2_REPACK
OutputBaseFilename=setup_by_geroinnn
SetupIconFile=D:\Aria\ac2.ico
Compression=lzma
SolidCompression=yes

[Languages]
Name: "russian"; MessagesFile: "compiler:Default.isl"

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Run]
Filename: {src}\data1.exe; WorkingDir: {app}; Parameters: -x -y -s2 -d.; StatusMsg: Идет распаковка данных, подождите пожалуйста...; Flags: runasoriginaluser

[UninstallDelete]
Name: {app}\*.*; Type: filesandordirs

[Registry]
Root: HKLM; SubKey: SOFTWARE\Ubisoft\Assassin's Creed II; ValueType: string; ValueName: InstallDir; ValueData: {app}\Ubisoft\Assassin's Creed II
Root: HKLM; SubKey: SOFTWARE\Ubisoft\Assassin's Creed II; ValueType: string; ValueName: Language; ValueData: Russian
Root: HKLM; SubKey: SOFTWARE\Ubisoft\Assassin's Creed II\GameUpdate; ValueType: string; ValueName: execPath; ValueData: ValueData: {app}\Ubisoft\Assassin's Creed II
Root: HKLM; SubKey: SOFTWARE\Ubisoft\Assassin's Creed II\GameUpdate; ValueType: string; ValueName: info; ValueData: 6a969888664347d4868abde730649a6d
Root: HKLM; SubKey: SOFTWARE\Ubisoft\Assassin's Creed II\GameUpdate; ValueType: string; ValueName: installdir; ValueData: {app}\Ubisoft\Assassin's Creed II
Root: HKLM; SubKey: SOFTWARE\Ubisoft\Assassin's Creed II\GameUpdate; ValueType: string; ValueName: language; ValueData: us

[Messages]
DiskSpaceMBLabel=Требуется как минимум 6,5 ГБ свободного дискового пространства.

;это для фриарка
[_ISToolPreCompile]
#sub ShowErr
#pragma error Str(void)
#endsub
#define Break(any S = "Empty") void = S, ShowErr
#ifndef Archives
#define Archives ""
#endif
#define LastLine
#define Current AddBackslash(GetEnv("TEMP")) + GetDateTimeString('dd/mm-hh:nn', '-', '-') +'.iss'
#sub GetLastLine
#expr SaveToFile(Current)
#for {faAnyFile = FileOpen(Current); !FileEof(faAnyFile); LastLine = FileRead(faAnyFile)} NULL
#expr FileClose(faAnyFile)
#endsub
#define TrimEx(str S = "", str T = " ") \
Pos(T,S) == 1 ? S = Copy(S,2,Len(S)) : S, Copy(S,Len(S)) == T ? S = Copy(S,1,Len(S)-1) : S, Pos(T,S) == 1 || Copy(S,Len(S)) == T ? TrimEx(S,T) : S
#define SkipText(str S = "", str T = ";", int F = 1) \
Local[0] = Pos(T, S), Local[0] > 0 ? (F == 0 ? Copy(S, Local[0]) : (F < 0 ? Copy(S,,Local[0] -1) : Copy(S, Local[0] + Len(T)))) : S
#define Find2Cut(str S, str B, str E = ";") \
S = LowerCase(S), B = LowerCase(B), \
(Local[0] = Pos(B, S)) > 0 ? (Local[1] = Copy(S, Local[0]+Len(B)), (Local[0] = Pos(E, Local[1])) > 0 ? (Copy(Local[1],, Local[0]-1)) : Local[1]) : ""
#define SourceToProgress() GetLastLine, \
Local[0] = Find2Cut(LastLine,"UnArc(",")"), Local[0] == "" ? Local[0] = Find2Cut(LastLine,"UnZip(",")") : void, Local[0] != "" && Pos("dontcopy", Find2Cut(LastLine,"Flags:")) == 0 ? Local[5] = "?" : void, \
Local[1] = TrimEx(TrimEx(SkipText(Local[0],"',",-1)),"'"), Local[2] = TrimEx(TrimEx(SkipText(Local[0],"',")),"'"), Local[1] == "" ? Local[1] = TrimEx(Find2Cut(LastLine,"Source:")) : void, Local[2] == "" ? Local[2] = TrimEx(Find2Cut(LastLine,"DestDir:")) : void, \
Local[3] = TrimEx(Find2Cut(LastLine,"Components:")), Local[3] == "" ? void : (Local[3] = "<"+ Local[3], void), Local[4] = TrimEx(Find2Cut(LastLine,"Tasks:")), Local[4] == "" ? void : (Local[4] = ">"+ Local[4], void), \
Local[1] == "" ? Break('Previous line must be in [Files] section') : (Local[0] = Local[1] +"/"+ Local[2] + Local[3] + Local[4] + Local[5]), TrimEx(Archives) == "" ? Archives = Local[0] : (Archives = Archives +"|"+ Local[0]), void
#define isFalse(any S) (S = LowerCase(Str(S))) == "no" || S == "false" || S == "off" ? "true" : "false"

;надписи для фриарка
russian.ArcBreak=Установка прервана!
russian.ArcError=Распаковщик FreeArc вернул код ошибки: %1
russian.ArcBroken=Возможно, архив <%1> повреждён или недостаточно места на диске назначения.
russian.ArcFail=Распаковка не завершена!
russian.ArcTitle=Распаковка архивов...
russian.StatusInfo=файлов: %1%2, %3%% выполнено, осталось ждать %4
russian.ArcInfo=Архив %1 из %2, объём %3 из %5, %4%% обработано
russian.ArcFinish=Распаковано архивов: %1, получено файлов: %2 [%3]
russian.taskbar=%1%%, %2 remains
russian.taskbar=%1%%, жди %2
russian.ending=завершение
russian.hour= часов
russian.min= мин
russian.sec= сек

;Далее идут файлы для испрекомпа
Source: C:\packjpg_dll.dll; DestDir: {sys}; Flags: deleteafterinstall;
Source: C:\precomp.dll; DestDir: {sys}; Flags: deleteafterinstall;
Source: C:\zlib1.dll; DestDir: {sys}; Flags: deleteafterinstall;
Source: C:\innocallback.dll; Flags: dontcopy;
Source: C:\isprecomp.dll; Flags: dontcopy;
Source: C:\unarc.dll; DestDir: {tmp}; Flags: dontcopy deleteafterinstall

Source: {src}\*.arc; DestDir: {app}\; Flags: external dontcopy
{#SourceToProgress}

[Code]
//--- фриарк + испрекомп ------------------------------------------------------------------
type
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
#if Ver < 84018176
#endif

TMessage = record hWnd: HWND; msg, wParam: Word; lParam: LongWord; Time: TFileTime; pt: TPoint; end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TPrecompCallback = procedure(progress: integer); //isprecomp
TArc = record Path, Dest, comp, task: string; allMb, Files: Integer; Size: Extended; end;
TBarInfo = record stage, name: string; size, allsize: Extended; count, perc, pos, mb, time: Integer; end;
TCWPSTRUCT = record lParam: LongWord; wParam: Word; Msg: LongWord; hwnd: HWnd; end;
TCWPSTRUCTProc = procedure(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
TTimerProc = procedure(HandleW, Msg, idEvent, TimeSys: LongWord);
var
StatusLabel, FileNameLabel, ExtractFile, StatusInfo: TLabel;
ProgressBar: TNewProgressBar;
CancelCode, n, ArcInd, UnPackError, StartInstall, LastTimerEvent, lastMb, baseMb: Integer;
FreeMB, TotalMB: Cardinal;
WndHookID, TimerID: LongWord;
Arcs, Records: array of TArc;
msgError: string;
Status: TBarInfo;
FreezeTimer: Boolean;
totalUncompressedSize, origsize: Integer;
Texture2, Texture: TBitmapImage;
PrecompFiles: Integer;
PrecompLabel: TLabel;
DestDir: String;
const
PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMB=1024*1024;
Period = 250;
BackColor = $fcfbfb; EndColor = $d8e9ec;
VK_ESCAPE = 27;
HC_ACTION = 0;
WH_CALLWNDPROC = 4;
WM_PAINT = $F;
CancelDuringInstall = {#isFalse(SetupSetting("AllowCancelDuringInstall"))};

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';

function WrapPrecompCallback(callback:TPrecompCallback; paramcount:integer):longword; external 'wrapcallback@files:innocallback.dll stdcall';
procedure PrecompExtract(in_file, extract_path: PAnsiChar; callback: longword); external 'precomp_extract@files:isprecomp.dll,precomp.dll,zlib1.dll,packjpg_dll.dll stdcall';
procedure PrecompBreak; external 'precomp_break@files:isprecomp.dll stdcall delayload';

Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

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

function GetTickCount: DWord; external 'GetTickCount@kernel32';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
function GetCurrentThreadID: LongWord; external 'GetCurrentThreadId@kernel32 stdcall delayload';
function MulDiv(Number, Numerator, Denominator: Integer): Integer; external 'MulDiv@kernel32 stdcall delayload';

function CallNextWNDPROC(idHook: LongWord; Code: Integer; wParam: Word; lParam: TCWPSTRUCT): LongWord; external 'CallNextHookEx@user32 stdcall delayload';
function SetWindowsHookEx(idHook: LongWord; callback: LongWord; hMod: LongWord; dwThreadID: HWND): LongWord; external 'SetWindowsHookExW@user32 stdcall delayload';
function UnhookWindowsHookEx(idHook: LongWord): LongWord; external 'UnhookWindowsHookEx@user32 stdcall delayload';
function WrapCWPSTRUCTProc(callback:TCWPSTRUCTProc; paramcount:integer): longword; external 'wrapcallback@files:innocallback.dll';
function WrapTimerProc(callback: TTimerProc; Paramcount: Integer): longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): longword; external 'SetTimer@user32';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32 stdcall delayload';

procedure AppProcessMessage;
var
Msg: TMessage;
begin
if not PeekMessage(Msg, {WizardForm.Handle} 0, 0, 0, PM_REMOVE) then Exit;
TranslateMessage(Msg); DispatchMessage(Msg);
end;

Function FreeArcCmd(callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer;
Begin
CancelCode:= 0; AppProcessMessage;
try
Result:= FreeArcExtract(callback, cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10); // Pass the specified arguments to 'unarc.dll'
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;
End;

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

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

Function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
Function LoWord(lw: LongWord): LongWord; Begin Result:= lw shr 16; End;

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

procedure PrecompCallback(progress: integer);
begin
ProgressBar.Position := progress;
StatusInfo.Caption := 'Обработано: ' + IntToStr(ProgressBar.Position) + '%';
AppProcessMessage;
end;

Procedure CheckPrecompFiles(Filename: String);
var
GetFile: String;
begin
If ExtractFileExt(Filename) = '.pcf' then //Находим файлы
begin
if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Filename)) > 0) then
GetFile:= Filename else //Если имеется полный путь, оставляем так
GetFile:= AddBackslash(DestDir) + Filename; //Если путь неполный, то добавляем необходимые строчки
SetIniString('Files', IntToStr(PrecompFiles), GetFile, ExpandConstant('{app}\Files.ini')) //Сохраняем название файла в файл
PrecompFiles:= PrecompFiles + 1 //Общее количество найденных файлов
end;
if Filename = '' then Exit;
end;

Procedure ISPrecompCmd();
var
StrN: Integer;
InFile, OutDir: String;
callback: Longword;
Begin
ProgressBar.Position:= 0; ProgressBar.Max:= 100
WizardForm.ProgressGauge.Position:=0;
WizardForm.ProgressGauge.Max:=PrecompFiles;
StatusLabel.Caption:= 'Преобразование файлов. Пожалуйста подождите';
Status.stage:= StatusLabel.Caption; ExtractFile.Hide;
for StrN:= 0 to (PrecompFiles-1) do //Получаем количество файлов
begin
InFile:=GetIniString('Files',IntToStr(StrN), '', ExpandConstant('{app}\Files.ini')); //Получаем название файла
FilenameLabel.Caption:= InFile
OutDir:= ExtractFilePath(InFile)
ProgressBar.Position:= 0; Callback:= WrapPrecompCallback(@PrecompCallback,1);
PrecompExtract(InFile, OutDir, callback);
WizardForm.ProgressGauge.Position:= WizardForm.ProgressGauge.Position + 1;
DeleteFile(InFile); //Удаляем файл
end;
AppProcessMessage;
End;

Function StringToArray(Text, Cut: String): array of String; var i, k: Integer; // поместить строки текста в элементы массив. шаблон перевода строк может быть любым. шаблон в начале/конце текста игнорируются
Begin
SetArrayLength(Result, 0); if Cut = '' then Cut:= #1310; //если шаблон пуст, считаем переводы строк
Repeat k:= Pos(Cut,Text);
if k = 1 then begin Delete(Text, 1, Length(Cut)); CONTINUE
end;
SetArrayLength(Result, GetArrayLength(Result) +1); i:= GetArrayLength(Result) -1;
if k = 0 then
Result[i]:=Text
else begin
Result[i]:= Copy(Text, 1, k -1); Delete(Text, 1, Length(Result[i]) + Length(Cut));
end;
Until Length(Text) * k = 0;
End;

Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer; Prefs: TObject): TLabel;
Begin
Result:=TLabel.Create(Parent); Result.parent:= Parent;
if Prefs <> Nil then begin
Top:= TWinControl(Prefs).Top; Left:= TWinControl(Prefs).Left; Width:= TWinControl(Prefs).Width; Height:= TWinControl(Prefs).Height;
end;
if Top > 0 then result.Top:=Top; if Left > 0 then result.Left:= Left; if Width > 0 then result.Width:= Width; if Height > 0 then result.Height:= Height;
if FontName <> '' then result.Font.Name:= FontName; if FontColor > 0 then result.Font.Color:= FontColor; if FontStyle <> [] then result.Font.Style:= FontStyle;
result.AutoSize:= AutoSize; result.WordWrap:= WordWrap; result.Transparent:=Transparent; result.ShowHint:= true;
End;

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

Function ExpandENV(string: String): String; var n: UINT; Begin // ExpandConstant + развёртывание DOS-переменных типа %SystemRoot%
if Pos('{',string) * Pos('}',string) = 0 then Result:= String else Result:= ExpandConstant(String); n:= Pos('%',result); if n = 0 then Exit;
Delete(result, n,1); Result:= Copy(Result,1, n-1) + ExpandConstant('{%'+Copy(Result, n, Pos('%',result) -n) +'}') + Copy(Result, Pos('%',result) +1, Length(result))
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;

Function RGB(r, g, b: Longint): Longint; Begin Result:= (r or (g shl 8) or (b shl 16)) End;
Function GetBValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 16) End;
Function GetGValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 8) End;
Function GetRValue(rgb: DWord): Byte; Begin Result:= Byte(rgb) End;

Procedure GradientFill(WorkBmp: TBitmapImage; BeginColor, FinishColor: Integer); var ColorBand: TRect; StartColor, i: Integer; Begin {если BeginColor < 0, то градиент горизонтальный}
WorkBmp.Bitmap.Width:= WorkBmp.Width; WorkBmp.Bitmap.Height:= WorkBmp.Height; StartColor:= trunc(Abs(BeginColor))
if BeginColor < 0 then n:= WorkBmp.Width else n:= WorkBmp.Height;
for i:=0 to n do begin if BeginColor < 0 then begin
ColorBand.Top:= 0; ColorBand.Bottom:= WorkBmp.Height;
ColorBand.Left:= MulDiv(i, WorkBmp.Width, n); ColorBand.Right:= MulDiv(i+1, WorkBmp.Width, n);
end else begin
ColorBand.Top:= MulDiv(i, WorkBmp.Height, n); ColorBand.Bottom:= MulDiv(i+1, WorkBmp.Height, n);
ColorBand.Left:= 0; ColorBand.Right:= WorkBmp.Width; end;
WorkBmp.Bitmap.Canvas.Brush.Color:= RGB(GetRValue(StartColor) + MulDiv(I, GetRValue(FinishColor) - GetRValue(StartColor), n-1), GetGValue(StartColor) + MulDiv(I, GetGValue(FinishColor) - GetGValue(StartColor), n-1), GetBValue(StartColor) + MulDiv(I, GetBValue(FinishColor) - GetBValue(StartColor), n-1));
WorkBmp.Bitmap.Canvas.FillRect(ColorBand); end;
End;

// Converts OEM encoded string into ANSI (Преобразует OEM строку в ANSI кодировку)
function 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 кодировку)
function AnsiToUtf8(strSource: string): string;
var
nRet, nRet2: integer; WideCharBuf, MultiByteBuf: AnsiString;
begin
SetLength(WideCharBuf, Length(strSource) * 2);
SetLength(MultiByteBuf, Length(strSource) * 2);
nRet:= MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
nRet2:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
if nRet * nRet2 = 0 then Result:= strSource else Result:= MultiByteBuf;
end;

Procedure UpdateStatus(Flags: Integer); // выполняется с периодичностью, заданной константой Period
var
Remaining: Integer; i, t, s: string;
Begin
if Flags and $1 > 0 then FreezeTimer:= Flags and $2 = 0; // bit 0 = 1 change start/stop, bit 1 = 0 stop, bit 1 = 1 start
if (Flags and $4 > 0) or (Status.size <> baseMb+lastMb) then LastTimerEvent:= 0; // bit 2 = 1 UpdateNow // обновить по флагу или записи из архива на диск
if FreezeTimer or (GetTickCount - LastTimerEvent <= Period) then Exit else LastTimerEvent:= GetTickCount;
Status.size := baseMb+lastMb; // извлечено на текущий момент
if totalUncompressedSize > 0 then with WizardForm.ProgressGauge do begin // основной прогресс движется по мере записи данных на диск
Position:= round(Max * Status.size/totalUncompressedSize)
end;
with WizardForm.ProgressGauge do begin // оставшееся время
#ifndef precomp
// к сожалению, этот код иногда сбоит на очень больших архивах, созданных с использованием внешних упаковщиков
if position > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((max - position)/position)) else
#endif
Remaining:= 0;
t:= cm('ending'); i:= t;
if Remaining > 0 then begin
t:= FmtMessage(cm('taskbar'), [IntToStr(Status.perc/10), TicksToTime(Remaining, 'h', 'm', 's', false)])
i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)
end;
end;
SetTaskBarTitle(t); // проценты и оставшееся время на кнопке инсталлятора
if Status.size > 0 then
s:= ' ['+ ByteOrTB(Status.size*oneMB, true) +']'; // если сделать подсчёт размера папки {app} через CalcDirSize, то при частом пересчёте папки большого объёма это может замедлить работу
StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(Status.count +ord(Status.count < 0)), s, Format('%.1n', [Abs(Status.perc/10)]), i]);
// второй прогрессбар движется по мере считывания текущего архива
if (Status.stage = cm('ArcTitle')) and (GetArrayLength(Arcs) > 0) then begin
ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), ByteOrTB(Arcs[ArcInd].Size, true), Format('%.0n', [Status.mb/(Arcs[ArcInd].Size/oneMB)*100]), ByteOrTB(Status.allsize, true)])
ProgressBar.Position:= round(ProgressBar.Max * Status.mb/trunc(Arcs[ArcInd].Size/oneMB))
end;
End;

Procedure MyTimerProc(h, msg, idevent, dwTime: Longword);
Begin
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0);
End;

Procedure OnWndHook(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
Begin
if (Code = HC_ACTION) and (LoWord(lParam.msg) = WM_PAINT) then begin // подготовка данных для последующего отображения по таймеру
if (Status.name <> WizardForm.FileNameLabel.Caption) and (WizardForm.FileNameLabel.Caption <> '') then begin // имя файла, названия ярлыка и прочее
FileNameLabel.Caption:= WizardForm.FileNameLabel.Caption;
Status.name:= WizardForm.FileNameLabel.Caption; // начало извлечения или распаковки очередного файла
Case Status.stage of
SetupMessage(msgStatusExtractFiles): // этап извлечения файлов инсталлятором
Status.count:= Status.count +1; // кол-во файлов
End;
end;
if (Status.stage <> WizardForm.StatusLabel.Caption) and (WizardForm.StatusLabel.Caption <> '') then begin
StatusLabel.Caption:= WizardForm.StatusLabel.Caption;
Status.stage:= WizardForm.StatusLabel.Caption; // текущий этап установки
if Status.stage = SetupMessage(msgStatusRollback) then begin
WizardForm.StatusLabel.Hide; WizardForm.FileNameLabel.Hide; StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;
end;
with WizardForm.ProgressGauge do begin
n:= (Max - Min)/1000
if n > 0 then Status.perc:= (Position-Min)/n; // 1000 процентов
end;
UpdateStatus(0);
end;
CallNextWNDPROC(WndHookID, Code, wParam, lParam) {освобождение события}
End;

function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer; // вызывается не менее 100 раз в секунду, что заменяет вызов по таймеру
begin
case string(what) of
'origsize': origsize:= Mb; // данных в тек. архиве (при распаковке не вызывается)
'total_files': Null;
'filename': begin // Update FileName label
WizardForm.FileNameLabel.Caption:= OemToAnsiStr(str); // извлекаемый файл, их имена пишутся в журнал установки
FileNameLabel.Caption:= OemToAnsiStr(str); // извлекаемый файл, их имена пишутся в журнал установки
CheckPrecompFiles(OemToAnsiStr(str))
Status.count:= Status.count + 1; // кол-во файлов, этап распаковки
end;
'read': // позиция в текущем архиве
Status.mb:= Mb;
'write': // Assign to Mb *total* amount of data extracted to the moment from all archives
lastMb:= Mb; // извлечено из текущего архива
end;
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0); // обновить страницу установки, не сбрасывая таймер
if (GetKeyState(VK_ESCAPE) < 0) and not CancelDuringInstall then
WizardForm.Close; // опрашиваем Cancel (если разрешена отмена установки)
AppProcessMessage;
Result:= CancelCode;
end;

Function ArcDecode(Line: string): array of TArc; // разбор строки Archives
var tmp, cut: array of String; n, i: integer;
Begin
SetArrayLength(result,0); if Line <> '' then tmp:= StringToArray(Line,'|') else Exit;
for n:= 0 to GetArrayLength(tmp) - 1 do begin
if tmp[n][Length(tmp[n])] = '?' then Continue; // эта запись обрабатывается в AfterInstall: UnArc(...)
SetArrayLength(result, GetArrayLength(result) +1); i:= GetArrayLength(result) -1;
cut:= StringToArray(tmp[n],'>') // задачи, логика or and not наверное не будет работать
if GetArrayLength(cut) > 1 then result[i].task:= cut[1];
cut:= StringToArray(cut[0],'<') // компоненты
if GetArrayLength(cut) > 1 then result[i].comp:= cut[1];
cut:= StringToArray(cut[0],'/') // папка распаковки
if GetArrayLength(cut) > 1 then result[i].Dest:= cut[1] else result[i].Dest:= '{app}'; // по-умолчанию
if (ExtractFileDrive(ExpandENV(cut[0])) = '') and (ExpandENV(cut[0]) = cut[0]) then // строка вида Rus\*.arc
result[i].Path:= '{src}\'+ cut[0] else result[i].Path:= cut[0]; // остаток от исходной строки
result[i].Dest:= ExpandENV(result[i].Dest); result[i].Path:= ExpandENV(result[i].Path);
end;
End;

function AddArcs(files, target: string): Integer; // добавление архивов в общий список и подсчёт объёма распакованных данных
var FSR: TFindRec; i: integer;
Begin
Result:= 0; if FindFirst(ExpandENV(files), FSR) then
try
repeat
// Skip everything but the folders
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
// Expand the folder list
i:= GetArrayLength(Arcs); SetArrayLength(Arcs, i +1);
Arcs[i].Dest:= target; // путь распаковки для найденных по маске архивов
Arcs[i].Path:= ExtractFilePath(ExpandENV(files)) + FSR.Name;
Arcs[i].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Status.allsize:= Status.allsize + Arcs[i].Size; // зарезервировано для подсчёта прогресса распаковки 7-zip архивов (is7z.dll)
Arcs[i].allMb:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4),'l','--',AnsiToUtf8(Arcs[i].Path),'','','','','','',''); // код ошибки

if Arcs[i].allMb >= 0 then begin
Arcs[i].allMb:= origsize; result:= result + Arcs[i].allMb; // размер распакованных данных успешно считан
end;
until not FindNext(FSR);
finally
FindClose(FSR);
end;
End;

function UnPackArchive(Source, Destination: string; allMb, Mode: Integer): Integer;
var
callback, callback2: longword;
Begin
// если отмена установки разрешена, кнопка Cancel станет доступна
WizardForm.CancelButton.Enabled:= not CancelDuringInstall;
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
DestDir:= Destination
Result:= FreeArcCmd(callback,'x','-o+','-dp'+AnsiToUtf8(Destination),'--',AnsiToUtf8(Source),'','','','',''); // код ошибки
//Destination + FileNameLabel.Caption
// callback2 := WrapPrecompCallback(@PrecompCallback,1);
// ISPrecompCmd('VoLT, 2010', Destination + '\' + FileNameLabel.Caption, Destination + '\' + 'Patch.dv2', callback2);
// Error occured
if Result = 0 then Exit;
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
WizardForm.StatusLabel.Caption:= msgError;
WizardForm.FileNameLabel.Caption:= ExtractFileName(Source);
GetSpaceOnDisk(ExtractFileDrive(Destination), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < allMb {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Source)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
Log(msgError); // записываем ошибку в лог, а также показываем её текст на странице завершения
End;

function UnPack(Archives: string): Integer;
begin
// UpdateStatus(1); // остановить таймер
Records:= ArcDecode(Archives); SetArrayLength(Arcs,0); Status.allsize:= 0; {общий объём}
for n:= 0 to GetArrayLength(Records) -1 do // Get the size of all archives
if (not IsTaskSelected(Records[n].task) and (Records[n].task <>'')) and (not IsComponentSelected(Records[n].comp) and (Records[n].comp <>'')) then Continue // компоненты и задачи не выбраны
else totalUncompressedSize:= totalUncompressedSize + AddArcs(Records[n].Path, Records[n].Dest); // создаём список архивов
// Other initializations
WizardForm.StatusLabel.Caption:= cm('ArcTitle'); // начало этапa распаковки
ExtractFile.Show; ProgressBar.Show;
baseMb:= 0; lastMb:= 0; Status.mb:= 0; // обнулить полученные мегабайты, если ранее вёлся подсчёт объёма файлов инсталлятора
Status.count:= 0; // не учитывать файлы, извлечённые инсталлятором
UpdateStatus(7); // немедленно обновить строку статуса
for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin // архивы в текущей папке, константы раскрыты в ArcDecode
Result:= UnPackArchive(Arcs[ArcInd].Path, Arcs[ArcInd].Dest, Arcs[ArcInd].allMb, 0); // код ошибки
if Result <> 0 then Break; // прервать цикл распаковки
baseMb:= baseMb + lastMb; lastMb:= 0; Status.mb:= 0; // общий объём распакованных файлов
// отработанный архив автоматически удаляется, если находится в папке {app} или {tmp}
if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) or (Pos(AnsiLowercase(ExpandConstant('{tmp}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) then
DeleteFile(Arcs[ArcInd].Path);
end;
end;

procedure CurStepChanged1(CurStep: TSetupStep);
begin
if CurStep = ssInstall then begin
StartInstall:= GetTickCount {время начала извлечения файлов}
WndHookID:= SetWindowsHookEx(WH_CALLWNDPROC, WrapCWPSTRUCTProc(@OnWndHook, 3), 0, GetCurrentThreadID); {установка SendMessage хука}
TimerID:= SetTimer(0, 0, 500 {полсекунды}, WrapTimerProc(@MyTimerProc, 4)); {установка таймера}
if not {#isFalse(SetupSetting("Uninstallable"))} then Status.count:= -1; // не считать файл unins000.exe
end;
if CurStep = ssPostInstall then
begin
StartInstall:= GetTickCount {время начала распаковки}
UnPackError:= UnPack('{#Archives}')
if UnPackError <> 0 then begin // Error occured, uninstall it then
if not {#isFalse(SetupSetting("Uninstallable"))} then // деинсталляция разрешёна
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); // откат установки из-за ошибки unarc.dll
WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
SetTaskBarTitle(SetupMessage(msgErrorTitle))
end else
SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
//Вынес сюда, иначе возникали глюки
KillTimer(0, TimerID) {удаление таймера}
UnhookWindowsHookEx(WndHookID) {удаление SendMessage хука}
//Вынес чтоб нормально работал SIPrecomp
if UnPackError = 0 then
if PrecompFiles <> 0 then //если кол-во найденных файлов не равно 0, то работает ISPrecomp
begin
ISPrecompCmd()
DeleteFile(ExpandConstant('{app}\Files.ini'))
WizardForm.StatusLabel.Caption:= FmtMessage(cm('ArcFinish'), [IntToStr(GetArrayLength(Arcs)), IntToStr(Status.count), ByteOrTB(Status.size*oneMB, true)]);
StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide; //Скрываем надписи и пргрессбары
end else //Иначе просто все скрываем
begin
WizardForm.StatusLabel.Caption:= FmtMessage(cm('ArcFinish'), [IntToStr(GetArrayLength(Arcs)), IntToStr(Status.count), ByteOrTB(Status.size*oneMB, true)]);
StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;
end;
end;

Procedure SetTexture(CurPageID: Integer); // на каждой странице своя картинка
Begin
WizardForm.Bevel1.Visible:= (WizardForm.CurPageID <> wpWelcome) and (WizardForm.CurPageID <> wpFinished);
WizardForm.Bevel1.Parent:= WizardForm.OuterNotebook.ActivePage

End;

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

procedure WizardClose(Sender: TObject; var Action: TCloseAction);
Begin
Action:= caNone; // так надо
if Status.stage = cm('ArcTitle') then begin // распаковка на этапе ssPostInstall
UpdateStatus(1); // остановить таймер
if MsgBox(SetupMessage(msgExitSetupMessage), mbInformation, MB_YESNO) = IDYES then
CancelCode:= -127; // прервать распаковку
UpdateStatus(7); // обновить информацию
end else
MainForm.Close; // стандартное нажатие кнопки закрытия окна, отмены или Escape.
End;

Procedure InitializeWizard1();
Begin
// Create controls to show extended info
PrecompFiles:=0
StatusLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.StatusLabel);
FileNameLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.FileNameLabel);
WizardForm.StatusLabel.Top:= WizardForm.ProgressGauge.Top; WizardForm.FileNameLabel.Top:= WizardForm.ProgressGauge.Top; // прячем под прогрессбар, тогда все события WM_PAINT перехватываются
with WizardForm.ProgressGauge do begin
StatusInfo:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, Top + ScaleY(32), Width, 0, Nil);
ProgressBar := TNewProgressBar.Create(WizardForm);
ProgressBar.SetBounds(Left, StatusInfo.Top + StatusInfo.Height + ScaleY(16), Width, Height);
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 65536;
ProgressBar.Hide; // будет показан при обработке нескольких архивов

ExtractFile:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, ProgressBar.Top + ScaleY(32), Width, 0, Nil);
end;
WizardForm.OnClose:= @WizardClose // позволяет прервать распаковку архивов стандартными способами

End;
Автор: alex2605
Дата сообщения: 13.04.2010 14:28
geroinnn one
пишет, что не найден innocallback.dll
чтобы работало, пропиши данный файл в секции [File]
Автор: vint56
Дата сообщения: 13.04.2010 15:49
geroinnn one
[Files]
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Автор: Belenos
Дата сообщения: 13.04.2010 17:01
Люди, помогите кто разбирается в кодах, фон темы ISSkin закрывает лого (тот что внизу инсталлера посередине), может в коде чего исправить можно или дописать, что бы фон ISSkin не закрывал лого ?

http://i052.radikal.ru/1003/47/092ec5ba6261.jpg

[more=Вот весь код][Setup]
OutputDir=D:\Games\1 Install
AppName=xxx
AppVerName=xxx
DefaultDirName={pf}\xxx
WizardSmallImageFile=D:\Games\1 Install\logo.bmp

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

[CustomMessages]
rus.ArcBreak=Установка прервана!
rus.ArcError=Распаковщик вернул код ошибки: %1
rus.ArcBroken=Возможно, архив <%1> повреждён или недостаточно места на диске назначения.
rus.ArcFail=Распаковка не завершена!
rus.ArcTitle=Распаковка архивов...
rus.StatusInfo=файлов: %1%2, %3%% выполнено, осталось ждать %4
rus.ArcInfo=Архив %1 из %2, объём %3 из %5, %4%% обработано
rus.ArcFinish=Распаковано архивов: %1, получено файлов: %2 [%3]
rus.taskbar=%1%%, ждёмс %2
rus.ending=завершение
rus.hour=часов
rus.min=мин
rus.sec=сек
rus.InsertDisk=Пожалуйста, вставьте диск № %1 и нажмите кнопку ОК.

[_ISToolPreCompile]
#define isFalse(any S) (S = LowerCase(Str(S))) == "no" || S == "false" || S == "off" ? "true" : "false"

[Files]
Source: D:\Games\1 Install\Slides\01.jpg; DestDir: {tmp}; Flags: ignoreversion dontcopy nocompression
Source: D:\Games\1 Install\Slides\02.jpg; DestDir: {tmp}; Flags: ignoreversion dontcopy nocompression
Source: isgsg.dll; DestDir: {tmp}; Flags: ignoreversion dontcopy nocompression
Source: compiler:unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: ISSkin.dll; DestDir: {app}; Flags: dontcopy
Source: Tiger.cjstyles; DestDir: {tmp}; Flags: dontcopy
Source: D:\Games\1 Install\logo.gif; DestDir: {tmp}; Flags: dontcopy
Source: gifctrl.dll; DestDir: {tmp}; Flags: dontcopy
Source: D:\Games\1 Install\fon.bmp; DestDir: {tmp}; Flags: dontcopy

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

[Code]
#define Archives "{src}\data-1.bin;DestDir:{app}\;Disk:1;Components: g0|{src}\data-2.bin;DestDir:{app}\;Disk:1;Components: g1|
type
#ifdef UNICODE
#define A "W"
#else
#define A "A" ;// точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
#endif
#if Ver < 84018176
#endif

TMessage = record hWnd: HWND; msg, wParam: Word; lParam: LongWord; Time: TFileTime; pt: TPoint; end;
TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
TArc = record Path, Dest, comp, task: string; allMb, Files, disks: Integer; Size: Extended; end;
TBarInfo = record stage, name: string; size, allsize: Extended; count, perc, pos, mb, time: Integer; end;
TCWPSTRUCT = record lParam: LongWord; wParam: Word; Msg: LongWord; hwnd: HWnd; end;
TCWPSTRUCTProc = procedure(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
TTimerProc = procedure(HandleW, Msg, idEvent, TimeSys: LongWord);
var
StatusLabel, FileNameLabel, ExtractFile, StatusInfo: TLabel;
ProgressBar: TNewProgressBar;
CancelCode, n, ArcInd, UnPackError, StartInstall, LastTimerEvent, lastMb, baseMb,faDiskCount,faDiskName, faUnpackedArchives: Integer;
FreeMB, TotalMB: Cardinal;
WndHookID, TimerID: LongWord;
Arcs, Records, AllArchives: array of TArc;
msgError: string;
Status: TBarInfo;
FreezeTimer, faDiskSuspendUpdateStatus: Boolean;
totalUncompressedSize, origsize: Integer; // total uncompressed size of archive data in mb
Texture2, Texture: TBitmapImage;
const
PM_REMOVE = 1;
CP_ACP = 0; CP_UTF8 = 65001;
oneMB=1024*1024;
Period = 250; // частота обновления кнопки таскбара и строки статуса
BackColor = $fcfbfb; EndColor = $d8e9ec; // цвета подобраны для темы Луна
VK_ESCAPE = 27;
HC_ACTION = 0;
WH_CALLWNDPROC = 4;
WM_PAINT = $F;
CancelDuringInstall = {#isFalse(SetupSetting("AllowCancelDuringInstall"))};

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';

Function OemToChar(lpszSrc, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
Function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpWideCharStr: PAnsiChar; cchWideChar: integer): longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
Function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: integer; lpMultiByteStr: PAnsiChar; cbMultiByte: integer; lpDefaultChar: integer; lpUsedDefaultChar: integer): longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

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

function GetTickCount: DWord; external 'GetTickCount@kernel32';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';
function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';
function GetCurrentThreadID: LongWord; external 'GetCurrentThreadId@kernel32 stdcall delayload';
function MulDiv(Number, Numerator, Denominator: Integer): Integer; external 'MulDiv@kernel32 stdcall delayload';

function CallNextWNDPROC(idHook: LongWord; Code: Integer; wParam: Word; lParam: TCWPSTRUCT): LongWord; external 'CallNextHookEx@user32 stdcall delayload';
function SetWindowsHookEx(idHook: LongWord; callback: LongWord; hMod: LongWord; dwThreadID: HWND): LongWord; external 'SetWindowsHookExW@user32 stdcall delayload';
function UnhookWindowsHookEx(idHook: LongWord): LongWord; external 'UnhookWindowsHookEx@user32 stdcall delayload';
function WrapCWPSTRUCTProc(callback:TCWPSTRUCTProc; paramcount:integer): longword; external 'wrapcallback@files:innocallback.dll';
function WrapTimerProc(callback: TTimerProc; Paramcount: Integer): longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): longword; external 'SetTimer@user32';
function KillTimer(hWnd, nIDEvent: LongWord): LongWord; external 'KillTimer@user32 stdcall delayload';

procedure AppProcessMessage;
var
Msg: TMessage;
begin
if not PeekMessage(Msg, {WizardForm.Handle} 0, 0, 0, PM_REMOVE) then Exit;
TranslateMessage(Msg); DispatchMessage(Msg);
end;

Function FreeArcCmd(callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer;
Begin
CancelCode:= 0; AppProcessMessage;
try
Result:= FreeArcExtract(callback, cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10); // Pass the specified arguments to 'unarc.dll'
if CancelCode < 0 then Result:= CancelCode;
except
Result:= -63; // ArcFail
end;
End;

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

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

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

Function StringToArray(Text, Cut: String): array of String; var i, k: Integer; // поместить строки текста в элементы массив. шаблон перевода строк может быть любым. шаблон в начале/конце текста игнорируются
Begin
SetArrayLength(Result, 0); if Cut = '' then Cut:= #1310; //если шаблон пуст, считаем переводы строк
Repeat k:= Pos(Cut,Text);
if k = 1 then begin Delete(Text, 1, Length(Cut)); CONTINUE
end;
SetArrayLength(Result, GetArrayLength(Result) +1); i:= GetArrayLength(Result) -1;
if k = 0 then
Result[i]:=Text
else begin
Result[i]:= Copy(Text, 1, k -1); Delete(Text, 1, Length(Result[i]) + Length(Cut));
end;
Until Length(Text) * k = 0;
End;

Function CreateLabel(Parent: TWinControl; AutoSize, WordWrap, Transparent: Boolean; FontName: String; FontStyle: TFontStyles; FontColor: TColor; Left, Top, Width, Height: Integer; Prefs: TObject): TLabel;
Begin
Result:=TLabel.Create(Parent); Result.parent:= Parent;
if Prefs <> Nil then begin
Top:= TWinControl(Prefs).Top; Left:= TWinControl(Prefs).Left; Width:= TWinControl(Prefs).Width; Height:= TWinControl(Prefs).Height;
end;
if Top > 0 then result.Top:=Top; if Left > 0 then result.Left:= Left; if Width > 0 then result.Width:= Width; if Height > 0 then result.Height:= Height;
if FontName <> '' then result.Font.Name:= FontName; if FontColor > 0 then result.Font.Color:= FontColor; if FontStyle <> [] then result.Font.Style:= FontStyle;
result.AutoSize:= AutoSize; result.WordWrap:= WordWrap; result.Transparent:=Transparent; result.ShowHint:= true;
End;

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

Function ExpandENV(string: String): String; var n: UINT; Begin // ExpandConstant + развёртывание DOS-переменных типа %SystemRoot%
if Pos('{',string) * Pos('}',string) = 0 then Result:= String else Result:= ExpandConstant(String); n:= Pos('%',result); if n = 0 then Exit;
Delete(result, n,1); Result:= Copy(Result,1, n-1) + ExpandConstant('{%'+Copy(Result, n, Pos('%',result) -n) +'}') + Copy(Result, Pos('%',result) +1, Length(result))
End;

Function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End;
Function LoWord(lw: LongWord): LongWord; Begin Result:= lw shr 16; 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;

Function RGB(r, g, b: Longint): Longint; Begin Result:= (r or (g shl 8) or (b shl 16)) End;
Function GetBValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 16) End;
Function GetGValue(rgb: DWord): Byte; Begin Result:= Byte(rgb shr 8) End;
Function GetRValue(rgb: DWord): Byte; Begin Result:= Byte(rgb) End;

Procedure GradientFill(WorkBmp: TBitmapImage; BeginColor, FinishColor: Integer); var ColorBand: TRect; StartColor, i: Integer; Begin {если BeginColor < 0, то градиент горизонтальный}
WorkBmp.Bitmap.Width:= WorkBmp.Width; WorkBmp.Bitmap.Height:= WorkBmp.Height; StartColor:= trunc(Abs(BeginColor))
if BeginColor < 0 then n:= WorkBmp.Width else n:= WorkBmp.Height;
for i:=0 to n do begin if BeginColor < 0 then begin
ColorBand.Top:= 0; ColorBand.Bottom:= WorkBmp.Height;
ColorBand.Left:= MulDiv(i, WorkBmp.Width, n); ColorBand.Right:= MulDiv(i+1, WorkBmp.Width, n);
end else begin
ColorBand.Top:= MulDiv(i, WorkBmp.Height, n); ColorBand.Bottom:= MulDiv(i+1, WorkBmp.Height, n);
ColorBand.Left:= 0; ColorBand.Right:= WorkBmp.Width; end;
WorkBmp.Bitmap.Canvas.Brush.Color:= RGB(GetRValue(StartColor) + MulDiv(I, GetRValue(FinishColor) - GetRValue(StartColor), n-1), GetGValue(StartColor) + MulDiv(I, GetGValue(FinishColor) - GetGValue(StartColor), n-1), GetBValue(StartColor) + MulDiv(I, GetBValue(FinishColor) - GetBValue(StartColor), n-1));
WorkBmp.Bitmap.Canvas.FillRect(ColorBand); end;
End;
// Converts OEM encoded string into ANSI (Преобразует OEM строку в ANSI кодировку)
function 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 кодировку) by CTAC-Ko
function AnsiToUtf8(strSource: string): string;
var
nRet, nRet2: integer; WideCharBuf, MultiByteBuf: AnsiString;
begin
SetLength(WideCharBuf, Length(strSource) * 2);
SetLength(MultiByteBuf, Length(strSource) * 2);
nRet:= MultiByteToWideChar(CP_ACP, 0, strSource, -1, WideCharBuf, Length(WideCharBuf));
nRet2:= WideCharToMultiByte(CP_UTF8, 0, WideCharBuf, -1, MultiByteBuf, Length(MultiByteBuf), 0, 0);
if nRet * nRet2 = 0 then Result:= strSource else Result:= MultiByteBuf;
end;

// ArcInd - текущий архив, счёт с 0
// baseMb - записано из пред. архива на диск
// lastMb - извлечено из тек. архива на диск
// Status.mb - позиция в текущем архиве
// Status.allsize - объём всех архивов
// Status.size - всего извлечено Мб на текущий момент
// totalUncompressedSize - точный объём данных в архивах
// общий прогресс нарастает по мере записи данных из архива на диск (точка 'write')
// прогресс архивов двигается в соответствии с позицией в текущем архиве (точка 'read')

Procedure UpdateStatus(Flags: Integer); // выполняется с периодичностью, заданной константой Period
var
Remaining: Integer; i, t, s: string;
Begin
if faDiskSuspendUpdateStatus then Exit; //если апдейт приостановлен - сразу на выход
if Flags and $1 > 0 then FreezeTimer:= Flags and $2 = 0; // bit 0 = 1 change start/stop, bit 1 = 0 stop, bit 1 = 1 start
if (Flags and $4 > 0) or (Status.size <> baseMb+lastMb) then LastTimerEvent:= 0; // bit 2 = 1 UpdateNow // обновить по флагу или записи из архива на диск
if FreezeTimer or (GetTickCount - LastTimerEvent <= Period) then Exit else LastTimerEvent:= GetTickCount;
Status.size := baseMb+lastMb; // извлечено на текущий момент
if totalUncompressedSize > 0 then with WizardForm.ProgressGauge do begin // основной прогресс движется по мере записи данных на диск
Position:= round(Max * Status.size/totalUncompressedSize)
end;
with WizardForm.ProgressGauge do begin // оставшееся время
#ifndef precomp
// к сожалению, этот код иногда сбоит на очень больших архивах, созданных с использованием внешних упаковщиков
if position > 0 then Remaining:= trunc((GetTickCount - StartInstall) * Abs((max - position)/position)) else
#endif
Remaining:= 0;
t:= cm('ending'); i:= t;
if Remaining > 0 then begin
t:= FmtMessage(cm('taskbar'), [IntToStr(Status.perc/10), TicksToTime(Remaining, 'h', 'm', 's', false)])
i:= TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)
end;
end;
SetTaskBarTitle(t); // проценты и оставшееся время на кнопке инсталлятора
if Status.size > 0 then
s:= ' ['+ ByteOrTB(Status.size*oneMB, true) +']'; // если сделать подсчёт размера папки {app} через CalcDirSize, то при частом пересчёте папки большого объёма это может замедлить работу
StatusInfo.Caption:= FmtMessage(cm('StatusInfo'), [IntToStr(Status.count +ord(Status.count < 0)), s, Format('%.1n', [Abs(Status.perc/10)]), i]);
// второй прогрессбар движется по мере считывания текущего архива
if (Status.stage = cm('ArcTitle')) and (GetArrayLength(Arcs) > 0) then begin
if faDiskCount=1 then
ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), ByteOrTB(Arcs[ArcInd].Size, true), Format('%.0n', [Status.mb/(Arcs[ArcInd].Size/oneMB)*100]), ByteOrTB(Status.allsize, true)])
else
ExtractFile.Caption:= FmtMessage(cm('ArcInfo')+'. Диск: '+inttostr(faDiskName)+'/'+inttostr(faDiskCount), [IntToStr(ArcInd+1), IntToStr(GetArrayLength(Arcs)), ByteOrTB(Arcs[ArcInd].Size, true), Format('%.0n', [Status.mb/(Arcs[ArcInd].Size/oneMB)*100]), ByteOrTB(Status.allsize, true)]);
ProgressBar.Position:= round(ProgressBar.Max * Status.mb/trunc(Arcs[ArcInd].Size/oneMB));
end;
End;

Procedure MyTimerProc(h, msg, idevent, dwTime: Longword);
Begin
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0);
End;

Procedure OnWndHook(Code: Integer; wParam: Word; lParam: TCWPSTRUCT);
Begin
if (Code = HC_ACTION) and (LoWord(lParam.msg) = WM_PAINT) then begin // подготовка данных для последующего отображения по таймеру
if (Status.name <> WizardForm.FileNameLabel.Caption) and (WizardForm.FileNameLabel.Caption <> '') then begin // имя файла, названия ярлыка и прочее
FileNameLabel.Caption:= WizardForm.FileNameLabel.Caption;
Status.name:= WizardForm.FileNameLabel.Caption; // начало извлечения или распаковки очередного файла
Case Status.stage of
SetupMessage(msgStatusExtractFiles): // этап извлечения файлов инсталлятором
Status.count:= Status.count +1; // кол-во файлов
End;
end;
if (Status.stage <> WizardForm.StatusLabel.Caption) and (WizardForm.StatusLabel.Caption <> '') then begin
StatusLabel.Caption:= WizardForm.StatusLabel.Caption;
Status.stage:= WizardForm.StatusLabel.Caption; // текущий этап установки
if Status.stage = SetupMessage(msgStatusRollback) then begin
WizardForm.StatusLabel.Hide; WizardForm.FileNameLabel.Hide; StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;
end;
with WizardForm.ProgressGauge do begin
n:= (Max - Min)/1000
if n > 0 then Status.perc:= (Position-Min)/n; // 1000 процентов
end;
UpdateStatus(0);
end;
CallNextWNDPROC(WndHookID, Code, wParam, lParam) {освобождение события}
End;

// compsize: в Mb объём архива
// total_files: в int2 ? число файлов в архиве
// origsize: в Mb общий объём данных в архиве
// write: в Mb число записанных (распакованных из архива) на диск мегабайт
// read: в Mb число обработанных мегабайт, в int2 размер текущего архива
// filename: вызывается перед обработкой каждого файла

// The main callback function for unpacking FreeArc archives
function FreeArcCallback(what: PAnsiChar; Mb, int2: Integer; str: PAnsiChar): Integer; // вызывается не менее 100 раз в секунду, что заменяет вызов по таймеру
begin
case string(what) of
'origsize': origsize:= Mb; // данных в тек. архиве (при распаковке не вызывается)
'total_files': Null;
'filename': begin // Update FileName label
WizardForm.FileNameLabel.Caption:= OemToAnsiStr(str); // извлекаемый файл, их имена пишутся в журнал установки
FileNameLabel.Caption:= OemToAnsiStr(str); // извлекаемый файл, их имена пишутся в журнал установки
Status.count:= Status.count + 1; // кол-во файлов, этап распаковки
end;
'read': // позиция в текущем архиве
Status.mb:= Mb;
'write': // Assign to Mb *total* amount of data extracted to the moment from all archives
lastMb:= Mb; // извлечено из текущего архива
end;
if WizardForm.CurPageID = wpInstalling then UpdateStatus(0); // обновить страницу установки, не сбрасывая таймер
if (GetKeyState(VK_ESCAPE) < 0) and not CancelDuringInstall then
WizardForm.Close; // опрашиваем Cancel (если разрешена отмена установки)
AppProcessMessage;
Result:= CancelCode;
end;

Function ArcDecode(Line: string): array of TArc; // разбор строки Archives
var tmp, cut: array of String; n, i: integer;
Begin
SetArrayLength(result,0); if Line <> '' then tmp:= StringToArray(Line,'|') else Exit;
for n:= 0 to GetArrayLength(tmp) - 1 do begin
if tmp[n][Length(tmp[n])] = '?' then Continue; // эта запись обрабатывается в AfterInstall: UnArc(...)
SetArrayLength(result, GetArrayLength(result) +1); i:= GetArrayLength(result) -1;
cut:= StringToArray(tmp[n],';Tasks:') // задачи, логика or and not наверное не будет работать
if GetArrayLength(cut) > 1 then result[i].task:= cut[1];
cut:= StringToArray(cut[0],';Components:') // компоненты
if GetArrayLength(cut) > 1 then result[i].comp:= cut[1];
cut:= StringToArray(cut[0],';Disk:') // диски
if GetArrayLength(cut) > 1 then result[i].disks:= StrToInt(cut[1]) else result[i].disks:=1;
cut:= StringToArray(cut[0],';DestDir:') // папка распаковки
if GetArrayLength(cut) > 1 then result[i].Dest:= cut[1] else result[i].Dest:= '{app}'; // по-умолчанию
if (ExtractFileDrive(ExpandENV(cut[0])) = '') and (ExpandENV(cut[0]) = cut[0]) then // строка вида Rus\*.arc
result[i].Path:= '{src}\'+ cut[0] else result[i].Path:= cut[0]; // остаток от исходной строки
result[i].Dest:= ExpandENV(result[i].Dest); result[i].Path:= ExpandENV(result[i].Path);
end;
End;

// Scans the specified folders for archives and add them to list
function AddArcs(files, target: string): Integer; // добавление архивов в общий список и подсчёт объёма распакованных данных
var FSR: TFindRec; i: integer;
Begin
Result:= 0; if FindFirst(ExpandENV(files), FSR) then
try
repeat
// Skip everything but the folders
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE;
// Expand the folder list
i:= GetArrayLength(Arcs); SetArrayLength(Arcs, i +1);
Arcs[i].Dest:= target; // путь распаковки для найденных по маске архивов
Arcs[i].Path:= ExtractFilePath(ExpandENV(files)) + FSR.Name;
Arcs[i].Size:= Size64(FSR.SizeHigh, FSR.SizeLow);
Status.allsize:= Status.allsize + Arcs[i].Size; // зарезервировано для подсчёта прогресса распаковки 7-zip архивов (is7z.dll)
Arcs[i].allMb:= FreeArcCmd(WrapFreeArcCallback(@FreeArcCallback,4),'l','--',AnsiToUtf8(Arcs[i].Path),'','','','','','',''); // код ошибки
if Arcs[i].allMb >= 0 then begin
Arcs[i].allMb:= origsize; result:= result + Arcs[i].allMb; // размер распакованных данных успешно считан
end;
until not FindNext(FSR);
finally
FindClose(FSR);
end;
End;

function UnPackArchive(Source, Destination: string; allMb, Mode: Integer): Integer;
var
callback: longword;
Begin
// если отмена установки разрешена, кнопка Cancel станет доступна
WizardForm.CancelButton.Enabled:= not CancelDuringInstall;
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
Result:= FreeArcCmd(callback,'x','-o+','-dp'+AnsiToUtf8(Destination),'-w'+AnsiToUtf8(Destination),'--',AnsiToUtf8(Source),'','','',''); // код ошибки
// Error occured
if Result = 0 then Exit;
msgError:= FmtMessage(cm('ArcError'), [IntToStr(Result)]);
WizardForm.StatusLabel.Caption:= msgError;
WizardForm.FileNameLabel.Caption:= ExtractFileName(Source);
GetSpaceOnDisk(ExtractFileDrive(Destination), True, FreeMB, TotalMB);
case Result of
-1: if FreeMB < allMb {Мб на диске} then msgError:= SetupMessage(msgDiskSpaceWarningTitle)
else msgError:= msgError + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Source)]);
-127: msgError:= cm('ArcBreak'); //Cancel button
-63: msgError:= cm('ArcFail');
end;
Log(msgError); // записываем ошибку в лог, а также показываем её текст на странице завершения
End;

// Extracts all found archives
function UnPack(Archives: string): Integer;
var
f: Integer;
begin
StartInstall:= GetTickCount {время начала распаковки}
// UpdateStatus(1); // остановить таймер
Records:= ArcDecode(Archives); SetArrayLength(Arcs,0); Status.allsize:= 0; f:=0; {общий объём}
totalUncompressedSize:=0; //сбросим общий прогрессбар чтобы не увеличивался с каждым диском в 2 раза
for n:= 0 to GetArrayLength(Records) -1 do begin // Get the size of all archives
if ((IsComponentSelected(Records[n].comp)and(Records[n].comp <>''))or(Records[n].comp ='')) then // компоненты или задачи выбраны
while (f<=(GetArrayLength(Records) -1)) do begin // создаём список архивов
if ((IsComponentSelected(Records[f].comp))or(Records[f].comp ='')) then
totalUncompressedSize:= totalUncompressedSize + AddArcs(Records[f].Path, Records[f].Dest); f:=f+1; end;
end;
// Other initializations
WizardForm.StatusLabel.Caption:= cm('ArcTitle') // начало этапa распаковки
ExtractFile.Show; ProgressBar.Show; StatusInfo.Show;
baseMb:= 0; lastMb:= 0; Status.mb:= 0; // обнулить полученные мегабайты, если ранее вёлся подсчёт объёма файлов инсталлятора
Status.count:= 0; // не учитывать файлы, извлечённые инсталлятором
UpdateStatus(7); // немедленно обновить строку статуса
for ArcInd:= 0 to GetArrayLength(Arcs) -1 do begin // архивы в текущей папке, константы раскрыты в ArcDecode
faDiskSuspendUpdateStatus:=false; //отключаем паузу автоапдейта по таймеру на время распаковки
Result:= UnPackArchive(Arcs[ArcInd].Path, Arcs[ArcInd].Dest, Arcs[ArcInd].allMb, 0); // код ошибки
faUnpackedArchives:= faUnpackedArchives + 1
faDiskSuspendUpdateStatus:=true; //ставим автоапдейт по таймеру на паузу - распаковка окончена (возможно временно)
if Result <> 0 then Break; // прервать цикл распаковки
baseMb:= baseMb + lastMb; lastMb:= 0; Status.mb:= 0; // общий объём распакованных файлов
// отработанный архив автоматически удаляется, если находится в папке {app} или {tmp}
if (Pos(AnsiLowercase(ExpandConstant('{app}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) or (Pos(AnsiLowercase(ExpandConstant('{tmp}')), AnsiLowercase(Arcs[ArcInd].Path)) > 0) then
DeleteFile(Arcs[ArcInd].Path);
end;
if Result = 0 then WizardForm.StatusLabel.Caption:= FmtMessage(cm('ArcFinish'), [IntToStr(faUnpackedArchives), IntToStr(Status.count), ByteOrTB(Status.size*oneMB, true)]);
StatusInfo.Hide; ExtractFile.Hide; ProgressBar.Hide;
end;

Function UnPackWithPrompts(Archives: string): Integer;
var
MsBox,q: Integer; faDiskPromptMsg:string;
begin
AllArchives:= ArcDecode(Archives); faUnpackedArchives:=0; MsBox:=IDOK; q:=0
FaDiskName:=1; FaDiskCount:= AllArchives[GetArrayLength(AllArchives)-1].disks;
while (Result = 0) and (faDiskName<=FaDiskCount) do begin
while (msBox=IDOK) and not (FileExists(AllArchives[faUnpackedArchives].Path)) do begin
FaDiskPromptMsg:= FmtMessage(cm('InsertDisk'),[IntToStr(FaDiskName)])
MsBox:= MsgBox(FaDiskPromptMsg, mbConfirmation, MB_OKCANCEL)
end;
if MsBox = IDCANCEL then Result:= -127;
//Получаем количество дисков
if FileExists(AllArchives[GetArrayLength(AllArchives)-1].Path) then FaDiskCount:=FaDiskName else
FaDiskCount:= AllArchives[GetArrayLength(AllArchives)-1].disks;
//Если компоненты выбраны и все необходимые архивы на одном диске то убираем следующие диски
if (faUnpackedArchives=(GetArrayLength(AllArchives)-1))then begin
if(IsComponentSelected(AllArchives[faUnpackedArchives].comp))and(FileExists(AllArchives[faUnpackedArchives].Path))then FaDiskCount:=FaDiskName; end;
while (q<=(GetArrayLength(AllArchives)-1)) do begin
if ((not FileExists(AllArchives[q].Path))and(IsComponentSelected(AllArchives[q].comp))) then FaDiskCount:= AllArchives[q].disks; q:=q+1 end ;
//Собственно сама распаковка
if (MsBox<>IDCANCEL)and(faDiskName<=FaDiskCount) then Result:= UnPack(Archives); FaDiskName:= FaDiskName+1;
//Проверяем если если некоторые кмпоненты не выбраны и некоторые архивы находятся на другом диске
if (faUnpackedArchives<=(GetArrayLength(AllArchives)-1))and(FaDiskCount>1) then begin
while (((not IsComponentSelected(AllArchives[faUnpackedArchives].comp))or(AllArchives[FaUnpackedArchives].comp<>''))and(FileExists(AllArchives[faUnpackedArchives].Path))) do faUnpackedArchives:= faUnpackedArchives + 1;end;
end;
end;

procedure CurStepChanged1(CurStep: TSetupStep);
begin
if CurStep = ssInstall then begin
StartInstall:= GetTickCount {время начала извлечения файлов}
WndHookID:= SetWindowsHookEx(WH_CALLWNDPROC, WrapCWPSTRUCTProc(@OnWndHook, 3), 0, GetCurrentThreadID); {установка SendMessage хука}
TimerID:= SetTimer(0, 0, 500 {полсекунды}, WrapTimerProc(@MyTimerProc, 4)); {установка таймера}
if not {#isFalse(SetupSetting("Uninstallable"))} then Status.count:= -1; // не считать файл unins000.exe
end;
if CurStep = ssPostInstall then
begin
UnPackError:= UnPackWithPrompts('{#Archives}')
if UnPackError <> 0 then begin // Error occured, uninstall it then
if not {#isFalse(SetupSetting("Uninstallable"))} then // деинсталляция разрешёна
Exec(ExpandConstant('{uninstallexe}'), '/SILENT','', sw_Hide, ewWaitUntilTerminated, n); // откат установки из-за ошибки unarc.dll
WizardForm.caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
SetTaskBarTitle(SetupMessage(msgErrorTitle))
end else
SetTaskBarTitle(SetupMessage(msgSetupAppTitle));
end;
end;

Procedure SetTexture(CurPageID: Integer); // на каждой странице своя картинка
Begin
WizardForm.Bevel1.Visible:= (WizardForm.CurPageID <> wpWelcome) and (WizardForm.CurPageID <> wpFinished);
WizardForm.Bevel1.Parent:= WizardForm.OuterNotebook.ActivePage
Texture.Parent:= WizardForm.InnerNotebook.ActivePage; Texture.SendToBack;
Texture.Visible:= CurPageID = wpInstalling; Texture2.Visible:= Texture.Visible;
End;

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

procedure WizardClose(Sender: TObject; var Action: TCloseAction);
Begin
Action:= caNone; // так надо
if Status.stage = cm('ArcTitle') then begin // распаковка на этапе ssPostInstall
UpdateStatus(1); // остановить таймер
if MsgBox(SetupMessage(msgExitSetupMessage), mbInformation, MB_YESNO) = IDYES then
CancelCode:= -127; // прервать распаковку
UpdateStatus(7); // обновить информацию
end else
MainForm.Close; // стандартное нажатие кнопки закрытия окна, отмены или Escape.
End;

Procedure InitializeWizard1();
Begin
// Create controls to show extended info
StatusLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.StatusLabel);
FileNameLabel:= CreateLabel(WizardForm.InstallingPage,false,false,true,'',[],0,0,0,0,0, WizardForm.FileNameLabel);
WizardForm.StatusLabel.Top:= WizardForm.ProgressGauge.Top; WizardForm.FileNameLabel.Top:= WizardForm.ProgressGauge.Top; // прячем под прогрессбар, тогда все события WM_PAINT перехватываются
with WizardForm.ProgressGauge do begin
StatusInfo:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, Top + ScaleY(32), Width, 0, Nil);
ProgressBar := TNewProgressBar.Create(WizardForm);
ProgressBar.SetBounds(Left, StatusInfo.Top + StatusInfo.Height + ScaleY(16), Width, Height);
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 65536;
ProgressBar.Hide; // будет показан при обработке нескольких архивов
ExtractFile:= CreateLabel(WizardForm.InstallingPage, false, true, true, '', [], 0, 0, ProgressBar.Top + ScaleY(32), Width, 0, Nil);
end;
WizardForm.OnClose:= @WizardClose // позволяет прервать распаковку архивов стандартными способами
// фоновая графика
Texture:= TBitmapImage.Create(WizardForm);
Texture.SetBounds(-WizardForm.InnerNotebook.Left, -WizardForm.InnerNotebook.Top, WizardForm.ClientWidth, WizardForm.ClientHeight);
Texture2:= TBitmapImage.Create(WizardForm);
Texture2.SetBounds(0, 0, WizardForm.ClientWidth, WizardForm.ClientHeight);
Texture2.Parent:= WizardForm.InnerPage;
Texture2.Bitmap:= Texture.Bitmap;
End;

Procedure DeInitializeSetup1;
Begin
KillTimer(0, TimerID) {удаление таймера}
UnhookWindowsHookEx(WndHookID) {удаление SendMessage хука}
End;

const
Indent=25;

function ssInitialize(hParent:HWND;ssTimeShow:integer;FadeOut:boolean;StretchMode:integer;BkgColor:DWORD):boolean; external 'ssInitialize@files:isgsg.dll stdcall delayload';
procedure ssDeInitialize; external 'ssDeInitialize@files:isgsg.dll stdcall delayload';
procedure ssAddImage(FileName:PChar); external 'ssAddImage@files:isgsg.dll stdcall delayload';
procedure ssStartShow; external 'ssStartShow@files:isgsg.dll stdcall delayload';
procedure ssStopShow; external 'ssStopShow@files:isgsg.dll stdcall delayload';
function GetSystemMetrics(nIndex:Integer):integer; external 'GetSystemMetrics@user32.dll stdcall delayload';

procedure InitializeWizard2;
begin
ssInitialize(GetWindowLong(MainForm.Handle,-8),7,True,1,$FF000000);
end;

procedure CurStepChanged2(CurStep: TSetupStep);
begin
if CurStep=ssInstall then begin
ExtractTemporaryFile('01.jpg');
ssAddImage(ExpandConstant('{tmp}')+'\01.jpg');
ExtractTemporaryFile('02.jpg');
ssAddImage(ExpandConstant('{tmp}')+'\02.jpg');
ssStartShow;
end;
if CurStep=ssPostInstall then ssStopShow;
end;

procedure CurPageChanged2(CurPageID: Integer);
begin
if CurPageID=wpInstalling then begin
WizardForm.MainPanel.Visible:=False;
WizardForm.Bevel1.Visible:=False;
WizardForm.Width:=ScaleX(445);
WizardForm.Height:=ScaleY(200);
WizardForm.Left:=ScaleX(GetSystemMetrics(0)-WizardForm.Width-Indent);
WizardForm.Top:=ScaleY(GetSystemMetrics(1)-WizardForm.Height-Indent);
WizardForm.InnerNotebook.Left:=ScaleX(10);
WizardForm.InnerNotebook.Top:=ScaleY(10);
WizardForm.InnerNotebook.Width:=ScaleX(417);
WizardForm.StatusLabel.Left:=ScaleX(0);
WizardForm.StatusLabel.Top:=ScaleY(0);
WizardForm.StatusLabel.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) or (CurPageID=wpInfoAfter) then begin
if WizardForm.Width<>497 then begin
WizardForm.Visible:=False;
WizardForm.Width:=ScaleX(497);
WizardForm.Height:=ScaleY(515);
WizardForm.Left:=(GetSystemMetrics(0)-WizardForm.Width) div 2;
WizardForm.Top:=(GetSystemMetrics(1)-WizardForm.Height) div 2;
WizardForm.MainPanel.Visible:=True;
WizardForm.Bevel1.Visible:=False;
WizardForm.InnerNotebook.Left:=ScaleX(40);
WizardForm.InnerNotebook.Top:=ScaleY(72);
WizardForm.InnerNotebook.Width:=ScaleX(417);
WizardForm.Visible:=True;
end;
end;
end;

procedure DeinitializeSetup2;
begin
ssDeInitialize;
end;

// Importing LoadSkin API from ISSkin.DLL
procedure LoadSkin(lpszPath: String; lpszIniFileName: 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
function ShowWindow(hWnd: Integer; uType: Integer): Integer;
external 'ShowWindow@user32.dll stdcall';

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

procedure DeinitializeSetup3();
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;

var
BmpFile: TBitmapImage;

procedure InitializeWizard4();
begin
ExtractTemporaryFile('fon.bmp');

BmpFile:= TBitmapImage.Create(WizardForm);
BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\fon.bmp'));
BmpFile.SetBounds(0, 0, 497, 318);
BmpFile.Stretch:= true
BmpFile.Parent:= WizardForm.WelcomePage;

BmpFile:= TBitmapImage.Create(WizardForm);
BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\fon.bmp'));
BmpFile.SetBounds(0, 0, 497, 318);
BmpFile.Stretch:= true
BmpFile.Parent:= WizardForm.FinishedPage;

with WizardForm do
begin
WelcomeLabel1.Hide;
WelcomeLabel2.hide;
FinishedHeadingLabel.Hide;
FinishedLabel.Hide;
end;
end;

procedure InitializeWizard5();
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;

procedure InitializeWizard6();
begin
WizardForm.ClientWidth:=ScaleX(497);
WizardForm.ClientHeight:=ScaleY(485);
WizardForm.Center;
WizardForm.WelcomePage;

WizardForm.ClientWidth:=ScaleX(497);
WizardForm.ClientHeight:=ScaleY(485);
WizardForm.Center;
WizardForm.FinishedPage;

with WizardForm do
begin
WelcomeLabel1.Hide;
WelcomeLabel2.hide;
FinishedHeadingLabel.Hide;
FinishedLabel.Hide;
end;
end;

const
HALIGN_CENTER = 0;
HALIGN_LEFT = 1;
HALIGN_RIGHT = 2;

VALIGN_CENTER = 0;
VALIGN_TOP = 1;
VALIGN_BOTTOM = 2;

FIT_NONE = 0;
FIT_WIDTH = 1;
FIT_HEIGHT = 2;
FIT_BOTH = 3;

CLR_INVALID = $FFFFFFFF;

function InitGifCtrl(): Boolean; external 'initgifctrl@files:gifctrl.dll stdcall';
function UninitGifCtrl(): Boolean; external 'uninitgifctrl@files:gifctrl.dll stdcall';
function NewGifbWnd(hWndParent: HWND; X, Y, nWidth, nHeight: Integer): HWND; external 'newgifwnd@files:gifctrl.dll stdcall';
function FreeGifWnd(hWndGif: HWND): Boolean; external 'freegifwnd@files:gifctrl.dll stdcall';
function GifWndSetParent(hWndGif: HWND; hWndParent: HWND): Boolean; external 'gifwndsetparent@files:gifctrl.dll stdcall';
function GifWndSetBounds(hWndGif: HWND; X, Y, nWidth, nHeight: Integer): Boolean; external 'gifwndsetbounds@files:gifctrl.dll stdcall';
function GifWndLoadFromFile(hWndGif: HWND; HAlign, VAlign: Integer; BGColor: DWord; Fit: integer; GifFileName: PChar): Boolean; external 'gifwndloadfromfile@files:gifctrl.dll stdcall';

var
GIFHWND: HWND;
function InitializeSetup7(): Boolean;
begin
InitGifCtrl();
GIFHWND := 0;
Result := True;
end;
procedure DeinitializeSetup7();
begin
UninitGifCtrl();
end;

procedure LblOnClick(Sender: TObject);
var
ErrorCode: Integer;
begin
ShellExec('open', 'http://forum.ru-board.com', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode);
end;
var
WLabel1, WLabel2,
FLabel1, FLabel2: TLabel;

procedure InitializeWizard7();
var
GifFileName: String;
Lbl: TNewStaticText;
begin
ExtractTemporaryFile('logo.gif');

GIFHWND := NewGifbWnd(WizardForm.Handle, ScaleX(75), WizardForm.Bevel.Top + ScaleY(40), 336, 132);
GifWndLoadFromFile(GIFHWND, HALIGN_CENTER, VALIGN_CENTER, CLR_INVALID, FIT_NONE, ExpandConstant('{tmp}\logo.gif'));
Lbl := TNewStaticText.Create(WizardForm);
Lbl.Parent := WizardForm;
Lbl.AutoSize := False;
Lbl.SetBounds(ScaleX(75), WizardForm.Bevel.Top + ScaleY(40), 336, 132);
Lbl.OnClick := @LblOnClick;
Lbl.Cursor := crHand;
end;


procedure CurStepChanged(CurStep: TSetupStep);
begin
CurStepChanged1(CurStep);
CurStepChanged2(CurStep);
end;

procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged1(CurPageID);
CurPageChanged2(CurPageID);
end;

procedure InitializeWizard();
begin
InitializeWizard1();
InitializeWizard2();
InitializeWizard4();
InitializeWizard5();
InitializeWizard6();
InitializeWizard7();
end;

procedure DeinitializeSetup();
begin
DeinitializeSetup1();
DeinitializeSetup2();
DeinitializeSetup3();
DeinitializeSetup7();
end;

function InitializeSetup(): Boolean;
begin
Result := InitializeSetup3(); if not Result then exit;
Result := InitializeSetup7(); if not Result then exit;
end;[/more]
Заранее Спасибо !
P.S. Уже 3-тий раз прошу о помощи, неужели так трудно помочь, или такая трудная проблема в коде что я выложил ?
Автор: csstalkers
Дата сообщения: 13.04.2010 18:52
Ок, попробую.
Автор: htuos
Дата сообщения: 13.04.2010 19:06
csstalkers
во-первых, положи сюда превью или ссылку на картинку.
во-вторых, убери код под теги [mоre] [/mоre]. в шапке по этому поводу написано большими буквами, для слепых
в-третьих, если не понимаешь, что делаешь, то зачем править рабочий скрипт? переделай его еще раз и все будет работать
Автор: duxa174
Дата сообщения: 13.04.2010 19:08
Люди помогите!
1)Не мог ли бы вы подправить, что бы надписи были одного шрифта, размера и т.д.

1


2

На странице завершения (1), было так же как на странице приветствия (2)

2) Как сделать что бы распаковка компонентов шла после распаковки архива?

Скрипт ниже:
[more]#define MyAppName "Zombie Driver"
#define MyAppVerName "Zombie Driver"
#define MyAppExeName "ZombieDriver.exe"
#define PB_ImageFile "progress1.bmp"

[Setup]
AppName={#MyAppName}
AppVerName={#MyAppVerName}
DefaultDirName={pf}\Akella Games\Zombie Driver
DefaultGroupName=Akella Games\Zombie Driver
LicenseFile=C:\repack\Лицензионное соглашение.txt
;InfoAfterFile=C:\repack\Техподдержка.txt
InfoBeforeFile=C:\repack\1.txt
OutputDir=C:\repack
OutputBaseFilename=setup
SetupIconFile=C:\repack\ZD_icon.ico
Compression=lzma/max
SolidCompression=yes
WizardSmallImageFile=WizardSmallImage.bmp
WizardImageFile=WizardImage.bmp
;WizardImageStretch=yes
AppPublisher=duxa

[Types]
;Name: "polnaya"; Description: "Полная установка"
Name: "viborochnaya"; Description: "Выборочная установка"; Flags: iscustom

[Components]
Name: "Fix"; Description: "Fix от KykyHe4ka"; Types: viborochnaya

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


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

[Tasks]
Name: desktopicon; Description: {cm:CreateDesktopIcon}; GroupDescription: {cm:AdditionalIcons}; Flags: unchecked

[Files]
;Source: C:\Program Files\Akella Games\Zombie Driver\Release\ZombieDriver.exe; DestDir: {app}; Flags: ignoreversion
; ОТМЕТЬТЕ: Не используйте "Флажки: Проигнорировать версию" на любых общедоступных системных файлах
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy deleteafterinstall
Source: InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy
Source: papka.bmp; DestDir: {tmp}; Flags: dontcopy
Source: logo.bmp; DestDir: {tmp}; Flags: dontcopy
Source: button.bmp; DestDir: {tmp}; Flags: dontcopy
Source: progress1.bmp; DestDir: {tmp}; Flags: dontcopy
Source: gamestartup.mp3; DestDir:{tmp}; Flags: dontcopy
Source: bass.dll; DestDir:{tmp}; Flags: dontcopy
Source: ISSkin.dll; DestDir: {app}; Flags: dontcopy
Source: Tiger.cjstyles; DestDir: {tmp}; Flags: dontcopy
Source: image2.bmp; DestDir: {tmp}; Flags: dontcopy
Source: ackground.bmp; DestDir: {tmp}; Flags: dontcopy

;Source: "C:\repack\ZD\*"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs

Source: "Fix\Fix.exe"; Components:Fix; DestDir: "{tmp}"

[Icons]
Name: {group}\{#MyAppName}; Filename: "{app}\Release\ZombieDriver.exe"; WorkingDir: "{app}\Release";
Name: {userdesktop}\{#MyAppName}; Filename: "{app}\Release\ZombieDriver.exe"; Tasks: desktopicon; WorkingDir: "{app}"
Name: {group}\Удалить Zombie Driver; Filename: "{app}\{uninstallexe}" ; WorkingDir: "{app}"

[Tasks]
Name: "AR"; Description: "Установить Adobe Reader"; GroupDescription: "Дополнительное програмное обеспечение:";
Name: "DirectX"; Description: "Установить DirectX"; GroupDescription: "Дополнительное програмное обеспечение:";
Name: "MVC"; Description: "Установить Microsoft Visual C++ 2008 Redistributable"; GroupDescription: "Дополнительное програмное обеспечение:";
Name: "OpenAl"; Description: "Установить OpenAl"; GroupDescription: "Дополнительное програмное обеспечение:";
Name: "PhysX"; Description: "Установить PhysX"; GroupDescription: "Дополнительное програмное обеспечение:";

[Run]
;Filename: {app}\Release\{#MyAppExeName}; Description: {cm:LaunchProgram,{#MyAppName}}; Flags: nowait postinstall skipifsilent

Filename: "{tmp}\Fix.exe"; Parameters: " -s -d""{app}"""; Flags: waituntilterminated; Components:Fix;

Filename: "{src}\Redist\Adobe Reader\AdbeRdr812_ru_RU.exe"; StatusMsg: "Установка Adobe Reader...Пожалуйста подождите"; Tasks: "AR";
Filename: "{src}\Redist\DirectX\DXSETUP.exe"; StatusMsg: "Установка DirectX...Пожалуйста подождите"; Tasks: "DirectX";
Filename: "{src}\Redist\OpenAl\oalinst.exe"; StatusMsg: "Установка OpenAl...Пожалуйста подождите"; Tasks: "OpenAl";
Filename: "{src}\Redist\PhysX\PhysX_9.09.0814_SystemSoftware.exe"; StatusMsg: "Установка PhysX...Пожалуйста подождите"; Tasks: "PhysX";
Filename: "{src}\Redist\VcRedist\vcredist_x86.exe";StatusMsg: "Установка MVC...Пожалуйста подождите"; Tasks: "MVC";

[Registry]
Root: HKLM; SubKey: SOFTWARE\Akella Games; Flags: uninsdeletekeyifempty
Root: HKLM; SubKey: SOFTWARE\Akella Games\Zombie Driver; ValueType: string; ValueData: {app}\Release\Zombie Driver.exe; Flags: uninsdeletevalue uninsdeletekeyifempty


[Messages]
ComponentsDiskSpaceMBLabel=

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

[code]

var
WelcomeLabel1, WelcomeLabel2: TLabel;
BmpFile: TBitmapImage;

procedure InitializeWizard11();
begin
ExtractTemporaryFile('ackground.bmp');

BmpFile:= TBitmapImage.Create(WizardForm);
BmpFile.Bitmap.LoadFromFile(ExpandConstant('{tmp}\ackground.bmp'));
BmpFile.SetBounds(0, 0, 483, 313);
BmpFile.Stretch:= true
BmpFile.Parent:= WizardForm.WelcomePage;

with WizardForm do
begin
WelcomeLabel1.Hide;
WelcomeLabel2.hide;
end;

WelcomeLabel1:= TLabel.Create(WizardForm);
with WelcomeLabel1 do
begin
WelcomeLabel1.Alignment:=taCenter;
Left:= ScaleX(176);
Top:= ScaleY(66);
Width:= ScaleX(301);
Height:= ScaleY(71);
AutoSize:= false;
Transparent:= true;
WordWrap:= true;
Font.Name:='Arial'
Font.Size:= 12;
Font.Color:=ClWhite
Parent:= WizardForm.WelcomePage;
Caption:= WizardForm.WelcomeLabel1.Caption;
end;

WelcomeLabel2:=TLabel.Create(WizardForm);
with WelcomeLabel2 do
begin
WelcomeLabel2.Alignment:=taCenter;
Top:= ScaleY(136);
Left:= ScaleX(176);
Width:= ScaleX(301);
Height:= ScaleY(300);
AutoSize:= false;
WordWrap:= true;
Font.Color:=ClWhite
Font.Name:='Tahoma'
Transparent:= true;
Parent:= WizardForm.WelcomePage;
Caption:= WizardForm.WelcomeLabel2.Caption;
end;
end;



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

procedure GetFreeSpaceCaption(Sender: TObject);
var
Path: String;
begin
Path := ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB > 1024 then
FreeSpaceLabel.Caption := 'Доступно места на диске: '+ FloatToStr(round(FreeMB/1024*100)/100) + ' GB' else
FreeSpaceLabel.Caption := 'Доступно места на диске: '+ IntToStr(FreeMB)+ ' MB';
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) + ' GB' else
NeedSpaceLabel.Caption := 'Требуется места на диске: '+ 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 := @GetFreeSpaceCaption;
WizardForm.DirEdit.Text := WizardForm.DirEdit.Text + #0;
end;

procedure CurPageChanged5(CurPageID: Integer);
begin
begin
if CurPageID=wpSelectDir then
begin
GetNeedSpaceCaption;
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:=false
WizardForm.WelcomeLabel2.Visible:=false
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;

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

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

type
#ifdef UNICODE ; если у вас ошибка на этой строке, то установите препроцессор или исправьте скрипт для вашей версии Inno Setup
#define A "W"
#else
#define A "A" ; точка входа в SetWindowText, {#A} меняется на A или W в зависимости от версии
// PAnsiChar = PChar; // Required for Inno Setup 5.3.0 and higher. (требуется для Inno Setup версии 5.3.0 и ниже)
#endif
#if Ver < 84018176
AnsiString = String; // There is no need for this line in Inno Setup 5.2.4 and above (для Inno Setup версий 5.2.4 и выше эта строка не нужна)
#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; OrigSize: Integer; Size: Extended; end;

var
ExtractFile: TLabel;
lblExtractFileName: 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 in mb
LastTimerEvent: DWORD;

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';

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, lpszDst: AnsiString): longint; external 'OemToCharA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32 stdcall delayload';
function SetWindowText(hWnd: Longint; lpString: String): Longint; external 'SetWindowText{#A}@user32 stdcall delayload';

function GetTickCount: DWord; external 'GetTickCount@kernel32';
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, 0, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;

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

function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') 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;

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

// OnClick event function for btnCancel
procedure btnCancelUnpackingOnClick(Sender: TObject);
begin
if MsgBox( SetupMessage( msgExitSetupMessage ), mbInformation, MB_YESNO ) = IDYES then
CancelCode:= -127;
end;

var origsize: Integer;
// The callback function for getting info about FreeArc archive
function 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' then else
Result:= CancelCode;
end;

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

// Scans the specified folders for archives and add them to list
function 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)) + FSR.Name;
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;

// Sets the 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
// Конвертирует милисекунды в человеко-читаемое изображение времени
Function TicksToTime(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 function for unpacking FreeArc archives
function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer;
var
percents, Remaining: Integer;
s: String;
begin
if GetTickCount - LastTimerEvent > 1000 then begin
// This code will be executed once each 1000 ms (этот код будет выполняться раз в 1000 миллисекунд)
// ....
// End of code executed by timer
LastTimerEvent := LastTimerEvent+1000;
end;

if string(what)='filename' then begin
// Update FileName label
lblExtractFileName.Caption:= FmtMessage( cm( 'Extracting' ), [OemToAnsiStr( str )] )
end else if (string(what)='write') and (totalUncompressedSize>0) and (Mb>lastMb) then 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.Position:= 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 := s + '. '+FmtMessage(cm('ArcInfo'), [IntToStr(n+1), IntToStr(GetArrayLength(Arcs))])
ExtractFile.Caption := 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:= s + '. '+FmtMessage(cm('remains'), [TicksToTime(Remaining, cm('hour'), cm('min'), cm('sec'), false)])
SetTaskBarTitle(FmtMessage(cm('taskbar'), [IntToStr(percents/10), TicksToTime(Remaining, 'h', 'm', 's', false)]))
end;
WizardForm.FileNameLabel.Caption := s
end;
AppProcessMessage;
Result:= CancelCode;
end;

// Extracts all found archives
function UnPack(Archives: string): Integer;
var
totalCompressedSize: Extended;
callback: longword;
FreeMB, TotalMB: Cardinal;
begin
// Display 'Extracting FreeArc archive'
lblExtractFileName.Caption:= '';
lblExtractFileName.Show;
ExtractFile.caption:= cm('ArcTitle');
ExtractFile.Show;
// Show the 'Cancel unpacking' button and set it as default button
btnCancelUnpacking.Caption:= WizardForm.CancelButton.Caption;
btnCancelUnpacking.Show;
WizardForm.ActiveControl:= btnCancelUnpacking;
WizardForm.ProgressGauge.Position:= 0;
// Get the size of all archives
totalUncompressedSize := 0;
totalCompressedSize := FindArcs(Archives);
WizardForm.ProgressGauge.Max:= totalUncompressedSize;
// Other initializations
callback:= WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
StartInstall:= GetTickCount; {время начала распаковки}
LastTimerEvent:= GetTickCount;
baseMb:= 0

for n:= 0 to GetArrayLength(Arcs) -1 do
begin
lastMb := 0
CancelCode:= 0;
AppProcessMessage;
try
// Pass the specified arguments to 'unarc.dll'
Result:= FreeArcExtract (callback, 'x', '-o+', '-dp' + AnsiToUtf8( ExpandConstant('{app}') ), '--', AnsiToUtf8(Arcs[n].Path), '', '', '', '', '');
if CancelCode < 0 then Result:= CancelCode;
except
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#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;
// Hide labels and button
WizardForm.FileNameLabel.Caption:= '';
lblExtractFileName.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.Caption:= SetupMessage(msgErrorTitle) +' - '+ cm('ArcBreak')
end;
end;
end;

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

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

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

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

// Create a 'Cancel unpacking' button and hide it for now.
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; lpszIniFileName: 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
function ShowWindow(hWnd: Integer; uType: Integer): Integer;
external 'ShowWindow@user32.dll stdcall';

function 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;

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 delayload';

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

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

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

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

function BASS_ChannelPlay(handle: DWORD; restart: BOOL): Boolean;
external 'BASS_ChannelPlay@files:BASS.dll stdcall delayload';

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

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

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


procedure InitializeWizard1();
begin
//Выносим кнопку "Отмена" на передний план
WizardForm.CancelButton.BringToFront;
end;

procedure CurPageChanged6(CurPageID: Integer);
begin
if CurPageID=wpInstalling then
begin
WizardForm.BorderStyle:=bsDialog;
WizardForm.MainPanel.Visible:=False;
WizardForm.Width:=ScaleX(320);
WizardForm.Height:=ScaleY(127);
WizardForm.InnerNotebook.Left:=ScaleX(7);
WizardForm.InnerNotebook.Top:=ScaleY(7);
WizardForm.InnerNotebook.Width:=ScaleX(300);
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(17);
WizardForm.FileNameLabel.Width:=WizardForm.InnerNotebook.Width;
WizardForm.ProgressGauge.Top:=ScaleY(37);
WizardForm.ProgressGauge.Left:=ScaleX(0);
WizardForm.ProgressGauge.Width:=WizardForm.InnerNotebook.Width;
WizardForm.CancelButton.Left:=ScaleX(122);
WizardForm.CancelButton.Top:=ScaleY(70);
WizardForm.Left:=GetSystemMetrics(16)-ScaleX(330);
WizardForm.Top:=GetSystemMetrics(17)-ScaleX(110);
end;
if CurPageID=wpFinished
then
begin
WizardForm.Width:=502;{Размер окна по горизонтали}
WizardForm.Height:=392;{Размер окна по вертикали}
WizardForm.Position:=poScreenCenter; {Возврат в исходное состояние}
end
end;




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

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

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

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

//Иницализация окна установки
procedure InitializeWizard6;
var
s, Name: string;
i : Integer;
begin
// Загружаем музыку
ExtractTemporaryFile('BASS.dll');
ExtractTemporaryFile('gamestartup.mp3');
if BASS_Init(-1, 44100, 0, 0, 0) then
begin
BASS_Start();
Name:=ExpandConstant('{tmp}\gamestartup.mp3');
i:=BASS_StreamCreateFile(FALSE, PChar(Name), 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;
Caption := 'II';
Hint := 'Вкл.Выкл. музыку';
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;
Caption := '-';
Hint := 'Убавить громкость';
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;
Caption := '+';
Hint := 'Прибавить громкость';
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;
Position := BASS_GetVolume;
end;

//Проверка на то какая громкость стоит в системе
if BASS_GetVolume >= 100 then 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('Удалить сохраненные игры?',mbconfirmation, mb_yesno) = IDYES then
begin
DelTree(ExpandConstant('{app}'), True, True, True);
MsgBox('Cохраненные игры были удалены', mbinformation, 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.PageNameLabel.Font.Color:=clWhite;
WizardForm.LicenseAcceptedRadio.Font.Color:=clWhite;
WizardForm.LicenseNotAcceptedRadio.Font.Color:=clWhite;
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.TypesCombo.Color:=Color;
WizardForm.WelcomeLabel1.Color:=Color;
WizardForm.InfoBeforeClickLabel.Color:=Color;
WizardForm.MainPanel.Color:=Color;
WizardForm.PageNameLabel.Color:=Color;
WizardForm.PageDescriptionLabel.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.FilenameLabel.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.UserInfoNameLabel.Color:=Color;
WizardForm.UserInfoNameEdit.Color:=Color;
WizardForm.UserInfoOrgLabel.Color:=Color;
WizardForm.UserInfoOrgEdit.Color:=Color;
WizardForm.PreparingLabel.Color:=Color;
WizardForm.FinishedHeadingLabel.Color:=Color;
WizardForm.UserInfoSerialLabel.Color:=Color;
WizardForm.UserInfoSerialEdit.Color:=Color;
WizardForm.TasksList.Color:=Color;
WizardForm.RunList.Color:=Color;
WizardForm.SelectDirBrowseLabel.Color:=Color;
WizardForm.SelectStartMenuFolderBrowseLabel.Color:=Color;
end;

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

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

// Функции для работы с таймером
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';

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

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

procedure CurPageChanged2(CurPageID: Integer);
var
pfunc: LongWord;
begin
if CurPageID = wpInstalling then
begin
// Устанавливаем таймер
pfunc := WrapTimerProc( @OnTimer, 4 );
TimerID := SetTimer( 0, 0, 100, pfunc );
intOldCurrWidth := 0;
end;

// Убираем таймер, когда находимся на последней странице.
if CurPageID = wpFinished then
KillTimer( 0, TimerID );
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( '{#PB_ImageFile}' );

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

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

procedure DeinitializeSetup6();
begin
// Убираем таймер
KillTimer( 0, TimerID );
end;


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

procedure CurPageChanged(CurPageID: Integer);
begin
CurPageChanged2(CurPageID);
CurPageChanged3(CurPageID);
CurPageChanged4(CurPageID);
CurPageChanged5(CurPageID);
CurPageChanged6(CurPageID);
end;
[/more]
____
Большое спасибо!
Автор: alex2605
Дата сообщения: 13.04.2010 19:52
duxa174
1) не уверен, но думаю тебе должна помочь эта секция:
[more][LangOptions]
LanguageName=Russian
LanguageID=$0419
LanguageCodePage=1251
DialogFontName=Tahoma
DialogFontSize=8
WelcomeFontName=Times New Roman
WelcomeFontSize=13
TitleFontName=Arial
TitleFontSize=29
CopyrightFontName=Arial
CopyrightFontSize=8[/more]
2) обсуждалось в предыдущей части темы

Страницы: 12345678

Предыдущая тема: Cracklock


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.