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

[Dodakaedr]

Не подскажите как брать путь установки из реестра. »
Приблизительно так[setup]
appname=app
appvername=1.0 app
defaultdirname={code:GetDir}

[Code]
function GetDir(S: string): string;
var
d,r: string;
begin
S := ExpandConstant('{pf}\app');
if RegKeyExists(HKLM, 'Software\1') then begin
if RegQueryStringValue(HKLM, 'Software\1', 'Dir', d) then
S := d;
end;
if RegKeyExists(HKLM, 'Software\2') then begin
if RegQueryStringValue(HKLM, 'Software\2', 'Dir', r) then
S := r;
end;
if RegValueExists(HKLM, 'Software\1', 'Dir') and RegValueExists(HKLM, 'Software\2', 'Dir') then
s := r;
Result := S;
end;

[Okta_333]

Доброго времени суток!
Помогите пожалуйста сделать панельку (не логотип), как на втором скрине:

http://i70.fastpic.ru/big/2015/0518/4b/c48b5ca4f31c98469a22eb51de0e514b.png http://i70.fastpic.ru/big/2015/0518/4e/76fe1f22913e63866ca12a509d9e6d4e.png

Панель представлена в виде PNG-картинки. Открывается с нажатием на кнопку. В активном режиме панели деактивируются CancelButton и NextButton.
MusicButton и VolPB не интересуют.

[Николай_Николаич@vk]

Здравствуйте.
Подскажите, как такое реализовать.
Путь установки C:\Prog
в папке Prog есть папка Prog1
И в этой папке куча папок.
Так вот, как сделать чтобы один файл file.hof раскидать по папкам которые находятся в папке Prog1

[ekspoint]

как сделать чтобы один файл file.hof раскидать по папкам которые находятся в папке Prog1 »

FileCopy(ExpandConstant('{app}\Prog\Prog1\file.hof'), ExpandConstant('{app}\Prog\Prog1\Prog1_1\file.hof'),false);
FileCopy(ExpandConstant('{app}\Prog\Prog1\file.hof'), ExpandConstant('{app}\Prog\Prog1\Prog1_2\file.hof'),false);

[kotyarko@fb]

ekspoint, для индусов такой вариант в самый раз подходит (это я про тот случай, если вложенных папок, например, 30). И не факт, что имеющиеся папки имеют не уникальные имена.

Путь установки C:\Prog
в папке Prog есть папка Prog1
И в этой папке куча папок.
Так вот, как сделать чтобы один файл file.hof раскидать по папкам которые находятся в папке Prog1 »
Например так:
var
TFR: TFindRec;
begin
if FindFirst(ExpandConstant('{app}\Prog\Prog1\') + '*', TFR) then
try
repeat
if (TFR.Name <> '.') and (TFR.Name <> '..') then
if TFR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then
FileCopy(ExpandConstant('{app}\file.hof'), ExpandConstant('{app}\Prog\Prog1\') + TFR.Name + '\file.hof', False);
until not FindNext(TFR);
finally
FindClose(TFR);
end;
end;

[Dodakaedr]

Так вот, как сделать чтобы один файл file.hof раскидать по папкам которые находятся в папке Prog1 »
Наглядный пример использования))[setup]
appname=test
appvername=test 1.0
defaultdirname={sd}\test

[files]
source: file.hof; destdir: {app};

[dirs]
name: {app}\Prog\Prog1\1;
name: {app}\Prog\Prog1\2g;
name: {app}\Prog\Prog1\3k;
name: {app}\Prog\Prog1\4i;

[code]
procedure SendFileToSubFolders;
var
TFR: TFindRec;
begin
if FindFirst(ExpandConstant('{app}\Prog\Prog1\') + '*', TFR) then
try
repeat
if (TFR.Name <> '.') and (TFR.Name <> '..') then
if TFR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then
FileCopy(ExpandConstant('{app}\file.hof'), ExpandConstant('{app}\Prog\Prog1\') + TFR.Name + '\file.hof', False);
until not FindNext(TFR);
finally
FindClose(TFR);
end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then SendFileToSubFolders;
end;

[Николай_Николаич@vk]

Наглядный пример использования))
Скрытый текст
Код:
[setup]
appname=test
appvername=test 1.0
defaultdirname={sd}\test
[files]
source: file.hof; destdir: {app};
[dirs]
name: {app}\Prog\Prog1\1;
name: {app}\Prog\Prog1\2g;
name: {app}\Prog\Prog1\3k;
name: {app}\Prog\Prog1\4i;
[code]
procedure SendFileToSubFolders;
var
TFR: TFindRec;
begin
if FindFirst(ExpandConstant('{app}\Prog\Prog1\') + '*', TFR) then
try
repeat
if (TFR.Name <> '.') and (TFR.Name <> '..') then
if TFR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then
FileCopy(ExpandConstant('{app}\file.hof'), ExpandConstant('{app}\Prog\Prog1\') + TFR.Name + '\file.hof', False);
until not FindNext(TFR);
finally
FindClose(TFR);
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then SendFileToSubFolders;
end;
»

Спасибо, а не подскажете, как по такому же принципу раскидать папку

[kotyarko@fb]

Спасибо, а не подскажете, как по такому же принципу раскидать папку »
Используйте SHFileOperation, в нём есть функция CopyDir.

[Николай_Николаич@vk]

Используйте SHFileOperation, в нём есть функция CopyDir. »
А вы не могли бы привести пример копирования в папки, как с файлом.
а то кроме как просто копировать, ничего не получается.

[kotyarko@fb]

А вы не могли бы привести пример копирования в папки, как с файлом.
а то кроме как просто копировать, ничего не получается. »
#include "SHFileOperation.iss"
.....
var
TFR: TFindRec;
begin
if FindFirst(ExpandConstant('{app}\Prog\Prog1\') + '*', TFR) then
try
repeat
if (TFR.Name <> '.') and (TFR.Name <> '..') then
if TFR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then
CopyDir(ExpandConstant('{app}\Folder'), ExpandConstant('{app}\Prog\Prog1\') + TFR.Name);
until not FindNext(TFR);
finally
FindClose(TFR);
end;
end;

Сам SHFileOperation можете спокойно найти в сети.

[Николай_Николаич@vk]

Код:
#include "SHFileOperation.iss"
.....
var
TFR: TFindRec;
begin
if FindFirst(ExpandConstant('{app}\Prog\Prog1\') + '*', TFR) then
try
repeat
if (TFR.Name <> '.') and (TFR.Name <> '..') then
if TFR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then
CopyDir(ExpandConstant('{app}\Folder'), ExpandConstant('{app}\Prog\Prog1\') + TFR.Name);
until not FindNext(TFR);
finally
FindClose(TFR);
end;
end;
Сам SHFileOperation можете спокойно найти в сети.

Спасибо огромное, но есть одна проблема, в папки у которых в имени есть _ не копируется.

[kotyarko@fb]

но есть одна проблема, в папки у которых в имени есть _ не копируется. »
Код, по идеи, не должен игнорировать такие папки. У меня не игнорирует (пруф в прикреплённом скрине).
Не знаю, почему у тебя так.

[Николай_Николаич@vk]

Код, по идеи, не должен игнорировать такие папки. У меня не игнорирует (пруф в прикреплённом скрине).
Не знаю, почему у тебя так. »
Если внести папку в секцию [dirs] то все хорошо.
Еще случай, один раз инсталл пропустил папку с названием "1", при повторной попытке всетаки скопировал.

[kotyarko@fb]

Еще случай, один раз инсталл пропустил папку с названием "1", при повторной попытке всетаки скопировал. »
Папки создаются при этой же инсталляции?

[Николай_Николаич@vk]

Папки создаются при этой же инсталляции? »
Нет, они уже были.

[kotyarko@fb]

Нет, они уже были. »
Тогда хз.

[Snoopak96]

Николай_Николаич@vk,
[setup]
appname=test
appvername=test 1.0
defaultdirname={sd}\test

[code]
type
TSHFileOpStruct = record
Wnd: HWND;
wFunc: UINT;
pFrom: PAnsiChar;
pTo: PAnsiChar;
fFlags: Word;
fAnyOperationsAborted: BOOL;
hNameMappings: HWND;
lpszProgressTitle: PAnsiChar;
end;

const
FO_MOVE = $0001;
FO_COPY = $0002;
FOF_SILENT = $0004;
FOF_NOCONFIRMATION = $0010;
FOF_FILESONLY = $0080;
FOF_NOCONFIRMMKDIR = $0200;

function SHFileOperation(const lpFileOp: TSHFileOpStruct):Integer; external 'SHFileOperation@shell32.dll stdcall';

function BackupDir(const fromDir, toDir: AnsiString; IsMove: Boolean): Boolean;
var
fos: TSHFileOpStruct;
_fromDir, _toDir: AnsiString;
SR: TFindRec;
res: Boolean;
begin
ForceDirectories(toDir);
if IsMove then
fos.wFunc := FO_MOVE else
fos.wFunc := FO_COPY;
fos.fFlags := FOF_FILESONLY or FOF_SILENT or
FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
_fromDir:= AddBackslash(fromDir);
_toDir := AddBackslash(toDir);
if (Length(fromDir) = Length(_fromDir)) then
begin
res:= FindFirst(_fromDir + '*', SR);
try
while res do
begin
if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
begin
if SR.Attributes = FILE_ATTRIBUTE_DIRECTORY then
begin
_fromDir:= _fromDir + SR.Name + #0#0;
_toDir := _toDir + #0#0;
fos.pFrom := PAnsiChar(_fromDir);
fos.pTo := PAnsiChar(_toDir);
end else
begin
_fromDir:= _fromDir + SR.Name + #0#0;
_toDir := _toDir + SR.Name + #0#0;
fos.pFrom := PAnsiChar(_fromDir);
fos.pTo := PAnsiChar(_toDir);
end;
Result := (0 = ShFileOperation(fos));
_fromDir:= ExtractFilePath(_fromDir);
_toDir:= ExtractFilePath(_toDir);
end;
res := FindNext(SR);
end;
finally
FindClose(SR);
end;
end else
begin
_fromDir:= RemoveBackslashUnlessRoot(_fromDir) + #0#0;
_toDir := RemoveBackslashUnlessRoot(_toDir) + #0#0;
fos.pFrom := PAnsiChar(_fromDir);
fos.pTo := PAnsiChar(_toDir);
Result := (0 = ShFileOperation(fos));
end;
end;

procedure SendFileToSubFolders(ScanDir, InFile: string);
var
TFR: TFindRec;
begin
if FindFirst(AddBackslash(RemoveBackslash(ScanDir)) + '*', TFR) then
try
repeat
if (TFR.Name <> '.') and (TFR.Name <> '..') then
if TFR.Attributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then begin
FileCopy(InFile, AddBackslash(RemoveBackslash(ScanDir)) + TFR.Name + '\' + ExtractFileName(InFile), False);
end;
until not FindNext(TFR);
finally
FindClose(TFR);
end;
end;

procedure SendDirToSubFolders(ScanDir, InDir: string);
var
TFR: TFindRec;
begin
if FindFirst(AddBackslash(RemoveBackslash(ScanDir)) + '*', TFR) then
try
repeat
if (TFR.Name <> '.') and (TFR.Name <> '..') then
if (TFR.Attributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
BackupDir(AddBackslash(RemoveBackslash(InDir)), AddBackslash(RemoveBackslash(ScanDir)) + TFR.Name + '\' + ExtractFileName(InDir), false);
until not FindNext(TFR);
finally
FindClose(TFR);
end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
//Для файла
// if CurStep = ssPostInstall then SendFileToSubFolders(ExpandConstant('{app}\1'), ExpandConstant('{sd}\spyhunter.log'));
//Для папки
if CurStep = ssPostInstall then SendDirToSubFolders(ExpandConstant('{app}\1'), ExpandConstant('{sd}\sh4ldr'));
end;

[svs23]

сори что не в тему!!!
kotyarko@fb ящик ЛС полный! новые сообщения не уходят...

[Николай_Николаич@vk]

Кстати, не подскажете, давно искал пример двойного прогресс бара (Один по файловый, второй - общий прогресс), но никак не мог найти.
Есть ли таковой?

[Okta_333]

Кстати, не подскажете, давно искал пример двойного прогресс бара (Один по файловый, второй - общий прогресс), но никак не мог найти.
Есть ли таковой? »
В ISDone 06final есть пример SecondProgressBar