FAQ FAQ по Inno Setup

Snoopak96

Старожил
В: Как сделать бэкап ветки реестра и потом восстановить из бэкапа?
О: Так
Код:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[code]
#define A = (Defined UNICODE) ? "W" : "A"
const
  SE_BACKUP_NAME = 'SeBackupPrivilege';
  SE_RESTORE_NAME = 'SeRestorePrivilege';

  TOKEN_QUERY = $8;
  TOKEN_ADJUST_PRIVILEGES = $20;
  SE_PRIVILEGE_ENABLED = $2;
  ERROR_SUCCESS = 0;
  KEY_WOW64_64KEY  =  $0100;
  MAXIMUM_ALLOWED = $02000000;
  REG_FORCE_RESTORE = $00000008;

type
  LUID = record
  LowPart: DWORD;
  HighPart: Longint;
  end;

  LUID_AND_ATTRIBUTES = record
  Luid: LUID;
  Attributes: DWORD;
  end;

  TOKEN_PRIVILEGES = record
  PrivilegeCount: DWORD;
  Privileges: array [0..0] of LUID_AND_ATTRIBUTES;
  end;

  REGSAM = DWORD;
  HKEY = LongWord;

function RegSaveKey(hKey: HKEY; lpFile: String; lpSecurityAttributes: Longint):longint; external 'RegSaveKey{#A}@advapi32.dll stdcall';
function RegOpenKeyEx(hKey: HKEY; lpSubKey: String; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint; external 'RegOpenKeyEx{#A}@advapi32.dll stdcall';
function RegCreateKeyEx(hKey: HKEY; lpSubKey: String; Reserved: DWORD; lpClass: String; dwOptions: DWORD; samDesired: REGSAM; lpSecurityAttributes: Longint; var phkResult: HKEY; var lpdwDisposition: DWORD): Longint; external 'RegCreateKeyEx{#A}@advapi32.dll stdcall';
function RegCloseKey(hKey: HKEY): Longint; external 'RegCloseKey@advapi32.dll stdcall';
function RegRestoreKey(hKey: HKEY; lpFile: String; lpSecurityAttributes: Longint):longint; external 'RegRestoreKey{#A}@advapi32.dll stdcall';

//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD; var TokenHandle: THandle): BOOL; external 'OpenProcessToken@advapi32.dll stdcall';
function GetCurrentProcess(): THandle; external 'GetCurrentProcess@kernel32.dll stdcall';
function LookupPrivilegeValue(lpSystemName, lpName: String; var lpLuid: LUID): BOOL; external 'LookupPrivilegeValue{#A}@advapi32.dll stdcall';
function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; NewState: TOKEN_PRIVILEGES; BufferLength: DWORD; var PreviousState: TOKEN_PRIVILEGES; var ReturnLength: Longint): BOOL; external 'AdjustTokenPrivileges@advapi32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function GetLastError(): DWORD; external 'GetLastError@Kernel32 stdcall';
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function NTSetPrivilege(sPrivilege: string; bEnabled: Boolean): Boolean;
var
  hToken: THandle;
  TokenPriv: TOKEN_PRIVILEGES;
  PrevTokenPriv: TOKEN_PRIVILEGES;
  ReturnLength: Cardinal;
  Version: TWindowsVersion;
  ret: Longint;
begin
  GetWindowsVersionEx(Version);
  if not Version.NTPlatform then Exit;

  if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
  begin
  try
  if LookupPrivilegeValue('', PAnsiChar(sPrivilege), TokenPriv.Privileges[0].Luid) then
  begin
  TokenPriv.PrivilegeCount := 1;

  case bEnabled of
  True: TokenPriv.Privileges[0].Attributes  := SE_PRIVILEGE_ENABLED;
  False: TokenPriv.Privileges[0].Attributes := 0;
  end;
  ReturnLength := 0;
  PrevTokenPriv := TokenPriv;

  AdjustTokenPrivileges(hToken, False, TokenPriv, SizeOf(PrevTokenPriv), PrevTokenPriv, ret);
  end;
  finally
  CloseHandle(hToken);
  end;
  end;
  Result := GetLastError = ERROR_SUCCESS;
  if not Result then MsgBox(SysErrorMessage(GetLastError), mbInformation, MB_OK);
end;
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure RegBackupTofile(intKey: HKEY; intSubKey, outfile: string; Wow32: BOOL);  //Процедура бэкапа ветки реестра в файл
//intKey - корневой раздел
//intSubKey - Путь к ветке реестра
//outfile - Имя бэкапа
//Wow32 - если true то вкл перенаправление Wow3264Node
var
  phkResult: HKEY;
begin
if not NTSetPrivilege(SE_BACKUP_NAME, true) then if MsgBox('Ошибка прав доступа!', mbInformation, MB_OK) = IDOK then Exit;
  if Wow32 then begin
  if RegOpenKeyEx(intKey, intSubKey, 0, MAXIMUM_ALLOWED, phkResult) > ERROR_SUCCESS then begin MsgBox('Ошибка чтения реестра!', mbInformation, MB_OK); Exit; end;
  end else if RegOpenKeyEx(intKey, intSubKey, 0, MAXIMUM_ALLOWED or KEY_WOW64_64KEY, phkResult) > ERROR_SUCCESS then begin MsgBox('Ошибка чтения реестра!', mbInformation, MB_OK); Exit; end;
  if RegSaveKey(phkResult, outfile, 0) > ERROR_SUCCESS then begin MsgBox('Ошибка сохранения файла!', mbInformation, MB_OK); Exit; end;
RegCloseKey(phkResult);
end;

procedure RegRestorefromfile(outKey: HKEY; outSubKey, infile: string; Wow32: BOOL);  //Процедура востановление реестра из файла, параметры по аналогии
var
  phkResult: HKEY;
  lpdwDisposition: DWORD;
begin
  if not FileExists(infile) then begin MsgBox('Файл не найден!', mbInformation, MB_OK); Exit; end;
  NTSetPrivilege(SE_BACKUP_NAME, true);
  NTSetPrivilege(SE_RESTORE_NAME, true);
  if Wow32 then begin
  if RegCreateKeyEx(outKey, outSubKey, 0, '', 0, MAXIMUM_ALLOWED, 0, phkResult, lpdwDisposition) > ERROR_SUCCESS then begin MsgBox('Ошибка записи в реестр!', mbInformation, MB_OK); Exit; end;
  end else if RegCreateKeyEx(outKey, outSubKey, 0, '', 0, MAXIMUM_ALLOWED or KEY_WOW64_64KEY, 0, phkResult, lpdwDisposition) > ERROR_SUCCESS then begin MsgBox('Ошибка записи в реестр!', mbInformation, MB_OK); Exit; end;
  if RegRestoreKey(phkResult, infile, REG_FORCE_RESTORE) > ERROR_SUCCESS then begin MsgBox('Ошибка доступа к реестру!', mbInformation, MB_OK); Exit; end;
  RegCloseKey(phkResult);
end;
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssPostInstall then begin
RegBackupTofile(HKEY_LOCAL_MACHINE, 'Software\Valve', ExpandConstant('{tmp}\RegBackup.dat'), true);
RegRestorefromfile(HKEY_LOCAL_MACHINE, 'Software\Valve_BackUp', ExpandConstant('{tmp}\RegBackup.dat'), true);
DeleteFile(ExpandConstant('{tmp}\RegBackup.dat')); end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
if CurUninstallStep = usPostUninstall then begin
RegBackupTofile(HKEY_LOCAL_MACHINE, 'Software\Valve_BackUp', ExpandConstant('{tmp}\RegBackup.dat'), true);
RegRestorefromfile(HKEY_LOCAL_MACHINE, 'Software\Valve', ExpandConstant('{tmp}\RegBackup.dat'), true);
DeleteFile(ExpandConstant('{tmp}\RegBackup.dat'));
RegDeleteKeyIncludingSubkeys(HKLM, 'Software\Valve_BackUp'); end;
end;
 
Последнее редактирование:

nik1967

Old Men
Проверенный
В: Как получить размер изображения (длина, ширина в пикселях) средствами Инно?
О: Как-то так.
Код:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application
OutputDir=.

[code]
var
    Wp,Hp: Longint;

function GetFileProperties(FilePath: String): String;
var
    Properties,ADir,AFile: Variant; Sw,Sh: String;
begin
    Properties:= CreateOleObject('shell.application');
    ADir:= Properties.NameSpace(ExtractFilePath(FilePath)) ;
    AFile:= ADir.Parsename (ExtractFileName(FilePath));
    Sw:= ADir.GetDetailsOf(AFile,31);
    Sh:= Sw;
    Delete(Sw,Pos(' ',Sw),Length(Sw));
    Delete(Sw,1,1);
    Delete(Sh,1,Pos(' ',Sh)+2);
    Delete(Sh,Length(Sh),1);
    Wp:= StrToInt(Sw); //длина картинки в пикселях
    Hp:= StrToInt(Sh); //ширина картинки в пикселях
end;

function InitializeSetup: Boolean;
begin
    GetFileProperties(ExpandConstant('{src}\14.png')); //здесь указывается путь до нужной картинки (в примере 14.png)
  MsgBox('Width  = '+IntToStr(Wp)+' pix.'+#13#10+'Height = '+IntToStr(Hp)+' pix.', mbInformation, MB_OK);
    //SaveStringToFile(ExpandConstant('{src}\14.txt'), 'Width  = '+IntToStr(Wp)+' pix.'+#13#10+'Height = '+IntToStr(Hp)+' pix.', false); //для проверки - запись в файл
    Result:= false;
end;
Пример от Snoopak96'а, допиленный мной.
Форматы изображений - все которые знает винда по умолчанию.
 
Последнее редактирование:

sergey3695

Ветеран
Модератор
В: Как сделать установку в Steam с выбором?
О: Так
Для примера возьмем SOMA. Что мы имеем? Страницу в стиме: http://store.steampowered.com/app/282140/
1. Идем в ...\Steam\SteamApps. Там находим appmanifest_*.acf, где вместо "*" ID игры, а в частности последние цифры в адресе страницы. Получаем appmanifest_282140.acf.
2. Открываем appmanifest_282140.acf, Notepad++ или прочий текстовый редактор.
3. Смотрим блок MountedDepots
4. Идем в ...\Steam\depotcache, и берем оттуда файлы название которых есть в блоке MountedDepots( пример: в MountedDepots будет "228981" "7613356809904826842", соответственно в папке depotcache будет 228981_7613356809904826842.manifest ).
5. Ну и не забываем забрать основные файлы игры из ..\Steam\SteamApps\common\SOMA
 

Вложения

Последнее редактирование:

Snoopak96

Старожил
В: Как извлечь информацию о драйвере устройства?
О: Так.
Код:
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Code]
const
  CR_NO_SUCH_VALUE  = $00000025;
  DIGCF_PRESENT  = $00000002;

  SPDRP_DEVICEDESC  = $00000000;// DeviceDesc (R/W)
  SPDRP_HARDWAREID  = $00000001;// HardwareID (R/W)
  SPDRP_COMPATIBLEIDS  = $00000002;// CompatibleIDs (R/W)
  SPDRP_UNUSED0  = $00000003;// unused
  SPDRP_SERVICE  = $00000004;// Service (R/W)
  SPDRP_UNUSED1  = $00000005;// unused
  SPDRP_UNUSED2  = $00000006;// unused
  SPDRP_CLASS  = $00000007;// Class (R--tied to ClassGUID)
  SPDRP_CLASSGUID  = $00000008;// ClassGUID (R/W)
  SPDRP_DRIVER  = $00000009;// Driver (R/W)
  SPDRP_CONFIGFLAGS  = $0000000A;// ConfigFlags (R/W)
  SPDRP_MFG  = $0000000B;// Mfg (R/W)
  SPDRP_FRIENDLYNAME  = $0000000C;// FriendlyName (R/W)
  SPDRP_LOCATION_INFORMATION  = $0000000D;// LocationInformation (R/W)
  SPDRP_PHYSICAL_DEVICE_OBJECT_NAME= $0000000E;// PhysicalDeviceObjectName ®
  SPDRP_CAPABILITIES  = $0000000F;// Capabilities ®
  SPDRP_UI_NUMBER  = $00000010;// UiNumber ®
  SPDRP_UPPERFILTERS  = $00000011;// UpperFilters (R/W)
  SPDRP_LOWERFILTERS  = $00000012;// LowerFilters (R/W)
  SPDRP_BUSTYPEGUID  = $00000013;// BusTypeGUID ®
  SPDRP_LEGACYBUSTYPE  = $00000014;// LegacyBusType ®
  SPDRP_BUSNUMBER  = $00000015;// BusNumber ®
  SPDRP_ENUMERATOR_NAME  = $00000016;// Enumerator Name ®
  SPDRP_SECURITY  = $00000017;// Security (R/W, binary form)
  SPDRP_SECURITY_SDS  = $00000018;// Security (W, SDS form)
  SPDRP_DEVTYPE  = $00000019;// Device Type (R/W)
  SPDRP_EXCLUSIVE  = $0000001A;// Device is exclusive-access (R/W)
  SPDRP_CHARACTERISTICS  = $0000001B;// Device Characteristics (R/W)
  SPDRP_ADDRESS  = $0000001C;// Device Address ®
  SPDRP_UI_NUMBER_DESC_FORMAT  = $0000001D;// UiNumberDescFormat (R/W)
  SPDRP_DEVICE_POWER_DATA  = $0000001E;// Device Power Data ®
  SPDRP_REMOVAL_POLICY  = $0000001F;// Removal Policy ®
  SPDRP_REMOVAL_POLICY_HW_DEFAULT  = $00000020;// Hardware Removal Policy ®
  SPDRP_REMOVAL_POLICY_OVERRIDE  = $00000021;// Removal Policy Override (RW)
  SPDRP_INSTALL_STATE  = $00000022;// Device Install State ®
  SPDRP_LOCATION_PATHS  = $00000023;// Device Location Paths ®
  SPDRP_MAXIMUM_PROPERTY  = $00000024;// Upper bound on ordinals

  ERROR_INSUFFICIENT_BUFFER = 122;
  DisplayGuid = '{4d36e968-e325-11ce-bfc1-08002be10318}';

type
 SP_DEVINFO_DATA=record
  cbSize:  DWORD;
  ClassGuid: TGuid;
  DevInst:  DWORD;
  Reserved:  Cardinal;
 end;

function CM_Enumerate_Classes(ulClassIndex: LongInt; var ClassGuid: TGUID; ulFlags: DWORD): DWORD; external 'CM_Enumerate_Classes@Cfgmgr32.dll stdcall';
function SetupDiGetClassDescription(var ClassGuid: TGUID; ClassDescription: String; ClassDescriptionSize: DWORD; var RequiredSize: DWORD): BOOL; external 'SetupDiGetClassDescriptionW@SetupApi.dll stdcall';
function SetupDiGetClassDevs(ClassGuid: TGUID; const Enumerator: String; hwndParent: HWND; Flags: DWORD): THandle; external 'SetupDiGetClassDevsW@SetupApi.dll stdcall';
function SetupDiEnumDeviceInfo(DeviceInfoSet: THandle; MemberIndex: DWord; var DeviceInfoData: SP_DEVINFO_DATA): LONGBOOL; external 'SetupDiEnumDeviceInfo@SetupApi.dll stdcall';
function SetupDiGetDeviceRegistryProperty(DeviceInfoSet: THandle; DeviceInfoData: SP_DEVINFO_DATA; PropertyInfo: DWORD; PropertyRegDataType: DWORD; PropertyBuffer: String; PropertyBufferSize: DWORD; var RequiredSize: DWORD): LONGBOOL; external 'SetupDiGetDeviceRegistryPropertyW@SetupApi.dll stdcall';
function SetupDiDestroyDeviceInfoList(DeviceInfoSet: THandle): LONGBOOL; external 'SetupDiDestroyDeviceInfoList@SetupApi.dll stdcall';
function GetLastError(): DWORD; external 'GetLastError@Kernel32 stdcall';

procedure ListDev;
var
  ClassIndex, Devn:LongInt;
  RES1, BufSize: DWORD;
  GUID: TGUID;
  Buffer: String;
  PnPHandle: THandle;
  RES2: LONGBOOL;
  DevData: SP_DEVINFO_DATA;

  BytesReturned: DWORD;
  RegDataType: DWORD;
  PropertyBuffer: String;
begin
  ClassIndex:=0;
  repeat
  RES1 := CM_Enumerate_Classes(ClassIndex, GUID, 0);
  if(RES1 <> CR_NO_SUCH_VALUE)then
  if(GUID = StringToGUID(DisplayGuid))then
  begin
  PnPHandle:=SetupDiGetClassDevs(GUID, '', 0, DIGCF_PRESENT);
  if PnPHandle = DWORD(-1) then Exit;
  Devn := 0;
  repeat
  DevData.cbSize := SizeOf(DevData);
  RES2 := SetupDiEnumDeviceInfo(PnPHandle, Devn, DevData);
  BytesReturned := 0;
  RegDataType := 0;
  if not SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, SPDRP_MFG, RegDataType, PropertyBuffer, Length(PropertyBuffer), BytesReturned) then
  if GetLastError = ERROR_INSUFFICIENT_BUFFER then
  begin
  SetLength(PropertyBuffer, BytesReturned);
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, SPDRP_MFG, RegDataType, PropertyBuffer, Length(PropertyBuffer), BytesReturned);

  MsgBox(PropertyBuffer, mbInformation, MB_OK);
  end;
  Inc(Devn);
  until not RES2;
  end;
  SetupDiDestroyDeviceInfoList(PnPHandle);
  Inc(ClassIndex);
  until RES1 = CR_NO_SUCH_VALUE;
end;

function InitializeSetup(): Boolean;
begin
  ListDev;
  Result := true;
end;
 

sergey3695

Ветеран
Модератор
В: ComboBoxEx в Inno? (с картинками комбобокс)
О: Так
Код:
[Setup]
AppName=Example
AppVerName=Example 1.0
DefaultDirName={pf}\Example
OutputDir=.

[Files]
Source: Setup1.ico; DestDir: {app}; Check: IsChecked(0);
Source: Setup2.ico; DestDir: {app}; Check: IsChecked(1);

[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
  WM_USER = $0400;
  WC_COMBOBOXEX =  'ComboBoxEx32';
  WS_CHILD = $40000000;
  WS_VISIBLE = $10000000;
  WS_TABSTOP = $10000;
  CBS_DROPDOWNLIST = $0003;
  CBS_SORT = $0100;
  ILC_COLOR24 = $0018;
  ILC_COLOR32 = $0020;
  CBEIF_TEXT = $1;
  CBEIF_IMAGE = $2;
  CBEIF_SELECTEDIMAGE = $4;
  CBEM_INSERTITEM = (WM_USER + {#ifndef UNICODE}1{#else}11{#endif});
  CBEM_SETIMAGELIST = (WM_USER + 2);
  CB_SETCURSEL = $014E;
  WM_COMMAND = $0111;
  CBN_SELCHANGE = 1;
  CB_GETCURSEL = $0147;
  CB_GETCOUNT = $0146;
  CB_GETLBTEXT = $0148;
  CB_GETLBTEXTLEN = $0149;
  //
type
  TComboBoxExItem = record
  mask: UINT;
  iItem: INT_PTR;
  pszText: string;
  cchTextMax: Integer;
  iImage: Integer;
  iSelectedImage: Integer;
  iOverlay: Integer;
  iIndent: Integer;
  lParam: Longint;
  end;

function CreateWindowEx(dwExStyle: DWORD; lpClassName, lpWindowName: string; dwStyle: DWORD; x, y, nWidth, nHeight: Integer; hWndParent: HWND; hMenu: HMENU; hInstance, lpParam: Longint): HWND; external 'CreateWindowEx{#A}@user32.dll stdcall';
function DestroyWindow(hWnd: HWND): BOOL; external 'DestroyWindow@user32.dll stdcall';
function DeleteObject(hObject: THandle): BOOL; external 'DeleteObject@gdi32.dll stdcall';
function ImageList_Create(cx, cy: Integer; flags: UINT; cInitial, cGrow: Integer): THandle; external 'ImageList_Create@comctl32.dll stdcall';
function ImageList_Destroy(ImageList: HImageList): Bool; external 'ImageList_Destroy@comctl32.dll stdcall';
function ImageList_ReplaceIcon(himl: HIMAGELIST; i: Integer; hIcon: HICON): Integer; external 'ImageList_ReplaceIcon@comctl32.dll stdcall';
function SendMessageCBEI(hWnd: HWND; Msg: UINT; wParam: Longint; var lParam: TComboBoxExItem): Longint; external 'SendMessage{#A}@user32.dll stdcall';
function ShowWindow(hWnd: Integer; uType: Integer): Integer; external 'ShowWindow@user32.dll stdcall';

var
  GImageList: HIMAGELIST;
  GComboBoxEx: HWND;
  Icon1: TNewIcon;

function IsChecked(const Index: Integer): Boolean;
begin
  Result:= False;
if GComboBoxEx<>0 then
if SendMessage(GComboBoxEx, CB_GETCURSEL, 0, 0)=Index then
  Result:= True;
end;

//////////////////////////////////////////////////////////
procedure CreateComboBoxExItem(Text, FileName: string);
var
  ImageIndex: Integer;
  CBItem: TComboBoxExItem;
  Icon: TNewIcon;
begin
  Icon:= TNewIcon.Create;
  ExtractTemporaryFile(FileName);
  try
  Icon.LoadFromFile(ExpandConstant('{tmp}\'+FileName));
  ImageIndex := ImageList_ReplaceIcon(GImageList, -1, Icon.Handle);
  finally
  Icon.Free;
  end;
  with CBItem do
  begin
  mask := CBEIF_TEXT or CBEIF_IMAGE or CBEIF_SELECTEDIMAGE;
  iItem := -1;
  pszText := Text;
  iImage := ImageIndex;
  iSelectedImage := ImageIndex;
  end;
  SendMessageCBEI(GComboBoxEx, CBEM_INSERTITEM, 0, CBItem);
end;

///////////////////////////
type
  LPARAM = Integer;
  WPARAM = Integer;
  LRESULT = Integer;
  TFNWndProc = Integer;
var
  OldProc: Longint;

function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';

function HiWord(L: DWORD): Word;
begin
  Result := L shr 16;
end;

var
  Text: String;
  nIndex: Integer;

function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  case Msg of WM_COMMAND:
begin
  if (lParam=GComboBoxEx) and (HIWORD(wParam) = CBN_SELCHANGE) then
  begin
  nIndex:= SendMessage(GComboBoxEx, CB_GETCURSEL, 0, 0);
  WizardForm.NextButton.Caption:= IntToStr(nIndex); // Выбранная строка
  WizardForm.CancelButton.Caption:= IntToStr(SendMessage(GComboBoxEx, CB_GETCOUNT, 0, 0)); // Количество строк
  //
  Text:= '';
  SetLength(Text,SendMessage(GComboBoxEx, CB_GETLBTEXTLEN, nIndex, 0));
  SendMessage(GComboBoxEx, CB_GETLBTEXT, nIndex, CastStringToInteger(Text));
  if WizardForm.Caption<>Text then
  WizardForm.Caption:= Text;
  end;
  end;
end;
  Result := CallWindowProc(OldProc, hWnd, Msg, wParam, lParam);
end;

///////////////////////////
procedure CreateComboBoxEx;
begin
  { create comboex }  // высота с учетом раскрытого списка
  GComboBoxEx := CreateWindowEx(0, WC_COMBOBOXEX, '', WS_VISIBLE or WS_CHILD or CBS_DROPDOWNLIST or CBS_SORT, ScaleX(20), ScaleY(320), ScaleX(210), ScaleY(320), WizardForm.Handle, 0, HInstance, 0);

  { create imagelist } // высота в итоге свернутого 32 (учитывается ImageList_Create)
  GImageList := ImageList_Create(ScaleX(32), ScaleY(32), ILC_COLOR32{ use ILC_COLOR24 for 24-bit icons }, 0, 0);

  { add items }
  CreateComboBoxExItem('Test entry 1', 'Setup1.ico');
  CreateComboBoxExItem('Test entry 2', 'Setup2.ico');

  { assign imagelist }
  SendMessage(GComboBoxEx, CBEM_SETIMAGELIST, 0, GImageList);

  { set selected item }
  SendMessage(GComboBoxEx, CB_SETCURSEL, 0, 0);

  if GComboBoxEx <> 0 then
  OldProc:= SetWindowLong(WizardForm.Handle, -4, CallbackAddr('WindowProc'));
end;

////////////////////////////
procedure DestroyComboBoxEx;
begin
  if GImageList <> 0 then
  ImageList_Destroy(GImageList);
  if GComboBoxEx <> 0 then
  DestroyWindow(GComboBoxEx);
end;

///////////////////////////
procedure InitializeWizard;
begin
//  WizardForm.OuterNotebook.Hide;
  CreateComboBoxEx;
//  ShowWindow(GComboBoxEx, SW_HIDE);
end;

////////////////////////////
procedure DeinitializeSetup();
begin
  SetWindowlong(WizardForm.Handle, -4, OldProc);
  DestroyComboBoxEx;
end;
Спасибо El Sanchez за пример, South за небольшое исправление примера.
 
Последнее редактирование:

AlexanderSergeev

Новичок
В: Как грузить маску из потока без создания дополнительных файлов в темпе?
При компиляции скрипта требуется расширенная китайская версия от Restools.
Большое спасибо El Sanchez за предоставленный скрипт.
О: Так
 

Вложения

Последнее редактирование:

VoLT

Мимокрокодил
Проверенный
И так для решения приватной загрузки курсора минуя выкладку на диск есть мысль заюзать сия хреновину http://www.codeproject.com/Articles/5220/Creating-a-color-cursor-from-a-bitmap

Некоторые используемые в хреновине процедуры в Delphi описаны так
Код:
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP; stdcall; (gdi32)
function CreateIconIndirect(var piconinfo: TIconInfo): HICON; stdcall; (user32)
function CreateCompatibleDC(DC: HDC): HDC; stdcall; (gdi32)
Я могу сильно ошибаться но кажется ResTools сделали это уже до меня )

Если кому не влом - перепишите это для потомков на Inno
 

AlexanderSergeev

Новичок
В: Как отобразить кастомный курсор без выгрузки файла на диск?
Благодарю за помощь автора скрипта El Sanchez.
О: Так
 

Вложения

Последнее редактирование:

nik1967

Old Men
Проверенный
В: Как добавить программу в исключения брандмауэра (заблокировать доступ к интернету)?
О: Как-то так.
Код:
#define Exe "ashsnap.exe"

[Setup]
AppName = MyApp
AppVerName = MyApp
DefaultDirname = {pf}\MyApp
OutputDir=.

[Code]   
procedure CurStepChanged(CurStep: TSetupStep);
var
  RC: integer;
   SIn,SOut: String;
begin
  if CurStep = ssDone then begin
     SIn:= ' advfirewall firewall add rule name=ashsnapinst dir=in action=block program='+ExpandConstant('"{app}\{#Exe}"')+' enable=yes';
     SOut:= ' advfirewall firewall add rule name=ashsnapinst dir=out action=block program='+ExpandConstant('"{app}\{#Exe}"')+' enable=yes';
     Exec('netsh', SIn, '', SW_HIDE, ewWaitUntilTerminated, RC);
     Exec('netsh', SOut, '', SW_HIDE, ewWaitUntilTerminated, RC);
   end;
end;
 

SBalykov

Старожил
В: Как отобразить страницу системных требований только средствами InnoSetup?
Немного доделанный скрипт из справки по InnoSetup.
За некоторые идеи, спасибо nik1967.
О: Так
Код:
#define NeedSystem = "5.1.3";

[Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
OutputDir=.

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

[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
  DISPLAY_DEVICE_PRIMARY_DEVICE = 4;
  oneMB = 1024*1024;
  NeedMHz = 1800;
  NeedVideoRAM = 128;
  NeedSoundCard = 'Creative X-Fi';
  NeedMB = 512;
  NeedPageFile = 1024;

type
#ifdef UNICODE
  PChar = PAnsiChar;
#else
  AnsiChar = Char;
#endif

THardwareRequirementSnapShot = record
  WinName, WinBits, SPack: String;
  WinVer: TWindowsVersion;
end;

PDisplay_Device = record
  cb: DWord;
  DeviceName: array [0..31] of Char;
  DeviceString: array [0..127] of Char; StateFlags: DWord;
  DeviceID, DeviceKey: array [0..127] of Char;
end;

TMixerCaps = record
  vPid, vDriverVersion: DWord;
  sName: array [0..31] of Char; Support, cDestinations: DWord;
end;

TMemoryStatusEx = record
  dwLength, dwMemoryLoad: DWord;
  LoTotalPhys, HiTotalPhys, LoAvailPhys, HiAvailPhys,
  LoTotalPageFile, HiTotalPageFile, LoAvailPageFile, HiAvailPageFile,
  LoTotalVirtual, HiTotalVirtual, LoAvailVirtual, HiAvailVirtual, LoAvailExtendedVirtual,
  HiAvailExtendedVirtual: Integer;
end;

var
  InfoPage: TWizardPage;
  TopText, BottomText: TNewStaticText;
  ChangeText: Boolean;
  SystemPanel, ProcessorPanel, VideoPanel,
  AudioPanel, RAMPanel, PageFilePanel: TMemo;
  SystemVersionPanel, ProcessorMHzPanel, VideoRAMPanel,
  AudioNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;
  lpCaps: TMixerCaps;
  MemoryEx: TMemoryStatusEx;
  i, n, errCode: Integer;
  Keys: TArrayOfString;
  DeviceValue: Cardinal;
  lpDisplayDevice: PDisplay_Device;
  SystemName, DeviceName, SoundName, DeviceKey, String: String;
  DeviceNamed: AnsiString;
  HWREQ: THardwareRequirementSnapShot;

function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): Boolean; external 'GlobalMemoryStatusEx@kernel32.dll stdcall';
function GetSystemMetrics(nIndex: Integer): Integer; external 'GetSystemMetrics@user32.dll stdcall';
function GetDeviceCaps(hDC, nIndex: Integer): Integer; external 'GetDeviceCaps@GDI32 stdcall';
function CreateDC(lpDriverName, lpDeviceName, lpOutput: String; lpInitData: Integer): Integer; external 'CreateDC{#A}@GDI32 stdcall';
function EnumDisplayDevices(lpDevice, iDevNum: DWord; var lpDisplayDevice: PDisplay_Device; dwFlags: DWord): Boolean; external 'EnumDisplayDevices{#A}@user32.dll stdcall';
function mixerGetDevCaps(uDeviceID: LongInt; var lpCaps: TMixerCaps; uSize: LongInt): LongInt; external 'mixerGetDevCaps{#A}@winmm.dll stdcall';
function mixerGetNumDevs: Integer; external 'mixerGetNumDevs@winmm.dll stdcall';

///Дополнить число до кратного Multiple
function ToMultiple(Bytes, Multiple: Integer): Integer;
begin
if Abs(Bytes/Multiple) > Bytes/Multiple then
  Result := (Bytes/Multiple + 1)*Multiple
  else
  Result := Bytes
end;

/// Размерность выражения
function Size64(Hi, Lo: Integer): Extended;
begin
  Result := Lo
if Lo < 0 then
  Result := Result + $7FFFFFFF + $7FFFFFFF + 2;
for Hi := Hi-1 downto 0 do
  Result := Result + $7FFFFFFF + $7FFFFFFF + 2;
end;

///Формат чмслового выражения
function NumToStr(Float: Extended): string;
begin
  Result:= Format('%.2n', [Float]); StringChange(Result, ',', '.');
while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do
  SetLength(Result, Length(Result)-1);
end;

/// Конвертация чисел Mb, Gb, Tb
function MbOrTb(Byte: Extended): string;
begin
if Byte < 1024 then Result:= NumToStr(Byte) + ' MB' else
if Byte/1024 < 1024 then
  Result:= NumToStr(Byte/1024) + ' GB' else
  Result:= NumToStr(Byte/oneMB) + ' TB';
end;

/// Удаление начальных, конечных и повторных пробелов
function DelSp(String: String): String;
begin
while (Pos(' ', String) > 0) do Delete(String, Pos(' ', String), 1);
  Result := Trim(String)
end;

/// Информация о версии сервис пака
function DecodeSystemStr(Str: String): TWindowsVersion;
var tmp, s: String;
begin
  tmp := str;
  s := Copy(tmp, 1, Pos('.', tmp)-1);
  Delete(tmp, 1, Pos('.', tmp));
if (s <> '') then Result.Major := StrToInt(s);
  s := Copy(tmp, 1, Pos('.', tmp)-1);
  Delete(tmp, 1, Pos('.', tmp));
if (s <> '') then Result.minor := StrToInt(s);
  s := Copy(tmp, 1, Pos('.', tmp)-1);
  Delete(tmp, 1, Pos('.', tmp));
if (s <> '') then Result.Build:= StrToInt(s);
  s := Copy(tmp, 1, Pos('.', tmp)-1);
  Delete(tmp, 1, Pos('.', tmp));
if (s <> '') then Result.ServicePackMajor := StrToInt(s);
end;

/// Информация о версии системы
function HWREQ_CompareWindows: Boolean;
var tmp: TWindowsVersion;
begin
  Result := False;
  tmp := DecodeSystemStr('{#NeedSystem}');
if HWREQ.WinVer.NTPlatform then begin
if (tmp.Major <= HWREQ.WinVer.Major) then
if (tmp.Minor <= HWREQ.WinVer.Minor) then
if (tmp.ServicePackMajor <= HWREQ.WinVer.ServicePackMajor) then
  Result := True;
end;
end;

/// Проверка процессоров
function CheckCPU(NeedMHz: Integer): Boolean;
begin
  String := 'Hardware\Description\System\CentralProcessor'; RegGetSubkeyNames(HKLM, String, Keys) ///Количество ядер
for n := 0 to GetArrayLength(Keys)-1 do
  RegQueryStringValue(HKLM, String + '\' + Keys[n], 'ProcessorNameString', Keys[n]);
if not RegQueryDWordValue(HKLM, String + '\0', '~MHz', DeviceValue) or (DeviceValue < NeedMHz) then
  Exit
  else
  Result := True;
end;

/// Поиск Установленной Видеокарты
function SearchCardName(const DeviceName: String): String;
begin
for i:= 0 to 9 do
  RegQueryStringValue(HKLM,'SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\000'+IntToStr(i),'AdapterDesc', DeviceName);
  Result := DeviceName;
end;

/// Модель Установленной Видеокарты
function CardDeviceName: Boolean;
begin
  SearchCardName(DeviceName);
  Result := (Pos('AMD', DeviceName) <> Pos('Gigabyte', DeviceName)) or (Pos('NVIDIA', DeviceName) <> Pos('MSI', DeviceName)) or (Pos('ASUS', DeviceName) <> Pos('Palit', DeviceName));
end;

// Сведения о Производителе Компьютера
function SystemManufacturer(SManufacturer: String): String;
begin
  RegQueryStringValue(HKLM, 'SYSTEM\CurrentControlSet\Control\SystemInformation', 'SystemManufacturer', SManufacturer);
  Result := SManufacturer;
end;

// Сведения об установленной памяти
function CheckMemorySize(NeedRAM: Integer): Boolean;
begin
  MemoryEx.dwLength := SizeOf(MemoryEx)
if not GlobalMemoryStatusEx(MemoryEx) then
  MsgBox('Ошибка функции:' + #13 + 'GlobalMemoryStatusEx', mbError, mb_Ok)
  else
if (ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16) < NeedRAM) then
  Exit
  else
  Result := True
end;

procedure InitializeWizard();
begin
  InfoPage := CreateCustomPage(wpLicense, 'Аппаратное и программное обеспечение',
'Программа установки обнаружила следующие наобходимые компоненты.');
with InfoPage do begin
  ChangeText := False

TopText := TNewStaticText.Create(nil)
with TopText do begin
  Parent := InfoPage.Surface
  Left := 0
  Align := alTop;
  AutoSize := True
end;

BottomText := TNewStaticText.Create(nil)
with BottomText do begin
  Parent := InfoPage.Surface
  Caption := 'Когда Вы будете готовы продолжить установку, нажмите "Далее".'
  Font.Color := clBlack
  Left := 0
  Top := 200
  AutoSize := True
end;

SystemPanel := TMemo.Create(nil)
with SystemPanel do begin
  Text := 'Система'
  Alignment := taCenter
  Parent := InfoPage.Surface
  Left := ScaleX(0)
  Top := ScaleY(33)
  Width := ScaleX(100)
  Height := ScaleY(22)
  ReadOnly := True
  Color := $EEEEEE
end;

SystemVersionPanel := TMemo.Create(nil)
with SystemVersionPanel do begin
  Alignment := taLeftJustify
  Parent := InfoPage.Surface
  Left := ScaleX(104)
  Top := SystemPanel.Top
  Width := ScaleX(310)
  Height := ScaleY(22)
  ReadOnly := True
end;

/// Информации о системе из реестра
if RegQueryStringValue(HKLM, 'SOFTWARE\Microsoft\Windows NT\CurrentVersion', 'ProductName', SystemName) then
  HWREQ.WinName := DelSP(SystemName);
  GetWindowsVersionEx(HWREQ.WinVer);

/// Информации о битности системы
if IsWin64 then
  HWREQ.WinBits := 'x64' else
  HWREQ.WinBits := 'x86';

/// Вывод информации о системе
if HWREQ.WinVer.ServicePackMajor > 0 then
  SystemVersionPanel.Text := ' ' + HWREQ.WinName+' SP'+IntToStr(HWREQ.WinVer.ServicePackMajor)+' '+HWREQ.WinBits+
' ('+IntToStr(HWREQ.WinVer.Major)+'.'+IntToStr(HWREQ.WinVer.Minor)+
'.'+IntToStr(HWREQ.WinVer.Build)+'), '+SystemManufacturer('SManufacturer') else
  SystemVersionPanel.Text := HWREQ.WinName+' '+HWREQ.WinBits+' ('+IntToStr(HWREQ.WinVer.Major)+
'.'+IntToStr(HWREQ.WinVer.Minor)+'.'+IntToStr(HWREQ.WinVer.Build)+
'); '+SystemManufacturer('SManufacturer');
  SystemVersionPanel.Color := $CCFFCC
if IntToStr(HWREQ.WinVer.Major)+'.'+IntToStr(HWREQ.WinVer.Minor)+'.'+IntToStr(HWREQ.WinVer.ServicePackMajor) < '{#NeedSystem}'
then begin
  SystemVersionPanel.Color := $CCCCFF
  ChangeText := True
end;

/// Процессор:
ProcessorPanel := TMemo.Create(nil)
with ProcessorPanel do begin
  Text := 'Процессор'
  Alignment := taCenter
  Parent := InfoPage.Surface
  Left := ScaleX(0)
  Top := SystemPanel.Top + 27
  Width := ScaleX(100)
  Height := ScaleY(22)
  ReadOnly := True
  Color := $EEEEEE
end;

ProcessorMHzPanel := TMemo.Create(nil)
with ProcessorMHzPanel do begin
  Alignment := taLeftJustify
  Parent := InfoPage.Surface
  Left := ScaleX(104)
  Top := ProcessorPanel.Top
  Width := ScaleX(310)
  Height := ScaleY(22)
  ReadOnly := True
end;

ProcessorMHzPanel.Color := $CCFFCC
if not CheckCPU(NeedMHz) then begin
  ProcessorMHzPanel.Color := $CCCCFF
  ChangeText := True
end;

/// Вывод информации о процессоре
  ProcessorMHzPanel.Text := ' ' + DelSp(Keys[0]) + ' @' + IntToStr(DeviceValue) + ' MHz'
if GetArrayLength(Keys) > 1 then
  ProcessorPanel.Text := 'Процессоры';

/// Видеокарта:
VideoPanel := TMemo.Create(nil)
with VideoPanel do begin
  Text := 'Видеоадаптер'
  Alignment := taCenter
  Parent := InfoPage.Surface
  Left := ScaleX(0)
  Top := ProcessorPanel.Top + 27
  Width := ScaleX(100)
  Height := ScaleY(22)
  ReadOnly := True
  Color := $EEEEEE
end;

VideoRAMPanel := TMemo.Create(nil)
with VideoRAMPanel do begin
  Alignment := taLeftJustify
  Parent := InfoPage.Surface
  Left := ScaleX(104)
  Top := VideoPanel.Top
  Width := ScaleX(310)
  Height := ScaleY(22)
  ReadOnly := True
end;

  VideoRAMPanel.Color := $CCFFCC;
  lpDisplayDevice.cb := SizeOf(lpDisplayDevice);
  DeviceKey := '';
  n := 0;
while not (EnumDisplayDevices(0, n, lpDisplayDevice, 0) and
(lpDisplayDevice.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE > 0)) and (n < 127) do
  n := n + 1;
for n := 0 to 127 do
  DeviceKey := DeviceKey + lpDisplayDevice.DeviceKey[n];
  Delete(DeviceKey, Pos(Chr(0), DeviceKey), 127);
  StringChange(DeviceKey, '\Registry\Machine\', '');
  errCode := 1;
  DeviceValue := 0;

if CardDeviceName then begin
for i := 0 to 9 do
if RegQueryBinaryValue(HKLM,'SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\000'+IntToStr(i),'HardwareInformation.MemorySize',DeviceNamed) then
end else
if RegQueryBinaryValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceNamed) then
for n := 1 to Length(DeviceNamed) do begin
  DeviceValue := DeviceValue + Ord(DeviceNamed[n])*errCode;
  errCode := errCode*$100;
  end else
if RegQueryDWordValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceValue) then
else
if CardDeviceName then begin
for i := 0 to 9 do
RegQueryDWordValue(HKLM,'SYSTEM\CurrentControlSet\Control\Class\{4D36E968-E325-11CE-BFC1-08002BE10318}\000'+IntToStr(i),'HardwareInformation.MemorySize',DeviceValue);
end else
RegQueryDWordValue(HKLM, DeviceKey + '\Info', 'VideoMemory', DeviceValue);
  DeviceName := '';
for n := 0 to 127 do
  DeviceName := DeviceName + lpDisplayDevice.DeviceString[n];
  Delete(DeviceName, Pos(Chr(0), DeviceName), 127);

if DeviceName <> '' then
if CardDeviceName then
  VideoRAMPanel.Text := DelSp(DeviceName) + ', ' + IntToStr(DeviceValue/oneMB) + ' Mb' else
  VideoRAMPanel.Text := DelSp(DeviceName) + ' (Integrated), ' + MbOrTb(DeviceValue/oneMB)
  else begin
if DeviceValue = 0 then
  VideoRAMPanel.Text := ' Драйвер устройства не обнаружен';
  VideoRAMPanel.Color := $CCCCFF;
  ChangeText := True;
end;

if (DeviceValue/oneMB < NeedVideoRAM) then begin
  VideoRAMPanel.Color := $CCCCFF;
  ChangeText := True;
end;

/// Вывод информации о видеокарте
  VideoRAMPanel.Text := ' ' + VideoRAMPanel.Text + ', ' + IntToStr(GetSystemMetrics(0)) + 'x' +
IntToStr(GetSystemMetrics(1)) + ' (' + IntToStr(GetDeviceCaps(CreateDC('DISPLAY','','',0),14) *
GetDeviceCaps(CreateDC('DISPLAY','','',0),12)) + ' bit)';

/// Звуковая карта:
AudioPanel := TMemo.Create(nil)
with AudioPanel do begin
  Alignment := taCenter
  Parent := InfoPage.Surface
  Left := ScaleX(0)
  Top := VideoPanel.Top + 27
  Text := 'Звуковая карта'
  Width := ScaleX(100)
  Height := ScaleY(22)
  ReadOnly := True
  Color := $EEEEEE
end;

AudioNamePanel := TMemo.Create(nil)
with AudioNamePanel do begin
  Alignment := taLeftJustify
  Parent := InfoPage.Surface
  Left := ScaleX(104)
  Top := AudioPanel.Top
  Width := ScaleX(310)
  Height := ScaleY(22)
  ReadOnly := True
end;

AudioNamePanel.Color := $CCFFCC;
for errCode := 0 to mixerGetNumDevs do begin
  mixerGetDevCaps(errCode-1, lpCaps, SizeOf(lpCaps));
  SoundName := ' '
for n := 0 to 31 do
  SoundName := SoundName + lpCaps.sName[n];
  Delete(SoundName, Pos(Chr(0), SoundName), 31);
  Delete(SoundName, Pos(' [', SoundName), 31);
  StringChange(SoundName, 'SB ', 'Creative ');
  Delete(SoundName, Pos(' Audio', SoundName), 31);
  SetArrayLength(Keys, errCode);
if errCode > 0 then Keys[errCode-1] := SoundName;
end;

/// Вывод информации о звуковой карте
if GetArrayLength(Keys) > 1 then begin
  AudioPanel.Text := 'Звуковые карты';
  AudioNamePanel.Text := '';
for n := 1 to GetArrayLength(Keys) do
  AudioNamePanel.Text := AudioNamePanel.Text + Keys[n-1];
end else
if GetArrayLength(Keys) = 0 then begin
  AudioNamePanel.Text := ' Драйвер устройства не обнаружен';
  AudioNamePanel.Color := $CCCCFF;
  ChangeText := True;
  end else
  AudioNamePanel.Text := Keys[0];
if Pos(NeedSoundCard, AudioNamePanel.Text) = 0 then
  AudioNamePanel.Text := AudioNamePanel.Text + ' (рекомендуется ' + NeedSoundCard + ')';

/// Объём памяти (RAM)
RAMPanel := TMemo.Create(nil)
with RAMPanel do begin
  Alignment := taCenter
  Parent := InfoPage.Surface
  Left := ScaleX(0)
  Text := 'Объём памяти'
  Top := AudioPanel.Top + 27
  Width := ScaleX(100)
  Height := ScaleY(22)
  ReadOnly := True
  Color := $EEEEEE
end;

RAMTotalPanel := TMemo.Create(nil)
with RAMTotalPanel do begin
  Alignment := taLeftJustify
  Parent := InfoPage.Surface
  Left := ScaleX(104)
  Top := RAMPanel.Top
  Width := ScaleX(310)
  Height := ScaleY(22)
  ReadOnly := True
end;

  RAMTotalPanel.Color := $CCFFCC;
if not CheckMemorySize(NeedMB) then begin
  RAMTotalPanel.Color := $CCCCFF;
  ChangeText := True;
end;

/// Вывод информации об установленной памяти
RAMTotalPanel.Text := ' ' + MbOrTb(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB) + ' всего, ' +
MbOrTb((Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys) -
Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys))/oneMB) + ' используется, ' +
MbOrTb(Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys)/oneMB) + ' свободно';

/// Виртуальная память (pagefile)
PageFilePanel := TMemo.Create(nil)
with PageFilePanel do begin
  Alignment := taCenter
  Parent := InfoPage.Surface
  Left := ScaleX(0)
  Text := 'Файл подкачки'
  Top := RAMPanel.Top + 27
  Width := ScaleX(100)
  Height := ScaleY(22)
  ReadOnly := True
  Color := $EEEEEE
end;

PageFileTotalPanel := TMemo.Create(nil)
  with PageFileTotalPanel do begin
  Alignment := taLeftJustify
  Parent := InfoPage.Surface
  Left := ScaleX(104)
  Top := PageFilePanel.Top
  Width := ScaleX(310)
  Height := ScaleY(22)
  ReadOnly := True
end;

/// Вывод информации о файле подкачки
  PageFileTotalPanel.Color := $CCFFCC;
  PageFileTotalPanel.Text := ' ' + MbOrTb((Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile) -
Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys))/oneMB) + ' всего, ' +
MbOrTb((Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile) -
Size64(MemoryEx.HiAvailPageFile, MemoryEx.LoAvailPageFile))/oneMB) + ' занято системным кэшем';
if Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile)/oneMB < NeedPageFile then begin
  PageFileTotalPanel.Color := $CCCCFF;
  ChangeText := True;
  end;
  end;
end;

procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = InfoPage.ID then begin
if ChangeText = True then begin
  TopText.Top := 0;
  TopText.Caption := 'Не все компоненты удовлетворяют минимальным требованиям.' #13
'Пожалуйста, проверьте позиции, выделенные красным цветом.';
  TopText.Font.Color := clRed;
  WizardForm.NextButton.Enabled := False;
end else begin
  TopText.Caption := 'Все компоненты соответствуют минимальным требованиям.';
  TopText.Font.Color := clGreen;
  TopText.Top := 8;
  WizardForm.NextButton.Enabled := True;
  end;
  end;
end;
 

Вложения

Последнее редактирование:

nik1967

Old Men
Проверенный
В: Как сделать окно инсталлятора полупрозрачным при его (окна) перетаскивании?
За основу скрипта и направление движения спасибо Shegorat'у!
О: Как-то так:
Код:
#ifndef IS_ENHANCED
  #error Enhanced edition of Inno Setup (restools) is required to compile this script
#endif

[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
OutputDir=.

[code]
const
  WM_NCLBUTTONDOWN = $00A1; // нажатие левой кнопки мыши по неклиентской области окна
  HTCAPTION = 2;            // константа определяет заголовок окна

  GWL_WNDPROC = -4;

function SetLayeredWindowAttributes(hwnd: HWND; crKey: TColor; bAlpha: BYTE; dwFlags: DWORD): Boolean; external 'SetLayeredWindowAttributes@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: Longint; hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; external 'CallWindowProcA@user32.dll stdcall'; 
function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall';
function GetWindowLong(Wnd: HWnd; Index: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall';
function ReleaseCapture(): Longint; external 'ReleaseCapture@user32.dll stdcall';

var
  OldProc: Longint;
   
function MyProc(h: HWND; Msg, wParam, lParam: longint): Longint;
begin
    if (Msg = WM_NCLBUTTONDOWN) and (wParam = HTCAPTION) then begin
        SetWindowLong(h, (-20), GetWindowLong(h, (-20)) or $80000);
        SetLayeredWindowAttributes(h, 0, 150, 2);  // делаем окно полупрозрачным изменяя bAlpha - у меня 150
        ReleaseCapture;
        SendMessage(WizardForm.Handle,$0112,$F012,0);
        SetWindowLong(h, (-20), GetWindowLong(h, (-20)) or $80000);
        SetLayeredWindowAttributes(h, 0, 255, 2);  // делаем окно снова непрозрачным bAlpha = 255
        Result:= 0;
        Exit;
  end;
  Result:= CallWindowProc(OldProc, h, Msg, wParam, lParam);
end;

procedure InitializeWizard();
begin
    OldProc:= SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('MyProc'));
end;

procedure DeinitializeSetup();
begin
  SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldProc);
end;
Это пример для расширенной версии Инно.
 

Xabib2302

Новичок
В: Как создать папку с именем пользовательского раздела SID?
О: Как-то так:
Код:
[Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
OutputDir=.

[code]
#define A = (Defined UNICODE) ? "W" : "A"
const
    TOKEN_READ = $00020008;
    TokenUser = 1;
    ERROR_INSUFFICIENT_BUFFER = 122;
    HEAP_ZERO_MEMORY = $8;
    MAX_PATH = 260;

type
    SID_AND_ATTRIBUTES = record
        Sid: Longint;
        Attributes: DWORD;
    end;

    TOKEN_USER = record
        User: SID_AND_ATTRIBUTES;
    end;

function GetCurrentProcess: THandle; external 'GetCurrentProcess@kernel32.dll stdcall';
function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD; out TokenHandle: THandle): BOOL; external 'OpenProcessToken@advapi32.dll stdcall';
function GetTokenInformation(TokenHandle: THandle; TokenInformationClass: Integer; TokenInformation: Longint; TokenInformationLength: DWORD; out ReturnLength: DWORD): BOOL; external 'GetTokenInformation@advapi32.dll stdcall';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function GetProcessHeap: THandle; external 'GetProcessHeap@kernel32.dll stdcall';
function HeapAlloc(hHeap: THandle; dwFlags, dwBytes: DWORD): Longint; external 'HeapAlloc@kernel32.dll stdcall';
function HeapFree(hHeap: THandle; dwFlags: DWORD; lpMem: Longint): BOOL; external 'HeapFree@kernel32.dll stdcall';
function RtlMoveMemoryTU(out Destination: TOKEN_USER; const Source: Longint; len: Integer): Integer; external 'RtlMoveMemory@kernel32.dll stdcall';
function ConvertSidToStringSid(Sid: Longint; out StringSid: Longint): BOOL; external 'ConvertSidToStringSid{#A}@advapi32.dll stdcall';
function LocalFree(hMem: THandle): THandle; external 'LocalFree@kernel32.dll stdcall';

///////////////////////////////////////////
function GetCurrentProcessOwnerSID: String;
var
    hProcessToken, hHeap: THandle;
    tuTokenUser: TOKEN_USER;
    lpTokenUser, lpStringSid: Longint;
    dwReturnLength: DWORD;
begin
    if not OpenProcessToken(GetCurrentProcess, TOKEN_READ, hProcessToken) then Exit;
    if not GetTokenInformation(hProcessToken, TokenUser, 0, 0, dwReturnLength) and BOOL(DLLGetLastError = ERROR_INSUFFICIENT_BUFFER) then
    begin
        hHeap := GetProcessHeap;
        if hHeap = 0 then Exit;
        lpTokenUser := HeapAlloc(hHeap, HEAP_ZERO_MEMORY, dwReturnLength);
        if lpTokenUser <> 0 then
        begin
            if GetTokenInformation(hProcessToken, TokenUser, lpTokenUser, dwReturnLength, dwReturnLength) then
            begin
                RtlMoveMemoryTU(tuTokenUser, lpTokenUser, SizeOf(tuTokenUser));
                if ConvertSidToStringSid(tuTokenUser.User.Sid, lpStringSid) then
                begin
                    Result := CastIntegerToString(lpStringSid);
                    LocalFree(lpStringSid);
                end;
            end;
            HeapFree(hHeap, 0, lpTokenUser);
        end;
    end;
    CloseHandle(hProcessToken);
end;

//////////////////////////
procedure InitializeWizard;
begin
    CreateDir(ExpandConstant('{src}\') + GetCurrentProcessOwnerSID);
end;
 

Xabib2302

Новичок
В: Как поменять страницы SelectDir и SelectComponents местами?
О: Как-то так:
Код:
[Setup]
AppName=My program
AppVerName=My program 1.5
DefaultDirName={pf}\My program

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

[Components]
Name: WB; Description: 'Мой компьютер' - Настройки; ExtraDiskSpaceRequired: 1048576

[code]
function OnShouldSkipPage(Sender: TWizardPage): Boolean;
begin
    if WizardForm.ComponentsList.Items.Count > 0 then WizardForm.Tag:= 1; // отображаются страницы выбора папки и компонентов
end;

Procedure CurPageChanged(CurPageID: Integer);
Begin
  Case CurPageID of
  wpSelectDir: if WizardForm.Tag = 1 then
    begin
        WizardForm.SelectDirPage.Notebook.ActivePage:= WizardForm.SelectComponentsPage;
        WizardForm.PageNameLabel.Caption:= SetupMessage(msgWizardSelectComponents)
        WizardForm.Hint:= WizardForm.PageDescriptionLabel.Caption; // запомнить SetupMessage(msgSelectDirDesc)
        WizardForm.PageDescriptionLabel.Caption:= SetupMessage(msgSelectComponentsDesc)
    end;
  wpSelectComponents: if WizardForm.Tag = 1 then
    begin
        WizardForm.SelectComponentsPage.Notebook.ActivePage:= WizardForm.SelectDirPage;
        WizardForm.DiskSpaceLabel.Caption:= WizardForm.ComponentsDiskSpaceLabel.Caption;
        WizardForm.PageNameLabel.Caption:= SetupMessage(msgWizardSelectDir)
        WizardForm.PageDescriptionLabel.Caption:= WizardForm.Hint // иначе вместо названия программы [name]
    end;
  end;
End;

Procedure InitializeWizard;
Begin
    PageFromID(wpSelectDir).OnShouldSkipPage:= @OnShouldSkipPage
end;
 

Xabib2302

Новичок
В: Как закрепить ярлык в Панели управления и в Пуске?
О: Как-то так:
Код:
[code]

function LoadLibraryEx(lpFileName: String; hFile: THandle; dwFlags: DWORD): THandle; external 'LoadLibraryEx{#A}@kernel32.dll stdcall';
function LoadString(hInstance: THandle; uID: SmallInt; var lpBuffer: Char; nBufferMax: Integer): Integer; external 'LoadString{#A}@user32.dll stdcall';
function SHGetNewLinkInfo(pszLinkTo, pszDir: String; var pszName: Char; var pfMustCopy: Longint; uFlags: UINT): BOOL; external 'SHGetNewLinkInfo{#A}@shell32.dll stdcall';

function PinToTaskbar(const szFilename: String; IsPin: Boolean): Boolean;
// szFilename : full path to executable file
// IsPin......: False - unpin from TaskBar, True - pin to TaskBar
var
    hInst: THandle;
    buf: array [0..255] of Char;
    i, res: Integer;
    strLnk, strVerb: String;
    objShell, colVerbs: Variant;
begin
    Result := False;
    if (GetWindowsVersion < $06010000) or not FileExists(szFilename) then Exit; { below Windows 7 }

    { String resources }
    if IsPin then
    begin
        if SHGetNewLinkInfo(szFilename, ExpandConstant('{tmp}'), buf[0], res, 0) then
        begin
            while buf[Length(strLnk)] <> #0 do Insert(buf[Length(strLnk)], strLnk, Length(strLnk)+1);
            if FileExists(ExpandConstant('{userappdata}\Microsoft\Internet Explorer\Quick Launch\User Pinned\TaskBar\') + ExtractFileName(strLnk)) then Exit;
        end;
        res := 5386;        { Pin to Tas&kbar }
    end else res := 5387;   { Unpin from Tas&kbar }

    { Load string resource }
    hInst := LoadLibraryEx(ExpandConstant('{sys}\shell32.dll'), 0, LOAD_LIBRARY_AS_DATAFILE);
    if hInst <> 0 then
    try
        for i := 0 to LoadString(hInst, res, buf[0], 255)-1 do Insert(buf[i], strVerb, i+1);
        try
            objShell := CreateOleObject('Shell.Application');
            colVerbs := objShell.Namespace(ExtractFileDir(szFilename)).ParseName(ExtractFileName(szFilename)).Verbs;
            for i := 1 to colVerbs.Count do if CompareText(colVerbs.Item[i].Name, strVerb) = 0 then
            begin
                colVerbs.Item[i].DoIt;
                Result := True;
                Break;
            end;
        except
            Exit;
        end;
    finally
        FreeDLL(hInst);
    end;
end;

Procedure CurPageChanged(CurPageID: Integer);
Begin
  Case CurPageID of
    wpFinished:
        begin
      if IsTaskSelected('icons\taskbaricon') then
        PinToTaskbar(ExpandConstant('{app}\{#MyAppExeName}'), True);
    end;
  end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
  instPath: string;
begin
    case CurUninstallStep of
      usUninstall:
      begin
      PinToTaskbar(ExpandConstant('{app}\{#MyAppExeName}'), False);
      end;
    end;
end;
Код:
[code]

function LoadLibraryEx(lpFileName: String; hFile: THandle; dwFlags: DWORD): THandle; external 'LoadLibraryEx{#A}@kernel32.dll stdcall';
function LoadString(hInstance: THandle; uID: SmallInt; var lpBuffer: Char; nBufferMax: Integer): Integer; external 'LoadString{#A}@user32.dll stdcall';
function SHGetNewLinkInfo(pszLinkTo, pszDir: String; var pszName: Char; var pfMustCopy: Longint; uFlags: UINT): BOOL; external 'SHGetNewLinkInfo{#A}@shell32.dll stdcall';

function PinToStartMenu(const szFilename: String; IsPin: Boolean): Boolean;
// szFilename : full path to exe- or lnk-file
// IsPin......: False - unpin from StartMenu, True - pin to StartMenu
var
    hInst: THandle;
    buf: array [0..259] of Char;
    i, res: Integer;
    strLnk, strVerb: String;
    objShell, colVerbs: Variant;
begin
    Result := False;
    if not FileExists(szFilename) then Exit;
    if GetWindowsVersion > $06020000 then Exit; { Window 8 and above }

    { Windows 7 }
    if (GetWindowsVersion >= $06010000) and boolean(SHGetNewLinkInfo(szFilename, ExpandConstant('{tmp}'), buf[0], res, 0)) then
    begin
        while buf[Length(strLnk)] <> #0 do Insert(buf[Length(strLnk)], strLnk, Length(strLnk)+1);
        if FileExists(ExpandConstant('{userappdata}\Microsoft\Internet Explorer\Quick Launch\User Pinned\StartMenu\') + ExtractFileName(strLnk)) then Exit;
    end;

    { String resources }
    if IsPin then
        res := 5381     { Pin to Start Men&u }
    else
        res := 5382;    { Unpin from Start Men&u }

    { Load string resource }
    hInst := LoadLibraryEx(ExpandConstant('{sys}\shell32.dll'), 0, LOAD_LIBRARY_AS_DATAFILE);
    if hInst <> 0 then
    try
        for i := 0 to LoadString(hInst, res, buf[0], 255)-1 do Insert(buf[i], strVerb, i+1);
        try
            objShell := CreateOleObject('Shell.Application');

            { below Windows 7 }
            if GetWindowsVersion < $06010000 then
            begin
                objShell.Namespace(ExtractFileDir(szFilename)).ParseName(ExtractFileName(szFilename)).InvokeVerb(strVerb);
                Result := True;
            end;

            { Windows 7 }
            if GetWindowsVersion >= $06010000 then
            begin
                colVerbs := objShell.Namespace(ExtractFileDir(szFilename)).ParseName(ExtractFileName(szFilename)).Verbs;
                for i := 1 to colVerbs.Count do if CompareText(colVerbs.Item[i].Name, strVerb) = 0 then
                begin
                    colVerbs.Item[i].DoIt;
                    Result := True;
                    Break;
                end;
            end;
        except
            Exit;
        end;
    finally
        FreeDLL(hInst);
    end;
end;

Procedure CurPageChanged(CurPageID: Integer);
Begin
  Case CurPageID of
    wpFinished:
        begin
      if IsTaskSelected('icons\startmenuicon') then
        PinToStartMenu(ExpandConstant('{app}\{#MyAppExeName}'), True);
    end;
  end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
  instPath: string;
begin
    case CurUninstallStep of
      usUninstall:
      begin
      PinToStartMenu(ExpandConstant('{app}\{#MyAppExeName}'), False);
      end;
    end;
end;
 

Timick

Старожил
В: Как текстурировать стандартный прогресс бар с помощью ботвы?
О: Вот так:
Код:
#define MyAppName "CustPBExample"
#define MyAppVersion "1.5"
#define MyAppExeName "MyProg.exe"

[Setup]
AppId={{528E8DAB-4CBC-46C2-B8F6-946BB0F3A1C5}
AppName={#MyAppName}
AppVersion={#MyAppVersion}
AppVerName={#MyAppName} {#MyAppVersion}
DefaultDirName=C:\{#MyAppName}
DefaultGroupName={#MyAppName}
AllowNoIcons=Yes
OutputBaseFilename=Setup
Compression=None
SolidCompression=No

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

[Files]
Source: "Files\*.*"; DestDir: "{app}"; Flags: IgnoreVersion
Source: "C:\Windows\Fonts\*.*"; DestDir: "{app}"; Flags: IgnoreVersion

[Code]
//================== [ Подключение модулей ] ==================\\
#Include "Modules\Botva2.iss"
#Include "Modules\ProgressBar.iss"
//================== [ Подключение модулей ] ==================\\

//================== [ Функции для работы таймера ] ==================\\
Function SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc: LongWord): LongWord; External 'SetTimer@user32.dll StdCall';
Function KillTimer(hWnd, nIDEvent: LongWord): LongWord; External 'KillTimer@user32.dll StdCall';
//================== [ Функции для работы таймера ] ==================\\

const
  TimerProgress = 1;

var
  CustProgBar: TImgPB;

//===========================================================================================================================\\

Function NumToStr(Float: Extended): String;
begin
  Result := Format('%.1n', [Float]);
  StringChange(Result, ',', '.');

  While ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do SetLength(Result, Length(Result) - 1);
end;


Procedure ProgressUpdate();
var
  OldValue: Integer;
begin
  // Если текущее значение прогресс бара не равно предыдущему, то выполняем условие
  if OldValue <> WizardForm.ProgressGauge.Position then begin
    // Присваиваем текущее значение прогресс бара в переменную
    OldValue := WizardForm.ProgressGauge.Position;

    // И обновляем позицию кастомного прогресс бара
    ImgPBSetPosition(CustProgBar, WizardForm.ProgressGauge.Position);

    // Добавляем проценты, может тоже понадобится)
    WizardForm.StatusLabel.Caption := 'Прогресс распаковки: ' + NumToStr(WizardForm.ProgressGauge.Position * 100 / WizardForm.ProgressGauge.Max) + '%';
  end;
end;

Function InitializeSetup(): Boolean;
begin
  // Извлекаем необходимые файлы в папку Temp
  ExtractTemporaryFile('Botva2.dll');
  ExtractTemporaryFile('B2P.dll');
  ExtractTemporaryFile('PB0.png');
  ExtractTemporaryFile('PB1.png');

  Result := True;
end;

Procedure CurPageChanged(CurPageID: Integer);
begin
  Case CurPageID of
    wpInstalling: begin
      // Скрываем стандартный прогресс бар
      WizardForm.ProgressGauge.Hide;

      // Создаём кастомный
      CustProgBar := ImgPBCreate(WizardForm.InstallingPage.Handle, 'PB0.png', 'PB1.png',
                                 ScaleX(WizardForm.ProgressGauge.Left), ScaleY(WizardForm.ProgressGauge.Top), ScaleX(WizardForm.ProgressGauge.Width), ScaleY(WizardForm.ProgressGauge.Height));

      // Показываем кастомного прогресс бара
      ImgPBVisibility(CustProgBar, True);

      // Устанавливаем его изначальную позицию
      ImgPBSetPosition(CustProgBar, WizardForm.ProgressGauge.Position);
    end;

    wpFinished: begin
      // Скрываем кастомный прогресс бар
      ImgPBVisibility(CustProgBar, False);

      // Убиваем таймер
      KillTimer(WizardForm.Handle, 01);
    end;
  end;
end;

Procedure CurStepChanged(CurStep: TSetupStep);
begin
  Case CurStep of
    ssInstall: begin
      // Запускаем таймер и обновляем раз в 15 миллисекунд
      SetTimer(WizardForm.Handle, 01, 15, CallBackAddr('ProgressUpdate'));
    end;
  end;
end;

Procedure DeinitializeSetup();
begin
  // ХЗ что делает, но надо для ботвы)
  gdipShutdown();
end;
//===========================================================================================================================\\
 

Вложения

sergey3695

Ветеран
Модератор
В: Как определить поля версии файла?
О: Так (спасибо El Sanchez)
Код:
#ifdef UNICODE
  #define A "W"
#else
  #define A "A"
#endif
function GetFileVersionInfoSize(lptstrFilename: String; lpdwHandle: Integer): Integer;
external 'GetFileVersionInfoSize{#A}@version.dll stdcall delayload';

function GetFileVersionInfo(lptstrFilename: String; dwHandle, dwLen: Integer; var lpData: Byte): Boolean;
external 'GetFileVersionInfo{#A}@version.dll stdcall delayload';

function VerQueryValue(var pBlock: Byte; lpSubBlock: String; var lplpBuffer: DWord; var puLen: Integer): Boolean;
external 'VerQueryValue{#A}@version.dll stdcall delayload';

function GetFileVerInfo(FileName, VerName: String): String;
//VerName:
//Comments, LegalCopyright, CompanyName, FileDescription, FileVersion, ProductVersion,
//InternalName, LegalTrademarks, OriginalFilename, ProductName, PrivateBuild, SpecialBuild
var
  dwLen, puLen, i: Integer;
  lpFileVerInfo: array of Byte;
  lplpBufferCP, lplpBufferVN: DWord;
  LangCodepage: String;
begin
  Result := '';
  if FileExists(FileName) then
  begin
    dwLen := GetFileVersionInfoSize(FileName, 0);
    if dwLen > 0 then
    begin
      SetArrayLength(lpFileVerInfo, dwLen);
      if GetFileVersionInfo(FileName, 0, dwLen, lpFileVerInfo[0]) then
      begin
        if VerQueryValue(lpFileVerInfo[0], '\VarFileInfo\Translation', lplpBufferCP, puLen) then
        begin
          LangCodepage := Format('%.2x%.2x%.2x%.2x', [lpFileVerInfo[(dwLen div 2)-5], lpFileVerInfo[(dwLen div 2)-6], lpFileVerInfo[(dwLen div 2)-3], lpFileVerInfo[(dwLen div 2)-4]]);
          if VerQueryValue(lpFileVerInfo[0], Format('\%s\%s\%s', ['StringFileInfo', LangCodepage, VerName]), lplpBufferVN, puLen) then
          begin
            i := (dwLen div 2) + lplpBufferVN - lplpBufferCP - 6;
            repeat
              if lpFileVerInfo[i] <> 0 then
              begin
                SetLength(Result, Length(Result)+1);
                Result[Length(Result)] := Chr(lpFileVerInfo[i]);
              end;
            i := i + 1;
            #ifdef UNICODE
            until i > (dwLen div 2) + lplpBufferVN - lplpBufferCP - 8 + puLen;
            #else
            until lpFileVerInfo[i] = 0;
            #endif
          end;
        end;
      end;
    end;
  end;
end;
 

sergey3695

Ветеран
Модератор
В: Как вывести ComboBox с дисками?
О: Так (спасибо El Sanchez)
Код:
[Setup]
AppName=Example
AppVerName=Example 1.0
DefaultDirName={pf}\Example
OutputDir=.

[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
    DRIVE_NO_ROOT_DIR = 1;
    DRIVE_FIXED = 3;

var
    cbDrive: TComboBox;

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

procedure cbDriveOnClick(Sender: TObject);
var
    DirValue: string;
begin
    DirValue := WizardDirValue;
    StringChangeEx(DirValue, AddBackslash(ExtractFileDrive(DirValue)), cbDrive.Items[cbDrive.ItemIndex], True);
    WizardForm.DirEdit.Text := DirValue;
end;

procedure DirEditOnChange(Sender: TObject);
var
    i: Integer;
begin
    for i := 0 to cbDrive.Items.Count - 1 do
    begin
        if CompareText(cbDrive.Items[i], AddBackslash(ExtractFileDrive(WizardDirValue))) = 0 then
        begin
            cbDrive.ItemIndex := i;
            Break;
        end;
    end;
end;

procedure FillCombo;
var
    dwDrives: DWORD;
    uDriveType: UINT;
    szDriveLetter: string;
    i: Integer;
begin
    dwDrives := GetLogicalDrives;
    for i := 2 to 25 do if dwDrives and (1 shl i) <> 0 then
    begin
        szDriveLetter := Chr(Ord('A') + i) + ':\';
        uDriveType := GetDriveType(szDriveLetter);
        case uDriveType of
            DRIVE_FIXED:
                begin
                    cbDrive.Items.Add(szDriveLetter);
                    if CompareText(cbDrive.Items[cbDrive.Items.Count - 1], AddBackslash(ExtractFileDrive(WizardDirValue))) = 0 then
                        cbDrive.ItemIndex := cbDrive.Items.Count - 1;
                end;
            DRIVE_NO_ROOT_DIR: Continue;
        end;
    end;
end;

procedure InitializeWizard;
begin
    WizardForm.DirEdit.OnChange := @DirEditOnChange;
    cbDrive := TComboBox.Create(WizardForm.SelectDirPage);
    with cbDrive do
    begin
        Parent := WizardForm.DirEdit.Parent;
        Top := WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + ScaleY(5);
        Width := 40;
        Style := csDropDownList;
        OnClick := @cbDriveOnClick;
        FillCombo;
    end;
end;
 
Последнее редактирование:

Xabib2302

Новичок
В: Как определить системный диск SSD или HDD?
О: Примерно так (Спасибо El Sanchez)
Код:
[Setup]
AppName=test
AppVerName=test
CreateAppDir=no
DefaultDirName={tmp}
Uninstallable=no
CreateUninstallRegKey=no

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

[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
  GENERIC_READ = $80000000;
  GENERIC_WRITE = $40000000;
  FILE_SHARE_READ = $1;
  FILE_SHARE_WRITE = $2;
  OPEN_EXISTING = 3;
  INVALID_HANDLE_VALUE = -1;
  IOCTL_ATA_PASS_THROUGH = $0004D02C;
  ATA_FLAGS_DRDY_REQUIRED = $0001;
  ATA_FLAGS_DATA_IN = $0002;
  ID_CMD = $EC;

type
  TATAPassThroughEx = record
    Length: WORD;
    AtaFlags: WORD;
    PathId: Byte;
    TargetId: Byte;
    Lun: Byte;
    ReservedAsUchar: Byte;
    DataTransferLength: DWORD;
    TimeOutValue: DWORD;
    ReservedAsUlong: DWORD;
    DataBufferOffset: DWORD;
    PreviousTaskFile: array [0..7] of Byte;
    CurrentTaskFile: array [0..7] of Byte;
  end;

  TATAIdentifyDeviceQuery = record
    Header: TATAPassThroughEx;
    Data: array [0..255] of WORD;
  end;

// Device Management Functions
function DeviceIoControlATAIdentifyDeviceQuery(hDevice: THandle; dwIoControlCode: DWORD; var lpInBuffer: TATAIdentifyDeviceQuery; nInBufferSize: DWORD; out lpOutBuffer: TATAIdentifyDeviceQuery; nOutBufferSize: DWORD; out lpBytesReturned: DWORD; lpOverlapped: DWORD): BOOL; external 'DeviceIoControl@kernel32.dll stdcall';

// File Management Functions
function CreateFile(lpFileName: string; dwDesiredAccess, dwShareMode: DWORD; lpSecurityAttributes: Longint; dwCreationDisposition, dwFlagsAndAttributes: DWORD; hTemplateFile: THandle): THandle; external 'CreateFile{#A}@kernel32.dll stdcall';

// Handle and Object Functions
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';

/////////////////////////////////////////////////////////
function IsDriveSSD(const ADriveLetter: string): Boolean;
var
  BytesReturned: DWORD;
  DeviceHandle: THandle;
  ATAIdentifyDeviceQuery: TATAIdentifyDeviceQuery;
begin
  Result := False;
  try
    DeviceHandle := CreateFile(Format('\\.\%s', [ADriveLetter]), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
    if DeviceHandle = INVALID_HANDLE_VALUE then
      RaiseException(SysErrorMessage(DLLGetLastError));

    ATAIdentifyDeviceQuery.Header.Length := SizeOf(ATAIdentifyDeviceQuery.Header);
    ATAIdentifyDeviceQuery.Header.AtaFlags := ATA_FLAGS_DATA_IN or ATA_FLAGS_DRDY_REQUIRED;
    ATAIdentifyDeviceQuery.Header.DataTransferLength := SizeOf(ATAIdentifyDeviceQuery.Data);
    ATAIdentifyDeviceQuery.Header.TimeOutValue := 3;
    ATAIdentifyDeviceQuery.Header.DataBufferOffset := SizeOf(ATAIdentifyDeviceQuery.Header);
    ATAIdentifyDeviceQuery.Header.CurrentTaskFile[6{ = Command/Status register }] := ID_CMD; // ATA IDENTIFY DEVICE command

    if not DeviceIoControlATAIdentifyDeviceQuery(DeviceHandle, IOCTL_ATA_PASS_THROUGH, ATAIdentifyDeviceQuery, SizeOf(ATAIdentifyDeviceQuery), ATAIdentifyDeviceQuery, SizeOf(ATAIdentifyDeviceQuery), BytesReturned, 0) then
    begin
      Log(Format('DeviceIoControl failed: %s', [SysErrorMessage(DLLGetLastError)]));
      Exit;
    end;
    Result := ATAIdentifyDeviceQuery.Data[{ Word }217{: Nominal media rotation rate }] = 1;
  finally
    if DeviceHandle > 0 then
      CloseHandle(DeviceHandle);
  end;
end;

///////////////////////////
procedure InitializeWizard;
begin
  if IsDriveSSD(ExpandConstant('{sd}')) then
    MsgBox('SSD', mbInformation, MB_OK)
  else
    MsgBox('No SSD', mbInformation, MB_OK);
end;
 
Сверху