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

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

Автор: nik1967
Дата сообщения: 21.12.2008 10:07
Victor_Dobrov, всё понял. Большое спасибо!
Автор: EagleSH
Дата сообщения: 21.12.2008 10:12
Victor_Dobrov
а мне ответить?
Автор: Don_Juan
Дата сообщения: 21.12.2008 11:39
Victor_Dobrov Можете помочь доработать данный скрипт выбора дисков. В нём в принципе всё нормально, но я не знаю, как убрать, чтобы он не отображал диски, на которые невозможно выполнить установку (например, CD ROM) и сделать как у вас в корона скин здесь только GB и MB, а у вас ТБ, ГБ, Мб, Кб, Бт. Буду очень Вам признателен!!!
[more=Подробнее..][Setup]
AppName=Drive Checked
AppVerName=Drive Checked
DefaultDirName={pf}\Drive Checked

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

[Messages]
ru.SelectDirBrowseLabel=Нажмите "Далее", чтобы продолжить. Для установки на другой диск, выберите из списка.

[Code]
var
cbDrive: TComboBox;
DrvLetters: array of string;
FreeSpaceLabel: TLabel;

function GetDriveType(lpDisk: string): integer;
external 'GetDriveTypeA@kernel32.dll stdcall';

function GetLogicalDriveStrings(nLenDrives: LongInt; lpDrives: string): integer;
external 'GetLogicalDriveStringsA@kernel32.dll stdcall';

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

function DriveTypeString(dtype: integer): string;
begin
case dtype of
DRIVE_NO_ROOT_DIR: Result:='Неверный путь';
DRIVE_REMOVABLE: Result:='Съемный';
DRIVE_FIXED: Result:='';
DRIVE_REMOTE: Result:='Сетевой';
DRIVE_CDROM: Result:='CD-ROM';
DRIVE_RAMDISK: Result:='Ram диск';
else
Result:='Неизвестный';
end;
end;

procedure cbDriveOnClick(Sender: TObject);
begin
WizardForm.DirEdit.Text:=DrvLetters[cbDrive.ItemIndex]+'Program Files\Disk Checked';
end;

procedure FillCombo();
var
n: integer;
drivesletters: string; lenletters: integer;
drive: string;
disktype, posnull: integer;
sd: string;
begin
sd:=UpperCase(ExpandConstant('{sd}'));
drivesletters:=StringOfChar(' ', 64);
lenletters:=GetLogicalDriveStrings(63, drivesletters);
SetLength(drivesletters, lenletters);
drive:='';
n:=0;
while ((Length(drivesletters) > 0)) do
begin
posnull:=Pos(#0, drivesletters);
if posnull > 0 then
begin
drive:=UpperCase(Copy(drivesletters, 1, posnull-1));
disktype:=GetDriveType(drive);
if (not(disktype=DRIVE_REMOVABLE)) then
begin
cbDrive.Items.Add(drive+DriveTypeString(disktype))
SetArrayLength(DrvLetters, N+1);
DrvLetters[n]:=drive;
if (Copy(drive, 1, 2)=sd) then cbDrive.ItemIndex:=n;
n:=n+1;
end
drivesletters:=Copy(drivesletters, posnull+1, Length(drivesletters));
end
end;
cbDriveOnClick(cbDrive);
end;

procedure GetFreeSpaceCaption(Sender: TObject);
var
Path: string;
FreeMB, TotalMB: cardinal;
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'
end;

procedure InitializeWizard();
begin
cbDrive:=TComboBox.Create(WizardForm.SelectDirPage);
FreeSpaceLabel:=TLabel.Create(WizardForm);
with cbDrive do
begin
Parent:=WizardForm.DirEdit.Parent;
Left:=WizardForm.DirEdit.Left;
Top:=WizardForm.DirEdit.Top+WizardForm.DirEdit.Height*2-15;
Width:=WizardForm.DirEdit.Width+83;
Style:=csDropDownList;
end
with FreeSpaceLabel do
begin
Parent:=WizardForm.SelectDirPage;
Left:=ScaleX(0);
Top:=Scaley(195);
Width:=ScaleX(209);
Height:=ScaleY(13);
end;
WizardForm.DirBrowseButton.Visible:=true;
WizardForm.DirEdit.Enabled:=true;
WizardForm.DirEdit.OnChange:=@GetFreeSpaceCaption;
WizardForm.DirEdit.Text:=WizardForm.DirEdit.Text+#0;
FillCombo;
cbDrive.OnClick:=@cbDriveOnClick;
end;[/more]
Автор: nik1967
Дата сообщения: 21.12.2008 13:04
Victor_Dobrov, вопрос по поводу проверки минимальных системных требований в InnoSetupUpgrade.
1. При NeedSys:= 5.1; NeedSp:= 2; на Vista 6.0.6001 Service Pack 1 пишет "Требуется сборка 5,1, пакет обновления 2" - лиловый цвет, хотя версия сборки выше.
2. Минимальные требования cpu=3,0 ггц (пентиум 4), для Core 2 Duo и Core 2 Quad значения не указаны. И при NeedMHZ:= 3000; на Core 2 Duo T8300(2,4 ггц) и на Core 2 Quad Q6600(2,4 ггц) пишет "Требуемая частота процессора 3000 Мгц." - красный цвет, хотя эти процессоры по умолчанию мощнее. То есть для себя я мог бы установить NeedMHZ:= 2200;, а как быть со старыми процессорами?
Автор: Victor_Dobrov
Дата сообщения: 21.12.2008 13:14
EagleSH

Цитата:
есть движущийся фон в окне inno, но кнопки, выбор пути промигивают. как заставить их жёстко стоять и не мигать? и как сверху наложить транспорент?

Цитата:
а мне ответить?

Я в этом не спец, как вариант, пропиши каждой кнопке BringToFront. Или попробуй использовать ISSkin.dll, возможно, кнопки мигать перестанут.

Don_Juan

Поменяй условие if (not(disktype=DRIVE_REMOVABLE)) на if disktype = DRIVE_FIXED

nik1967
InnoSetupUpgrade - это пройденный этап. В Corona Skin проверка требований работает лучше и дорабатывать старый скрипт (который я забросил) для меня напрасная трата времени.
Автор: Don_Juan
Дата сообщения: 21.12.2008 14:04
Victor_Dobrov
Спасибо. А еще такой вопрос: Как сделать, чтобы менялась только буква диска при смене, а не под папка вместе с ней.
Автор: nik1967
Дата сообщения: 21.12.2008 15:21
Victor_Dobrov
Спасибо за оперативный ответ! И всё-таки по поводу проверки минимальных системных требований теперь уже Corona Skin:
1. При NeedSys:= 5.1; NeedSp:= 2; на Vista 6.0.6001 Service Pack 1 пишет "Требуется версия 5,1 или выше, пакет обновления 2" - лиловый цвет, хотя версия сборки выше. Увы, это осталось.
2. По проверкам цпу всё отлично,сенкс.
3. И ещё одно: после нажатии на надпись "Объём папок"(всплывающая надпись "подсчёт размера папок займёт некоторое время") выводится сообщение "Подождите пожалуйста.Идёт подсчёт размера папок". Через пару секунд выводится сообщение "Runtime Error" "Math error". Процесс зависает. Выход только через диспетчер задач Windows.
Автор: Victor_Dobrov
Дата сообщения: 21.12.2008 16:05
nik1967
По номеру сборки и сервиспака ошибку исправлю в следующей версии.

Цитата:
"Runtime Error" "Math error".

Такой ошибки при подсчёте папок никогда не получал.
Если не трудно, проверь вот этот скрипт: [more=DirSizeCalc]
[Setup]
AppName=Calc DirSize
AppVerName=Calc DirSize
CreateAppDir=false

[Code]
/////////// NEW ///////////////////////
type
TMsg = record
hwnd: HWnd;
msg: Word;
wParam: Word;
lParam: Word;
time: Longint;
pt: TPoint;
end;

var
Browse, SizeButton: TButton; LSize: TLabel; Folder: String; Work: Boolean;
Msg: TMsg;

function PeekMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax, wRemoveMsg: LongInt): LongInt; external 'PeekMessageW@user32.dll stdcall';

procedure ProcessMessage();
begin
    Work:= False;
end;
/////////// NEW ///////////////////////
const
oneMB= 1024*1024; VK_SHIFT = $10;

function GetKeyState(nVirtKey: Integer): ShortInt; external 'GetKeyState@user32 stdcall delayload';

Function ByteOrGB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб (до 3х знаков после запятой)}
Begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Mb' else
if Bytes < 1024 then if Bytes = 0 then Result:= '0' else Result:= FloatToStr(Int(Bytes)) +' Bt' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Kb' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Mb' else
Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Gb'
StringChange(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 CalcDirSize(const fromDir, fileMask: string; SubDirsAllow: Boolean): Extended;
var
FSR, DSR: TFindRec; FindResult: Boolean; APath: string;
res: longint;
Begin
APath:= AddBackslash(fromDir);
FindResult:= FindFirst(APath + fileMask, FSR);
Try
while FindResult do
begin
/////////// NEW ///////////////////////
res:= PeekMessage(Msg, SizeButton.Handle, $0201, $0203, 1);
if res <> 0 then
begin
ProcessMessage();
Exit;
end;
/////////// NEW ///////////////////////
if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then Result:= Result + Size64(FSR.SizeHigh, FSR.SizeLow)
//if GetKeyState(VK_SHIFT) < 0 then Work:= false; // флаг сброшен, это значит, что клавиша прерывания работы нажималась
if not Work then Exit; // прерывание подсчёта, если нажата клавиша
FindResult:= FindNext(FSR);
end;
FindResult := FindFirst(APath + '*.*', DSR);
while FindResult and SubDirsAllow do
begin
if ((DSR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) and not ((DSR.Name = '.') or (DSR.Name = '..')) then
{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
// если есть хоть одна рекурсия, то подсчёт почему-то не прерывается
FindResult:= FindNext(DSR);
end;
Finally
FindClose(FSR); FindClose(DSR);
end;
End;

Procedure SizeButtonOnClick(Sender: TObject); var res: Extended;
Begin
    LSize.Caption:= 'Please wait...' #13#10 'Calculating folders'; WizardForm.Repaint
    Work:= true; // флаг нажатия клавиши прерывания работы функции CalcDirSize.
    SizeButton.Caption:= 'Stop'; // NEW
    res:= CalcDirSize(Folder, '*', True); // если подсчёт (или копирование в SHFileOperation) идёт долго, то должна быть возможность его прервать
    LSize.Caption:= 'DirSize = ' + ByteOrGB(res, true) + #13#10 + Folder
    SizeButton.Caption := 'Calc';
End;

Procedure BrowseOnClick(Sender: TObject);
Begin
if BrowseForFolder('Calc Folder', Folder, false) then SizeButtonOnClick(SizeButton);
End;

Procedure InitializeWizard;
begin
Browse:= TButton.Create(WizardForm);
Browse.SetBounds(WizardForm.ClientWidth - WizardForm.CancelButton.Left - WizardForm.CancelButton.Width, WizardForm.CancelButton.Top, 48, WizardForm.CancelButton.Height)
Browse.Caption := 'Change';
Browse.OnClick := @BrowseOnClick;
Browse.Parent := WizardForm;

SizeButton:= TButton.Create(WizardForm);
SizeButton.SetBounds(Browse.Left + Browse.Width, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width/2, WizardForm.CancelButton.Height)
SizeButton.Caption := 'Calc';
SizeButton.OnClick := @SizeButtonOnClick;
SizeButton.Parent := WizardForm;

Folder:= ExpandConstant('{win}') // для начала берём эту папку

LSize:= TLabel.Create(WizardForm);
LSize.SetBounds(SizeButton.Left + SizeButton.Width + 8, SizeButton.Top, 12, 12)
LSize.Caption:= 'Click Calc button' #13#10 'Current dir: ' + Folder;
LSize.Parent:= WizardForm;
end;
[/more] нормально работает?.
Автор: nik1967
Дата сообщения: 21.12.2008 16:18
Victor_Dobrov, скрипт: DirSizeCalc работает хорошо. В Corona Skin обзор папок и подсчёт размера работает тоже хорошо. Надпись "Объём папок" слева (рядом с чекбоксом), справа данные.
Автор: EagleSH
Дата сообщения: 21.12.2008 16:51
Victor_Dobrov и господа, кто компетентен:

как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.
Автор: Dermuin
Дата сообщения: 21.12.2008 17:48
Ну ктонить поможет.
Автор: SotM
Дата сообщения: 21.12.2008 18:01
Dermuin
На предыдущей странице не совсем понятен твой вопрос. Запустить программу можно после установки. В примерах можно найти это. На последней странице можно добавить галочку, и если она checked, то после нажатия кнопки Закрыть происходит запуск приложения.
Автор: cdman67
Дата сообщения: 21.12.2008 18:30
sanmon, ну уж не знаю - чё там непонятного, я в 3 секунды разобрался:

Прекомпрессия: precomp -slow image.img
На выходе имеем файл image.pcf - это и есть файл с разжатыми zLib-потоками, который, в отличие от оригинала image.img, жмётся тем же севензипом на ура.

Обратная рекомпрессия: precomp -r image.pcf
На выходе имеем файл image.img, т.е. исходный оригинал.

Что ещё непонятно - говори, подскажу.


Автор: EagleSH
Дата сообщения: 21.12.2008 21:27
Victor_Dobrov и господа, кто компетентен:

как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.

вопрос в силе.



ещё интересует момент, нужно при старте инстала прописать переменную числовую, к примеру number=1

как в секции [code] организовать свою тему, которая бы добавляла к текстовой переменной, к примеру number$=demo числовую number, на выходе имеем demo1

делаем чё там нада с этой demo1, увеличиваем number, тоесть получается number=number+1

в следущий такт получается demo2, потом demo3 и тд. делаем проверку на 50 к примеру, если number=50 делаем его снова 1 и так по кругу.

короче тема такая, чтоб пока работает инсталлер, постоянно выполняется моя процедурка

надеюсь понятно объяснил. такое возможно ваще?
Автор: SotM
Дата сообщения: 21.12.2008 22:19
EagleSH
Не поощряю использование матерных слов в качестве переменных. Советую удалить их из поста.
Автор: Victor_Dobrov
Дата сообщения: 22.12.2008 00:13
EagleSH

Цитата:
чтобы, пока работает инсталлер, постоянно выполняется моя процедурка

Попробуй так: [more]
[Setup]
AppName=Timer
AppVerName=InnoCallback Timer
CreateAppDir=false

[Files]
Source: compiler:InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy

[Code]
var Sec: Integer;

type
TTimerProc=procedure(h:longword; msg:longword; idevent:longword; dwTime:longword);

function WrapTimerProc(callback: TTimerProc; Paramcount: Integer): Longword; external 'wrapcallback@files:innocallback.dll stdcall';
function SetTimer(hWnd: longword; nIDEvent, uElapse: Longword; lpTimerFunc: Longword): Longword; external 'SetTimer@user32.dll stdcall';

//Note, we musn't declare our routine as Stdcall
procedure MyTimerProc(h: Longword; msg: Longword; idevent: Longword; dwTime: Longword);
begin
    if sec > 49 then sec:= 0; sec:= sec + 1;
    WizardForm.Caption:= 'Timer: ' + IntToStr(sec)
end;

function InitializeSetup: Boolean;
var timercallback, callback: Longword;
begin
timercallback:= WrapTimerProc(@MyTimerProc, 4); //Our proc has 4 arguments
settimer(0,0,1000,timercallback); //Create a timer and give it our callback as an argument

result:=true; //keep loading setup..
end;
[/more]

Цитата:
как с помощью isxbb библиотеки тупо повесить картинку на wizard? чтоб она везде была при переходе со страницу на страницу ну и сверху наложить транспорент к примеру.

Смотри как пример Vista Lite Skin (или Inno Setup Scripting), там один фон на каждой странице.
Автор: EagleSH
Дата сообщения: 22.12.2008 01:06
Victor_Dobrov

Цитата:
Смотри как пример Vista Lite Skin (или Inno Setup Scripting), там один фон на каждой странице.

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

вот каая фигня получается:

Автор: mikutu
Дата сообщения: 22.12.2008 04:26
Victor_Dobrov
Решил переделать внешний CoronaSkin под себя и вот что вышло
http://s1.ipicture.ru/uploads/081222/CYwswYRysm.jpg
можно это (я имею виду цвет фона надписей имя фамилия пользователя и организация) как-то в нормальный вид привести.

и еще что вы думаете по моему вопросу http://forum.ru-board.com/topic.cgi?forum=5&topic=27438&start=1900#16, просто мне важно знать ответ на данный вопрос (пусть даже он будет отрицательным)
Автор: omals
Дата сообщения: 22.12.2008 08:57
Dermuin

Цитата:
... Запустить Программу XXXX ...

если правильно понял задачу, то

procedure CurStepChanged(CurStep: TSetupStep);
var:
MyProgramm4Run, WorkDir4myProgramm, MyParameters: String;
res: Integer;
begin
if CurStep=ssDone then
begin
if MsgBox('Запустить С.Т.А.Л.К.Е.Р. - Чистое небо?', mbConfirmation, MB_YESNO) = IDYES then
begin
MyProgramm4Run:= ExpandConstant('{app}\STALKER.exe'); // полный путь к EXE
WorkDir4myProgramm:= ExpandConstant('{app}'); // полный путь к рабочей папке если нужно, а не нужно, то ''
MyParameters:= ''; // пареметры если нужно передать твоей STALKER.exe
Exec(MyProgramm4Run, MyParameters, WorkDir4myProgramm, SW_SHOW, ewWaitUntilTerminated, res);
end;
end;
end;


Автор: nik1967
Дата сообщения: 22.12.2008 10:14
Victor_Dobrov, по поводу скрипта DirSizeCalc: вчера поторопился, полностью не потестил. Вообщем, если сперва нажать на Change, выбрать папку и нажать OK - то всё хорошо. А вот если нажать на Calc, то приложение зависает и выдаёт сообщение: Runtime Error
Line 76:
Math error.

76.{Recursion} Result:= Result + CalcDirSize(APath + DSR.Name, fileMask, SubDirsAllow);
Автор: EagleSH
Дата сообщения: 22.12.2008 11:21
Victor_Dobrov
с таймером то что нужно! спасибо!

осталось с Vista Skin + isxbb
Автор: sanmon
Дата сообщения: 22.12.2008 11:58
cdman67, спасибо за объяснение, я сам перемудрил из-за скудного знания анг.языка.
Как сделать картинку сверху и выбор диска как на этой картинке?

Автор: Victor_Dobrov
Дата сообщения: 22.12.2008 12:29
EagleSH

Цитата:
осталось с Vista Skin + isxbb

Я не пользуюсь Vista Lite Skin-ом и isxbb, но возможно, стоит изменить порядок создания компонентов, например, сначала создай фон, а затем всё остальное.

mikutu

Цитата:
Решил переделать CoronaSkin под себя и вот что вышло
можно это (я имею виду цвет фона надписей имя фамилия пользователя и организация) как-то в нормальный вид привести.

Скин легко настраивается при помощи констант. Поменяй константу BackGroundColor и пропиши в InitializeSkin строку WizardForm.Font.Color:= clWhite. Или ставь цвет отдельно для каждого компонента.

nik1967

Цитата:
по поводу скрипта DirSizeCalc: если сперва нажать на Change, выбрать папку и нажать OK - то всё хорошо. А вот если нажать на Calc, то приложение зависает и выдаёт сообщение: Runtime Error
Line 76:
Math error.

Если ничего не менять, то подсчитывается папка Windows. Скорей всего, ошибка получается при доступе к какой-то системной папке, у которой установлена особая политика безопасности.
Ещё раз повторю, что я такой ошибки не видел, хотя тестировал скрипт на многих компьютерах (от Win98 до Vista).
Автор: EagleSH
Дата сообщения: 22.12.2008 13:01
Victor_Dobrov

Цитата:
Я не пользуюсь Vista Lite Skin-ом и isxbb, но возможно, стоит изменить порядок создания компонентов, например, сначала создай фон, а затем всё остальное.

так и делаю, фон первым ложится, потом остальное - результат на скрине.
Автор: nik1967
Дата сообщения: 22.12.2008 15:11
Victor_Dobrov, спасибо за разъяснение. Тогда не подскажете, как сделать надпись "Объём папок" неактивной? (Corona Skin)
Автор: htuos
Дата сообщения: 22.12.2008 17:17
cdman67

Цитата:
Добрый день, господа !!! Подскажите, возможен ли вывод окна SFX-архива, запускаемого в процессе инсталляции, в произвольном месте экрана или эта задача принципиально нерешабельна средствами инно ? Если этот вопрос уже освещался - просьба подтвердить, я не поленюсь перелопатить все 4 ветки )

хм, уболтал. выложу здесь, может кому еще пригодится
вот [more=примерчик][Setup]
AppName=My Program
AppVerName=My Program v.1.2
DirExistsWarning=no
DefaultDirName={pf}\My Program

[Code_]
type
TThreadEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ThreadID: DWORD;
th32OwnerProcessID: DWORD;
tpBasePri: Longint;
tpDeltaPri: Longint;
dwFlags: DWORD;
end;

TGUIThreadinfo = record
cbSize: DWORD;
flags: DWORD;
hwndActive: HWND;
hwndFocus: HWND;
hwndCapture: HWND;
hwndMenuOwner: HWND;
hwndMoveSize: HWND;
hwndCaret: HWND;
rcCaret: TRect;
end;

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

TProcessEntry32 = record
dwSize: DWORD;
cntUsage: DWORD;
th32ProcessID: DWORD;
th32DefaultHeapID: DWORD;
th32ModuleID: DWORD;
cntThreads: DWORD;
th32ParentProcessID: DWORD;
pcPriClassBase: Longint;
dwFlags: DWORD;
szExeFile: array[0..259] of Char;
end;

var
AppHandle:HWND;

function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
function Thread32First(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32First@kernel32.dll stdcall';
function Thread32Next(hSnapshot: THandle; var lpte: TThreadEntry32): BOOL; external 'Thread32Next@kernel32.dll stdcall';
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32First@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL; external 'Process32Next@kernel32.dll stdcall';
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; external 'OpenProcess@kernel32.dll stdcall';
function GetGUIThreadInfo (idThread: DWORD; var pgui: TGUIThreadinfo): BOOL; external 'GetGUIThreadInfo@user32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, wFlags: Longint):boolean; external 'SetWindowPos@user32.dll stdcall';
function WaitForInputIdle(hProcess: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForInputIdle@user32.dll stdcall';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForSingleObject@kernel32.dll stdcall';
function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall';
function TranslateMessage(const lpMsg: TMsg): BOOL; external 'TranslateMessage@user32.dll stdcall';
function DispatchMessage(const lpMsg: TMsg): Longint; external 'DispatchMessageA@user32.dll stdcall';
function GetWindowLong(hWnd, nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll';

function GetAppHandle:HWND;
begin
Result:=GetWindowLong(MainForm.Handle,-8);
end;

procedure AppProcessMessage;
var
Msg: TMsg;
begin
while PeekMessage(Msg,AppHandle,0,0,1) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;

procedure GetProcessParam(const FileName:string; var PHandle:THandle; var PID:Cardinal);
var
h:THandle;
PS:TProcessEntry32;
fn:string;
i:integer;
begin
h:=CreateToolHelp32Snapshot($00000002,0);
if h=0 then Exit;
PS.dwSize:=SizeOf(PS);
if Process32First(h,PS) then
repeat
fn:=''; //идиотизм, но по-другому не получилось
for i:=0 to 254 do begin
if PS.szExeFile[i]=#0 then Break;
fn:=fn+PS.szExeFile[i];
end;
if AnsiUpperCase(fn)=AnsiUpperCase(FileName) then begin
PID:=PS.th32ProcessID;
Break;
end;
until not Process32Next(h,PS);
CloseHandle(h);
PHandle:=OpenProcess($001F0FFF,False,PID);
end;

procedure GetWndHandle(PID:Cardinal; var hWnd:HWND);
var
h:THandle;
TS:TThreadEntry32;
GUIThreadInfo:TGUIThreadInfo;
begin
h:=CreateToolhelp32Snapshot($00000004,0);
if h=0 then Exit;
TS.dwSize:=SizeOf(TS);
GUIThreadinfo.cbSize:=SizeOf(GUIThreadinfo);
if Thread32First(h,TS) then
repeat
if PID=TS.th32OwnerProcessID then
if GetGUIThreadInfo(TS.th32ThreadID,GUIThreadInfo) then
if (GUIThreadInfo.hwndActive>0) then begin
hWnd:=GUIThreadInfo.hwndActive;
Break;
end;
until not Thread32Next(h,TS);
CloseHandle(h);
end;

procedure ExecAppAndMoveWindow(Filename,Params,WorkingDir:string;X,Y:integer;WaitingProcess:boolean);
var
ErrorCode: Integer;
PID:Cardinal;
PH:THandle;
PWndHandle:HWND;
begin
//при таком подходе SW_HIDE ставить нельзя, окно не найдется, что хреново, будет видно перемещение окна
if not ShellExec('',Filename,Params,WorkingDir,SW_SHOW,ewNoWait,ErrorCode) then Exit;
PH:=0;
PID:=0;
PWndHandle:=0;
GetProcessParam(FileName,PH,PID);
try
if (PID<>0) and (PH<>0) then begin
WaitForInputIdle(PH,DWORD($FFFFFFFF));
//здесь надо бы юзать EnumThreadWindows (тогда бы можно было использовать SW_HIDE в ShellExec и все бы было красиво),
//но это тащить с собой innocallback.dll, поэтому попробуем по-другому
GetWndHandle(PID,PWndHandle);
if PWndHandle<>0 then begin
SetWindowPos(PWndHandle,0,X,Y,0,0,$41);
if WaitingProcess then begin
AppHandle:=GetAppHandle;
while WaitForSingleObject(PH,200)<>0 do AppProcessMessage;
end;
end;
end;
finally
CloseHandle(PH);
end;
end;

procedure InitializeWizard();
begin
//огрангичения - если запущено несколько одноименных процессов, то работать будет криво, лучше наверное сказать - не будет
//из неприятного - видно перемещение окна. от этого можно избавиться если использовать innocallback.dll
ExecAppAndMoveWindow('notepad.exe','e:\test.txt','',250,250,True);
end;[/more]
здесь есть свои ограничения и неприятности
по правильному нужно писать dll и делать совсем по-другому


Добавлено:
EagleSH
зачем тебе для рисования фона на форме isxbb? это можно и без нее сделать
Автор: EagleSH
Дата сообщения: 22.12.2008 18:15
Victor_Dobrov или кто в курсе, кто мне объяснит, почему не отображаются файлы, которые в данный момент копируются???
добавил по аналогии PageNameLabel, PageDescriptionLabel и банан
[more]
var
PageNameLabel, PageDescriptionLabel, FileNameLabel: TLabel;


procedure InitializeWizard();
begin
PageNameLabel := TLabel.Create(WizardForm);
with PageNameLabel do
begin
Left := ScaleX(10);
Top := ScaleY(10);
Width := ScaleX(300);
Height := ScaleY(14);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
Font.Style := [fsBold];
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;

PageDescriptionLabel := TLabel.Create(WizardForm);
with PageDescriptionLabel do
begin
Left := ScaleX(15);
Top := ScaleY(25);
Width := ScaleX(475);
Height := ScaleY(30);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;

FileNameLabel := TLabel.Create(WizardForm);
with FileNameLabel do
begin
Left := ScaleX(15);
Top := ScaleY(65);
Width := ScaleX(475);
Height := ScaleY(30);
AutoSize := False;
WordWrap := True;
Font.Color := clBlack;
ShowAccelChar := False;
Transparent := True;
Parent := WizardForm.MainPanel;
end;

with WizardForm do
begin
PageNameLabel.Hide;
PageDescriptionLabel.Hide;
FileNameLabel.Hide;

end;
end;


procedure CurPageChanged(CurPageID: Integer);
begin
PageNameLabel.Caption := WizardForm.PageNameLabel.Caption;
PageDescriptionLabel.Caption := WizardForm.PageDescriptionLabel.Caption;
FileNameLabel.Caption := WizardForm.FileNameLabel.Caption;
end;
[/more]
Автор: LordVeider
Дата сообщения: 22.12.2008 18:28
Апаю свои два вопроса:
Дописывание параметров к ярлыку при выборе определенных компонентов.
Список компонентов с хитрой структурой.
Пока решения так и не придумал...
Автор: cnegok
Дата сообщения: 23.12.2008 15:56
Привет, народ. У меня к Вам вопросик, вроде где-то на страницах ветки видел ответ на него, да уже не помню где именно, а заново перелистывать страницу за страницей нет сил..
Сам вопрос: как сделать, чтобы в зависимости от выбора языка установки на страницах wpLicense и wpInfoAfter файл лицензии и второй файл показывались на своих соответствующих языках. в программе установки три языка, имеются по три файла лицензии для каждого.

Заранее спасибо!

Вопрос решен, ответ найден на 97-й странице, с другой стороны перечитал почти с середины ветку, копнул другой разной информации.. =)
Автор: LordVeider
Дата сообщения: 23.12.2008 18:32
Итак, первый мой вопрос решён с помощью функции IsComponentSelected.
[more=Пример кода]
Код: [Components]
Name: cmp1; Description: desc1
Name: cmp2; Description: desc2
Name: cmp3; Description: desc3

[Code]
function BuildCommandlineParams(CLP: String): String;
begin
    CLP:='';
    if IsComponentSelected('cmp1') then CLP:=CLP+'param1';
    if IsComponentSelected('cmp2') then CLP:=CLP+'param2';
    if IsComponentSelected('cmp3') then CLP:=CLP+'param3';
    Result:=CLP;
end;

[Icons]
Name: name; Filename: filename; Parameters: {code:BuildCommandlineParams}

Страницы: 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970

Предыдущая тема: Презентация


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