[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/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;