Новый участник
Сообщения: 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 и т.д. удалил, чтобы не захлмлять. К проблеме отношения все равно не имеют.
|