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

[Tco 03]

Установщик сканирует флешки »
Их несколько чтоли (флешек)? А сам установщик в этот момент (по замыслу) где должен находиться?
находит файл "Cons.exe »
Пример поиска файла по маске (http://forum.oszone.net/post-1351758-1312.html)
Ищет там папку »
Где именно (вопрос про флешки)?
Запускает файлик "Cons.exe" с ключами /Receive /Base* /Yes »
Тут мне вообще не понятно. Какие ключи? От чего? И что это: /Receive /Base* /Yes

[Mailchik]

Тут мне вообще не понятно. Какие ключи? От чего? И что это: /Receive /Base* /Yes »
Ключи запуска программы. [Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Code]
procedure InitializeWizard;
var
ResultCode: integer;
begin
if Exec(ExpandConstant('{src}\Cons.exe'), '/Receive /Base* /Yes', '', SW_HIDE,
ewWaitUntilTerminated, ResultCode) then
MsgBox('Success', mbInformation, MB_OK) else
MsgBox('Not success', mbInformation, MB_OK);
end;

[i-Lex]

Tco 03, Их несколько чтоли (флешек)? А сам установщик в этот момент (по замыслу) где должен находиться? »
Либо на флешке, либо на CD.
И да, флешек может быть куча вставлена.
Где именно (вопрос про флешки)? »
Да, на одной из флешек лежит папка. Она может называться по разному. В ней лежит файлик Cons.exe и ещё несколько файлов и папок.
Одна из этих папок называется "Receive". Туда и нужно копировать файлы.
Потом нужно запустить файл Cons.exe с параметрами /Receive /Base* /YesТут мне вообще не понятно. Какие ключи? От чего? И что это: /Receive /Base* /Yes »
Это команды автопополнения.

Важно, что искать программа должна именно на флешках. Т.к. на компе может быть установлена демо версия Консультанта, с такими же файлами, но урезанная и не умеющая пополняться.

[habib2302]

доброе время суток.дайте пожалуйста мне скрипт на кликабельное лого без фона

[habib2302]

Так же нужен скрипт под Fenixx »
жми сюда (http://rghost.ru/44786173)

[El Sanchez]

i-Lex, папка Receive с апдейтами рядом со скриптом :


#define AppName "Консультант Плюс"
#define AppExe "CONS.EXE"
#define UpdateDir "RECEIVE"

#define FindHandle
#define FindResult

#sub ProcessFoundFile
#define public AppVer GetFileVersion(UpdateDir + "\" + FindGetFileName(FindHandle))
#endsub

#for {FindHandle = FindResult = FindFirst(UpdateDir + "\vr*.res", 0); FindResult; FindResult = FindNext(FindHandle)} ProcessFoundFile

[Setup]
AppName={#AppName}
AppVerName={#AppName} {#AppVer}
AppVersion={#AppVer}
CreateAppDir=false
DefaultDirName={tmp}
UsePreviousAppDir=false
UsePreviousGroup=false
UsePreviousSetupType=false
UsePreviousTasks=false
UsePreviousUserInfo=false
DisableStartupPrompt=true
DisableWelcomePage=yes
Uninstallable=false
CreateUninstallRegKey=false

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

[Messages]
ru.SetupAppTitle=Обновление
ru.SetupWindowTitle=Обновление — %1
ru.WizardReady=Всё готово к обновлению
ru.ReadyLabel1=Программа установки готова начать обновление [name/ver] на вашем компьютере.
ru.ReadyLabel2b=Выберите папки установки и нажмите «Обновить», чтобы продолжить.
ru.WizardInstalling=Обновление...
ru.InstallingLabel=Пожалуйста, подождите, пока [name] обновится на вашем компьютере.
ru.FinishedHeadingLabel=Завершение Мастера обновления [name]
FinishedLabelNoIcons=Программа [name] обновлена на вашем компьютере.

[Files]
Source: {#UpdateDir}\*; DestDir: {tmp}\{#UpdateDir}; Flags: createallsubdirs recursesubdirs

[Code]
#define A = (Defined UNICODE) ? "W" : "A"

const
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
FO_COPY = $2;
FOF_SILENT = $4;
FOF_NOCONFIRMMKDIR = $200;
FOF_NOCONFIRMATION = $10;
FOF_NOERRORUI = $400;

type
SHFILEOPSTRUCT = record
hwnd: HWND;
wFunc: UINT;
pFrom: String;
pTo: String;
fFlags: Longint;
fAnyOperationsAborted: BOOL;
hNameMappings: Longint;
lpszProgressTitle: String;
end;

var
szPaths: TStringList;
AppPathsCheckListBox: TNewCheckListBox;

function GetLogicalDrives(): DWORD; external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(lpRootPathName: String): UINT; external 'GetDriveType{#A}@kernel32.dll stdcall';
function SHFileOperation(var lpFileOp: SHFILEOPSTRUCT): Integer; external 'SHFileOperation{#A}@shell32.dll stdcall';

//////////////////////////////////////////////////////////////////
function FindAppExePath(const szPath, szFileName: String): String;
var
FR: TFindRec;
begin
if FindFirst(Format('%s\%s', [szPath, szFileName]), FR) then
try
repeat
if (FR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0) then
if DirExists(Format('%s\{#UpdateDir}', [szPath])) then Result := szPath;
until not FindNext(FR) or (Result <> '');
finally
FindClose(FR);
end;
// recurse
if FindFirst(Format('%s\*', [szPath]), FR) then
try
repeat
if (FR.Attributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and (FR.Name <> '.') and (FR.Name <> '..') then
Result := FindAppExePath(Format('%s\%s', [szPath, FR.Name]), szFileName);
until not FindNext(FR) or (Result <> '');
finally
FindClose(FR);
end;
end;

////////////////////////////////////
function GetAppPaths(): TStringList;
var
dwDrives, dwDriveType: DWORD;
i: Integer;
szDriveLetter: String;
begin
if Result = nil then Result := TStringList.Create;
dwDrives := GetLogicalDrives();
for i := 2 to 25 do if dwDrives and (1 shl i) <> 0 then
begin
szDriveLetter := Format('%s:', [Chr(Ord('A') + i)]);
dwDriveType := GetDriveType(szDriveLetter);
case dwDriveType of
DRIVE_REMOVABLE: begin
Result.Add(FindAppExePath(szDriveLetter, '{#AppExe}'));
if Result.Strings[Result.Count-1] = '' then Result.Delete(Result.Count-1);
end;
DRIVE_NO_ROOT_DIR: Continue;
end;
end;
end;

///////////////////////////////////////////////////////
procedure AppPathsCheckListBoxOnClick(Sender: TObject);
var
i: Integer;
begin
WizardForm.NextButton.Enabled := False;
for i := 0 to TNewCheckListBox(Sender).ItemCount-1 do WizardForm.NextButton.Enabled := WizardForm.NextButton.Enabled or TNewCheckListBox(Sender).Checked[i];
end;

////////////////////////////////////
function InitializeSetup(): Boolean;
begin
szPaths := GetAppPaths();
Result := szPaths.Count > 0;
if not Result then MsgBox('Ахтунг! Программа {#AppName} не найдена на съемных дисках!', mbError, MB_OK);
end;

/////////////////////////////
procedure InitializeWizard();
var
i: Integer;
begin
WizardForm.ReadyMemo.Hide;
AppPathsCheckListBox := TNewCheckListBox.Create(WizardForm);
with AppPathsCheckListBox do
begin
Parent := WizardForm.ReadyPage;
SetBounds(WizardForm.ReadyMemo.Left, WizardForm.ReadyMemo.Top, WizardForm.ReadyMemo.Width, WizardForm.ReadyMemo.Height);
BorderStyle := bsNone;
Color := clBtnFace;
WantTabs := True;
MinItemHeight := ScaleY(21);
OnClickCheck := @AppPathsCheckListBoxOnClick;
for i := 0 to szPaths.Count-1 do AddCheckBox(szPaths.Strings[i], '', 0, True, True, False, False, nil);
end;
end;

/////////////////////////////////////////////
procedure CurPageChanged(CurPageID: Integer);
begin
case CurPageID of
wpReady: WizardForm.NextButton.Caption := 'Обновить';
end;
end;

//////////////////////////////////////////////
procedure CurStepChanged(CurStep: TSetupStep);
var
fs: SHFILEOPSTRUCT;
i, ResultCode: Integer;
begin
case CurStep of
ssPostInstall: begin
fs.wFunc := FO_COPY;
fs.pFrom := ExpandConstant('{tmp}\{#UpdateDir}'#0);
fs.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_NOERRORUI;
for i := 0 to AppPathsCheckListBox.ItemCount-1 do if AppPathsCheckListBox.Checked[i] then
begin
fs.pTo := Format('%s'#0, [AppPathsCheckListBox.ItemCaption[i]]);
if SHFileOperation(fs) <> 0 then Break;
Exec(Format('%s\{#AppExe}', [AppPathsCheckListBox.ItemCaption[i]]), '/Receive /Base* /Yes', '', SW_HIDE, ewWaitUntilTerminated, ResultCode);
end;
end;
end;
end;

//////////////////////////////
procedure DeinitializeSetup();
begin
szPaths.Free;
end;

[Johny777]

i-Lex,

El Sanchez, Ну ты меня опередил на минуту :) , как вариант:
пробегаемся в цикле функцией GetDriveType() по дискам пока она не вернёт DRIVE_REMOVABLE
рекурсивно ищем в диске (то бишь во флэшке) файл и заполняем структуру

type
_RUN_STRUCT = record
pConsExe: String; // путь к экзешнику Cons.exe
pReceive: String; // к папке Receive
end;

на этапе установки в цикле из рядом с инаталлом извлекаем архив по папкам и запускаем екзешники с параметрами
целых 176 строк кода :)
код:

[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program
CreateAppDir=no

[Files]
Source: 7-zip32.dll; Flags: dontcopy


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

const
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVABLE = 2;
DRIVE_FIXED = 3;
MAX_PATH = 260;

type
_RUN_STRUCT = record
pConsExe: String;
pReceive: String;
end;

function GetDriveType(lpRootPathName: String): UINT; external 'GetDriveType{#A}@kernel32.dll stdcall';


procedure SearchForFile(const RootFolder, FileName: String; var ResultPathArray: array of _RUN_STRUCT);
var
NewSearchPath: String;
FindRec: TFindRec;
Len: Integer;
begin
NewSearchPath := AddBackslash(RemoveBackslash(RootFolder));

if FindFirst(NewSearchPath + '*.*', FindRec) then
try

repeat
if (FindRec.Name <> '.') and (FindRec.Name <> '..') then
begin
if FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
begin
if FindRec.Name = FileName then
begin
Len := GetArrayLength(ResultPathArray);
SetArrayLength(ResultPathArray, Len+1);
ResultPathArray[Len].pConsExe := NewSearchPath + FindRec.Name;
ResultPathArray[Len].pReceive := NewSearchPath + 'RECEIVE';
end;
end else
if FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then SearchForFile(NewSearchPath + FindRec.Name, FileName, ResultPathArray);
end;
until not FindNext(FindRec);

finally
FindClose(FindRec);
end;
end;



function ScanDrives(): array of _RUN_STRUCT;
var
UndefDriveLetter: String;
DriveType: UINT;
i: Integer;
begin
for i := 67 to 90 do // Loop from C..Z to determine available drives
begin
UndefDriveLetter := Chr(i) + ':\';
DriveType := GetDriveType(UndefDriveLetter);
case DriveType of
DRIVE_REMOVABLE: begin
SearchForFile(UndefDriveLetter, 'Cons.exe', Result);
end;
DRIVE_NO_ROOT_DIR, DRIVE_FIXED: Continue;
end;
end;
end;

///////////////////////////////////////////////////////////////////////////////////////


#define A = (Defined UNICODE) ? "W" : "A"

const
SZ_ERROR = 1;
SZ_DLLERROR = 3;
ARCEXTRACT_INPROCESS = 1;
WM_USER = $400;
PBM_SETPOS = (WM_USER + 2);
PBM_SETRANGE32 = (WM_USER + 6);

type
EXTRACTINGINFO = record
dwFileSize: DWORD;
dwWriteSize: DWORD;
szSourceFileName: array [0..512] of Char;
dummy1: array [0..2] of Byte;
szDestFileName: array [0..512] of Char;
dummy: array [0..2] of Byte;
end;

function SevenZip(const hwnd: HWND; szCmdLine: PAnsiChar; szOutput: AnsiString; const dwSize: DWORD): Integer; external 'SevenZip@files:7-zip32.dll stdcall';
function SevenZipSetOwnerWindowEx(_hwnd: HWND; _lpArcProc: Longint): BOOL; external 'SevenZipSetOwnerWindowEx@files:7-zip32.dll stdcall';
function SevenZipKillOwnerWindowEx(_hwnd: HWND): BOOL; external 'SevenZipKillOwnerWindowEx@files:7-zip32.dll stdcall';
//
function RtlMoveMemory(var Destination: EXTRACTINGINFO; const Source: Longint; len: Integer): Integer; external 'RtlMoveMemory@kernel32.dll stdcall';
function SetWindowText(hWnd: HWND; lpString: String): BOOL; external 'SetWindowText{#A}@user32.dll stdcall';
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';
function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: String; cbMultiByte: Integer; lpWideCharStr: String; cchWideChar: Integer): Integer; external 'MultiByteToWideChar@kernel32.dll stdcall';

var
ei: EXTRACTINGINFO;

function ArchiverCallbackProc(hwnd: HWND; uMsg, nState: UINT; lpEis: Longint): BOOL;
begin
Result := True;
case nState of
ARCEXTRACT_INPROCESS: begin
RtlMoveMemory(ei, lpEis, SizeOf(ei));
PostMessage(hwnd, PBM_SETRANGE32, 0, 100);
PostMessage(hwnd, PBM_SETPOS, Round(ei.dwWriteSize*100/ei.dwFileSize), 0);
end;
end;
end;


function SevenZipCommand(const hWnd: HWND; szParams: String; const lpArchiverCallback: Longint): Longint;
begin
Result := SZ_ERROR;
if lpArchiverCallback <> 0 then szParams := Format('%s -hide', [szParams]);
CharToOemBuff(szParams);
try
if lpArchiverCallback <> 0 then SevenZipSetOwnerWindowEx(hWnd, lpArchiverCallback); //set callback
Result := SevenZip(hWnd, szParams, '', 0);
finally
if lpArchiverCallback <> 0 then SevenZipKillOwnerWindowEx(hWnd);
except
Result := SZ_DLLERROR;
end;
end;



///////////////////////////////////////////////////////////////////////////////////////
type
HINST = THandle;

function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST; external 'ShellExecute{#A}@shell32.dll stdcall';

procedure CurStepChanged(CurStep: TSetupStep);
var
UndefRunArray: array of _RUN_STRUCT;
i, ErrorCode: Integer;
begin
if CurStep = ssInstall then
begin
UndefRunArray := ScanDrives();
for i := 0 to GetArrayLength(UndefRunArray)-1 do
begin
// extract with callback
SevenZipCommand(WizardForm.ProgressGauge.Handle, Format('x "%s" "%s" -y', [AddBackslash(ExpandConstant('{src}'))+'123.7z', AddBackslash(UndefRunArray[i].pReceive)]), CallbackAddr('ArchiverCallbackProc'));
if ShellExecute(0, 'open', UndefRunArray[i].pConsExe, '/Receive /Base* /Yes', '', SW_SHOWNORMAL) <= 32 then MsgBoxEx(0, SysErrorMessage(DLLGetLastError), SetupMessage(msgErrorTitle), MB_OK, 0, 10);
end;
end;
end;

ЗЫ: i-Lex, у меня там пара лишних объявленных переменных (Ex: ErrorCode). Забыл подмести. Сам убери!
архив с примером:

[Gnom_aka_Lexander]

Если кому интересно, вот окончательное решение задачки товарища i-Lex:
[Setup]
AppName=Consultant Plus Update
AppVersion=1.5
UsePreviousGroup=False
DisableProgramGroupPage=yes
CreateAppDir=False
Uninstallable=no
OutputBaseFilename=ConsultantPlusUpdate
AppCopyright=ООО "Информационный Центр Консультант"
WizardImageFile=null.bmp
WizardSmallImageFile=2.bmp
SetupIconFile=1.ico
BitmapResource=BIG:1.bmp
OutputDir=.

[Files]
Source : "{code:GetSrcDir}\*"; DestDir:"{code:GetDir}"; Flags: ignoreversion recursesubdirs createallsubdirs external skipifsourcedoesntexist

[Run]
Filename: "{code:GetExec}"; Parameters: "{code:GetExecParam}";WorkingDir:"{code:GetWork}"; Flags: nowait

[*code]
#ifdef UNICODE
#define A="W"
#else
#define A="A"
#endif
var
res, found : Boolean;
sl : TStringList;

function GetLogicalDrives: DWORD;
external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(nDrive: String): Longint;
external 'GetDriveType{#A}@kernel32.dll stdcall';
function GetWindowLong(Wnd: HWnd; Index: Integer): Longint;
external 'GetWindowLong{#A}@user32.dll stdcall';
function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint;
external 'SetWindowLong{#A}@user32.dll stdcall';

function GetDir(const s: string): string;
begin
Result :=sl[1];
end;

function GetExecParam(const s: string): string;
begin
case FileExists(ExpandConstant('{src}\Settings.inx')) of
false : Result :='/Receive /Base* /Yes';
true: Result := GetIniString('Setup', 'ExecParam', '/Receive /Base* /Yes', ExpandConstant('{src}\Settings.inx'));
end;
end;

function GetSrcDir(const s: string): string;
begin
case FileExists(ExpandConstant('{src}\Settings.inx')) of
false : Result :=RemoveBackslash(ExpandConstant('{src}\Updates'));
true: Result :=RemoveBackslash(ExpandConstant('{src}\')+GetIniString('Setup', 'SrcDir', 'Updates', ExpandConstant('{src}\Settings.inx')));
end;
end;

function GetExec(const s: string): string;
begin
Result :=sl[0];
end;

function GetWork(const s: string): string;
begin
Result := RemoveBackslash(ExtractFilePath(sl[0]));
end;

function ChecFull(dir : string): Boolean;
var
SR : TFindRec;
FR : Boolean;
dirs : string;
dc : DWORD;
begin
dc := 0;
dirs := 'ROS CMB CJI PSP PKS PDR PGU PKP PTS ARB COMMON';
FR := FindFirst(AddBackslash(dir)+'*', SR);
while FR do
begin
if ((SR.Attributes and $00000010) = $00000010) and ((SR.Name<>'.') and (SR.Name<> '..')) then
begin
inc(dc);
if Pos(SR.Name, dirs)=0 then Break;
end;
Application.ProcessMessages;
FR := FindNext(SR);
end;
FindClose(SR);
Result := dc = 11;
end;

procedure FindFile(destd, mask : string; sl : TStrings);
var
SR : TFindRec;
FR : Boolean;
begin
FR := FindFirst(AddBackslash(destd )+ '*.*', SR);
while (FR and not res)do
begin
if pos(mask, AddBackslash(destd ) + SR.Name)<>0 then
begin
Application.ProcessMessages;
if ChecFull(AddBackslash(destd)+'base') then
if DirExists(AddBackslash(destd)+'RECEIVE')then
begin
sl.Add(AddBackslash(destd) + SR.Name);
sl.Add(AddBackslash(destd)+'RECEIVE');
res := True;
break;
end;
end;
Application.ProcessMessages;
if ((SR.Attributes and $00000010) = $00000010) and ((SR.Name = '.') or (SR.Name = '..')) then
begin
FR := FindNext(SR);
Continue;
end;
Application.ProcessMessages;
if ((SR.Attributes and $00000010) = $00000010) then
begin
FindFile(AddBackslash(destd ) + SR.Name + '\', mask, sl);
FR := FindNext(SR);
Continue; // продолжить цикл
end;
Application.ProcessMessages;
FR := FindNext(SR);
end;
FindClose(SR);
end;

function ChecCP(): Boolean;
var
x: LongInt;
bit, i: integer;
tp: Uint;
tip: string;
frm : TForm;
begin
frm := TForm.Create(nil);
with frm do
begin
BorderStyle := bsDialog;
BorderIcons := [];
SetBounds(0, 0, ScaleX(400), ScaleY(50));
Position := poScreenCenter;
Caption := 'Подождите, идет поиск вашей программы...';
Show;
end;
with TNewProgressBar.Create(frm) do
begin
Parent := frm;
Align := alClient;
Style := npbsPaused;
SetWindowLong(Handle,-16,GetWindowLong(Handle, -16) or $08);
SendMessage(Handle, $0400 + 10, 10, 1);
Show;
end;
res := false;
sl := TStringList.Create;
x:=GetLogicalDrives();
if x=0 then Exit;
for i:=1 to 64 do
begin
Application.ProcessMessages;
bit:=x and 1;
if bit=1 then
begin
if res then Break;
tip := PAnsiChar(chr(64+i)+':');
if ((GetDriveType(tip)=2) and (DirExists(tip))) then FindFile(tip, 'cons.exe', sl);
end;
Application.ProcessMessages;
x:= x shr 1;
end;
Result := sl.Count>1;
if not Result then MsgBox('Программа не найдена, либо у Вас demo-версия программы.', mbError, MB_OK);
frm.Free;
end;

function InitializeSetup(): Boolean;
begin
sl := TStringList.Create;
found := ChecCP;
Result := found;
if not Result then
sl.Free;
end;

procedure DeinitializeSetup();
begin
if found then sl.Free;
end;

procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = wpReady then
begin
with WizardForm.ReadyMemo do
begin
Show;
Clear;
Lines.Add('Папка обновлений: ');
Lines.Add(' '+GetSrcDir(''));
Lines.Add('');
Lines.Add('Папка приложения: ');
Lines.Add(' '+GetWork(''));
Lines.Add('');
Lines.Add('Папка установки обновлений: ');
Lines.Add(' '+GetDir(''));
Lines.Add('');
Lines.Add('Параметры запуска: ');
Lines.Add(' '+GetExec('')+' '+GetExecParam(''));
end;
end;
end;

procedure InitializeWizard();
begin
with WizardForm do
begin
WizardBitmapImage.Bitmap.FreeImage;
WizardBitmapImage2.Bitmap.FreeImage;
WizardBitmapImage.Bitmap.LoadFromResourceName(HInstance, '_IS_BIG');
WizardBitmapImage2.Bitmap.LoadFromResourceName(HInstance, '_IS_BIG');
end;
end;
Без коментариев(есть за мной такой косяк ;) ) но там вроде все и так понятно. буду благодарен товарищу El Sanchez, если подскажет, как можно дополнительно оптимизировать поиск, кроме принудительного обрыва рекурсии.

[El Sanchez]

как можно дополнительно оптимизировать поиск, кроме принудительного обрыва рекурсии. »
Gnom_aka_Lexander, да никак, искать до потери пульса либо рвать поиск на первом совпадении и надеяться, что на флешке не окажется второй и более копий программы, до которых поиск так и не дойдет. Хотя можно теоретически как-то задействовать Indexing Service/Windows Search Service.

вот окончательное решение задачки »
Gnom_aka_Lexander, граната ChecFull не той системы. :)

[Gnom_aka_Lexander]

граната ChecFull не той системы »
Все той. Уточнял у вопрошавшего как надежно отличить полную версию от демо-версии. был указан этот список папок для той версии Консультанта, с которой он работает.да никак »
а апишные функции поиска не должны ускорить? в интерпретаторе инно там своя реализация, поэтому вызов апишных вроде-бы должен ускорить. на данный момент секунды полторы на поиск уходит при средней загруженности флешки левыми файлами-папками, я посчитал это уже приемлемым, но может можно еще быстрей?

[Johny777]

Gnom_aka_Lexander, El Sanchez,

дельфи и инно используют для поиска WinApi функции:
function FindFirstFile(...): THandle;
function FindNextFile(...): BOOL;
function FindClose(...): BOOL;
которые лежат в kernel32.dll и работа напрямую с этими функциями дала бы некоторое повышение скорости
а то получаем торомоза из-за вызова функции внутри другой

вот накатал 2 примера рекурсивного поиска по расширению: обычная и с использованием вышеупомянутых WinApi напрямую:


[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program
CreateAppDir=no
DisableWelcomePage=yes
InfoBeforeFile=compiler:Default.isl


[code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
const
MAX_PATH = 260;
INVALID_HANDLE_VALUE = -1;

type
_WIN32_FIND_DATA = record
dwFileAttributes: DWORD;
ftCreationTime: TFileTime;
ftLastAccessTime: TFileTime;
ftLastWriteTime: TFileTime;
nFileSizeHigh: DWORD;
nFileSizeLow: DWORD;
dwReserved0: DWORD;
dwReserved1: DWORD;
cFileName: array[0..MAX_PATH - 1] of Char;
cAlternateFileName: array[0..13] of Char;
end;


function FindFirstFile(lpFileName: String; var lpFindFileData: _WIN32_FIND_DATA): THandle; external 'FindFirstFile{#A}@kernel32.dll stdcall';
function FindNextFile(hFindFile: THandle; var lpFindFileData: _WIN32_FIND_DATA): BOOL; external 'FindNextFile{#A}@kernel32.dll stdcall';
function Win_Api_FindClose(hFindFile: THandle): BOOL; external 'FindClose@kernel32.dll stdcall';

function GetTickCount(): DWORD; external 'GetTickCount@kernel32.dll stdcall';


function CharArrayToString(cArray: array of Char): String;
begin
Result := '';
while cArray[Length(Result)] <> #0 do Insert(cArray[Length(Result)], Result, Length(Result)+1);
end;



function WinApiSearchForFiles(const RootFolder, Extension: String; var ResultPathArray: array of String): Boolean; // get all files with their path
var
FindData: _WIN32_FIND_DATA;
NewSearchPath: String;
hFindFile: THandle;
Len: Integer;
begin
NewSearchPath := AddBackslash(RemoveBackslash(RootFolder));

hFindFile := FindFirstFile(NewSearchPath + Extension, FindData);

if hFindFile = INVALID_HANDLE_VALUE then
begin
MsgBoxEx(0, SysErrorMessage(DLLGetLastError), SetupMessage(msgErrorTitle), MB_OK, 0, 0);
Exit;
end;

try
repeat

if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
begin
Len := GetArrayLength(ResultPathArray);
SetArrayLength(ResultPathArray, Len+1);
ResultPathArray[Len] := NewSearchPath + CharArrayToString(FindData.cFileName);
end else if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY) and (String(FindData.cFileName[0]) <> '.') and (String(FindData.cFileName[0]) <> '..') then
/// recurse
WinApiSearchForFiles(AddBackslash(NewSearchPath + CharArrayToString(FindData.cFileName)), Extension, ResultPathArray);

until not FindNextFile(hFindFile, FindData);

finally
Result := Win_Api_FindClose(hFindFile);
end;
end;


////////////////////////////////////////////////////////////////



procedure SearchForFiles(const RootFolder, Extension: String; var ResultPathArray: array of String); // get all files with their path
var
NewSearchPath: String;
FindRec: TFindRec;
Len: Integer;
begin
NewSearchPath := AddBackslash(RemoveBackslash(RootFolder));

if FindFirst(NewSearchPath + Extension, FindRec) then
try

repeat
if (FindRec.Name <> '.') and (FindRec.Name <> '..') then
begin
if FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0 then
begin
Len := GetArrayLength(ResultPathArray);
SetArrayLength(ResultPathArray, Len+1);
ResultPathArray[Len] := NewSearchPath + FindRec.Name;
end else
if FindRec.Attributes and FILE_ATTRIBUTE_DIRECTORY = FILE_ATTRIBUTE_DIRECTORY then SearchForFiles(NewSearchPath + FindRec.Name, Extension, ResultPathArray);
end;
until not FindNext(FindRec);

finally
FindClose(FindRec);
end;
end;





procedure InitializeWizard;
var
i: Integer;
S: String;
UndefArray: array of String;

dwStartTime: DWORD;
begin
// dwStartTime := GetTickCount();
// SearchForFiles('C:\Program Files\Adobe\Adobe Photoshop CS5.1 (64 Bit)', '*.*', UndefArray);
// MsgBox('Inno Search Time:' + #32 + IntToStr(GetTickCount()-dwStartTime), mbInformation, MB_OK);

dwStartTime := GetTickCount();
WinApiSearchForFiles('C:\Program Files\Adobe\Adobe Photoshop CS5.1 (64 Bit)', '*.*', UndefArray);
MsgBox('Win Api Search Time:' + #32 + IntToStr(GetTickCount()-dwStartTime), mbInformation, MB_OK);

for i := 0 to GetArrayLength(UndefArray)-1 do S := S + #13#10 + UndefArray[i];
WizardForm.InfoBeforeMemo.Text := S;
end;



но в результате обычная работает быстрее тк, для апишной приходится использовать функцию конвертации массива символов в строку, тк урезанная инно не умеет преобразовать тип String(array of Char) :(

=================

ускорить поиск думаю можно указанием имени файла а не расширения:
SearchForFiles('C:\Program Files\Adobe\Adobe Photoshop CS5.1 (64 Bit)', 'Bib.dll', UndefArray);

[El Sanchez]

Все той. Уточнял у вопрошавшего как надежно отличить полную версию от демо-версии. »
Gnom_aka_Lexander, я не про предназначение функции, я про это:
inc(dc); »

[i-Lex]

Большое спасибо Gnom_aka_Lexander, за помощь!

[i-Lex]

рвать поиск на первом совпадении и надеяться, что на флешке не окажется второй и более копий программы, до которых поиск так и не дойдет. »
У клиента только один экземпляр.
Флешка чисто консовская. Поэтому можно рвать поиск при первом результате =)

[habib2302]

доброе время суток.дайте пожалуйста мне скрипт на кликабельное лого без фона »
АААУУУ!!!МНЕ КТО НИБУДЬ ОТВЕТИТ?

[audiofeel]

доброе утро всем, ну задумка (или глупость) такая = хотелось GroupEdit.Color := clBlack; ну получилось но при нажатии "NoIconsCheck" фон в GroupEdit "белеет" и текста не видно (было бы хорошо если бы "GroupEdit" был транспарент) . И как сделать фон "NoIconsCheck" черный (или транспарент) а текст белый. Спасибо!

[vint56]

habib2302 http://rghost.ru/44839186

[Alloc]

Все приветы! Уважаемые форумчане, подскажите как грамотно реализовать алгоритм, который будет отображать в компоненте Label проценты из ProgressGauge (progressbar); Я имею данный скрипт:


procedure ExtLog();
begin
with WizardForm.ProgressGauge do
ProgressLabel.Caption:=IntToStr((Position-Min)/((Max - Min)/100)) + '%';
end;


Далее я просто вставляю ссылку процедуры на файлы в раздел [Files] таким образомЖ


[Files]
Source: E:\Program*; DestDir: {app}; Flags: ignoreversion recursesubdirs createallsubdirs; AfterInstall: ExtLog();


Вроде как все правильно и оно работает, но проценты из ProgressLabel под конец доходят до 112% а не до 100 как должно быть..
Уважаемые, помогите пожалуйста решить данный косяк...

[saurn]

Alloc Пост #239 (http://forum.oszone.net/post-1932100-239.html)

[El Sanchez]

2 all, тема будет закрыта и переведена в архивное состояние. Продолжаем тут: http://forum.oszone.net/thread-257328.html