[Nikish X]

alert30, они мне не скажут.

LordSP, установи Unicode, ANSI не подерживает большинство функций.

[LordSP]

Да и на Unicode не работает большинство скриптов, не так давно было такое: У меня все нормально запускалось на Win 7 x64 а у знакомого при старте установки на его Win 7 x86 выдавала app crash, перекомпилировал ANSI, все заработало.

[Dark_Delphin]

Всем привет.

Подскажите, пожалуйста, скрипт, чтобы вывести кнопку Дополнительно и при нажатии на неё выводятся дполнительные комопненты.

Заранее благодарен.

[Johny777]

Dark_Delphin, Держи раннюю версию моего кода установки Халфы 1 и её офф. аддонов и офф. модов для изучения:
скрин:

читать дальше »

код:

читать дальше »

Код:

[Setup]
SourceDir=.
OutputDir=final
AppName=GoldSource
AppVerName=GoldSource
AppVersion=GoldSource
AppPublisher=VALVE
AppCopyright=VALVE
DefaultDirName={pf}\steamapps
DefaultGroupName=GoldSource
AllowNoIcons=yes
WizardImageFile=WizardImage.bmp
WizardSmallImageFile=WizardSmallImage.bmp
OutputBaseFilename=Setup
WindowVisible=no
WindowShowCaption=no
WindowResizable=no
Compression=none
;lzma2/ultra64
LZMAUseSeparateProcess=yes
LZMAMatchFinder=BT
LZMANumFastBytes=273
LZMADictionarySize=262144
///LZMADictionarySize=131072
InternalCompressLevel=ultra64
DiskSpanning=true
DiskSliceSize=960495616
SlicesPerDisk=1
UninstallFilesDir={app}\Uninstall


[Components]
Name: hl1; Description: Half-Life; Flags: dontinheritcheck disablenouninstallwarning
Name: hl1\en; Description: английская озвучка; Flags: exclusive disablenouninstallwarning
Name: hl1\ru; Description: русская озвучка; Flags: exclusive disablenouninstallwarning
Name: bs; Description: Half-Life Blue Shift; Flags: dontinheritcheck disablenouninstallwarning
Name: bs\en; Description: английская озвучка; Flags: exclusive disablenouninstallwarning
Name: bs\ru; Description: русская озвучка; Flags: exclusive disablenouninstallwarning
Name: of; Description: Half-Life Opposing Force; Flags: dontinheritcheck disablenouninstallwarning
Name: of\en; Description: английская озвучка; Flags: exclusive disablenouninstallwarning
Name: of\ru; Description: русская озвучка; Flags: exclusive disablenouninstallwarning
Name: dc; Description: Half-Life Decay; Flags: dontinheritcheck disablenouninstallwarning
Name: dc\en; Description: английская озвучка; Flags: exclusive disablenouninstallwarning
Name: dc\ru; Description: русская озвучка; Flags: exclusive disablenouninstallwarning
Name: cs; Description: Counter Strike; Flags: dontinheritcheck disablenouninstallwarning
Name: ds; Description: Counter Strike Condition Zero Deleted Scenes; Flags: dontinheritcheck disablenouninstallwarning
Name: ds\en; Description: английская озвучка; Flags: exclusive disablenouninstallwarning
Name: ds\ru; Description: английская озвучка + русский интерфейс; Flags: exclusive disablenouninstallwarning


[Icons]
Name: {group}\Half-Life; Filename: {app}\common\half-life\Half-Life.exe; WorkingDir: {app}\common\half-life; Check: CreateIcon('Half-Life', 'Start');
Name: {userdesktop}\Half-Life; Filename: {app}\common\half-life\Half-Life.exe; WorkingDir: {app}\common\half-life; Check: CreateIcon('Half-Life', 'Desktop');
Name: {group}\Half-Life Blue Shift; Filename: {app}\common\half-life blue shift\Half-Life Blue Shift_unlocked.exe; WorkingDir: {app}\common\half-life blue shift; Check: CreateIcon('Half-Life Blue Shift', 'Start');
Name: {userdesktop}\Half-Life Blue Shift; Filename: {app}\common\half-life blue shift\Half-Life Blue Shift_unlocked.exe; WorkingDir: {app}\common\half-life blue shift; Check: CreateIcon('Half-Life Blue Shift', 'Desktop');
Name: {group}\Half-Life Opposing Force; Filename: {app}\common\half-life opposing force\Half-Life Opposing Force.exe; WorkingDir: {app}\common\half-life opposing force; Check: CreateIcon('Half-Life Opposing Force', 'Start');
Name: {userdesktop}\Half-Life Opposing Force; Filename: {app}\common\half-life opposing force\Half-Life Opposing Force.exe; WorkingDir: {app}\common\half-life opposing force; Check: CreateIcon('Half-Life Opposing Force', 'Desktop');
Name: {group}\Half-Life Decay; Filename: {app}\common\half-life decay\Half-Life Decay.exe; WorkingDir: {app}\common\half-life decay; Check: CreateIcon('Half-Life Decay', 'Start');
Name: {userdesktop}\Half-Life Decay; Filename: {app}\common\half-life decay\Half-Life Decay.exe; WorkingDir: {app}\common\half-life decay; Check: CreateIcon('Half-Life Decay', 'Desktop');
Name: {group}\Counter Strike; Filename: {app}\common\counter strike\Counter Strike.exe; WorkingDir: {app}\common\counter strike; Check: CreateIcon('Counter Strike', 'Start');
Name: {userdesktop}\Counter Strike; Filename: {app}\common\counter strike\Counter Strike.exe; WorkingDir: {app}\common\counter strike; Check: CreateIcon('Counter Strike', 'Desktop');
Name: {group}\Counter Strike Condition Zero Deleted Scenes; Filename: {app}\common\counter strike condition zero deleted scenes\Counter Strike Condition Zero Deleted Scenes.exe; WorkingDir: {app}\common\counter strike condition zero deleted scenes; Check: CreateIcon('Counter Strike Condition Zero Deleted Scenes', 'Start');
Name: {userdesktop}\Counter Strike Condition Zero Deleted Scenes; Filename: {app}\common\counter strike condition zero deleted scenes\Counter Strike Condition Zero Deleted Scenes.exe; WorkingDir: {app}\common\counter strike condition zero deleted scenes; Check: CreateIcon('Counter Strike Condition Zero Deleted Scenes', 'Desktop');
Name: {group}\{cm:UninstallProgram,GoldSource}; Filename: {uninstallexe}


[Run]
Description: {cm:LaunchProgram, Half-Life}; Filename: {app}\common\half-life\Half-Life.exe; WorkingDir: {app}\common\half-life; Flags: nowait postinstall skipifsilent unchecked; Components: hl1
Description: {cm:LaunchProgram, Half-Life Blue Shift}; Filename: {app}\common\half-life blue shift\Half-Life Blue Shift_unlocked.exe; WorkingDir: {app}\common\half-life blue shift; Flags: nowait postinstall skipifsilent unchecked; Components: bs
Description: {cm:LaunchProgram, Half-Life Opposing Force}; Filename: {app}\common\half-life opposing force\Half-Life Opposing Force.exe; WorkingDir: {app}\common\half-life opposing force; Flags: nowait postinstall skipifsilent unchecked; Components: of
Description: {cm:LaunchProgram, Half-Life Decay}; Filename: {app}\common\half-life decay\Half-Life Decay.exe; WorkingDir: {app}\common\half-life decay; Flags: nowait postinstall skipifsilent unchecked; Components: dc
Description: {cm:LaunchProgram, Counter Strike}; Filename: {app}\common\counter strike\Counter Strike.exe; WorkingDir: {app}\common\counter strike; Flags: nowait postinstall skipifsilent unchecked; Components: cs
Description: {cm:LaunchProgram, Counter Strike Condition Zero Deleted Scenes}; Filename: {app}\common\counter strike condition zero deleted scenes\Counter Strike Condition Zero Deleted Scenes.exe; WorkingDir: {app}\common\counter strike condition zero deleted scenes; Flags: nowait postinstall skipifsilent unchecked; Components: ds


[UninstallDelete]
Type: files; Name: {app}


[  code]
var
  AddCompCcheckListBox: TNewCheckListBox;
  IconComboBox, TypeComboBox: TComboBox;
  Selected: BOOL;
    

function CreateIcon(const GameName, Folder: String): boolean;
var
  i: Integer;
begin
  with AddCompCcheckListBox do
  begin
    Result := Checked[Items.IndexOf(GameName)] and ItemEnabled[Items.IndexOf(GameName)];
    if Result then
    case Folder of
      'Desktop': Result := Checked[Items.IndexOf(GameName)+1];
      'Start': Result := Checked[Items.IndexOf(GameName)+2];
    end;
  end;
end;


procedure AddButtonOnClick(Sender: TObject);
var
  uBOOL: BOOL;
  i: Integer;
begin
  case TButton(Sender).Caption of
    'Значки':
    begin
      uBOOL := False;
      TButton(Sender).Caption := 'Скрыть';
    end;
    'Скрыть':
    begin
      uBOOL := True;
      TButton(Sender).Caption := 'Значки';
    end;
  end;
  TypeComboBox.Visible := uBOOL;
  IconComboBox.Visible := not uBOOL;
  WizardForm.ComponentsList.Visible := uBOOL;
  if uBOOL then WizardForm.ComponentsList.SetFocus;
  AddCompCcheckListBox.Visible := not uBOOL;
  if not uBOOL then with AddCompCcheckListBox do
  begin
    if WizardSelectedComponents(False) <> '' then
    for i := Items.IndexOf('Half-Life') to Items.IndexOf('Counter Strike Condition Zero Deleted Scenes') do
    begin
      if WizardForm.ComponentsList.Items.IndexOf(Items.Strings[i]) <> -1 then
      begin
        ItemEnabled[i] := WizardForm.ComponentsList.Checked[WizardForm.ComponentsList.Items.IndexOf(Items.Strings[i])];
        ItemEnabled[i+1] := WizardForm.ComponentsList.Checked[WizardForm.ComponentsList.Items.IndexOf(Items.Strings[i])];
        ItemEnabled[i+2] := WizardForm.ComponentsList.Checked[WizardForm.ComponentsList.Items.IndexOf(Items.Strings[i])];
      end;
    end
    else for i := Items.IndexOf('Создать значки для:') to Items.IndexOf('Counter Strike Condition Zero Deleted Scenes') do ItemEnabled[i] := False;
    SetFocus;
  end;
end;


procedure ComboBoxesOnClick(Sender: TObject);
var
  i: Integer;
begin
  case TComboBox(Sender) of
    IconComboBox:
    case TComboBox(Sender).Text of
      'Выбрать всё': for i := 0 to AddCompCcheckListBox.Items.Count-1 do AddCompCcheckListBox.Checked[i] := True;
      'Очистить выбор': for i := 0 to AddCompCcheckListBox.Items.Count-1 do AddCompCcheckListBox.Checked[i] := False;
    end;
    TypeComboBox: with WizardForm.ComponentsList do
    case TComboBox(Sender).Text of
      'Выбрать всё': for i := 0 to Items.Count-1 do Checked[i] := True;
      'Только игры серии Half-Life': for i := 0 to Items.Count-1 do Checked[i] := (Items.Strings[i] = 'Half-Life') or (Items.Strings[i] = 'Half-Life Opposing Force') or (Items.Strings[i] = 'Half-Life Blue Shift') or (Items.Strings[i] = 'Half-Life Decay');
      'Только игры серии Counter Strike': for i := 0 to Items.Count-1 do Checked[i] := (Items.Strings[i] = 'Counter Strike') or (Items.Strings[i] = 'Counter Strike Condition Zero Deleted Scenes');
      'Всё на русском': for i := 0 to Items.Count-1 do Checked[i] := (Items.Strings[i] = 'русская озвучка') or (Items.Strings[i] = 'английская озвучка + русский интерфейс');
      'Всё на английском':
      begin
        for i := 0 to Items.Count-1 do Checked[i] := (Items.Strings[i] = 'английская озвучка');
        Checked[Items.IndexOf('Counter Strike')];
      end;
      'Очистить выбор': for i := 0 to Items.Count-1 do Checked[i] := False;
    end;
  end;
end;                   


procedure InitializeWizard();
begin
  with WizardForm do
  begin
    with TNewButton.Create(WizardForm) do
    begin
      Parent := WizardForm.SelectComponentsPage;
      Caption := 'Значки';
      SetBounds(ScaleX(ComponentsList.Left + ComponentsList.Width - 80), ScaleY(ComponentsList.Top + ComponentsList.Height + 7), ScaleX(80), ScaleY(23));
      OnClick := @AddButtonOnClick;
    end;
    AddCompCcheckListBox := TNewCheckListBox.Create(WizardForm)
    with AddCompCcheckListBox do
    begin
      Parent := ComponentsList.Parent;
      SetBounds(ComponentsList.Left, ComponentsList.Top, ComponentsList.Width, ComponentsList.Height);
      AddCheckBox('Создать значки для:', '', 0, True, (WizardSelectedComponents(False) <> ''), False, False, nil);
        AddCheckBox('Half-Life', '', 1, True, ComponentsList.Checked[ComponentsList.Items.IndexOf('Half-Life')], False, True, nil);
          AddCheckBox('на "Рабочем Столе"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life')], False, True, nil);
          AddCheckBox('в меню "Пуск"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life')], False, True, nil);
        AddCheckBox('Half-Life Blue Shift', '', 1, True, ComponentsList.Checked[ComponentsList.Items.IndexOf('Half-Life Blue Shift')], False, True, nil);
          AddCheckBox('на "Рабочем Столе"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life Blue Shift')], False, True, nil);
          AddCheckBox('в меню "Пуск"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life Blue Shift')], False, True, nil);
        AddCheckBox('Half-Life Opposing Force', '', 1, True, ComponentsList.Checked[ComponentsList.Items.IndexOf('Half-Life Opposing Force')], False, True, nil);
          AddCheckBox('на "Рабочем Столе"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life Opposing Force')], False, True, nil);
          AddCheckBox('в меню "Пуск"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life Opposing Force')], False, True, nil);
        AddCheckBox('Half-Life Decay', '', 1, True, ComponentsList.Checked[ComponentsList.Items.IndexOf('Half-Life Decay')], False, True, nil);
          AddCheckBox('на "Рабочем Столе"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life Decay')], False, True, nil);
          AddCheckBox('в меню "Пуск"', '', 2, True, ItemEnabled[Items.IndexOf('Half-Life Decay')], False, True, nil);
        AddCheckBox('Counter Strike', '', 1, True, ComponentsList.Checked[ComponentsList.Items.IndexOf('Counter Strike')], False, True, nil);
          AddCheckBox('на "Рабочем Столе"', '', 2, True, ItemEnabled[Items.IndexOf('Counter Strike')], False, True, nil);
          AddCheckBox('в меню "Пуск"', '', 2, True, ItemEnabled[Items.IndexOf('Counter Strike')], False, True, nil);
        AddCheckBox('Counter Strike Condition Zero Deleted Scenes', '', 1, True, ComponentsList.Checked[ComponentsList.Items.IndexOf('Counter Strike Condition Zero Deleted Scenes')], False, True, nil);
          AddCheckBox('на "Рабочем Столе"', '', 2, True, ItemEnabled[Items.IndexOf('Counter Strike Condition Zero Deleted Scenes')], False, True, nil);
          AddCheckBox('в меню "Пуск"', '', 2, True, ItemEnabled[Items.IndexOf('Counter Strike Condition Zero Deleted Scenes')], False, True, nil);
      Visible := False;  
    end;
    IconComboBox := TComboBox.Create(WizardForm)
    with IconComboBox do
    begin
      Parent := TypesCombo.Parent;
      SetBounds(TypesCombo.Left, TypesCombo.Top, TypesCombo.Width, TypesCombo.Height);
      Items.Add('Выбрать всё');
      Items.Add('Очистить выбор');
      Style := csDropDownList;
      ItemIndex := 0;
      OnClick := @ComboBoxesOnClick;
    end;
    TypeComboBox := TComboBox.Create(WizardForm)
    with TypeComboBox do
    begin
      Parent := TypesCombo.Parent;
      SetBounds(TypesCombo.Left, TypesCombo.Top, TypesCombo.Width, TypesCombo.Height);
      Items.Add('Выбрать всё');
      Items.Add('Только игры серии Half-Life');
      Items.Add('Только игры серии Counter Strike');
      Items.Add('Всё на русском');
      Items.Add('Всё на английском');
      Items.Add('Очистить выбор');
      Style := csDropDownList;
      ItemIndex := -1;
      OnClick := @ComboBoxesOnClick;
    end;
    TypesCombo.Hide;
  end;
end;


function NextButtonClick(CurPageID: Integer): Boolean;
begin
  if CurPageID = wpSelectComponents then
  begin
    Result := WizardSelectedComponents(False) <> '';
    if not Result then Result := Selected;
    if not Result then
    begin
      Result := MsgBox('Не выбрано ни одного компонента для установки. Так и должно быть?', mbConfirmation, MB_YESNO) = IDYES;
      Selected := Result;
    end;
  end else Result := True;
end;


procedure RadioRunListOnClick(Sender: TObject);
var
  i: Integer;
begin
  for i := 1 to TNewCheckListBox(Sender).Items.Count-1 do WizardForm.RunList.Checked[i-1] := TNewCheckListBox(Sender).Checked[i];
end;


procedure CurPageChanged(CurPageID: Integer);
var
  i: Integer;
begin
  if CurPageID = wpFinished then with WizardForm do if RunList.Items.Count <> 0 then
  begin
    with TNewCheckListBox.Create(WizardForm) do
    begin
      Parent := RunList.Parent;
      SetBounds(RunList.Left, RunList.Top, RunList.Width, RunList.Height);
      AddRadioButton('Ничего не запускать', '', 0, True, True, nil);
      for i := 0 to RunList.Items.Count-1 do
      begin
        AddRadioButton(RunList.Items.Strings[i], '', 0, False, True, nil);
        RunList.Checked[i] := False;
      end;
      OnClickCheck := @RadioRunListOnClick;
    end;
    RunList.Visible := False;
  end;
end;

[Johny777]

в предыдущее сообщение не поместилось , поэтому вот второе:
kodzoyev,

окна которое рекомендует пользователю закрыть браузер »

Реализовал таки(пришлось напрячься ):
принцип такой:
имеем тип-запись:

Код:

    BROWSER_ERROR_STRUCT = record
        ProcsToTerminate: array of String;
        ErrorForm: TForm;
    end;

именно этот тип и возвращает функция прототипа: function CreateBrowserError(const BrowserAraay, BrowserProcNames: array of String): BROWSER_ERROR_STRUCT;
где входные параметры - два динамичных массива записей:
первый содержит запись А = имя браузера
второй содержит запись А = имя процесса или путь к папке экзешника (спасибо ещё раз El Sanchez-у) выше упомянутого браузера
вот такие "пары" мы и отправляем
в функции CreateBrowserError() в цикле пробегаем по входным массивам и проверяем наличие процесса(ов) попутно, если какой-то процесс запущен заполняя два локальных массива
если массивы не пусты то в BROWSER_ERROR_STRUCT.ErrorForm создаём форму с именами работающих бразеров и кнопками
BROWSER_ERROR_STRUCT.ProcsToTerminate присваиваем массив с именами процессов оных!
полученную формы показываем модально и если в переменную ShowModal запишется mrYes из кнопки "да", то отправляем наш массив процессов BROWSER_ERROR_STRUCT.ProcsToTerminate в
function TerminateManyApps(const AppProcArray: array of String): BOOL; которая в цикле завершает процессы/закрывает окна.
Внимание: Функция TerminateManyApps возвращает булев значение короое формируется из булев значений локального массива, в каждый элемент которого пишется - завершился или не завершился тот или иной процесс. Те если из 3-х папущенных процессов не завершится 1 (очень мало вероятно ) то функция вернёт False!

Пользуйтесь кому надо! Буду рад!
код:

читать дальше »

Код:

[Setup]
SourceDir=.
OutputDir=final
AppName=GoldSource
AppVerName=GoldSource
AppVersion=GoldSource
AppPublisher=VALVE
AppCopyright=VALVE
DefaultDirName={pf}\steamapps
DefaultGroupName=GoldSource
AllowNoIcons=yes
WizardImageFile=WizardImage.bmp
WizardSmallImageFile=WizardSmallImage.bmp
OutputBaseFilename=Setup
WindowVisible=no
WindowShowCaption=no
WindowResizable=no
Compression=none
;lzma2/ultra64
LZMAUseSeparateProcess=yes
LZMAMatchFinder=BT
LZMANumFastBytes=273
LZMADictionarySize=262144
///LZMADictionarySize=131072
InternalCompressLevel=ultra64
DiskSpanning=true
DiskSliceSize=960495616
SlicesPerDisk=1
UninstallFilesDir={app}\Uninstall




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

const
    TH32CS_SNAPPROCESS = $2;
    INVALID_HANDLE_VALUE = -1;
    PROCESS_TERMINATE = $1;
    PROCESS_CREATE_THREAD = $2;
    PROCESS_VM_OPERATION = $8;
    PROCESS_VM_WRITE = $20;
    PROCESS_QUERY_INFORMATION = $400;
    SYNCHRONIZE = $100000;
    MEM_COMMIT = $1000;
    MEM_RESERVE = $2000;
    PAGE_EXECUTE_READWRITE = $40;
    TOKEN_QUERY = $8;
    TOKEN_ADJUST_PRIVILEGES = $20;
    SE_PRIVILEGE_ENABLED = $2;
    MAX_PATH = 260;
    TA_FAILED = 0;
    TA_SUCCESS_CLEAN = 1;
    TA_SUCCESS_KILL = 2;
    WM_CLOSE = $10;
    WAIT_OBJECT_0 = $0;
    WAIT_TIMEOUT = $102;

type
    TPROCESSENTRY32 = record
        dwSize, cntUsage, th32ProcessID: DWORD;
        th32DefaultHeapID: Longint;
        th32ModuleID, cntThreads, th32ParentProcessID: DWORD;
        pcPriClassBase: Longint;
        dwFlags: DWORD;
        szExeFile: array [0..259] of char;
    end;
    
    BROWSER_ERROR_STRUCT = record
        ProcsToTerminate: array of String;
        ErrorForm: TForm;
    end;
    
    _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;

function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
#ifdef UNICODE
function Process32First(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32First{#A}@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32Next{#A}@kernel32.dll stdcall';
#else
function Process32First(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32First@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32Next@kernel32.dll stdcall';
#endif
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function GetModuleFileNameEx(hProcess: THandle; hModule: Longint; var lpFilename: Char; nSize: DWORD): DWORD; external 'GetModuleFileNameEx{#A}@psapi.dll stdcall';
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; external 'OpenProcess@kernel32.dll stdcall';
function GetModuleHandle(lpModuleName: String): THandle; external 'GetModuleHandle{#A}@kernel32.dll stdcall';
function GetProcAddress(hModule: THandle; lpProcName: String): Longint; external 'GetProcAddress@kernel32.dll stdcall';
function CreateRemoteThread(hProcess: THandle; lpThreadAttributes, dwStackSize, lpStartAddress, lpParameter, dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; external 'CreateRemoteThread@kernel32.dll stdcall';
function GetCurrentThread(): THandle; external 'GetCurrentThread@kernel32.dll stdcall';
function GetCurrentProcess(): THandle; external 'GetCurrentProcess@kernel32.dll stdcall';
function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD; var TokenHandle: THandle): BOOL; external 'OpenProcessToken@advapi32.dll stdcall';
function TerminateProcess(hProcess: THandle; uExitCode: UINT): BOOL; external 'TerminateProcess@kernel32.dll stdcall';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForSingleObject@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 VirtualAllocEx(hProcess: THandle; lpAddress, dwSize: Longint; flAllocationType, flProtect: DWORD): Longint; external 'VirtualAllocEx@kernel32.dll stdcall';
function WriteProcessMemory(hProcess: THandle; lpBaseAddress, lpBuffer, nSize: Longint; var lpNumberOfBytesWritten: Longint): BOOL; external 'WriteProcessMemory@kernel32.dll stdcall';
function EnumWindows(lpEnumFunc, lParam: Longint): BOOL; external 'EnumWindows@user32.dll stdcall';
function GetWindowThreadProcessId(hWnd: HWND; var lpdwProcessId: DWORD): DWORD; external 'GetWindowThreadProcessId@user32.dll stdcall';


function IsProcessRunning(const FileName: String): Boolean; //FileName - имя exe-файла процесса
var
    hProcessSnap: THandle;
    pe32: TPROCESSENTRY32;
    szExeFile: String;
begin
    hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if hProcessSnap = INVALID_HANDLE_VALUE then Exit;
    pe32.dwSize := sizeof(pe32);
    if not Process32First(hProcessSnap, pe32) then Exit;
    while not Result and Process32Next(hProcessSnap, pe32) do
    begin
        szExeFile := '';
        while not (pe32.szExeFile[Length(szExeFile)] = #0) do szExeFile := szExeFile + pe32.szExeFile[Length(szExeFile)];
        Result := LowerCase(FileName) = LowerCase(szExeFile);
    end;
    CloseHandle(hProcessSnap);
end;

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

////////////////////////////////////////////////////////////
function EnumWindowsProc(hwnd: HWND; lParam: Longint): BOOL;
var
    dwID: DWORD;
begin
    GetWindowThreadProcessId(hwnd, dwID);
    if dwID = lParam then PostMessage(hwnd, WM_CLOSE, 0, 0);
    Result := True;
end;

////////////////////////////////////////////////////////////////////////
function TerminateApp(const szProcess: String; dwTimeout: DWORD): DWORD;
var
    hProcessSnap, hProc, hToken, hThread, lpProcName: THandle;
    pe32: TPROCESSENTRY32;
    szExeFile: array [0..MAX_PATH-1] of Char;
    ptrProc: Longint;
    tkp: _TOKEN_PRIVILEGES;
    SeDebugNameValue: _LUID;
    lpMemory, ret: Longint;
    lpThreadId: DWORD;
begin
    ptrProc := CallbackAddr('EnumWindowsProc');
    hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if hProcessSnap = INVALID_HANDLE_VALUE then Exit;
    try
        pe32.dwSize := SizeOf(pe32);
        if not Process32First(hProcessSnap, pe32) then Exit;
        while Process32Next(hProcessSnap, pe32) do
        begin
            if CompareText(CharArrayToString(pe32.szExeFile), ExtractFileName(szProcess)) <> 0 then Continue;
            // try open process
            hProc := OpenProcess(PROCESS_TERMINATE or PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION or SYNCHRONIZE, False, pe32.th32ProcessID);
            if hProc = TA_FAILED then
            begin
                // open process token adjust privileges
                if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then Exit;
                if not LookupPrivilegeValue('', 'SeDebugPrivilege', SeDebugNameValue) then Exit;
                try
                    // fill token privileges struct
                    tkp.PrivilegeCount := 1;
                    tkp.Privileges[0].Luid := SeDebugNameValue;
                    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
                    // set debug privileges
                    if not AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), tkp, ret) then Exit;
                    // try open process with debug privileges
                    hProc := OpenProcess(PROCESS_TERMINATE or PROCESS_CREATE_THREAD or PROCESS_VM_OPERATION or PROCESS_VM_WRITE or PROCESS_QUERY_INFORMATION or SYNCHRONIZE, False, pe32.th32ProcessID);
                    if hProc = TA_FAILED then Exit;
                finally
                    tkp.Privileges[0].Attributes := 0;
                    AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), tkp, ret);
                    CloseHandle(hToken);
                end;
            end;
            // if szProcess is full path
            if CompareText(szProcess, ExtractFileName(szProcess)) <> 0 then
            begin
                GetModuleFileNameEx(hProc, 0, szExeFile[0], MAX_PATH);
                if CompareText(CharArrayToString(szExeFile), szProcess) <> 0 then
                begin
                    CloseHandle(hProc);
                    //Continue;
                end;
            end;
            // try stop process
            try
                EnumWindows(ptrProc, pe32.th32ProcessID);
                case WaitForSingleObject(hProc, dwTimeout) of
                    WAIT_OBJECT_0: Result := TA_SUCCESS_CLEAN;
                    WAIT_TIMEOUT: try
                        lpProcName := GetProcAddress(GetModuleHandle('kernel32.dll'), 'ExitProcess');
                        if lpProcName = 0 then Exit;
                        //
                        lpMemory := VirtualAllocEx(hProc, 0, SizeOf(lpProcName), MEM_COMMIT or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
                        if not WriteProcessMemory(hProc, lpMemory, lpProcName, SizeOf(lpProcName), ret) then Exit;
                        //
                        hThread := CreateRemoteThread(hProc, 0, 0, lpMemory, 0, 0, lpThreadId);
                        if hThread > 0 then
                        case WaitForSingleObject(hThread, dwTimeout) of
                            WAIT_OBJECT_0: Result := TA_SUCCESS_CLEAN;
                            WAIT_TIMEOUT: if TerminateProcess(hProc, 0) then Result := TA_SUCCESS_KILL;
                        end;
                    finally
                        CloseHandle(hThread);
                    end;
                end;
            finally
                CloseHandle(hProc);
                if CompareText(szProcess, ExtractFileName(szProcess)) <> 0 then Exit;
            end;
        end;
    finally
        CloseHandle(hProcessSnap);
    end;
end;



function CreateBrowserError(const BrowserAraay, BrowserProcNames: array of String): BROWSER_ERROR_STRUCT;
var
    uBrowserStringArray, uBrowserProcStringArray: array of String;
    StaticInfo: TNewStaticText;
    uString: String;
    i: Integer;
begin
    for i := 0 to GetArrayLength(BrowserAraay)-1 do
    begin
        if IsProcessRunning(BrowserProcNames[i]) then
        begin
            SetArrayLength(uBrowserStringArray, i+1);
            uBrowserStringArray[i] := BrowserAraay[i];
            SetArrayLength(uBrowserProcStringArray, i+1);
            uBrowserProcStringArray[i] := BrowserProcNames[i];
        end;
    end;
    if GetArrayLength(uBrowserStringArray) = 0 then Exit;
    Result.ErrorForm := TForm.Create(nil)
    with Result.ErrorForm do
    begin
        ClientHeight := ScaleY(100);
        Position := PoscreenCenter;
        BorderStyle := bsDialog;
        Caption := 'Error';
        StaticInfo := TNewStaticText.Create(Result.ErrorForm)
        with StaticInfo do
        begin
            Parent := Result.ErrorForm;
            Left := ScaleX(7);
            Top := ScaleY(7);
            Font.Size := 10;
            Caption := 'Запущен(ы) браузер(ы):';
            for i := 0 to GetArrayLength(uBrowserStringArray)-1 do Caption := Caption + #32 + uBrowserStringArray[i] + ',';
            uString := Caption;
            Delete(uString, Length(uString), Length(uString));
            Caption := uString + '.' + #13#10 + 'Завершить процессы?';
        end;
        ClientWidth := ScaleX(StaticInfo.Width+30);
        with TNewButton.Create(Result.ErrorForm) do
        begin
            Parent := Result.ErrorForm;
            SetBounds(ScaleX(Result.ErrorForm.Width-100), ScaleY(Result.ErrorForm.Height-60), ScaleX(80), ScaleY(25));
            Caption := SetupMessage(msgButtonNo);
            ModalResult := mrNo;
        end;
        with TNewButton.Create(Result.ErrorForm) do
        begin
            Parent := Result.ErrorForm;
            SetBounds(ScaleX(Result.ErrorForm.Width-190), ScaleY(Result.ErrorForm.Height-60), ScaleX(80), ScaleY(25));
            Caption := SetupMessage(msgButtonYes);
            ModalResult := mrYes;
        end;
    end;
    SetArrayLength(Result.ProcsToTerminate, GetArrayLength(uBrowserProcStringArray));
    Result.ProcsToTerminate := uBrowserProcStringArray;
end;

function TerminateManyApps(const AppProcArray: array of String): BOOL;
var
    bArray: array of BOOL;
    uArrayLen: Integer;
    i: Integer;
begin
    for i := 0 to GetArrayLength(AppProcArray)-1 do
    begin
        SetArrayLength(bArray, i+1);
        bArray[i] := TerminateApp(AppProcArray[i], 5000) = 1;
    end;
    Result := bArray[0];
    uArrayLen := GetArrayLength(bArray);
    if uArrayLen > 1 then for i := 1 to uArrayLen-1 do Result := Result and bArray[i];
end;

function NextButtonClick(CurPageID: Integer): Boolean;
var
    uBROWSER_ERROR_STRUCT: BROWSER_ERROR_STRUCT;
begin
    if CurPageID = wpReady then
    begin
        uBROWSER_ERROR_STRUCT := CreateBrowserError(['Mozilla Firefox', 'Internet Explorer'], ['firefox.exe', 'iexplore.exe']);
        if uBROWSER_ERROR_STRUCT.ErrorForm <> nil then
        if uBROWSER_ERROR_STRUCT.ErrorForm.ShowModal = mrYes then
        Result := TerminateManyApps(uBROWSER_ERROR_STRUCT.ProcsToTerminate);
    end else Result := True;
end;

скрин:

читать дальше »

[Johny777]

Пацаны! Помогите пожалуйста скрыть (в лучшем случае заменить) системные тултипы (маленькие всплывающие подсказки "Закрыть", "Свернуть", "Развернуть").
Дело в том что я использую скин и мне удалось скрыть неактивную кнопку развернуть в правом верхнем углу формы таким образом:
1. Удаляем текстуру у кнопки свернуть и заменяем ею же кнопку развернуть- получаем 2 кнопки. Родную кнопку "Свернуть" делаем неактивной
2. При нажатии на кнопку свернуть(на самом деле развернуть) обнуляем сообщение wParam := 0 и посылаем форме сообщение свернуть.
3. Отлавливаем дополнительно двойной клик по заголовку окна и обнуляем, чтоб окно не развернулось на весь экран.
Всё это прекрасно работает, но но при наведении на новую кнопку свернуть всплывает подсказка от развернуть
вот здесь (Делфи) http://forum.vingrad.ru/forum/topic-...-system/0.html
нашёл решение, портировал, но не работает. Получилось только отловить наведение мыши на кнопки
всё выше описанное реализовано на default window proc ( http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx )
вот страница на МСДН о тултипах http://msdn.microsoft.com/en-us/libr...=VS.85%29.aspx
вот здесь есть простенький код на C++ http://www.codeproject.com/Articles/...-More-Tooltips
вот всё что удалось сделать:

читать дальше »

Код:

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

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

const
  WM_MOVE = $3;

  GWL_WNDPROC = -4;
  HTMAXBUTTON = 9;
  WM_NCHITTEST        = $0084;
  HTMINBUTTON = 8;
  WM_USER             = $0400;
  TTM_ACTIVATE            = WM_USER + 1;
  MAX_PATH = 260;
  WM_CLOSE = $10;
  HTCLOSE = 20;
  
type
  LPARAM = Integer;
  WPARAM = Integer;
  LRESULT = Integer;
  TFNWndProc = Integer;

var
  OldWindowProc: Longint;
  
function IsWindowVisible(hWnd: HWND): BOOL; external 'IsWindowVisible@user32.dll stdcall';
function GetClassName(hWnd: HWND; lpClassName: PChar; nMaxCount: Integer): Integer; external 'GetClassName{#A}@user32.dll stdcall';
function ShowWindow(hWnd: HWND; nCmdShow: Integer): BOOL; external 'ShowWindow@user32.dll stdcall';
function EnumWindows(lpEnumFunc, lParam: Longint): BOOL; external 'EnumWindows@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function GetTickCount: DWORD; external 'GetTickCount@kernel32.dll stdcall';
  
function HideSystemTooltip(Wnd: HWND; lPrm: Longint): BOOL;
var
  WndCl: String;
begin
  Result := True;
  if not IsWindowVisible(Wnd) then Exit;
  SetLength(WndCl, MAX_PATH+1);
  try
    GetClassName(Wnd, WndCl, MAX_PATH+1);
  finally
    SetLength(WndCl, 0);
  end;
end;

function EnumWindowsProc(hwnd: HWND; lParam: LPARAM): BOOL;
begin
  MsgBox('OK', mbError, MB_OK);
  SendMessage(hWnd, TTM_ACTIVATE, 0, 0);
end;



function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
  case wParam of
    HTCLOSE, HTMINBUTTON, HTMAXBUTTON: EnumWindows(CallbackAddr('EnumWindowsProc'), 0);
  end;
  Result := CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam);
end;

procedure InitializeWizard();
begin
  WizardForm.BorderIcons := [biSystemMenu, biMaximize];
  OldWindowProc := SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('WindowProc'));
end;

procedure DeinitializeSetup();
begin
  SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldWindowProc);
end;

Буду очень признателен за помощь!

[sergey3695]

Johny777, хм интересная идея. чето не получается. только если библу писануть. а как третий пункт сделал?

[Johny777]

sergey3695, вот тебе полный пример. Изучай!

читать дальше »

Код:

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

[Files]
Source: {fonts}\*; DestDir: {app}; Flags: external

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

const
  GWL_WNDPROC = -4;
  WM_SYSCOMMAND = $0112;
  SC_MINIMIZE = 61472;
  SC_MAXIMIZE = 61488;
  SC_SIZE = 61440;
  SC_MOVE = 61456;
  SC_RESTORE = 61728;
  WM_NCLBUTTONDBLCLK = $00A3;
  MF_BYCOMMAND = 0;
  WM_NCLBUTTONDOWN = $00A1;
  WM_NCRBUTTONDOWN = $00A4;
  WM_NCLBUTTONUP = $00A2;
  WM_NCHITTEST = $0084;
  HTCLOSE = 20;
  HTMAXBUTTON = 9;
  SC_CLOSE = 61536;
  
  WM_JOHNY = 7777;
  
type
  LPARAM = Integer;
  WPARAM = Integer;
  LRESULT = Integer;
  TFNWndProc = Integer;

var
  OldWindowProc: Longint;
  SysPopupMenu: TPopupMenu;
  
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function GetSystemMenu(hWnd: HWND; bRevert: BOOL): HMENU; external 'GetSystemMenu@user32.dll stdcall';
function DeleteMenu(hMenu: HMENU; uPosition, uFlags: UINT): BOOL; external 'DeleteMenu@user32.dll stdcall';
function DestroyMenu(hMenu: HMENU): BOOL; external 'DestroyMenu@user32.dll stdcall';
function GetCursorPos(var lpPoint: TPoint): BOOL; external 'GetCursorPos@user32.dll stdcall';
  
function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  pt: TPoint;
begin
  case Msg of
    WM_SYSCOMMAND:
    case wParam of
      SC_MAXIMIZE:
      begin
        wParam := 0;
        SendMessage(hWnd, WM_SYSCOMMAND, SC_MINIMIZE, 0);
      end;
    end;
    WM_NCLBUTTONDBLCLK: Msg := 0; // двойной клик по заголовку окна
    WM_NCRBUTTONDOWN:
    begin
      Msg := 0;
      if GetCursorPos(pt) then SysPopupMenu.Popup(pt.x, pt.y);
    end;
    WM_JOHNY: MsgBox('демо подмены кнопок от Johny777 :)', mbInformation, MB_OK);
//    WM_NCLBUTTONDOWN:
//    case wParam of
//      HTMAXBUTTON: Application.Minimize;
//    end;
  end;
  Result := CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam);
end;

procedure SysMenuOnClick(Sender: TObject);
begin
  case TMenuItem(Sender).Caption of
    'MINIMIZE': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
    'CLOSE': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_CLOSE, 0);
    'MOVE': SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_MOVE, 0);
  end;
end;

procedure InitializeWizard();
var
  hSYSMENU: HWND;
  mMinimize, mClose, mMove: TMenuItem;
begin
  WizardForm.BorderIcons := [biSystemMenu, biMaximize];
  OldWindowProc := SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('WindowProc'));
  SysPopupMenu := TPopupMenu.Create(WizardForm);
  with SysPopupMenu do
  begin
    mMinimize := TMenuItem.Create(WizardForm);
    with mMinimize do
    begin
      Caption := 'MINIMIZE';
      SysPopupMenu.Items.Add(mMinimize);
      OnClick := @SysMenuOnClick;
    end;
    mClose := TMenuItem.Create(WizardForm);
    with mClose do
    begin
      Caption := 'CLOSE';
      SysPopupMenu.Items.Add(mClose);
      OnClick := @SysMenuOnClick;
    end;
    mMove := TMenuItem.Create(WizardForm);
    with mMove do
    begin
      Caption := 'MOVE';
      SysPopupMenu.Items.Add(mMove);
      OnClick := @SysMenuOnClick;
    end;
  end;
//  hSYSMENU := GetSystemMenu(WizardForm.Handle, False);
//  DeleteMenu(hSYSMENU, SC_MINIMIZE, MF_BYCOMMAND);
//  DeleteMenu(hSYSMENU, SC_MAXIMIZE, MF_BYCOMMAND);
//  DeleteMenu(hSYSMENU, SC_SIZE, MF_BYCOMMAND);
//  DeleteMenu(hSYSMENU, SC_RESTORE, MF_BYCOMMAND);
end;

procedure CurPageChanged(CurPageID: Integer);
begin
  if CurPageID = wpWelcome then SendMessage(WizardForm.Handle, WM_JOHNY, 0, 0);
end;

procedure DeinitializeSetup();
begin
  SetWindowlong(WizardForm.Handle, GWL_WNDPROC, OldWindowProc);
end;

только если библу писануть »

это крайность. Думаю можно и без библиотек реализовать! Истина где-то рядом...

[by_gangster]

Всем привет, можно ли сделать инсталлятор который качает файлы из интернета в указаную папку? А сам истал весит не более 1мб, знаю что такие инсталы есть, но вот как их сделать я не знаю.

[LordSP]

by_gangster, Скачать