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

[Johny777]

El Sanchez,
помню спрашивал как быстро определить размер папки (те для меня пример ...\Inno Setup 5\Scripts\Dobrov\DirSizeCal.iss работает слишком медленно)

нашёл пример использующий объект FileSystemObject http://msdn.microsoft.com/en-us/library/f1xtf7ta%28v=vs.85%29.aspx
на форуме http://forum.vingrad.ru/forum/topic-84976/unread-1.html

результат - функция (здесь вывод в мегабайтах под мои нужды) : :)

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

[ code]
function GetFolserSize(path:string):Integer;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.GetFolder(path).Size div (1024*1024);
end;

procedure InitializeWizard();
begin
MsgBox(IntToStr(GetFolserSize('C:\Program Files (x86)')), mbInformation, MB_OK);
end;

в данном случае папку Program Files (x86) у меня (пока что размером почти 2 гига после переустановки винды) посчитала за секунду
более наглядный пример:

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

[ code]
function GetFolserSize(path:string):Extended;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.GetFolder(path).Size;
end;


function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';

function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of Char;
begin
try
Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
except end;
end;

procedure InitializeWizard();
begin
MsgBox(BytesToSize(GetFolserSize('C:\Program Files (x86)')), mbInformation, MB_OK);
end;

но вот при попытке посчитать C:\Windows вылетает с ошибкой на Result := oFS.GetFolder(path).Size div (1024*1024);

---------------------------
Runtime Error
---------------------------
Line 14:

Exception: : .
---------------------------
ОК
---------------------------

может папка слишком большого размера и он не может посчитать или я функцию криво записал
с другой стороны папку с видео размером больше 250 гигов посчитала корректно и тоже быстро
в общем хотелось бы узнать в чём причина ошибки ну и как следствие - улучшение/исправление

в качестве производных:
размер файла:

function GetFileSize(FilePath:string):Extended;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.GetFile(FilePath).Size;
end;


function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';

function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of Char;
begin
try
Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
except end;
end;

procedure InitializeWizard();
begin
MsgBox(BytesToSize(GetFileSize('C:\Windows\regedit.exe')), mbInformation, MB_OK);
end;


версия файла:

function FileVersion(FilePath:string):string;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.GetFileVersion(FilePath);
end;


procedure InitializeWizard();
begin
MsgBox((FileVersion('C:\Windows\regedit.exe')), mbInformation, MB_OK);
end;


получение буквы жёсткого диска на которм лежит файл:

function GetFolserSize(FilePath:string):string;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.GetDriveName(FilePath);
end;


procedure InitializeWizard();
begin
MsgBox((GetFolserSize('C:\Windows\regedit.exe')), mbInformation, MB_OK);
end;


генерирование уникального имени папки для использования её в %Temp%

function CreateFolserUniqueName:string;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.GetTempName;
end;


procedure InitializeWizard();
begin
MsgBox(CreateFolserUniqueName, mbInformation, MB_OK);
end;


альтернатива функции DirExists:

function FolderExists(Folder:string):boolean;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.FolderExists(Folder);
end;


procedure InitializeWizard();
begin
if FolderExists('C:\setup') then MsgBox('ok', mbInformation, MB_OK);
end;


проверка наличия жёсткого диска по букве:

function DriveExists(Drive:string):boolean;
var
oFS: Variant;
begin
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.DriveExists(Drive);
end;


procedure InitializeWizard();
begin
if DriveExists('C') then MsgBox('ok', mbInformation, MB_OK);
end;

[SatHan]

привет. при установке извлекаются некоторые файлы. из них exe bmp итд. скажите. можно сделать чтоб они работали внутри инсталятора. или хотяб брались из файла x.tmp который извлекается в %temp% а не в чистом виде?

[El Sanchez]

но вот при попытке посчитать C:\Windows вылетает с ошибкой на Result := oFS.GetFolder(path).Size div (1024*1024); »
Johny777, вот же ж двоешник.
1. Проверяй в функции наличие папки. Исключение как раз из-за этого.
2. Размер Integer мал для "толстых" папок, нужно, например, Extended.

function GetFolserSize(path: String): Extended;
var
oFS: Variant;
begin
try
if not DirExists(path) then Exit;
oFS := CreateOleObject('Scripting.FileSystemObject');
Result := oFS.GetFolder(path).Size/1024/1024;
except
Result := 0;
end;
end;

//два знака после запятой
MsgBox(FormatFloat('#0.00', GetFolserSize('C:\Windows')), mbInformation, MB_OK);

[Mailchik]

SatHan, [Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application
BitmapResource=Test:compiler:WizModernImage-IS.bmp

[Code]
procedure InitializeWizard;
begin
WizardForm.WizardBitmapImage.Bitmap.LoadFromResourceName(HInstance, '_IS_Test');
end;

[El Sanchez]

также вот процедура перемещения файлов
просьба проверить нигде ли я не накосячил: »
Johny777, первый параметр метода MoveFile может содержать групповые символы:

procedure MoveFiles(SourceFolder, Mask, DestFolder: String);
var
oFS: Variant;
begin
try
if not DirExists(SourceFolder) or not DirExists(DestFolder) then Exit;
oFS := CreateOleObject('Scripting.FileSystemObject');
oFS.MoveFile(AddBackslash(RemoveBackslash(SourceFolder)) + Mask, DestFolder);
except
//ShowExceptionMessage;
end;
end;

[Raf-9600]

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

[Gnom_aka_Lexander]

Raf-9600, как-то так, только мне не очень нравится, как это работает, может старшие товарище подскажут, как сделать лучше.
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Components]
Name: std; Description: Стандартная; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: std\a; Description: Анси; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: std\u; Description: Юникод; Flags: exclusive disablenouninstallwarning; Types: custom compact full

Name: ext; Description: Китаяса; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: ext\a; Description: Анси; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: ext\u; Description: Юникод; Flags: exclusive disablenouninstallwarning; Types: custom compact full

[*code]
procedure HintStr(Sender: TObject; X: Integer; Y: Integer; Index: Integer; Area: TItemArea);
begin
with WizardForm do
with ComponentsList do
case Index of
0 : Hint := 'Стандартная';
1 : Hint := 'Стандартная Анси';
2 : Hint := 'Стандартная Юникод';
3 : Hint := 'Китаяса';
4 : Hint := 'Китаяса Анси';
5 : Hint := 'Китаяса Юникод';
else
Hint := 'Наведите на компонент для отображения подсказки';
end;
end;

procedure InitializeWizard();
begin
with WizardForm do
begin
with ComponentsList do
begin
ShowHint := True;
Hint := '';
OnItemMouseMove := @HintStr;
end;
end;
end;Скорей всего на стандартной версии не будет работать.

[Raf-9600]

как-то так, только мне не очень нравится, как это работает, может старшие товарище подскажут, как сделать лучше. »
После того как первая подсказка исчезает, больше ни одна не появляется :(

[Shegorat]

После того как первая подсказка исчезает, больше ни одна не появляется »
Как вариант можно сделать так
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Components]
Name: std; Description: Стандартная; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: std\a; Description: Анси; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: std\u; Description: Юникод; Flags: exclusive disablenouninstallwarning; Types: custom compact full

Name: ext; Description: Китаяса; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: ext\a; Description: Анси; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: ext\u; Description: Юникод; Flags: exclusive disablenouninstallwarning; Types: custom compact full

[code]
var
LastIndex: Integer;

procedure HintStr(Sender: TObject; X: Integer; Y: Integer; Index: Integer; Area: TItemArea);
begin
if Index<>LastIndex then begin
LastIndex:= Index;
WizardForm.ComponentsList.ShowHint:= False;
WizardForm.ComponentsList.Hint:= '';
Exit;
end;

with WizardForm.ComponentsList do
case Index of
0 : Hint := 'Стандартная';
1 : Hint := 'Стандартная Анси';
2 : Hint := 'Стандартная Юникод';
3 : Hint := 'Китаяса';
4 : Hint := 'Китаяса Анси';
5 : Hint := 'Китаяса Юникод';
else
Hint := 'Наведите на компонент для отображения подсказки';
end;
WizardForm.ComponentsList.ShowHint:= True;
end;

procedure InitializeWizard();
begin
with WizardForm do
begin
with ComponentsList do
begin
ShowHint := True;
Hint := '';
OnItemMouseMove := @HintStr;
end;
end;
end;

[Raf-9600]

Как вариант можно сделать так »
Самое оно! Благодарю.
Я бы ещё хотел узнать, можно ли сделать так, чтобы текст определённого Hint'а менялся в зависимости от выбранных компонентов?
Т.е. чтобы допустим если выбран компонент "ext\u" то у "ext\a" подсказка менялась на другую?

[Mailchik]

Raf-9600, тот же, от Шегората:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Components]
Name: std; Description: Стандартная; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: std\a; Description: Анси; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: std\u; Description: Юникод; Flags: exclusive disablenouninstallwarning; Types: custom compact full

Name: ext; Description: Китаяса; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: ext\a; Description: Анси; Flags: exclusive disablenouninstallwarning; Types: custom compact full
Name: ext\u; Description: Юникод; Flags: exclusive disablenouninstallwarning; Types: custom compact full

[code]
var
LastIndex: Integer;

procedure HintStr(Sender: TObject; X: Integer; Y: Integer; Index: Integer; Area: TItemArea);
begin
if Index<>LastIndex then begin
LastIndex:= Index;
WizardForm.ComponentsList.ShowHint:= False;
WizardForm.ComponentsList.Hint:= '';
Exit;
end;

with WizardForm.ComponentsList do
case Index of
0 : Hint := 'Стандартная';
1 : Hint := 'Стандартная Анси';
2 : Hint := 'Стандартная Юникод';
3 : Hint := 'Китаяса';
4 : begin
if IsComponentSelected('ext\u') then // то, что вам нужно.
Hint := 'Китаяса Анси 2'
else Hint := 'Китаяса Анси';
end;
5 : Hint := 'Китаяса Юникод';
else
Hint := 'Наведите на компонент для отображения подсказки';
end;
WizardForm.ComponentsList.ShowHint:= True;
end;

procedure InitializeWizard();
begin
with WizardForm do
begin
with ComponentsList do
begin
ShowHint := True;
Hint := '';
OnItemMouseMove := @HintStr;
end;
end;
end;

[SatHan]

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

[Gnom_aka_Lexander]

SatHan, я тоже люблю поиздеваться. а можно сделать чтобы подсказка плавала за курсором мыши в области компонента а не стояла на одном месте? »
Можно (http://www.delphimaster.net/view/1-65850)

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

Можно ли как-то обойти окно выбора языка при старте установщика, задав "насильно" устанавливаемый язык?

[Gnom_aka_Lexander]

R.i.m.s.k.y., только с опорой на язык системы, больше никак.
[Setup]
ShowLanguageDialog=no
LanguageDetectionMethod=locale

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

Имеется
[Setup]
ShowLanguageDialog=no
LanguageDetectionMethod=locale

[Languages]
Name: russian; MessagesFile: compiler:Languages\Russian.isl
Name: english; MessagesFile: compiler:Languages\english.isl
Можно как-то "обощить" инсталлер на множество нерусских языков? если система русская - инсталлер выбирал русский язык (что собственно в секции Setup и указано), но если ОС любая кроме русской (китайская, корейская, бразильская etc) - то принудительно выбирался английский язык? естественно без окна выбора языка

[Mailchik]

R.i.m.s.k.y., поставьте английский первым в списке, то есть:
[Setup]
AppName=Test
AppVerName=Test v1.1
DefaultDirName={pf}\Test
ShowLanguageDialog=no
LanguageDetectionMethod=locale

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

[SatHan]

Можно »на ссылку чевото не переходит:(.

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

поставьте английский первым в списке »
что-то я сомневаюсь что такое сработает
Что будет если установщик запустят на бразильской или китайской системе?

[Mailchik]

R.i.m.s.k.y., можете сами проверить. панель управления -- часы, язык и регион -- язык и региональные стандарты -- формат.
я думаю вы имеете в виду язык самой системы, но и в том случае должен сработать. инсталлятор, насколько я знаю, выбирает первый язык из списка [languages], если ShowLanguageDialog=no.
из справки:
3.Если ни один не найден, первый указанный язык в секции [Languages] принимается языком по умолчанию.