Small design changes

Added multi-account support to the local install functions (experimental!)
This commit is contained in:
Christian Hammacher 2006-04-16 00:25:49 +00:00
parent 28b04878ce
commit cb92e45712
5 changed files with 329 additions and 221 deletions

Binary file not shown.

View File

@ -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
begin
if FindFirst(Mask, Attr, eSearch) = 0 then 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;

View File

@ -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 := '';
eDirectories.Free;
Result := nil;
end;
function GetModPathName(eMod: String): String;

View File

@ -5760,12 +5760,72 @@ object frmMain: TfrmMain
Top = 0
Width = 527
Height = 314
object lblInstallMethod: TLabel
Left = 124
Top = 104
Width = 223
object lblLocalHint: TLabel
Left = 136
Top = 118
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,142 +5898,67 @@ object frmMain: TfrmMain
Shape = bsBottomLine
end
end
object pnlInstallMethod: TPanel
Left = 122
Top = 120
Width = 267
Height = 153
object pnlRemote: TPanel
Left = 136
Top = 230
Width = 255
Height = 23
BevelOuter = bvLowered
TabOrder = 1
object Label1: TLabel
object frbFTP: TFlatRadioButton
Left = 4
Top = 16
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 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
Top = 28
Width = 259
Height = 65
BevelOuter = bvLowered
Top = 4
Width = 35
Height = 17
Caption = 'FTP'
TabOrder = 0
object frbDedicatedServer: TFlatRadioButton
Left = 4
Top = 4
Width = 135
Height = 17
Caption = 'Steam Dedicated Server'
Checked = True
TabOrder = 0
TabStop = True
OnClick = frbLocalClick
end
object frbListenServer: TFlatRadioButton
Left = 4
Top = 18
Width = 115
Height = 17
Caption = 'Steam Listen Server'
TabOrder = 1
OnClick = frbLocalClick
end
object frbStandaloneServer: TFlatRadioButton
Left = 4
Top = 32
Width = 107
Height = 17
Caption = 'Standalone Server'
TabOrder = 2
OnClick = frbLocalClick
end
object frbSelectMod: TFlatRadioButton
Left = 4
Top = 46
Width = 117
Height = 17
Caption = 'Select mod directory'
TabOrder = 3
OnClick = frbLocalClick
end
OnClick = frbFTPClick
end
object pnlRemote: TPanel
end
object pnlLocal: TPanel
Left = 136
Top = 130
Width = 255
Height = 65
BevelOuter = bvLowered
TabOrder = 2
object frbDedicatedServer: TFlatRadioButton
Left = 4
Top = 126
Width = 259
Height = 23
BevelOuter = bvLowered
Top = 4
Width = 135
Height = 17
Caption = 'Steam Dedicated Server'
Checked = True
TabOrder = 0
TabStop = True
OnClick = frbLocalClick
end
object frbListenServer: TFlatRadioButton
Left = 4
Top = 18
Width = 115
Height = 17
Caption = 'Steam Listen Server'
TabOrder = 1
object frbFTP: TFlatRadioButton
Left = 4
Top = 4
Width = 35
Height = 17
Caption = 'FTP'
TabOrder = 0
OnClick = frbFTPClick
end
OnClick = frbLocalClick
end
object frbStandaloneServer: TFlatRadioButton
Left = 4
Top = 32
Width = 107
Height = 17
Caption = 'Standalone Server'
TabOrder = 2
OnClick = frbLocalClick
end
object frbSelectMod: TFlatRadioButton
Left = 4
Top = 46
Width = 117
Height = 17
Caption = 'Select mod directory'
TabOrder = 3
OnClick = frbLocalClick
end
end
end
@ -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
Left = 134
Top = 144
object trvMods: TTreeView
Left = 135
Top = 141
Width = 253
Height = 97
ItemHeight = 13
Height = 117
BorderStyle = bsNone
Indent = 19
MultiSelectStyle = []
ReadOnly = True
RightClickSelect = True
RowSelect = True
TabOrder = 1
OnClick = lstModsClick
Activate = True
BorderColor = clBtnShadow
Flat = True
ShowBorder = True
Version = '1.26'
OnClick = trvModsClick
end
end
object jspFTP: TJvStandardPage

View File

@ -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;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
trvMods: TTreeView;
lblRemoteInstallation: TLabel;
lblRemoteHint: TLabel;
pnlRemote: TPanel;
frbFTP: TFlatRadioButton;
lblLocalHint: TLabel;
lblLocalInstallation: TLabel;
lblLocalHintItalic: TLabel;
pnlLocal: TPanel;
frbDedicatedServer: TFlatRadioButton;
frbListenServer: TFlatRadioButton;
frbStandaloneServer: TFlatRadioButton;
frbSelectMod: TFlatRadioButton;
Label5: TLabel;
pnlRemote: TPanel;
frbFTP: TFlatRadioButton;
Shape1: TShape;
Label1: TLabel;
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);
try
eRegistry.RootKey := HKEY_CURRENT_USER;
if eRegistry.OpenKey('Software\Valve\Steam', False) then begin
ePath := eRegistry.ReadString('ModInstallPath');
ePath := Copy(ePath, 1, Length(ePath) -10) + '\dedicated server\';
if DirectoryExists(ePath) then begin
SteamPath := ePath;
lstMods.Clear;
// Check Mods
lstMods.Items.Text := GetAllMods(ePath, False);
// Misc
jspSelectMod.Show;
lstMods.ItemIndex := -1;
cmdNext.Enabled := False;
ePath := GetSteamAppsDir;
if ePath = '' then
MessageBox(Handle, 'You haven''t installed Steam yet! Download it at www.steampowered.com, install Dedicated Server and try again.', 'Error', MB_ICONWARNING)
else begin
trvMods.Items.Clear;
with GetSteamAccounts do begin
if Count = 1 then begin
gMultiAccount := False;
SteamPath := ePath + Strings[0] + '\dedicated server\';
eStr := GetAllMods(SteamPath, False);
for i := 0 to eStr.Count -1 do
trvMods.Items.Add(nil, eStr[i]);
eStr.Free;
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;
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;
trvMods.Selected := nil;
cmdNext.Enabled := False;
end;
end;
end
else if frbListenServer.Checked then begin // Listen Server
eRegistry := TRegistry.Create(KEY_READ);
try
eRegistry.RootKey := HKEY_CURRENT_USER;
if eRegistry.OpenKey('Software\Valve\Steam', False) then begin
ePath := eRegistry.ReadString('ModInstallPath') + '\';
lstMods.Clear;
ePath := Copy(ePath, 1, Length(ePath) -10);
if DirectoryExists(ePath) then begin
SteamPath := ePath;
// Check Mods
lstMods.Items.Text := GetAllMods(ePath, True);
if DirectoryExists(ePath + 'half-life') then
lstMods.Items.Text := lstMods.Items.Text + GetAllMods(ePath + 'half-life', False);
// Misc
jspSelectMod.Show;
lstMods.ItemIndex := -1;
cmdNext.Enabled := False;
ePath := GetSteamAppsDir;
if ePath = '' then
MessageBox(Handle, 'You haven''t installed Steam yet! Download it at www.steampowered.com, install Dedicated Server and try again.', 'Error', MB_ICONWARNING)
else begin
trvMods.Items.Clear;
with GetSteamAccounts do begin
if Count = 1 then begin
gMultiAccount := False;
SteamPath := ePath + Strings[0] + '\';
eStr := GetAllMods(SteamPath, True);
for i := 0 to eStr.Count -1 do
trvMods.Items.Add(nil, eStr[i]);
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
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;
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;
trvMods.Selected := nil;
cmdNext.Enabled := False;
end;
end;
end
else if frbStandaloneServer.Checked then begin // Standalone Server
@ -436,8 +493,16 @@ 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);
jspSelectMod.Show;
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);
@ -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.