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

[R.i.m.s.k.y.]

на Win 7 x64 не помогло. На XP отработало без проблем »
Это работает на всех виндах, проверено не только мной. Сам видишь вызывается стандартная для всех виндов команда консоли RD, которой передается путь {app}
Как вариант вставь MSGBox

...
if CurUninstallStep=usDone then begin
MsgBox(ExpandConstant('{app}'), mbError, mb_Ok);
if DirExists(ExpandConstant('{app}')) then begin
RD(ExpandConstant('{app}'))
end;

...
увидишь может путь не такой

[Rikill]

Johny777, у меня на совсем новой машине не запускался инсталлятор. Закрытый вариант - значит не для публики.

P.S. Скучал по форуму. Буду иногда появляться, если нужен вам. :)

[Johny777]

Rikill,
забил,
тк на день раз 20 запускаю для теста основы и очень часто оба примера перестают работать через несколько повторных запусков
у меня шрифт только в 6-8 местах использовался (как в главном меню халфы 2 с лямбдой)
вот наглядный пример
http://rghost.ru/36920285/image.png (http://rghost.ru/36920285.view)
заменю на картинки
разницы не будет никакой, а качество поднимется :)
если нужен вам »
нужен.

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

http://rghost.ru/36630976

[El Sanchez]

тк на день раз 20 запускаю для теста основы и очень часто оба примера перестают работать через несколько повторных запусков »
Johny777, Несколько замечаний по обоим примерам кастомного шрифта:
1. Совсем не обязательно рассылать сообщение WM_FONTCHANGE всем top-level окнам, достаточно послать форме. А можно и вообще Send/PostMessage убрать.
2. FontExists лучше делать до вызова AddFontResource, т.к. шрифт может быть уже установленым в системе и повторное его добавление это не есть хорошо.
3. Булев флаг IsCustomFontInstalled лишний.
4. Все это лучше не делать в функции InitializeSetup, когда формы еще нет.
5. Применить для уверенности функцию AddFontResourceEx, зная что шрифт будет использован только вызываемым приложением.


#define Font "Edisson.ttf"
#define FontName "Edisson"

[Files]
Source: {#Font}; Flags: dontcopy

[Code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif

const
FR_PRIVATE = $10;

function AddFontResource(lpszFilename: String; fl, pdv: DWORD): Integer; external 'AddFontResourceEx{#A}@gdi32.dll stdcall';
function RemoveFontResource(lpFileName: String; fl, pdv: DWORD): BOOL; external 'RemoveFontResourceEx{#A}@gdi32.dll stdcall';

procedure InitializeWizard();
begin
if not FontExists('{#FontName}') then
begin
ExtractTemporaryFile('{#Font}');
AddFontResource(ExpandConstant('{tmp}\{#Font}'), FR_PRIVATE, 0);
end;
WizardForm.Font.Name := '{#FontName}';
end;

procedure DeinitializeSetup();
begin
RemoveFontResource(ExpandConstant('{tmp}\{#Font}'), FR_PRIVATE, 0);
WizardForm.Free;
end;

[Gnom_aka_Lexander]

El Sanchez, одна беда - шрифт остается во временной папке. А рабочесть примера подтверждаю - у меня как раз такая система, на которой классический пример использования кастомного шрифта не работает, не зависимо от степени убитости системы. Повисает оповещательное сообщение. Немного исправляло положение замена SendMessage на PostMessage но результат нестабилен. Причина, как объяснили, какая-то программа ловит это сообщение и не пересылает его дальше. От степени убитости системы, повторюсь, это никак не зависит. Виноват криворукий программер, который написал какую-то обслуживающую утилитку, по всей видимости.

[by_gangster]

Здравствуйте, помогите поправить скрипт (с распаковкой arc), надо что бы он нормально распаковывался, а то он только сам архив расспаковывает, а надо что бы ещё он всё что в архиве расспаковывал. Пожалуйста помогите!!!!

[Setup]
AppName=Sigerous Mod для COP
AppVerName=Sigerous Mod v2.2
DefaultDirName=stalker
InfoBeforeFile=embedded\InfoBefore.rtf
WizardImageFile=embedded\WizardImage.bmp
WizardSmallImageFile=embedded\WizardSmallImage.bmp
Compression=zip

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

[Files]
Source: *.arc; DestDir: {app}; Flags: ignoreversion
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy

[Icons]
Name: {group}\Uninstall; IconFilename: {app}\unins000.exe; Filename: {app}\unins000.exe

[Code]


const
PM_REMOVE = 1;

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

procedure AppProcessMessage;
var
Msg: TMsg;
begin
while PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;



type

TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;

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



var
ProgressBar: TNewProgressBar;
ExtractFile: TNewStaticText;
Button1: TButton;
Cancel: Integer;

procedure InitializeWizard();
begin
ProgressBar := TNewProgressBar.Create(WizardForm);
ExtractFile:=TNewStaticText.Create(WizardForm);
with WizardForm.ProgressGauge do
begin
ProgressBar.Left := Left;
ProgressBar.Top := Top + ScaleX(55);
ProgressBar.Width := Width;
ProgressBar.Height := Height;
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 1000;
ProgressBar.Position := 0;
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width := Width;
ExtractFile.top:=Top + ScaleX(35);
ExtractFile.caption:='Распаковка архива FreeArc';
end;
end;

procedure Button1OnClick(Sender: TObject);
begin
Cancel := -1;
end;

function FreeArcCallback (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
var percents: Integer;
begin
if string(what)='filename' then
//ExtractFile.Caption:=str
else if (string(what)='progress') and (int2>0) then begin
percents := (int1*1000) div int2;
ProgressBar.Position := percents;
ExtractFile.Caption:='Распаковано '+IntToStr(int1)+' из '+IntToStr(int2)+' мб ('+FloatToStr(percents/10)+'%)';
end;
AppProcessMessage;
Result := Cancel;
end;

procedure ExtractFreeArcArchive(arcname: String; destpath: String);
var callback: longword;
res: Integer;
begin
AppProcessMessage;
callback:=WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
Cancel := 0;
try
res := FreeArcExtract (callback, 'x', '-o+', '-dp'+destpath, '--', arcname, '', '', '', '', '');
if cancel<0 then
MsgBox('Installation cancelled', mbInformation, MB_OK);
if res<0 then
MsgBox('Decompression failed with error code '+IntToStr(res)+'!', mbError, MB_OK);
Button1.visible:=false;
except
MsgBox('Decompression failed!', mbError, MB_OK);
Button1.visible:=false;
end;
DeleteFile(arcname);
end;

procedure CurStepChanged(CurStep: TSetupStep);
var app: String;
begin
If CurStep=ssPostInstall then
begin
Button1:=TButton.create(WizardForm);
Button1.parent:=WizardForm;
Button1.width:=135;
Button1.caption:='Cancel installation';
Button1.left:=260;
Button1.top:=WizardForm.cancelbutton.top;
Button1.OnClick:=@Button1OnClick;

app := ExpandConstant('{app}');
ExtractFreeArcArchive(app+'\data.arc', app);
ExtractFreeArcArchive(app+'\data.arc', app);
end;
end;

[fackir]

Добрый ден, перерыл все 3 Предыдущие ветки и эту, так и несмог найти ответна, вроде, элементарный вопрос:

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

[Run]
Filename: "http://mi_site.ru/"

так не работает :), Спасибо

[LinkOFF]

Всем добрый день!Помогите пожалуйста! Я никак не могу сделать разбиение на диски в скрипте ISDone. Я пробовал сделать так, как написано в справке, но у меня нечего не получается.Просто пишет что FreeArc-архив не найден.Помогите пожалуйста решить проблему.И не получается с распаковкой архивов в зависимости от выбранных компонентов.Наверно что-то со скриптом не так(делал как сказано в справке).
Вот скрипт - http://rghost.ru/36901450

[R.i.m.s.k.y.]

fackir,
[CustomMessages]
english.runSVPTeam=Visit SVP-Team web-site
russian.runSVPTeam=Зайти на сайт SVP-Team

[Run]
Filename: http://www.SVP-Team.com; Description: {cm:runSVPTeam}; Flags: shellexec skipifsilent postinstall nowait Unchecked

[nik1967]

fackir, или так
procedure CurStepChanged(CurStep: TSetupStep);
var
ErrorCode: Integer;
begin
if CurStep = ssDone then
ShellExec('open', 'http://mi_site.ru', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode);
end;

[R.i.m.s.k.y.]

nik1967, это хреновый пример, сайт откроется не спрашивая
А за такое надо насмерть закармливать печеньками

[by_gangster]

Здравствуйте, помогите поправить скрипт (с распаковкой arc), надо что бы он нормально распаковывался, а то он только сам архив расспаковывает, а надо что бы ещё он всё что в архиве расспаковывал. Пожалуйста помогите!!!!
[Setup]
AppName=Sigerous Mod для COP
AppVerName=Sigerous Mod v2.2
DefaultDirName=stalker
InfoBeforeFile=embedded\InfoBefore.rtf
WizardImageFile=embedded\WizardImage.bmp
WizardSmallImageFile=embedded\WizardSmallImage.bmp
Compression=zip

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

[Files]
Source: *.arc; DestDir: {app}; Flags: ignoreversion
Source: unarc.dll; DestDir: {tmp}; Flags: dontcopy
Source: InnoCallback.dll; DestDir: {tmp}; Flags: dontcopy

[Icons]
Name: {group}\Uninstall; IconFilename: {app}\unins000.exe; Filename: {app}\unins000.exe

[_code]


const
PM_REMOVE = 1;

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

procedure AppProcessMessage;
var
Msg: TMsg;
begin
while PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;



type

TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;

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



var
ProgressBar: TNewProgressBar;
ExtractFile: TNewStaticText;
Button1: TButton;
Cancel: Integer;

procedure InitializeWizard();
begin
ProgressBar := TNewProgressBar.Create(WizardForm);
ExtractFile:=TNewStaticText.Create(WizardForm);
with WizardForm.ProgressGauge do
begin
ProgressBar.Left := Left;
ProgressBar.Top := Top + ScaleX(55);
ProgressBar.Width := Width;
ProgressBar.Height := Height;
ProgressBar.Parent := WizardForm.InstallingPage;
ProgressBar.max := 1000;
ProgressBar.Position := 0;
ExtractFile.parent:=WizardForm.InstallingPage;
ExtractFile.autosize:=false;
ExtractFile.Width := Width;
ExtractFile.top:=Top + ScaleX(35);
ExtractFile.caption:='Распаковка архива FreeArc';
end;
end;

procedure Button1OnClick(Sender: TObject);
begin
Cancel := -1;
end;

function FreeArcCallback (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer;
var percents: Integer;
begin
if string(what)='filename' then
//ExtractFile.Caption:=str
else if (string(what)='progress') and (int2>0) then begin
percents := (int1*1000) div int2;
ProgressBar.Position := percents;
ExtractFile.Caption:='Распаковано '+IntToStr(int1)+' из '+IntToStr(int2)+' мб ('+FloatToStr(percents/10)+'%)';
end;
AppProcessMessage;
Result := Cancel;
end;

procedure ExtractFreeArcArchive(arcname: String; destpath: String);
var callback: longword;
res: Integer;
begin
AppProcessMessage;
callback:=WrapFreeArcCallback(@FreeArcCallback,4); //FreeArcCallback has 4 arguments
Cancel := 0;
try
res := FreeArcExtract (callback, 'x', '-o+', '-dp'+destpath, '--', arcname, '', '', '', '', '');
if cancel<0 then
MsgBox('Installation cancelled', mbInformation, MB_OK);
if res<0 then
MsgBox('Decompression failed with error code '+IntToStr(res)+'!', mbError, MB_OK);
Button1.visible:=false;
except
MsgBox('Decompression failed!', mbError, MB_OK);
Button1.visible:=false;
end;
DeleteFile(arcname);
end;

procedure CurStepChanged(CurStep: TSetupStep);
var app: String;
begin
If CurStep=ssPostInstall then
begin
Button1:=TButton.create(WizardForm);
Button1.parent:=WizardForm;
Button1.width:=135;
Button1.caption:='Cancel installation';
Button1.left:=260;
Button1.top:=WizardForm.cancelbutton.top;
Button1.OnClick:=@Button1OnClick;

app := ExpandConstant('{app}');
ExtractFreeArcArchive(app+'\data.arc', app);
ExtractFreeArcArchive(app+'\data.arc', app);
end;
end;

[fackir]

R.i.m.s.k.y., nik1967, Спасибо за оперативный ответ, седня попробую

[Johny777]

fackir, nik1967, R.i.m.s.k.y.,
мне кажется вот так проще всего (через гугл нашёл)
[Run]
Filename: http://forum.oszone.net; Description: Посетить форум OSzone.net; Flags: nowait postinstall shellexec
правда не знаю насколько нужен флаг postinstall

[R.i.m.s.k.y.]

правда не знаю насколько нужен флаг postinstall »
этот флаг формирует на последней странице чекбокс с описанием "Посетить форум OSzone.net"
Без него - см выше про печеньки

[Johny777]

R.i.m.s.k.y.,
да я знаю :)
просто из этого примера fackir трудно понять
[Run]
Filename: "http://mi_site.ru/"
может ему не нужен чекбокс и он хочет как у K-Lite кодек пака

а то он только сам архив расспаковывает, а надо что бы ещё он всё что в архиве расспаковывал. »
а как это?
я правильно понимаю, что в архиве лежат ещё архивы. которые должны быть распакованы?

[by_gangster]

Johny777, нет он сначала распаковывает сам arc архив а потом файлы внём, вот проблема с распаковкой файлов

[Gnom_aka_Lexander]

[Files] Source: *.arc; DestDir: {app}; Flags: ignoreversion »
by_gangster, Вот по кой черт ты архивы в инсталл пихаешь? Где ты вообще увидел, что их нужно пихать в инсталл? Покажи мне того дебила, который сказал, что именно так и нужно сделать. И не говори, что так в примере - там точно не так!

[nik1967]

nik1967, это хреновый пример, сайт откроется не спрашивая
А за такое надо насмерть закармливать печеньками »
Хе, ну или так:
[Setup]
AppName=sdads
AppVerName=sdads
DefaultDirName={pf}\splash

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

[_Code]
var
NewCheckBox2: TCheckBox;

procedure InitializeWizard();
begin
NewCheckBox2 := TNewCheckBox.Create(WizardForm);
with NewCheckBox2 do
begin
Name := 'NewCheckBox2';
Parent := WizardForm.FinishedPage;
Left := ScaleX(220);
Top := ScaleY(200);
Width := ScaleX(288);
Height := ScaleY(33);
Caption := 'Посетить сайт';
Checked := True;
end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
var
ErrorCode: Integer;
begin
if CurStep = ssDone then
if NewCheckBox2.Checked then
ShellExec('open', 'http://www.site.com', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode);
end;

[valyok666]

by_gangster, вопрос почему у тебя 2жды архив прописан?
app := ExpandConstant('{app}');
ExtractFreeArcArchive(app+'\data.arc', app);
ExtractFreeArcArchive(app+'\data.arc', app)
лучше используй исдоне))