HLMetaModOfficial/cruft/installer/UnitInstall.pas

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.