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

[Gnom_aka_Lexander]

[Files] Source: {code_GetSpecialPath}\MyProg; DestDir: {code:GetVideoPath}\MyProg »
тут засада. MyProg это файл или папка?
Просто Мое Видео входит в системные файлы папки и система может не дать изменить то, что уже есть. По крайней мере семерка.

[ChVL]

это файл или папка? »
Папка.
Но какой-то выход из положения должен быть. Цель тривиальная: положить туда свою папку.

[Gnom_aka_Lexander]

папка с содержимым? Просто вот так:
Source: {code_GetSpecialPath}\MyProg; DestDir: {code:GetVideoPath}\MyProg
это будет файл.
А вот так:
Source: {code_GetSpecialPath}\MyProg\*; DestDir: {code:GetVideoPath}\MyProg
содержимое папки без подпапок. Если нужно создать пустую папку, то лучше использовать секцию [Dirs] а не файлов.

[ChVL]

Gnom_aka_Lexander,
То, что надо положить: папка\папка\файл

[Gnom_aka_Lexander]

Source: {code_GetSpecialPath}\папка\папка\файл; DestDir: {code:GetVideoPath}\папка\папка

[ChVL]

Gnom_aka_Lexander,
Естественно, обычная запись.

[ChVL]

Кстати, в ХР та же ситуация:

http://rghost.ru/39835954/image.png (http://rghost.ru/39835954.view)

Это подтверждает необходимость уточнять скрипт.

[Gnom_aka_Lexander]

ChVL, тогда вот так:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={code:GetVideoPath}

[Files]
Source: GetVideoPath.iss; Flags : dontcopy;

[*code]
function SHGetSpecialFolderPath(hwndOwner: HWND; lpszPath: PAnsiChar; nFolder: Integer; fCreate: BOOL): BOOL;
external 'SHGetSpecialFolderPathA@shell32.dll stdcall';

function GetSpecialPath(CSIDL: Word): string;
var
s: string;
begin
SetLength(s, 260);
if not SHGetSpecialFolderPath(0, PAnsiChar(s), CSIDL, True) then s := '';
Result:= PAnsiChar(s);
end;

function GetVideoPath(s : string): string;
begin
Result:= GetSpecialPath($0e);
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then
begin
ForceDirectories(GetSpecialPath($0e) +'\MyProgName');
ExtractTemporaryFileEx('GetVideoPath.iss',GetSpecialPath($0e)+'\MyProgName');
end;
end; но у меня почему-то распаковывает в папку видео, а не в подпапку MyProgName, которая даже не создается. Видимо, все-таки система запрещает вмешательство, не вижу других причин.

[ChVL]

Вообще-то решение существует. Встречал несколько программ, у которых эта функция реализована. Но до секции [Сode] не добраться...

[El Sanchez]

ChVL, так попробуйте. Если система будет выделываться, уберите флаг CSIDL_FLAG_CREATE.

[Files]
Source: test.txt; DestDir: {code:GetVideoPath}\test

[Code]
const
MAX_PATH = 260;
CSIDL_MYVIDEO = $E;
CSIDL_FLAG_CREATE = $8000;
SHGFP_TYPE_DEFAULT = $1;

function SHGetFolderPath(hwndOwner: HWND; nFolder: Integer; hToken: THandle; dwFlags: DWORD; pszPath: String): Longint; external 'SHGetFolderPathA@shell32.dll stdcall';

function GetVideoPath(Param: String): String;
begin
SetLength(Result, MAX_PATH);
if SHGetFolderPath(0, CSIDL_MYVIDEO or CSIDL_FLAG_CREATE, 0, SHGFP_TYPE_DEFAULT, Result) <> 0 then Result := '';
Result := CastIntegerToString(CastStringToInteger(Result));
end;

[Ivan_009]

Как зделать так чтобы иконка отображалась в этой области... :sorry:

[Johny777]

Ivan_009,

[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Files]
Source: icon.ico; DestDir: {tmp}; Flags: dontcopy

[ Code]
function LoadImage(hInst: THandle; ImageName: PChar; ImageType: UINT; X, Y: Integer; Flags: UINT): THandle; external 'LoadImageA@user32.dll stdcall delayload';

procedure InitializeWizard;
begin
ExtractTemporaryFile('icon.ico');
SendMessage(WizardForm.Handle, $0080, 0, LoadImage(0,ExpandConstant('{tmp}')+'\icon.ico',1,16,16,$1010));
end;

где icon.ico - иконка 16 на 16 пикселей

Автор скрипта - South

Ваня!
только сейчас догнал этот пример тебе не катит, тк у тебя нет границ окна
вот код

[Setup]
AppName=My Program
AppVersion=1.5
AppVerName=My Program 1.5
DefaultDirName={pf}\My Program
DefaultGroupName=My Program

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

[Files]
Source: "hl2.ico"; Flags: dontcopy

[ Code]
procedure InitializeWizard();
begin
with WizardForm do
begin
OuterNotebook.Hide;
BorderStyle := bsNone;
Color := $506a5a;
end;

with TNewIconImage.Create(nil) do
begin
Parent := WizardForm;
SetBounds(ScaleX(3), ScaleY(3), ScaleX(16), ScaleY(16));
ExtractTemporaryFile('hl2.ico');
Icon.LoadFromFile(ExpandConstant('{tmp}\hl2.ico'));
end;
end;


с файлом: http://sendfile.su/651666 (проверено, одобрено)


использование на форме деинсталятора

[Setup]
AppName=My Program
AppVersion=1.5
AppVerName=My Program 1.5
DefaultDirName={pf}\My Program
DefaultGroupName=My Program

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

[Files]
Source: "hl2.ico"; DestDir: {app}; Flags: ignoreversion nocompression; Attribs: hidden system;

[Code ]
procedure InitializeWizard();
begin
with WizardForm do
begin
OuterNotebook.Hide;
BorderStyle := bsNone;
Color := $506a5a;
end;

with TNewIconImage.Create(nil) do
begin
Parent := WizardForm;
SetBounds(ScaleX(3), ScaleY(3), ScaleX(16), ScaleY(16));
ExtractTemporaryFile('hl2.ico');
Icon.LoadFromFile(ExpandConstant('{tmp}\hl2.ico'));
end;
end;


procedure InitializeUninstallProgressForm();
begin
UninstallProgressForm.BorderStyle := bsNone;
UninstallProgressForm.Color := $506a5a;
UninstallProgressForm.OuterNotebook.Hide;
UninstallProgressForm.ProgressBar.Parent := UninstallProgressForm;

if FileCopy(ExpandConstant('{app}\hl2.ico'), ExpandConstant('{tmp}\hl2.ico'), False) = True then
begin
with TNewIconImage.Create(nil) do
begin
Parent := UninstallProgressForm;
SetBounds(ScaleX(3), ScaleY(3), ScaleX(16), ScaleY(16));
Icon.LoadFromFile(ExpandConstant('{tmp}\hl2.ico'));
end;
end;
end;

[sergey3695]

Как зделать так чтобы иконка отображалась в этой области... »
А толку от неё там? Тупо чтобы была?
Если уж так нужно, то как-то так:

[Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
DisableFinishedPage=yes
OutputDir=.
Compression=lzma/ultra

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

[Files]
Source: Files\Icon1.ico; DestDir: {app}; Flags: ignoreversion; Attribs: hidden system;

[Code ]
function InitializeSetup(): Boolean;
begin
if not FileExists(ExpandConstant('{tmp}\Icon1.ico')) then ExtractTemporaryFile('Icon1.ico');
Result:= True;
end;

var
MyIcon: TNewIconImage;

procedure InitializeWizard();
begin
with WizardForm do begin
BorderStyle:= bsNone;
InnerNotebook.Hide;
OuterNotebook.Hide;
end;
MyIcon := TNewIconImage.Create(Wizardform);
with MyIcon do
begin
Parent := Wizardform;
SetBounds(ScaleX(5),ScaleY(5),ScaleX(16),ScaleY(16));
Icon.LoadFromFile(ExpandConstant('{tmp}\Icon1.ico'));
end;
end;
Johny777, на скрин посмотри. Ни че не видешь в правом углу, кнопки на которых свернуть и закрыть.

[Johny777]

подскажите пожалуйста как в этой процедуре обрабатываемой при изменении лист бокса получить текст выбранного айтема
procedure FileListOnClick(Sender: TObject);
begin
// From_Edit.Text := FileList.Items(Sender).Text;
end;
код целиком:


[Setup]
AppName=Test
AppVersion=1.0
DefaultDirName={pf}\Test
DefaultGroupName=Test
AllowNoIcons=yes
OutputDir=.
OutputBaseFilename=setup
Compression=lzma
SolidCompression=true
Uninstallable=false

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

[ Code]
var
Page: TInputDirWizardPage;
Extract_Button: TButton;
From_Edit: TNewEdit;
From_Button: TNewButton;
To_Edit: TNewEdit;
To_Button: TNewButton;
FileList: TNewListBox;
n: integer;

function GetFileCount(dir: string): Integer;
var
FindFiles: TFindRec;
begin
Result := 0;
if FindFirst(dir + '\*.exe', FindFiles) then
begin
repeat
if FindFiles.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then Result := Result + 1;
until not FindNext(FindFiles) or (Result > 1);
FindClose(FindFiles);
end;
end;

procedure GetAllFiles( Path: string; Lb: TNewListBox );
var
sRec: TFindRec;
isFound: boolean;
begin
isFound := FindFirst(Path +'\*.exe*',sRec);
while isFound do
begin
if (sRec.Name <> '.') and (sRec.Name <> '..') then
begin
if (sRec.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
GetAllFiles(Path + '\' + sRec.Name, Lb);
Lb.Items.Add(Path + sRec.Name);
n := FileList.Items.Count;
end;
Application.ProcessMessages;
isFound := FindNext(sRec);
end;
FindClose(sRec);
end;


procedure FileListOnClick(Sender: TObject);
begin
// From_Edit.Text := FileList.Items(Sender).Text;
end;

procedure BrowseButtonOnClick(Sender: TObject);
var
Dir: String;
MyExit: TSetupForm;
begin
case TButton(Sender) of
From_Button: if BrowseForFolder(SetupMessage(msgBrowseDialogLabel), Dir, False) then
begin
// From_Edit.Text := Dir;
if GetFileCount(Dir) > 1 then
begin
MyExit := CreateCustomForm();
with MyExit do
begin
Position := poScreenCenter;
ClientWidth := ScaleX(400);
ClientHeight := ScaleY(300);
Caption := 'Уточнитель';
Color := clWindow;

with TButton.Create(nil) do
begin
Parent := MyExit;
Caption := ExpandConstant(SetupMessage(msgButtonNo));
SetBounds(ScaleX(18), ScaleY(220), ScaleX(71), ScaleY(25));
Cursor := crHand;
ModalResult:= mrNo;
end;

with TButton.Create(nil) do
begin
Caption := ExpandConstant(SetupMessage(msgButtonYes));
Parent := MyExit;
SetBounds(ScaleX(110), ScaleY(220), ScaleX(71), ScaleY(25));
Cursor := crHand;
ModalResult := mrYes;
end;

FileList := TNewListBox.Create(nil);
with FileList do
begin
Parent := MyExit;
SetBounds(ScaleX(0),ScaleY(0),ScaleX(400),ScaleY(200));
ItemHeight := 13;
ItemIndex := n;
OnClick := @FileListOnClick;
end;

GetAllFiles(Dir, FileList );

case ShowModal() of
mrNo : MsgBox( '', mbError, MB_OK);
mrYes : MsgBox( '', mbError, MB_OK);
end;
end;
end;
end;

To_Button: if BrowseForFolder(SetupMessage(msgBrowseDialogLabel), Dir, True) then To_Edit.Text := Dir;

end;
end;

procedure Edits_OnChange(Sender: TObject);
begin
Extract_Button.Enabled := (From_Edit.Text <> '') and (To_Edit.Text <> '');
end;

procedure Extract(Sender: TObject);
var
ErrorCode: Integer;
begin
Exec(From_Edit.Text, '-y -o"' + To_Edit.Text + '"', From_Edit.Text, SW_HIDE, ewWaitUntilTerminated, ErrorCode);
end;

procedure InitializeWizard();
begin
with WizardForm do
begin
Bevel.Hide;
OuterNotebook.Hide;
end;

From_Edit := TNewEdit.Create(WizardForm);
with From_Edit do
begin
Parent := WizardForm;
Left := ScaleX(64);
Top := ScaleY(168);
Width := ScaleX(313);
Height := ScaleY(21);
OnChange := @Edits_OnChange;
end;

From_Button := TNewButton.Create(WizardForm);
with From_Button do
begin
Caption := 'Обзор';
Parent := WizardForm;
Left := ScaleX(400);
Top := ScaleY(168);
Width := ScaleX(75);
Height := ScaleY(25);
OnClick := @BrowseButtonOnClick;
end;

To_Edit := TNewEdit.Create(WizardForm);
with To_Edit do
begin
Parent := WizardForm;
Left := ScaleX(64);
Top := ScaleY(208);
Width := ScaleX(313);
Height := ScaleY(21);
OnChange := @Edits_OnChange;
end;

To_Button := TNewButton.Create(WizardForm);
with To_Button do
begin
Caption := 'Обзор';
Parent := WizardForm;
Left := ScaleX(400);
Top := ScaleY(208);
Width := ScaleX(75);
Height := ScaleY(25);
OnClick := @BrowseButtonOnClick;
end;

Extract_Button:=TButton.Create(WizardForm);
with Extract_Button do
begin
Parent:=WizardForm;
SetBounds(WizardForm.Width - ScaleX(300),WizardForm.Height - ScaleX(65),ScaleX(75),ScaleY(25));
Caption:='Извлечь';
Enabled := False;
OnClick:=@Extract;
end;
end;

[Ivan_009]

Как сделать такие края в инсталляторе без ботвы..... :not-me:

[nik1967]

Как сделать такие края в инсталляторе без ботвы..... »Выдернуть из AutoRun.iss Need for Speed™ Undercover'а.

[Ivan_009]

nik1967, А поподробней можно какие функции :)

[nik1967]

Ivan_009, [Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

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

[ Code]
const
Radius = 55; // Тут сами экспериментируйте

function CreateRoundRectRgn(p1, p2, p3, p4, p5, p6: Integer): THandle; external 'CreateRoundRectRgn@gdi32 stdcall';
function SetWindowRgn(hWnd: HWND; hRgn: THandle; bRedraw: Boolean): Integer; external 'SetWindowRgn@user32 stdcall';

procedure ShapeForm(aForm: TForm; edgeSize: integer);
var
FormRegion:LongWord;
begin
FormRegion:=CreateRoundRectRgn(0,0,aForm.Width,aForm.Height,edgeSize,edgeSize);
SetWindowRgn(aForm.Handle,FormRegion,True);
end;

procedure InitializeWizard();
begin
ShapeForm(WizardForm, radius);
end; Только пропадает прозрачность.

[Mafioza]

как сделать , окно подготовки к установке и его точный прогресс , хотя бы как в NSIS ?заранее спасибо !

[Ivan_009]

Mafioza, ты про это что ли... :)
Johny777, как такое зделать незнаешь случаем... :not-me: