Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Новый участник


Сообщения: 26
Благодарности: 4

Профиль | Отправить PM | Цитировать


Код скрипта:
Скрытый текст

Код: Выделить весь код
#define MyAppName "My Game"
#define MyAppVersion "1.0"
#define NOT_FOUND "notFound";

[Setup]
AppId={{ADF6076C-BDF7-4515-8D60-17F9DBAD5B41}
AppName={#MyAppName}
AppVersion={#MyAppVersion}
DefaultDirName={code:NoSD}\{#MyAppName}
DefaultGroupName={#MyAppName}
AllowNoIcons=yes
OutputBaseFilename=MyGameSetup
Compression=none
SolidCompression=yes
DiskSpanning=yes
SlicesPerDisk=1
DiskSliceSize=2100000000
DiskClusterSize=4096
DisableProgramGroupPage=yes
SetupLogging=yes
DirExistsWarning=no

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

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked


[Files]
Source: "D:\MyGame\*"; DestDir: "{app}"; Flags: ignoreversion

[Dirs]
Name: "{app}\saves"

[Code;]
function GetLogicalDrives: DWORD; external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(lpRootPathName: PAnsiChar): Cardinal; external 'GetDriveTypeA@kernel32.dll stdcall';

const
  DRIVE_FIXED = 3;
  TH32CS_SNAPPROCESS = $2;
  INVALID_HANDLE_VALUE = -1;

var ChooseVersionPage: TInputOptionWizardPage;

function NoSD(s: string): string;
var
  x, bit, i: Integer;
  tp: Cardinal;
  sd: string;
begin
  sd:= ExpandConstant('{sd}');
  Result:= sd;
  x:= GetLogicalDrives;
  if x <> 0 then
  for i:= 1 to 64 do
    begin
      bit:= x and 1;
      if bit = 1 then
        begin
          tp:= GetDriveType(PAnsiChar(Chr(64 + i) + ':'));
          if tp = DRIVE_FIXED then
          if Chr(64 + i) <> Copy(sd, 1, 1) then
            begin
              Result:= Chr(64 + i) + ':';
              Break;
            end;
        end;
      x:= x shr 1;
    end;
end;

function doubleSlash(Param: string): string;
var
    sd: string;
    i: byte;
begin
  sd := Param;
  i := 1;

  while i < length(sd) + 1 do begin
    if sd[i] = '\' then begin
      insert('\', sd, i);
      i := i + 2;
    end
    else begin
     i := i + 1;
    end;
  end;

  Result := sd;
end;

function IsStringCyrillic(Str: String): Boolean;
var
    objRegExp: Variant;
begin
    try
        objRegExp := CreateOleObject('VBScript.RegExp');
    except
        ShowExceptionMessage;
    end;

    if objRegExp.Test(Str) then
    begin
        objRegExp.Pattern := '[\u0400-\u04FF,\u0500-\u052F,\u2DE0-\u2DFF,\uA640-\uA69F]';
        Result := objRegExp.Execute(Str).Count = 1;
    end;
end;

function IsProcessRunning(FileName: String): Boolean;
var
  objSWbemLocator, objSWbemServices: Variant;
begin
  try
    objSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  except
    ShowExceptionMessage;
    Exit;
  end;
  objSWbemServices := objSWbemLocator.ConnectServer();
  objSWbemServices.Security_.ImpersonationLevel := 3;
  Result := (objSWbemServices.ExecQuery('SELECT * FROM Win32_Process WHERE Name="' + FileName + '"').Count > 0);
end;

procedure closeSteam(isUninstall: boolean);
var
i: integer;
str: string;
begin
  if isUninstall then
    str := 'удаления'
  else
    str := 'установки';

  MsgBox('Steam.exe запущен. Перед началом ' + str + ' процесс должен быть завершен.' #13#13 'Закройте его самостоятельно, либо процесс будет завершен принудительно.', mbInformation, MB_OK)
  Exec(ExpandConstant('{sys}\taskkill.exe'), ' /F /IM Steam.exe', '', SW_HIDE, ewWaitUntilTerminated, i);
end;

function GetSystemMetrics (nIndex: Integer): Integer; external 'GetSystemMetrics@User32.dll stdcall setuponly';

Const
  SM_CXSCREEN = 0;
  SM_CYSCREEN = 1;

function getScreenSize(Param: string): string;
begin
  if Param = 'w' then
    begin
      try
        Result := IntToStr(GetSystemMetrics(SM_CXSCREEN));
      except
        Result := '640';
      end
    end
  else 
    begin
      try
        Result := IntToStr(GetSystemMetrics(SM_CYSCREEN));
      except
        Result := '480';
      end
    end
end;

function IsIncludeToInstall(GameType: integer): Boolean;
begin
  Result := (GameType = ChooseVersionPage.SelectedValueIndex)
end;

function GetGamePathFromRegistry(): String;
begin
  Result := ExpandConstant('{reg:HKLM\SOFTWARE\WOW6432Node\Bethesda Softworks\Oblivion,Installed Path|{#NOT_FOUND}}');

  if Result = '{#NOT_FOUND}' then
    Result := ExpandConstant('{reg:HKLM\SOFTWARE\Bethesda Softworks\Oblivion,Installed Path|{#NOT_FOUND}}')
end;

procedure InitializeWizard;
begin
  ChooseVersionPage := CreateInputOptionPage(wpWelcome,
    'Выбор версии игры', 'Какая версия игры берется за основу?', '',
    True, False);
  ChooseVersionPage.Add('1С');
  ChooseVersionPage.Add('Steam');
  ChooseVersionPage.Add('GOG');

  ChooseVersionPage.SelectedValueIndex := 0;
end;

procedure RegisterPreviousData(PreviousDataKey: Integer);
var
  GameType: String;
begin
  case ChooseVersionPage.SelectedValueIndex of
    0: GameType := '1C';
    1: GameType := 'Steam';
    2: GameType := 'GOG';
  end;
  SetPreviousData(PreviousDataKey, 'GameType', GameType);
end;

function NextButtonClick(CurPageID: Integer): Boolean;
var installPath: string;
begin
  Result := True;

  if CurPageID = ChooseVersionPage.ID then begin
    if (ChooseVersionPage.SelectedValueIndex = 1)
    and (ExpandConstant('{reg:HKLM\SOFTWARE\WOW6432Node\Valve\Steam,InstallPath|{#NOT_FOUND}}') = '{#NOT_FOUND}')
    and (ExpandConstant('{reg:HKLM\SOFTWARE\Valve\Steam,InstallPath|{#NOT_FOUND}}') = '{#NOT_FOUND}') then
      Result := MsgBox('Steam.exe не найден' #13#13 'Все равно продолжить?', mbError, MB_YESNO) = idYes
  end

  if CurPageID = wpSelectDir then
    if (IsStringCyrillic(WizardForm.DirEdit.Text)) then
    begin
      MsgBox('В пути установки присуствуют русские символы'+#13#10+'Пожалуйста, повторите ввод.', mbError, mb_Ok);
      Result := False;
    end
    else begin
      installPath := GetGamePathFromRegistry();
      log(installPath)  ;
      if (installPath <> '{#NOT_FOUND}') and (installPath <> WizardDirValue) then
        MsgBox('Указанный путь установки отличается от пути, приписанного для игры в реестре.' #13#13 'Корректная работа ' + '{#MyAppName}' + ' не гарантируется.', mbConfirmation, mb_Ok);
    end

  if CurPageID = wpSelectComponents then
    MsgBox('WizardDirValue: ' + WizardDirValue +#13#10+'App: ' + ExpandConstant('{app}'), mbError, mb_Ok);
end;

procedure CurPageChanged(CurPageID: Integer);
var sd: string;
    //isPathFound: boolean;
begin   
 if CurPageId = wpSelectDir then
  sd := GetGamePathFromRegistry();

  if sd = '{#NOT_FOUND}' then begin
    sd := NoSD('') + '\{#MyAppName}';
    MsgBox('Запись об установленной игре отсутствует в реестре Windows.' #13#13 'Возможно, игра была установлена, но ее запуск не был произведен, либо игра установлена некорректно.' #13#13 'Корректная работа ' + '{#MyAppName}' + ' не гарантируется.', mbInformation, MB_OK);
  end

  WizardForm.DirEdit.Text := sd;
end;

procedure CurStepChanged(CurStep: TSetupStep);
begin
  if (CurStep = ssInstall) and (ChooseVersionPage.SelectedValueIndex = 1) and IsProcessRunning('Steam.exe') then
    closeSteam(false)
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
  Value: String;
begin
log(GetPreviousData('GameType', ''));
  if (CurUninstallStep = usUninstall)
  and (GetPreviousData('GameType', '') = 'Steam')
  and IsProcessRunning('Steam.exe') then
    closeSteam(true)
end;

Директивы Files, Components и т.д. удалил, чтобы не захлмлять. К проблеме отношения все равно не имеют.

Последний раз редактировалось EdMSL, 23-10-2022 в 09:03.


Отправлено: 08:53, 23-10-2022 | #847