1. Уважаемые гости и пользователи форума.
    Администрация настоятельно рекомендует не регистрировать несколько аккаунтов для одного пользователя. При выявлении наличия мультиаккаунтов будут заблокированы все учетные записи данного пользователя.
    Аккаунты, зарегистрированные на временную почту будут также заблокированы.

FAQ FAQ по Inno Setup

Тема в разделе "Inno Setup", создана пользователем Shegorat, 16 июн 2011.

Метки:
  1. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    971
    Симпатии:
    667
    В: Как определить классический стиль Windows?
    О: Так
    Код (Text):
    function IsThemeActive: BOOL; external 'IsThemeActive@UxTheme.dll stdcall delayload';
    //...
    if IsThemeActive then // False если классическая
    begin
    Snoopak96, Спасибо за проверку примера должным образом :yes:
     
    Последнее редактирование: 22 фев 2015
    Adil нравится это.
  2. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    971
    Симпатии:
    667
    В: Как растянуть bmp у компанентлиста когда стоит увеличение шрифта в системе (+ откл колесика чтоб не ехало)?
    О: Так
    Спасибо Snoopak96 за растягивание bmp!
     

    Вложения:

    • Resize bmp.rar
      Размер файла:
      1,5 МБ
      Просмотров:
      24
    Последнее редактирование: 7 янв 2016
    Adil, Snoopak96 и vint56 нравится это.
  3. Ветеран

    Регистрация:
    17 июн 2011
    Сообщения:
    470
    Симпатии:
    281
    В: Как сделать бэкап ветки реестра и потом восстановить из бэкапа?
    О: Так
    Код (Text):

    [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;
     
     
    Последнее редактирование: 23 май 2015
    TryRooM, sergey3695 и Хамик нравится это.
  4. Ветеран

    Регистрация:
    13 авг 2011
    Сообщения:
    97
    Симпатии:
    36
    В: Как запустить установку обновлений формата *.msu ?
    О: Так
    Код (Text):
    [Run]
    Filename: {sys}\wusa.exe; Parameters: "{src}\Redist\Windows6.1-KB2670838-x64.msu /quiet /norestart";
     
    AlexS, Winst@n, YURSHAT и ещё 1-му нравится это.
  5. Old Men Проверенный

    Регистрация:
    17 июн 2011
    Сообщения:
    425
    Симпатии:
    405
    Пол:
    Мужской
    В: Как получить размер изображения (длина, ширина в пикселях) средствами Инно?
    О: Как-то так.
    Код (Inno):
    [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'а, допиленный мной.
    Форматы изображений - все которые знает винда по умолчанию.
     
    Последнее редактирование: 1 авг 2016
    Winst@n, YURSHAT, Adil и ещё 1-му нравится это.
  6. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    971
    Симпатии:
    667
    В: Как сделать установку в Steam с выбором?
    О: Так
     

    Вложения:

    • Steam.rar
      Размер файла:
      3,1 МБ
      Просмотров:
      88
    Последнее редактирование: 10 дек 2015
    Winst@n, Хамик, ExPlayer и 4 другим нравится это.
  7. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    971
    Симпатии:
    667
    В: VclStylesinno+Transparent_Edit? (Unicode)
    О: Так
     

    Вложения:

    Adil и ExPlayer нравится это.
  8. Ветеран

    Регистрация:
    17 июн 2011
    Сообщения:
    470
    Симпатии:
    281
    В: Как извлечь информацию о драйвере устройства?
    О: Так.
    Код (Text):

    [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;
     
    YURSHAT, Adil и sergey3695 нравится это.
  9. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    971
    Симпатии:
    667
    В: ComboBoxEx в Inno? (с картинками комбобокс)
    О: Так
    Код (Text):

    [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 за небольшое исправление примера.
     
    Последнее редактирование: 7 май 2016
    Winst@n, ZVSRus, Adil и 4 другим нравится это.
  10. Пользователь

    Регистрация:
    20 апр 2016
    Сообщения:
    29
    Симпатии:
    11
    Пол:
    Мужской
    В: Как грузить маску из потока без создания дополнительных файлов в темпе?
    При компиляции скрипта требуется расширенная китайская версия от Restools.
    Большое спасибо El Sanchez за предоставленный скрипт.
    О: Так
     

    Вложения:

    • Script.7z
      Размер файла:
      1,9 КБ
      Просмотров:
      46
    Последнее редактирование: 14 ноя 2016
    VoLT и Krinkels нравится это.
  11. Старожил Проверенный

    Регистрация:
    15 июн 2011
    Сообщения:
    8
    Симпатии:
    5
    И так для решения приватной загрузки курсора минуя выкладку на диск есть мысль заюзать сия хреновину http://www.codeproject.com/Articles/5220/Creating-a-color-cursor-from-a-bitmap

    Некоторые используемые в хреновине процедуры в Delphi описаны так
    Код (Text):
    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 нравится это.
  12. Пользователь

    Регистрация:
    20 апр 2016
    Сообщения:
    29
    Симпатии:
    11
    Пол:
    Мужской
    В: Как отобразить кастомный курсор без выгрузки файла на диск?
    Благодарю за помощь автора скрипта El Sanchez.
    О: Так
     

    Вложения:

    • Script.7z
      Размер файла:
      1,2 КБ
      Просмотров:
      46
    Последнее редактирование: 14 ноя 2016
    Timick нравится это.
  13. Old Men Проверенный

    Регистрация:
    17 июн 2011
    Сообщения:
    425
    Симпатии:
    405
    Пол:
    Мужской
    В: Как добавить программу в исключения брандмауэра (заблокировать доступ к интернету)?
    О: Как-то так.
    Код (Inno):

    #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;
     
     
    Carlos, AlexanderSergeev, Timick и 2 другим нравится это.
  14. Ветеран

    Регистрация:
    31 мар 2015
    Сообщения:
    304
    Симпатии:
    151
    Пол:
    Мужской
    В: Как отобразить страницу системных требований только средствами InnoSetup?
    Немного доделанный скрипт из справки по InnoSetup.
    За некоторые идеи, спасибо nik1967.
    О: Так
    Код (Inno):

    #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;
     
     

    Вложения:

    • is_sys.7z
      Размер файла:
      4,5 КБ
      Просмотров:
      37
    Последнее редактирование: 19 ноя 2016
    AlexanderSergeev, Nemko, Timick и ещё 1-му нравится это.
  15. Old Men Проверенный

    Регистрация:
    17 июн 2011
    Сообщения:
    425
    Симпатии:
    405
    Пол:
    Мужской
    В: Как сделать окно инсталлятора полупрозрачным при его (окна) перетаскивании?
    За основу скрипта и направление движения спасибо Shegorat'у!
    О: Как-то так:
    Код (Inno):
    #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;
    Это пример для расширенной версии Инно.
     
    hexep, import, Timick и 7 другим нравится это.
  16. Ветеран

    Регистрация:
    28 май 2013
    Сообщения:
    48
    Симпатии:
    5
    В: Как создать папку с именем пользовательского раздела SID?
    О: Как-то так:
    Код (Inno):
    [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;
     
  17. Ветеран

    Регистрация:
    28 май 2013
    Сообщения:
    48
    Симпатии:
    5
    В: Как поменять страницы SelectDir и SelectComponents местами?
    О: Как-то так:
    Код (Inno):
    [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;
     
    Nemko нравится это.
  18. Ветеран

    Регистрация:
    28 май 2013
    Сообщения:
    48
    Симпатии:
    5
    В: Как закрепить ярлык в Панели управления и в Пуске?
    О: Как-то так:
    Код (Inno):
    [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;
    Код (Inno):
    [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;
     
  19. Ветеран

    Регистрация:
    26 дек 2014
    Сообщения:
    311
    Симпатии:
    187
    Пол:
    Мужской
    В: Как текстурировать стандартный прогресс бар с помощью ботвы?
    О: Вот так:
    Код (Inno):

    #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;
    //===========================================================================================================================\\

     
     

    Вложения:

    ExPlayer, Adil, Nemko и ещё 1-му нравится это.
  20. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    971
    Симпатии:
    667
    В: Как определить поля версии файла?
    О: Так (спасибо El Sanchez)
    Код (Inno):
    #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;
     

Поделиться этой страницей