Small design changes

Added multi-account support to the local install functions (experimental!)

installer/installer/UnitFunctions.pas

@@ -2,11 +2,13 @@ unit UnitFunctions;
 
 interface
 
-uses SysUtils, Classes, Windows, IdFTPList, Math;
+uses SysUtils, Classes, Windows, IdFTPList, Math, Registry;
 
 function CalcSpeed(eOld, eNew: Integer): String;
 // local
 function GetAllFiles(Mask: String; Attr: Integer; Recursive: Boolean; ShowDirs: Boolean; ShowPath: Boolean = True): TStringList;
+function GetSteamAppsDir: String;
+function GetSteamAccounts: TStringList;
 // ftp
 function GetAllDirs: TStringList;
 
@@ -30,8 +32,7 @@ begin
   Result := TStringList.Create;
 
   // Find all files
-  if FindFirst(Mask, Attr, eSearch) = 0 then
+  if FindFirst(Mask, Attr, eSearch) = 0 then begin
-  begin
     repeat
       if eSearch.Name[1] <> '.' then begin
         if ShowPath then begin
@@ -58,6 +59,38 @@ begin
   end;
 end;
 
+function GetSteamAppsDir: String;
+var eRegistry: TRegistry;
+begin
+  eRegistry := TRegistry.Create(KEY_READ);
+  try
+    eRegistry.RootKey := HKEY_CURRENT_USER;
+    if eRegistry.OpenKey('Software\Valve\Steam', False) then
+      Result := ExtractFilePath(StringReplace(eRegistry.ReadString('SteamExe'), '/', '\', [rfReplaceAll])) + 'SteamApps\'
+    else
+      Result := '';
+  except
+    Result := '';
+  end;
+  eRegistry.Free;
+end;
+
+function GetSteamAccounts: TStringList;
+var eSearch: TSearchRec;
+    ePath: String;
+begin
+  Result := TStringList.Create;
+  ePath := GetSteamAppsDir;
+  if DirectoryExists(ePath) then begin
+    if FindFirst(ePath + '*.*', faDirectory, eSearch) = 0 then begin
+      repeat
+        if (Pos('@', eSearch.Name) <> 0) then
+          Result.Add(eSearch.Name)
+      until FindNext(eSearch) <> 0;
+    end;
+  end;
+end;
+
 function GetAllDirs: TStringList;
 var eList: TStringList;
     i: integer;
@@ -73,7 +106,7 @@ begin
   Result := eList;
 end;
 
-{ This is another possibility I coded because I couldn't find another bug...
+{ This is another possibility I wrote because I couldn't find another bug...
 
 function GetAllDirs: TStringList;
 var eList: TStringList;

installer/installer/UnitScanMods.pas

@@ -4,7 +4,7 @@ interface
 
 uses SysUtils, Classes, Dialogs;
 
-function GetAllMods(eBaseDir: String; eSearchNames: Boolean): String;
+function GetAllMods(eBaseDir: String; eSearchNames: Boolean): TStringList;
 function GetModPathName(eMod: String): String;
 function ModIndex(Name: String; CheckName: Boolean): Integer;
 
@@ -17,7 +17,7 @@ uses UnitFunctions;
 
 // functions
 
-function GetAllMods(eBaseDir: String; eSearchNames: Boolean): String;
+function GetAllMods(eBaseDir: String; eSearchNames: Boolean): TStringList;
 var i: integer;
     eDirectories: TStringList;
 begin
@@ -31,11 +31,10 @@ begin
       else
         eDirectories[i] := eMods[ModIndex(eDirectories[i], True)];
     end;
-    Result := eDirectories.Text;
+    Result := eDirectories;
   end
   else
-    Result := ''; 
+    Result := nil; 
-  eDirectories.Free;
 end;
 
 function GetModPathName(eMod: String): String;

installer/installer/UnitfrmMain.dfm

@@ -5760,12 +5760,72 @@ object frmMain: TfrmMain
       Top = 0
       Width = 527
       Height = 314
-      object lblInstallMethod: TLabel
+      object lblLocalHint: TLabel
-        Left = 124
+        Left = 136
-        Top = 104
+        Top = 118
-        Width = 223
+        Width = 243
+        Height = 11
+        Caption = 'Use this if your server has been installed on your own PC:'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -9
+        Font.Name = 'Tahoma'
+        Font.Style = []
+        ParentFont = False
+      end
+      object lblRemoteInstallation: TLabel
+        Left = 136
+        Top = 204
+        Width = 91
         Height = 13
-        Caption = 'Please select an install method for AMX Mod X:'
+        Caption = 'Remote installation'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'Tahoma'
+        Font.Style = [fsUnderline]
+        ParentFont = False
+      end
+      object lblRemoteHint: TLabel
+        Left = 136
+        Top = 218
+        Width = 257
+        Height = 11
+        Caption = 
+          'Use this if you rent a server or if you run it on another server' +
+          ':'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -9
+        Font.Name = 'Tahoma'
+        Font.Style = []
+        ParentFont = False
+      end
+      object lblLocalInstallation: TLabel
+        Left = 136
+        Top = 104
+        Width = 78
+        Height = 13
+        Caption = 'Local installation'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -11
+        Font.Name = 'Tahoma'
+        Font.Style = [fsUnderline]
+        ParentFont = False
+      end
+      object lblLocalHintItalic: TLabel
+        Left = 341
+        Top = 118
+        Width = 18
+        Height = 11
+        Caption = 'own'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -9
+        Font.Name = 'Tahoma'
+        Font.Style = [fsItalic]
+        ParentFont = False
       end
       object pnlHeader2: TPanel
         Left = 0
@@ -5838,87 +5898,30 @@ object frmMain: TfrmMain
           Shape = bsBottomLine
         end
       end
-      object pnlInstallMethod: TPanel
+      object pnlRemote: TPanel
-        Left = 122
+        Left = 136
-        Top = 120
+        Top = 230
-        Width = 267
+        Width = 255
-        Height = 153
+        Height = 23
         BevelOuter = bvLowered
         TabOrder = 1
-        object Label1: TLabel
+        object frbFTP: TFlatRadioButton
           Left = 4
-          Top = 16
+          Top = 4
-          Width = 243
+          Width = 35
-          Height = 11
+          Height = 17
-          Caption = 'Use this if your server has been installed on your own PC:'
+          Caption = 'FTP'
-          Font.Charset = DEFAULT_CHARSET
+          TabOrder = 0
-          Font.Color = clWindowText
+          OnClick = frbFTPClick
-          Font.Height = -9
-          Font.Name = 'Tahoma'
-          Font.Style = []
-          ParentFont = False
         end
-        object Label2: TLabel
-          Left = 209
-          Top = 16
-          Width = 18
-          Height = 11
-          Caption = 'own'
-          Font.Charset = DEFAULT_CHARSET
-          Font.Color = clWindowText
-          Font.Height = -9
-          Font.Name = 'Tahoma'
-          Font.Style = [fsItalic]
-          ParentFont = False
-        end
-        object Label3: TLabel
-          Left = 4
-          Top = 100
-          Width = 91
-          Height = 13
-          Caption = 'Remote installation'
-          Font.Charset = DEFAULT_CHARSET
-          Font.Color = clWindowText
-          Font.Height = -11
-          Font.Name = 'Tahoma'
-          Font.Style = [fsUnderline]
-          ParentFont = False
-        end
-        object Label4: TLabel
-          Left = 4
-          Top = 2
-          Width = 78
-          Height = 13
-          Caption = 'Local installation'
-          Font.Charset = DEFAULT_CHARSET
-          Font.Color = clWindowText
-          Font.Height = -11
-          Font.Name = 'Tahoma'
-          Font.Style = [fsUnderline]
-          ParentFont = False
-        end
-        object Label5: TLabel
-          Left = 4
-          Top = 114
-          Width = 257
-          Height = 11
-          Caption = 
-            'Use this if you rent a server or if you run it on another server' +
-            ':'
-          Font.Charset = DEFAULT_CHARSET
-          Font.Color = clWindowText
-          Font.Height = -9
-          Font.Name = 'Tahoma'
-          Font.Style = []
-          ParentFont = False
       end
       object pnlLocal: TPanel
-          Left = 4
+        Left = 136
-          Top = 28
+        Top = 130
-          Width = 259
+        Width = 255
         Height = 65
         BevelOuter = bvLowered
-          TabOrder = 0
+        TabOrder = 2
         object frbDedicatedServer: TFlatRadioButton
           Left = 4
           Top = 4
@@ -5958,24 +5961,6 @@ object frmMain: TfrmMain
           OnClick = frbLocalClick
         end
       end
-        object pnlRemote: TPanel
-          Left = 4
-          Top = 126
-          Width = 259
-          Height = 23
-          BevelOuter = bvLowered
-          TabOrder = 1
-          object frbFTP: TFlatRadioButton
-            Left = 4
-            Top = 4
-            Width = 35
-            Height = 17
-            Caption = 'FTP'
-            TabOrder = 0
-            OnClick = frbFTPClick
-          end
-        end
-      end
     end
     object jspSelectMod: TJvStandardPage
       Left = 0
@@ -5984,7 +5969,7 @@ object frmMain: TfrmMain
       Height = 314
       object lblInfo: TLabel
         Left = 134
-        Top = 114
+        Top = 110
         Width = 255
         Height = 26
         Caption = 
@@ -5992,6 +5977,29 @@ object frmMain: TfrmMain
           ' to install AMX Mod X to:'
         WordWrap = True
       end
+      object Shape1: TShape
+        Left = 134
+        Top = 140
+        Width = 255
+        Height = 119
+        Pen.Color = clBtnShadow
+      end
+      object Label1: TLabel
+        Left = 134
+        Top = 262
+        Width = 234
+        Height = 22
+        Caption = 
+          'Note: If your game isn'#39't listed here use the "Select mod directo' +
+          'ry" function in the "Select install method" page'
+        Font.Charset = DEFAULT_CHARSET
+        Font.Color = clWindowText
+        Font.Height = -9
+        Font.Name = 'Tahoma'
+        Font.Style = []
+        ParentFont = False
+        WordWrap = True
+      end
       object pnlSelectMod: TPanel
         Left = 0
         Top = 0
@@ -6063,19 +6071,19 @@ object frmMain: TfrmMain
           Shape = bsBottomLine
         end
       end
-      object lstMods: TmxFlatListBox
+      object trvMods: TTreeView
-        Left = 134
+        Left = 135
-        Top = 144
+        Top = 141
         Width = 253
-        Height = 97
+        Height = 117
-        ItemHeight = 13
+        BorderStyle = bsNone
+        Indent = 19
+        MultiSelectStyle = []
+        ReadOnly = True
+        RightClickSelect = True
+        RowSelect = True
         TabOrder = 1
-        OnClick = lstModsClick
+        OnClick = trvModsClick
-        Activate = True
-        BorderColor = clBtnShadow
-        Flat = True
-        ShowBorder = True
-        Version = '1.26'
       end
     end
     object jspFTP: TJvStandardPage

installer/installer/UnitfrmMain.pas

@@ -37,8 +37,6 @@ type
     imgIcon2: TImage;
     lblTitle2: TLabel;
     lblSubTitle2: TLabel;
-    lblInstallMethod: TLabel;
-    pnlInstallMethod: TPanel;
     cmdBack: TFlatButton;
     jspFTP: TJvStandardPage;
     pnlHeader3: TPanel;
@@ -83,7 +81,6 @@ type
     lblSelectModInfo: TLabel;
     bvlSelectMod: TBevel;
     lblInfo: TLabel;
-    lstMods: TmxFlatListBox;
     chkPassive: TFlatCheckBox;
     lblStep3: TLabel;
     pnlOS: TPanel;
@@ -98,18 +95,21 @@ type
     tmrSpeed: TTimer;
     IdLogFile: TIdLogFile;
     lblInfo4: TLabel;
-    Label1: TLabel;
+    trvMods: TTreeView;
-    Label2: TLabel;
+    lblRemoteInstallation: TLabel;
-    Label3: TLabel;
+    lblRemoteHint: TLabel;
-    Label4: TLabel;
+    pnlRemote: TPanel;
+    frbFTP: TFlatRadioButton;
+    lblLocalHint: TLabel;
+    lblLocalInstallation: TLabel;
+    lblLocalHintItalic: TLabel;
     pnlLocal: TPanel;
     frbDedicatedServer: TFlatRadioButton;
     frbListenServer: TFlatRadioButton;
     frbStandaloneServer: TFlatRadioButton;
     frbSelectMod: TFlatRadioButton;
-    Label5: TLabel;
+    Shape1: TShape;
-    pnlRemote: TPanel;
+    Label1: TLabel;
-    frbFTP: TFlatRadioButton;
     procedure jvwStepsCancelButtonClick(Sender: TObject);
     procedure cmdCancelClick(Sender: TObject);
     procedure cmdNextClick(Sender: TObject);
@@ -118,7 +118,6 @@ type
     procedure cmdConnectClick(Sender: TObject);
     procedure jplWizardChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
-    procedure lstModsClick(Sender: TObject);
     procedure cmdProxySettingsClick(Sender: TObject);
     procedure txtPortChange(Sender: TObject);
     procedure trvDirectoriesExpanded(Sender: TObject; Node: TTreeNode);
@@ -135,6 +134,7 @@ type
     procedure jspFTPShow(Sender: TObject);
     procedure frbFTPClick(Sender: TObject);
     procedure frbLocalClick(Sender: TObject);
+    procedure trvModsClick(Sender: TObject);
   private
     OldProgress: Integer;
     CurrProgress: Integer;
@@ -144,6 +144,7 @@ type
 
 var
   frmMain: TfrmMain;
+  gMultiAccount: Boolean;
 
 const VERSION = '1.72';
 
@@ -194,6 +195,7 @@ var ePath: String;
     eStr: TStringList;
     CurNode: TTreeNode;
     eOS: TOS;
+    i, k: integer;
 begin
   if jplWizard.ActivePage = jspFTP then begin
     if not IdFTP.Connected then
@@ -275,7 +277,9 @@ begin
     if (frbDedicatedServer.Checked) or (frbStandaloneServer.Checked) then begin
       jspInstallProgress.Show;
       ChosenMod := modNone;
-      ePath := LowerCase(GetModPathName(lstMods.Items[lstMods.ItemIndex]));
+      ePath := LowerCase(GetModPathName(trvMods.Selected.Text));
+      if gMultiAccount then
+        SteamPath := GetSteamAppsDir + trvMods.Selected.Parent.Text + '\dedicated server\'; // setting this path for a user with only one account is not neccessary
       // ask for additional mods...
       if (ePath = 'cstrike') or (ePath = 'czero') then begin
         if MessageBox(Handle, 'Install Counter-Strike addon?', PChar(Application.Title), MB_ICONQUESTION + MB_YESNO) = mrYes then
@@ -324,7 +328,9 @@ begin
     { Listen Server }
     if frbListenServer.Checked then begin
       ChosenMod := modNone;
-      ePath := lstMods.Items[lstMods.ItemIndex];
+      if gMultiAccount then
+        SteamPath := GetSteamAppsDir + trvMods.Selected.Parent.Text + '\'; // setting this path for a user with only one account is not neccessary
+      ePath := trvMods.Selected.Text;
       if DirectoryExists(SteamPath + ePath + '\' + GetModPathName(ePath)) then
         ePath := SteamPath + ePath + '\' + GetModPathName(ePath)
       else if DirectoryExists(SteamPath + 'half-life\' + ePath) then
@@ -377,57 +383,108 @@ begin
     jplWizard.NextPage
   else begin
     if frbDedicatedServer.Checked then begin    // Dedicated Server
-      eRegistry := TRegistry.Create(KEY_READ);
+      ePath := GetSteamAppsDir;
-      try
+      if ePath = '' then
-        eRegistry.RootKey := HKEY_CURRENT_USER;
+        MessageBox(Handle, 'You haven''t installed Steam yet! Download it at www.steampowered.com, install Dedicated Server and try again.', 'Error', MB_ICONWARNING)
-        if eRegistry.OpenKey('Software\Valve\Steam', False) then begin
+      else begin
-          ePath := eRegistry.ReadString('ModInstallPath');
+        trvMods.Items.Clear;
-          ePath := Copy(ePath, 1, Length(ePath) -10) + '\dedicated server\';
+
-          if DirectoryExists(ePath) then begin
+        with GetSteamAccounts do begin
-            SteamPath := ePath;
+          if Count = 1 then begin
-            lstMods.Clear;
+            gMultiAccount := False;
-            // Check Mods
+            SteamPath := ePath + Strings[0] + '\dedicated server\';
-            lstMods.Items.Text := GetAllMods(ePath, False);
+            
-            // Misc
+            eStr := GetAllMods(SteamPath, False);
+            for i := 0 to eStr.Count -1 do
+              trvMods.Items.Add(nil, eStr[i]);
+            eStr.Free;
+          end
+          else begin
+            gMultiAccount := True;
+            for i := 0 to Count -1 do begin
+              SteamPath := ePath + Strings[i] + '\dedicated server\';
+              if DirectoryExists(SteamPath) then begin
+                CurNode := trvMods.Items.Add(nil, Strings[i]);
+
+                eStr := GetAllMods(SteamPath, False);
+                for k := 0 to eStr.Count -1 do
+                  trvMods.Items.AddChild(CurNode, eStr[k]);
+                eStr.Free;
+
+                CurNode.Expand(False);
+              end;
+            end;
+          end;
+          
+          Free;
+        end;
+
+        if trvMods.Items.Count = 0 then
+          MessageBox(Handle, 'You haven''t used dedicated server yet. Please start it once before installing AMX Mod X.', 'Error', MB_ICONERROR)
+        else begin
           jspSelectMod.Show;
-            lstMods.ItemIndex := -1;
+          trvMods.Selected := nil;
           cmdNext.Enabled := False;
-          end
+        end;
-          else
-            MessageBox(Handle, 'You have to run Dedicated Server once before installing AMX Mod X!', 'Error', MB_ICONWARNING);
-        end
-        else
-          MessageBox(Handle, 'You haven''t installed Steam yet! Download it at www.steampowered.com, install Dedicated Server and try again.', 'Error', MB_ICONWARNING);
-      finally
-        eRegistry.Free;
       end;
     end
     else if frbListenServer.Checked then begin  // Listen Server
-      eRegistry := TRegistry.Create(KEY_READ);
+      ePath := GetSteamAppsDir;
-      try
+      if ePath = '' then
-        eRegistry.RootKey := HKEY_CURRENT_USER;
+        MessageBox(Handle, 'You haven''t installed Steam yet! Download it at www.steampowered.com, install Dedicated Server and try again.', 'Error', MB_ICONWARNING)
-        if eRegistry.OpenKey('Software\Valve\Steam', False) then begin
+      else begin
-          ePath := eRegistry.ReadString('ModInstallPath') + '\';
+        trvMods.Items.Clear;
-          lstMods.Clear;
+
-          ePath := Copy(ePath, 1, Length(ePath) -10);
+        with GetSteamAccounts do begin
-          if DirectoryExists(ePath) then begin
+          if Count = 1 then begin
-            SteamPath := ePath;
+            gMultiAccount := False;
-            // Check Mods         
+            SteamPath := ePath + Strings[0] + '\';
-            lstMods.Items.Text := GetAllMods(ePath, True);
+            eStr := GetAllMods(SteamPath, True);
-            if DirectoryExists(ePath + 'half-life') then
+            for i := 0 to eStr.Count -1 do
-              lstMods.Items.Text := lstMods.Items.Text + GetAllMods(ePath + 'half-life', False);
+              trvMods.Items.Add(nil, eStr[i]);
-            // Misc
+            eStr.Free;
+
+            if DirectoryExists(SteamPath + 'half-life') then begin
+              eStr := GetAllMods(SteamPath + 'half-life\', False);
+              for i := 0 to eStr.Count -1 do
+                trvMods.Items.Add(nil, eStr[i]);
+              eStr.Free;
+            end;
+          end
+          else begin
+            gMultiAccount := True;
+            for i := 0 to Count -1 do begin
+              SteamPath := ePath + Strings[i] + '\';
+              if DirectoryExists(SteamPath) then begin
+                CurNode := trvMods.Items.Add(nil, Strings[i]);
+
+                eStr := GetAllMods(SteamPath, False);
+                for k := 0 to eStr.Count -1 do
+                  trvMods.Items.AddChild(CurNode, eStr[k]);
+                eStr.Free;
+
+                CurNode.Expand(False);
+
+                if DirectoryExists(SteamPath + 'half-life') then begin
+                  eStr := GetAllMods(SteamPath + 'half-life', False);
+                  for k := 0 to eStr.Count -1 do
+                    trvMods.Items.AddChild(CurNode, eStr[k]);
+                  eStr.Free;
+                end;
+              end;
+            end;
+          end;
+          
+          Free;
+        end;
+
+        if trvMods.Items.Count = 0 then
+          MessageBox(Handle, 'You haven''t installed any Steam games yet. It is neccessary to do that if you want to install AMX Mod X on a listen server.', 'Error', MB_ICONERROR)
+        else begin
           jspSelectMod.Show;
-            lstMods.ItemIndex := -1;
+          trvMods.Selected := nil;
           cmdNext.Enabled := False;
-          end
+        end;
-          else
-            MessageBox(Handle, 'You haven''t installed Steam yet! Download it at www.steampowered.com, install Dedicated Server and try again.', 'Error', MB_ICONWARNING);
-        end
-        else
-          MessageBox(Handle, 'You haven''t installed Steam yet! Download it at www.steampowered.com, install Dedicated Server and try again.', 'Error', MB_ICONWARNING);
-      finally
-        eRegistry.Free;
       end;
     end
     else if frbStandaloneServer.Checked then begin // Standalone Server
@@ -436,11 +493,19 @@ begin
         eRegistry.RootKey := HKEY_CURRENT_USER;
         if eRegistry.OpenKey('Software\Valve\HLServer', False) then begin
           StandaloneServer := IncludeTrailingPathDelimiter(eRegistry.ReadString('InstallPath'));
-          lstMods.Items.Text := GetAllMods(StandaloneServer, False);
+          if DirectoryExists(StandaloneServer) then begin
+            with GetAllMods(StandaloneServer, False) do begin
+              gMultiAccount := False;
+              for i := 0 to Count -1 do
+                trvMods.Items.Add(nil, Strings[i]);
+            end;
             jspSelectMod.Show;
           end
           else
             MessageBox(Handle, 'You haven''t installed Half-Life Dedicated Server yet!',  'Error', MB_ICONWARNING);
+        end
+        else
+          MessageBox(Handle, 'You haven''t installed Half-Life Dedicated Server yet!',  'Error', MB_ICONWARNING);
       finally
         eRegistry.Free;
       end;
@@ -649,11 +714,6 @@ begin
   end;
 end;
 
-procedure TfrmMain.lstModsClick(Sender: TObject);
-begin
-  cmdNext.Enabled := lstMods.ItemIndex <> -1;
-end;
-
 procedure TfrmMain.cmdProxySettingsClick(Sender: TObject);
 begin
   frmProxy.ShowModal;
@@ -809,4 +869,12 @@ begin
   frbFTP.Checked := False;
 end;
 
+procedure TfrmMain.trvModsClick(Sender: TObject);
+begin
+  if gMultiAccount then
+    cmdNext.Enabled := (Assigned(trvMods.Selected)) and (Assigned(trvMods.Selected.Parent))
+  else
+    cmdNext.Enabled := (Assigned(trvMods.Selected));
+end;
+
 end.