1
0
mirror of https://github.com/alliedmodders/metamod-source.git synced 2024-12-10 22:24:12 +01:00
HLMetaModOfficial/cruft/installer/UnitInstall.pas
David Anderson 20552a8939 More re-arranging. Not what we discussed in IRC but I think it works out better, Make can't deal with upward dependencies nicely.
--HG--
rename : installer/Attach.cfg => cruft/installer/Attach.cfg
rename : installer/Attach.dpr => cruft/installer/Attach.dpr
rename : installer/Attach.exe => cruft/installer/Attach.exe
rename : installer/HL2Launch.cfg => cruft/installer/HL2Launch.cfg
rename : installer/HL2Launch.dpr => cruft/installer/HL2Launch.dpr
rename : installer/HL2Launch.exe => cruft/installer/HL2Launch.exe
rename : installer/MMS_Installer.cfg => cruft/installer/MMS_Installer.cfg
rename : installer/MMS_Installer.dpr => cruft/installer/MMS_Installer.dpr
rename : installer/MMS_Installer.exe => cruft/installer/MMS_Installer.exe
rename : installer/MMS_Installer.res => cruft/installer/MMS_Installer.res
rename : installer/UnitFunctions.pas => cruft/installer/UnitFunctions.pas
rename : installer/UnitInstall.pas => cruft/installer/UnitInstall.pas
rename : installer/UnitPackSystem.pas => cruft/installer/UnitPackSystem.pas
rename : installer/UnitSelectModPath.dfm => cruft/installer/UnitSelectModPath.dfm
rename : installer/UnitSelectModPath.pas => cruft/installer/UnitSelectModPath.pas
rename : installer/UnitfrmMain.dfm => cruft/installer/UnitfrmMain.dfm
rename : installer/UnitfrmMain.pas => cruft/installer/UnitfrmMain.pas
rename : installer/UnitfrmProxy.dfm => cruft/installer/UnitfrmProxy.dfm
rename : installer/UnitfrmProxy.pas => cruft/installer/UnitfrmProxy.pas
rename : installer/del.bat => cruft/installer/del.bat
rename : installer/files/Readme.txt => cruft/installer/files/Readme.txt
rename : installer/install.bmp => cruft/installer/install.bmp
rename : installer/upx.exe => cruft/installer/upx.exe
2008-11-14 04:14:35 -06:00

561 lines
17 KiB
ObjectPascal

unit UnitInstall;
interface
uses SysUtils, Classes, Windows, Graphics, Forms, ShellAPI, Controls, Messages,
TlHelp32, IdFTPCommon, ComCtrls;
type TOS = (osWindows, osLinux);
procedure AddStatus(Text: String; Color: TColor; ShowTime: Boolean = True);
procedure AddDone(Additional: String = '');
procedure AddSkipped;
procedure AddNotFound;
procedure DownloadFile(eFile: String; eDestination: String);
procedure BasicInstallation(ePath: String; SteamInstall, ListenInstall: Boolean; OS: TOS; const Source: Boolean);
procedure InstallDedicated(eModPath: String; const UseSteam, Source: Boolean);
procedure InstallListen(ePath: String; const Source: Boolean);
procedure InstallCustom(ePath: String; eOS: TOS; const Source: Boolean);
procedure InstallFTP(OS: TOS; const Source: Boolean);
var StartTime: TDateTime;
SteamPath: String;
StandaloneServer: String;
Cancel: Boolean = False;
implementation
uses UnitfrmMain, UnitfrmProxy, UnitFunctions, UnitPackSystem;
// useful stuff
function InstallTime: String;
begin
Result := Copy(FormatDateTime('HH:MM:SS', Now - StartTime), 4, 5);
end;
procedure AddStatus(Text: String; Color: TColor; ShowTime: Boolean = True);
begin
frmMain.rtfDetails.SelStart := Length(frmMain.rtfDetails.Text);
if ShowTime then begin
frmMain.rtfDetails.SelAttributes.Color := clBlack;
if frmMain.rtfDetails.Text = '' then
frmMain.rtfDetails.SelText := '[' + InstallTime + '] '
else
frmMain.rtfDetails.SelText := #13#10 + '[' + InstallTime + '] ';
frmMain.rtfDetails.SelStart := Length(frmMain.rtfDetails.Text);
end
else
frmMain.rtfDetails.SelText := #13#10;
frmMain.rtfDetails.SelStart := Length(frmMain.rtfDetails.Text);
frmMain.rtfDetails.SelAttributes.Color := Color;
frmMain.rtfDetails.SelText := Text;
frmMain.rtfDetails.Perform(WM_VSCROLL, SB_BOTTOM, 0);
frmMain.Repaint;
Application.ProcessMessages;
end;
procedure AddDone(Additional: String = '');
begin
frmMain.rtfDetails.SelStart := Length(frmMain.rtfDetails.Text);
frmMain.rtfDetails.SelAttributes.Color := clGreen;
if Additional = '' then
frmMain.rtfDetails.SelText := ' Done.'
else
frmMain.rtfDetails.SelText := ' Done, ' + Additional + '.';
frmMain.rtfDetails.Perform(WM_VSCROLL, SB_BOTTOM, 0);
frmMain.Repaint;
Application.ProcessMessages;
end;
procedure AddSkipped;
begin
frmMain.rtfDetails.SelStart := Length(frmMain.rtfDetails.Text);
frmMain.rtfDetails.SelAttributes.Color := $004080FF; // orange
frmMain.rtfDetails.SelText := ' Skipped.';
frmMain.rtfDetails.Perform(WM_VSCROLL, SB_BOTTOM, 0);
frmMain.Repaint;
Application.ProcessMessages;
end;
procedure AddNotFound;
begin
frmMain.rtfDetails.SelStart := Length(frmMain.rtfDetails.Text);
frmMain.rtfDetails.SelAttributes.Color := clRed;
frmMain.rtfDetails.SelText := ' Not found.';
frmMain.rtfDetails.Perform(WM_VSCROLL, SB_BOTTOM, 0);
frmMain.Repaint;
Application.ProcessMessages;
end;
procedure FileCopy(Source, Destination: String; CopyConfig: Boolean; AddStatus: Boolean = True);
begin
if (not CopyConfig) and (Pos('config', Source) <> 0) then begin
if AddStatus then
AddSkipped;
exit;
end;
if not FileExists(Source) then begin
if AddStatus then
AddNotFound;
exit;
end;
try
if FileExists(Destination) then
DeleteFile(PChar(Destination));
CopyFile(PChar(Source), PChar(Destination), False);
except
Application.ProcessMessages;
end;
if AddStatus then
AddDone;
end;
procedure DownloadFile(eFile: String; eDestination: String);
var TransferType: TIdFTPTransferType;
begin
// There's only one file to download and it's ASCII :]
TransferType := ftASCII;
if frmMain.IdFTP.TransferType <> TransferType then
frmMain.IdFTP.TransferType := TransferType;
// download the file
frmMain.IdFTP.Get(eFile, eDestination, True);
end;
procedure UploadFile(eFile: String; eDestination: String; CopyConfig: Boolean = True);
var TransferType: TIdFTPTransferType;
begin
if (Pos('config', eFile) > 0) and (not CopyConfig) then begin
AddSkipped;
exit;
end;
eDestination := StringReplace(eDestination, '\', '/', [rfReplaceAll]);
// the same as in DownloadFile()
TransferType := ftBinary;
if ExtractFileExt(LowerCase(eFile)) = '.txt' then TransferType := ftASCII;
if frmMain.IdFTP.TransferType <> TransferType then
frmMain.IdFTP.TransferType := TransferType;
// upload the file
frmMain.IdFTP.Put(eFile, eDestination);
AddDone;
end;
procedure FTPMakeDir(eDir: String);
begin
eDir := StringReplace(eDir, '\', '/', [rfReplaceAll]);
try
frmMain.IdFTP.MakeDir(eDir);
except
Application.ProcessMessages;
end;
end;
function FSize(eFile: String): Cardinal;
var eRec: TSearchRec;
begin
if FindFirst(eFile, faAnyFile, eRec) = 0 then
Result := eRec.Size
else
Result := 0;
end;
// stuff for killing processes
function GetProcessID(sProcName: String): Integer;
var
hProcSnap: THandle;
pe32: TProcessEntry32;
begin
result := -1;
hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
if hProcSnap = INVALID_HANDLE_VALUE then
exit;
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(hProcSnap, pe32) = true then begin
while Process32Next(hProcSnap, pe32) = true do begin
if pos(sProcName, pe32.szExeFile) <> 0then
result := pe32.th32ProcessID;
end;
end;
CloseHandle(hProcSnap);
end;
procedure KillProcess(dwProcID: DWORD);
var
hProcess : Cardinal;
dw : DWORD;
begin
hProcess := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, dwProcID);
TerminateProcess(hProcess, 0);
dw := WaitForSingleObject(hProcess, 5000);
case dw of
WAIT_TIMEOUT: begin
CloseHandle(hProcess);
exit;
end;
WAIT_FAILED: begin
RaiseLastOSError;
CloseHandle(hProcess);
exit;
end;
end;
CloseHandle(hProcess);
end;
// Installation here
{ Basic Installation }
procedure BasicInstallation(ePath: String; SteamInstall, ListenInstall: Boolean; OS: TOS; const Source: Boolean);
var eStr: TStringList;
i: integer;
CopyConfig: Boolean;
eFound: Boolean;
begin
frmMain.ggeAll.MaxValue := 8;
frmMain.ggeAll.Progress := 0;
frmMain.ggeItem.MaxValue := 1;
frmMain.ggeItem.Progress := 0;
{if (GetProcessID('Steam.exe') <> -1) and (SteamInstall) then begin
if MessageBox(frmMain.Handle, 'Steam is still running. It is necersarry to shut it down before you install Metamod:Source. Shut it down now?', PChar(frmMain.Caption), MB_ICONQUESTION + MB_YESNO) = mrYes then begin
AddStatus('Shutting down Steam...', clBlack, False);
if GetProcessID('Steam.exe') = -1 then
AddDone
else
KillProcess(GetProcessID('Steam.exe'));
while GetProcessID('Steam.exe') <> -1 do begin // sure is sure...
Sleep(50);
Application.ProcessMessages;
end;
AddDone;
end
else begin
Application.Terminate;
exit;
end;
end;}
frmMain.ggeAll.Progress := 1;
frmMain.ggeItem.Progress := 1;
{ Unpack }
frmMain.ggeItem.Progress := 0;
AddStatus('Unpacking files...', clBlack);
if not Unpack(Source) then begin
AddStatus('No files attached!', clRed);
Screen.Cursor := crDefault;
exit;
end;
AddDone;
frmMain.ggeAll.Progress := 2;
frmMain.ggeItem.Progress := 1;
{ Check for installation / Create directories }
CopyConfig := True;
AddStatus('Creating directories...', clBlack);
if DirectoryExists(ePath + 'addons\metamod\bin') then begin
case MessageBox(frmMain.Handle, 'A Metamod:Source installation was already detected. If you choose to reinstall, your configuration files will be erased. Click Yes to continue, No to Upgrade, or Cancel to abort the install.', PChar(frmMain.Caption), MB_ICONQUESTION + MB_YESNOCANCEL) of
mrNo: CopyConfig := False;
mrCancel: begin
Application.Terminate;
exit;
end;
end;
AddSkipped;
end
else begin
frmMain.ggeItem.Progress := 0;
ForceDirectories(ePath + 'addons\metamod\bin');
AddDone;
end;
frmMain.ggeItem.Progress := 1;
frmMain.ggeAll.Progress := 3;
{ gameinfo.txt }
if not FileExists(ePath + 'gameinfo.txt') then begin
if MessageBox(frmMain.Handle, 'The file "gameinfo.txt" couldn''t be found. Continue installation?', PChar(frmMain.Caption), MB_ICONQUESTION + MB_YESNO) = mrNo then begin
AddStatus('Installation canceled by user!', clRed, False);
Screen.Cursor := crDefault;
Cancel := True;
exit;
end;
end
else begin
eStr := TStringList.Create;
{ Metaplugins.ini }
frmMain.ggeItem.Progress := 0;
AddStatus('Creating metaplugins.ini...', clBlack);
if CopyConfig then begin
eStr.SaveToFile(ePath + 'addons\metamod\metaplugins.ini');
AddDone;
end
else
AddSkipped;
frmMain.ggeItem.Progress := 1;
frmMain.ggeAll.Progress := 4;
{ Gameinfo.txt }
frmMain.ggeItem.Progress := 0;
eFound := False;
AddStatus('Editing gameinfo.txt...', clBlack);
eStr.LoadFromFile(ePath + 'gameinfo.txt');
for i := 0 to eStr.Count -1 do begin
if Trim(LowerCase(eStr[i])) = 'gamebin |gameinfo_path|addons/metamod/bin' then begin
eFound := True;
break;
end;
end;
if not eFound then begin
for i := 0 to eStr.Count -1 do begin
if Trim(eStr[i]) = 'SearchPaths' then begin
eStr.Insert(i +2, ' GameBin |gameinfo_path|addons/metamod/bin');
break;
end;
end;
SetFileAttributes(PChar(ePath + 'gameinfo.txt'), 0);
eStr.SaveToFile(ePath + 'gameinfo.txt');
SetFileAttributes(PChar(ePath + 'gameinfo.txt'), faReadOnly); // important for listen servers
AddDone;
end
else
AddSkipped;
eStr.Free;
frmMain.ggeItem.Progress := 1;
frmMain.ggeAll.Progress := 5;
end;
{ Copy files }
frmMain.ggeItem.Progress := 0;
AddStatus('Copying server.dll...', clBlack);
CopyFile(PChar(ExtractFilePath(ParamStr(0)) + 'server.dll'), PChar(ePath + 'addons\metamod\bin\server.dll'), False);
AddDone;
frmMain.ggeItem.Progress := 1;
frmMain.ggeAll.Progress := 6;
if ListenInstall then begin
ePath := ExtractFilePath(Copy(ePath, 1, Length(ePath)-1));
AddStatus('Copying hl2launch.exe...', clBlack);
CopyFile(PChar(ExtractFilePath(ParamStr(0)) + 'hl2launch.exe'), PChar(ePath + 'hl2launch.exe'), False);
AddDone;
end;
{ Remove files }
frmMain.ggeItem.Progress := 0;
AddStatus('Removing temporary files...', clBlack);
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'hl2launch.exe'));
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'server.dll'));
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'server_i486.so'));
AddDone;
frmMain.ggeItem.Progress := 1;
frmMain.ggeAll.Progress := 8;
{ Finish }
AddStatus('', clBlack, False);
AddStatus('Finished installation!', clBlack, False);
frmMain.cmdNext.Enabled := True;
frmMain.cmdCancel.Hide;
Screen.Cursor := crDefault;
if ListenInstall then
MessageBox(frmMain.Handle, PChar('The Source launcher "hl2launch.exe" has been copied to ' + ePath + '. You can use it to start your game with Metamod:Source enabled.'), PChar(Application.Title), MB_ICONINFORMATION);
end;
{ Dedicated Server }
procedure InstallDedicated(eModPath: String; const UseSteam, Source: Boolean);
begin
StartTime := Now;
Screen.Cursor := crHourGlass;
AddStatus('Starting Metamod:Source installation on dedicated server...', clBlack, False);
BasicInstallation(eModPath, UseSteam, False, osWindows, Source);
end;
{ Listen Server }
procedure InstallListen(ePath: String; const Source: Boolean);
begin
StartTime := Now;
Screen.Cursor := crHourGlass;
AddStatus('Starting Metamod:Source installation on the listen server...', clBlack);
BasicInstallation(ePath, True, True, osWindows, Source);
end;
{ Custom mod }
procedure InstallCustom(ePath: String; eOS: TOS; const Source: Boolean);
begin
StartTime := Now;
Screen.Cursor := crHourGlass;
AddStatus('Starting Metamod:Source installation...', clBlack);
BasicInstallation(ePath, False, False, eOS, Source);
end;
{ FTP }
procedure InstallFTP(OS: TOS; const Source: Boolean);
function DoReconnect: Boolean;
begin
Result := False;
if MessageBox(frmMain.Handle, 'You have been disconnected due to an error. Try to reconnect?', PChar(Application.Title), MB_ICONQUESTION + MB_YESNO) = mrYes then begin
try
frmMain.IdFTP.Connect;
Result := True;
except
MessageBox(frmMain.Handle, 'Failed to reconnect. Installation aborted.', PChar(Application.Title), MB_ICONSTOP);
end;
end;
end;
label CreateAgain;
label UploadAgain;
var eStr: TStringList;
i: integer;
CopyConfig, eFound: Boolean;
begin
frmMain.cmdCancel.Show;
frmMain.cmdNext.Hide;
Screen.Cursor := crHourGlass;
frmMain.ggeAll.MaxValue := 6;
frmMain.ggeAll.Progress := 0;
frmMain.ggeItem.MaxValue := 1;
frmMain.ggeItem.Progress := 0;
{ Unpack }
frmMain.ggeItem.Progress := 0;
AddStatus('Unpacking files...', clBlack);
if not Unpack(Source) then begin
AddStatus('No files attached!', clRed);
Screen.Cursor := crDefault;
exit;
end;
AddDone;
frmMain.ggeAll.Progress := 2;
frmMain.ggeItem.Progress := 1;
{ Check for installation }
AddStatus('Editing gameinfo.txt...', clBlack);
eStr := TStringList.Create;
DownloadFile('gameinfo.txt', ExtractFilePath(ParamStr(0)) + 'gameinfo.txt');
eStr.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'gameinfo.txt');
CopyConfig := True;
eFound := False;
for i := 0 to eStr.Count -1 do begin
if Trim(LowerCase(eStr[i])) = 'gamebin |gameinfo_path|addons/metamod/bin' then begin
eFound := True;
case MessageBox(frmMain.Handle, 'A Metamod:Source installation was already detected. If you choose to reinstall, your configuration files will be erased. Click Yes to continue, No to Upgrade, or Cancel to abort the install.', PChar(frmMain.Caption), MB_ICONQUESTION + MB_YESNOCANCEL) of
mrNo: CopyConfig := False;
mrCancel: begin
Application.Terminate;
eStr.Free;
exit;
end;
end;
break;
end;
end;
if not eFound then begin
for i := 0 to eStr.Count -1 do begin
if Trim(eStr[i]) = 'SearchPaths' then begin
eStr.Insert(i +2, ' GameBin |gameinfo_path|addons/metamod/bin');
AddDone;
break;
end;
end;
eStr.SaveToFile(ExtractFilePath(ParamStr(0)) + 'gameinfo.txt');
UploadFile(ExtractFilePath(ParamStr(0)) + 'gameinfo.txt', 'gameinfo.txt');
try
AddStatus('Trying to set gameinfo.txt to read-only...', clBlack);
frmMain.IdFTP.Site('CHMOD 744 gameinfo.txt');
AddDone;
except
AddStatus('Warning: CHMOD not supported.', clMaroon);
end;
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'gameinfo.txt'));
end
else
AddSkipped;
frmMain.ggeAll.Progress := 3;
frmMain.ggeItem.Progress := 1;
{ Create directories }
frmMain.ggeItem.Progress := 0;
frmMain.ggeItem.MaxValue := 3;
AddStatus('Creating directories...', clBlack);
if not eFound then begin
FTPMakeDir('addons');
frmMain.IdFTP.ChangeDir('addons');
frmMain.ggeItem.Progress := 1;
FTPMakeDir('metamod');
frmMain.IdFTP.ChangeDir('metamod');
frmMain.ggeItem.Progress := 2;
FTPMakeDir('bin');
frmMain.ggeItem.Progress := 3;
AddDone;
end
else
AddSkipped;
frmMain.ggeAll.Progress := 4;
frmMain.ggeItem.Progress := 3;
{ Upload metaplugins.ini }
frmMain.ggeAll.Progress := 4;
frmMain.ggeItem.MaxValue := 1;
frmMain.ggeItem.Progress := 0;
AddStatus('Uploading metaplugins.ini...', clBlack);
if CopyConfig then begin
eStr.Clear;
eStr.SaveToFile(ExtractFilePath(ParamStr(0)) + 'metaplugins.ini');
UploadFile(ExtractFilePath(ParamStr(0)) + 'metaplugins.ini', 'metaplugins.ini');
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'metaplugins.ini'));
end
else
AddSkipped;
frmMain.ggeAll.Progress := 5;
frmMain.ggeItem.Progress := 1;
{ Upload server.dll / server_i486.so }
frmMain.tmrSpeed.Enabled := True;
frmMain.ggeItem.Progress := 0;
frmMain.IdFTP.ChangeDir('bin');
if OS = osWindows then begin
AddStatus('Uploading server.dll...', clBlack);
frmMain.ggeItem.MaxValue := FSize(ExtractFilePath(ParamStr(0)) + 'server.dll');
UploadFile(ExtractFilePath(ParamStr(0)) + 'server.dll', 'server.dll');
end
else begin
AddStatus('Uploading server_i486.so...', clBlack);
frmMain.ggeItem.MaxValue := FSize(ExtractFilePath(ParamStr(0)) + 'server_i486.so');
UploadFile(ExtractFilePath(ParamStr(0)) + 'server_i486.so', 'server_i486.so');
end;
{ Remove created files }
AddStatus('Removing temporary files...', clBlack);
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'hl2launch.exe'));
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'server.dll'));
DeleteFile(PChar(ExtractFilePath(ParamStr(0)) + 'server_i486.so'));
AddDone;
{ End }
frmMain.IdFTP.Disconnect;
frmMain.ggeAll.Progress := frmMain.ggeAll.MaxValue;
frmMain.ggeItem.Progress := frmMain.ggeItem.MaxValue;
AddStatus('', clBlack, False);
AddStatus('Finished installation!', clBlack, False);
frmMain.tmrSpeed.Enabled := False;
eStr.Free;
Screen.Cursor := crDefault;
frmMain.cmdNext.Enabled := True;
frmMain.cmdCancel.Hide;
frmMain.cmdNext.Show;
frmMain.tmrSpeed.Enabled := False;
frmMain.Caption := Application.Title;
end;
end.