unit UnitfrmMain; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, TFlatRadioButtonUnit, StdCtrls, ComCtrls, mxFlatControls, JvPageList, ExtCtrls, JvExControls, JvComponent, TFlatButtonUnit, jpeg, TFlatEditUnit, TFlatGaugeUnit, ImgList, FileCtrl, Registry, CheckLst, TFlatComboBoxUnit, TFlatCheckBoxUnit, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IdException, IdAntiFreezeBase, IdAntiFreeze, IdIntercept, IdLogBase, IdLogFile; type TfrmMain = class(TForm) jplWizard: TJvPageList; jspWelcome: TJvStandardPage; pnlButtons: TPanel; bvlSpace: TBevel; cmdNext: TFlatButton; cmdCancel: TFlatButton; imgInstall: TImage; lblWelcome: TLabel; lblInfo1: TLabel; lblInfo2: TLabel; lblInfo3: TLabel; jspLicense: TJvStandardPage; pnlLicense: TPanel; imgIcon1: TImage; lblTitle1: TLabel; lblSubTitle1: TLabel; freLicense: TmxFlatRichEdit; frbAgree: TFlatRadioButton; ftbDontAgree: TFlatRadioButton; jspInstallMethod: TJvStandardPage; pnlHeader2: TPanel; imgIcon2: TImage; lblTitle2: TLabel; lblSubTitle2: TLabel; lblInstallMethod: TLabel; pnlInstallMethod: TPanel; frbDedicatedServer: TFlatRadioButton; frbListenServer: TFlatRadioButton; frbSelectMod: TFlatRadioButton; frbFTP: TFlatRadioButton; cmdBack: TFlatButton; jspFTP: TJvStandardPage; pnlHeader3: TPanel; imgIcon3: TImage; lblTitle3: TLabel; lblSubTitle3: TLabel; lblStep1: TLabel; pnlFTPData: TPanel; lblHost: TLabel; txtHost: TFlatEdit; lblUserName: TLabel; txtUserName: TFlatEdit; txtPassword: TFlatEdit; lblPassword: TLabel; txtPort: TFlatEdit; lblPort: TLabel; lblStep2: TLabel; cmdConnect: TFlatButton; pnlDirectory: TPanel; trvDirectories: TTreeView; lblStep4: TLabel; jspInstallProgress: TJvStandardPage; pnlHeader5: TPanel; imgIcon5: TImage; lblTitle5: TLabel; lblSubTitle5: TLabel; ggeAll: TFlatGauge; lblProgress: TLabel; ggeItem: TFlatGauge; rtfDetails: TmxFlatRichEdit; lblDetails: TLabel; bvlSpace2: TBevel; ilImages: TImageList; bvlSpacer1: TBevel; bvlSpacer2: TBevel; bvlSpacer3: TBevel; bvlSpacer5: TBevel; jspSelectMod: TJvStandardPage; pnlSelectMod: TPanel; imgIcon6: TImage; lblSelectMod: TLabel; lblSelectModInfo: TLabel; bvlSelectMod: TBevel; lblInfo: TLabel; lstMods: TmxFlatListBox; chkPassive: TFlatCheckBox; lblStep3: TLabel; pnlOS: TPanel; optWindows: TFlatRadioButton; optLinux: TFlatRadioButton; IdFTP: TIdFTP; cmdProxySettings: TFlatButton; IdAntiFreeze: TIdAntiFreeze; frbStandaloneServer: TFlatRadioButton; tmrSpeed: TTimer; IdLogFile: TIdLogFile; procedure jvwStepsCancelButtonClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); procedure cmdNextClick(Sender: TObject); procedure CheckNext(Sender: TObject); procedure cmdBackClick(Sender: TObject); 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); procedure trvDirectoriesChange(Sender: TObject; Node: TTreeNode); procedure IdFTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure tmrSpeedTimer(Sender: TObject); procedure trvDirectoriesExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); procedure trvDirectoriesCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); private OldProgress: Integer; CurrProgress: Integer; public procedure ExceptionHandler(Sender: TObject; E: Exception); end; var frmMain: TfrmMain; const VERSION = '1.2.1'; implementation uses UnitFunctions, UnitfrmProxy, UnitInstall, UnitSelectModPath; {$R *.dfm} procedure TfrmMain.jvwStepsCancelButtonClick(Sender: TObject); begin Close; end; procedure TfrmMain.cmdCancelClick(Sender: TObject); begin Close; end; procedure TfrmMain.cmdNextClick(Sender: TObject); var ePath: String; eRegistry: TRegistry; eStr: TStringList; CurNode: TTreeNode; eOS: TOS; begin { FTP } if jplWizard.ActivePage = jspFTP then begin if not IdFTP.Connected then IdFTP.Connect; eStr := TStringList.Create; ePath := '/'; CurNode := trvDirectories.Selected; repeat ePath := '/' + CurNode.Text + ePath; CurNode := CurNode.Parent; until (not Assigned(CurNode)); IdFTP.ChangeDir(ePath); IdFTP.List(eStr, '', False); if eStr.IndexOf('gameinfo.txt') = -1 then begin MessageBox(Handle, 'Invalid directory. Please select your mod directory and try again.', PChar(Application.Title), MB_ICONWARNING); eStr.Free; exit; end else eStr.Free; // design stuff trvDirectories.Enabled := False; cmdConnect.Enabled := False; optWindows.Enabled := False; optLinux.Enabled := False; Screen.Cursor := crHourGlass; if optWindows.Checked then eOS := osWindows else if optLinux.Checked then eOS := osLinux; jspInstallProgress.Show; // installation Screen.Cursor := crAppStart; InstallFTP(eOS); end else if jplWizard.ActivePage = jspInstallProgress then Close else if jplWizard.ActivePage = jspSelectMod then begin { Dedicated Server } if (frbDedicatedServer.Checked) or (frbStandaloneServer.Checked) then begin jspInstallProgress.Show; ePath := lstMods.Items[lstMods.ItemIndex]; if ePath = 'Counter-Strike:Source' then ePath := 'cstrike' else if ePath = 'Day of Defeat:Source' then ePath := 'dod' else ePath := 'hl2mp'; // install it if frbDedicatedServer.Checked then begin if DirectoryExists(SteamPath + ePath) then InstallDedicated(IncludeTrailingPathDelimiter(SteamPath + ePath), True) else begin MessageBox(Handle, 'Error: The directory of the mod you selected doesn''t exist any more. Run Dedicated Server with the chosen mod and try again.', PChar(Application.Title), MB_ICONERROR); Application.Terminate; exit; end; end else begin if DirectoryExists(StandaloneServer + ePath) then InstallDedicated(IncludeTrailingPathDelimiter(StandaloneServer + ePath), False) else begin MessageBox(Handle, 'Error: The directory of the mod you selected doesn''t exist (any more). Run Half-Life Dedicated Server with the chosen mod again and restart.', PChar(Application.Title), MB_ICONERROR); Application.Terminate; exit; end; end; end; { Listen Server } if frbListenServer.Checked then begin ePath := lstMods.Items[lstMods.ItemIndex]; if ePath = 'Counter-Strike:Source' then ePath := SteamPath + 'counter-strike source\cstrike' else if ePath = 'Half-Life 2 Deathmatch' then ePath := SteamPath + 'half-life 2 deathmatch\hl2mp' else ePath := SteamPath + 'Day Of Defeat source\dod'; if Pos(SteamPath, ePath) = 0 then MessageBox(Handle, 'An error occured. Please report this bug to the Metamod:Source team and post a new thread on the forums of www.amxmodx.org.', PChar(Application.Title), MB_ICONSTOP) else begin if not FileExists(ePath + '\gameinfo.txt') then begin MessageBox(Handle, 'You have to play this game once before installing Metamod:Source. Do this and try again.', PChar(Application.Title), MB_ICONWARNING); exit; end; jspInstallProgress.Show; ePath := IncludeTrailingPathDelimiter(ePath); InstallListen(ePath); end; end; { Custom mod below } end else if jplWizard.ActivePage <> jspInstallMethod then 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) + '\source dedicated server\'; if DirectoryExists(ePath) then begin SteamPath := ePath; lstMods.Clear; // Check Mods if DirectoryExists(SteamPath + 'cstrike') then lstMods.Items.Add('Counter-Strike:Source'); if DirectoryExists(SteamPath + 'dod') then lstMods.Items.Add('Day of Defeat:Source'); if DirectoryExists(SteamPath + 'hl2mp') then lstMods.Items.Add('Half-Life 2 Deatmatch'); // Misc jspSelectMod.Show; lstMods.ItemIndex := -1; cmdNext.Enabled := False; end else MessageBox(Handle, 'You have to run Dedicated Server once before installing Metamod:Source!', '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); 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 if DirectoryExists(SteamPath + 'counter-strike source') then lstMods.Items.Add('Counter-Strike:Source'); if DirectoryExists(SteamPath + 'half-life 2 deathmatch') then lstMods.Items.Add('Half-Life 2 Deathmatch'); if DirectoryExists(SteamPath + 'Day Of Defeat source') then lstMods.Items.Add('Day of Defeat: Source'); // Misc jspSelectMod.Show; lstMods.ItemIndex := -1; cmdNext.Enabled := False; 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 eRegistry := TRegistry.Create; try eRegistry.RootKey := HKEY_CURRENT_USER; if eRegistry.OpenKey('Software\Valve\HLServer', False) then begin StandaloneServer := IncludeTrailingPathDelimiter(eRegistry.ReadString('InstallPath')); if DirectoryExists(StandaloneServer + 'cstrike') then lstMods.Items.Add('Counter-Strike:Source'); if DirectoryExists(StandaloneServer + 'dod') then lstMods.Items.Add('Day of Defeat:Source'); if DirectoryExists(StandaloneServer + 'hl2mp') then lstMods.Items.Add('Half-Life 2 Deatmatch'); jspSelectMod.Show; end else MessageBox(Handle, 'You haven''t installed Half-Life Dedicated Server yet!', 'Error', MB_ICONWARNING); finally eRegistry.Free; end; end else if frbSelectMod.Checked then begin { Custom mod } if frmSelectModPath.ShowModal = mrOk then begin jspInstallProgress.Show; InstallCustom(IncludeTrailingPathDelimiter(frmSelectModPath.trvDirectory.SelectedFolder.PathName), osWindows); end; end else if frbFTP.Checked then // FTP jspFTP.Show; end; end; procedure TfrmMain.CheckNext(Sender: TObject); begin cmdNext.Enabled := frbAgree.Checked; end; procedure TfrmMain.cmdBackClick(Sender: TObject); begin if jplWizard.ActivePage = jspFTP then jspInstallMethod.Show else begin jplWizard.PrevPage; cmdBack.Visible := jplWizard.ActivePageIndex <> 0; end; end; procedure TfrmMain.cmdConnectClick(Sender: TObject); var i: integer; eStr: TStringList; CurNode: TTreeNode; begin if (Trim(txtHost.Text) = '') or (Trim(txtUsername.Text) = '') then MessageBox(Handle, 'Please fill in each field!', PChar(Application.Title), MB_ICONWARNING) else if cmdConnect.Caption = 'Connect' then begin // ... design stuff ... Screen.Cursor := crHourGlass; cmdConnect.Enabled := False; cmdProxySettings.Enabled := False; txtHost.Enabled := False; txtPort.Enabled := False; txtUsername.Enabled := False; txtPassword.Enabled := False; chkPassive.Enabled := False; cmdConnect.Caption := 'Connecting...'; // ... set values ... IdFTP.Host := txtHost.Text; IdFTP.Port := StrToInt(txtPort.Text); IdFTP.Username := txtUsername.Text; IdFTP.Passive := chkPassive.Checked; IdFTP.Password := txtPassword.Text; // ... connect and check values etc ... try IdFTP.Connect(True, 15000); // ... scan for initial directory ... eStr := TStringList.Create; eStr.Text := StringReplace(IdFTP.RetrieveCurrentDir, '/', #13, [rfReplaceAll]); for i := eStr.Count -1 downto 0 do begin if eStr[i] = '' then eStr.Delete(i); end; // ... connect successful, change captions ... trvDirectories.Enabled := True; cmdConnect.Enabled := True; cmdConnect.Caption := 'Disconnect'; CurNode := nil; if eStr.Count <> 0 then begin for i := 0 to eStr.Count -1 do CurNode := trvDirectories.Items.AddChild(CurNode, eStr[i]); end; if trvDirectories.Items.Count <> 0 then trvDirectories.Items.Item[0].Expand(True); eStr.Free; // ... scan for directories ... with GetAllDirs do begin for i := 0 to Count -1 do trvDirectories.Items.AddChild(trvDirectories.Items.AddChild(CurNode, Strings[i]), 'Scanning...'); Free; end; if Assigned(CurNode) then CurNode.Expand(False); except on E: Exception do begin // reset button properties cmdConnect.Enabled := True; txtHost.Enabled := True; txtPort.Enabled := True; txtUsername.Enabled := True; txtPassword.Enabled := True; chkPassive.Enabled := True; cmdProxySettings.Enabled := True; cmdNext.Enabled := False; cmdConnect.Caption := 'Connect'; // analyze messages if Pos('Login incorrect.', E.Message) <> 0 then begin // login failed MessageBox(Handle, 'Login incorrect. Check your FTP settings and try again.', PChar(Application.Title), MB_ICONWARNING); txtUsername.SetFocus; txtUsername.SelectAll; end else if Pos('Host not found.', E.Message) <> 0 then begin // host not found MessageBox(Handle, 'The entered host couldn''t be found. Check your settings and try again.', PChar(Application.Title), MB_ICONWARNING); txtHost.SetFocus; txtHost.SelectAll; end else if Pos('Connection refused.', E.Message) <> 0 then begin // wrong port (?) MessageBox(Handle, 'The host refused the connection. Check your port and try again.', PChar(Application.Title), MB_ICONWARNING); txtPort.SetFocus; txtPort.SelectAll; end else if E is EIdProtocolReplyError then begin // wrong port MessageBox(Handle, 'The port you entered is definitely wrong. Check it and try again.', PChar(Application.Title), MB_ICONWARNING); txtPort.SetFocus; txtPort.SelectAll; end else MessageBox(Handle, PChar(E.Message), PChar(Application.Title), MB_ICONWARNING); // unknown error // ... connect failed, leave procedure ... Screen.Cursor := crDefault; exit; end; end; Screen.Cursor := crDefault; end else begin Screen.Cursor := crHourGlass; IdFTP.Quit; trvDirectories.Items.Clear; trvDirectories.Enabled := False; cmdConnect.Enabled := True; cmdProxySettings.Enabled := True; txtHost.Enabled := True; txtPort.Enabled := True; txtUsername.Enabled := True; txtPassword.Enabled := True; chkPassive.Enabled := True; cmdConnect.Caption := 'Connect'; cmdNext.Enabled := False; Screen.Cursor := crDefault; end; end; procedure TfrmMain.jplWizardChange(Sender: TObject); begin if (jplWizard.ActivePage = jspInstallProgress) then begin cmdNext.Caption := '&Finish'; cmdNext.Enabled := False; cmdBack.Visible := False; end else begin cmdNext.Caption := '&Next >'; cmdNext.Enabled := True; cmdBack.Visible := jplWizard.ActivePageIndex <> 0; end; if (jplWizard.ActivePage = jspLicense) then cmdNext.Enabled := frbAgree.Checked; if (jplWizard.ActivePage = jspFTP) then cmdNext.Enabled := False; end; procedure TfrmMain.FormCreate(Sender: TObject); begin if LowerCase(ParamStr(1)) = '-logftp' then begin MessageBox(Handle, 'FTP installation will be logged to FTP.log!', PChar(Application.Title), MB_ICONINFORMATION); IdLogFile.Filename := ExtractFilePath(ParamStr(0)) + 'FTP.log'; IdLogFile.Active := True; end; rtfDetails.Clear; end; procedure TfrmMain.lstModsClick(Sender: TObject); begin cmdNext.Enabled := lstMods.ItemIndex <> -1; end; procedure TfrmMain.cmdProxySettingsClick(Sender: TObject); begin frmProxy.ShowModal; // Apply Proxy Settings case frmProxy.cboProxy.ItemIndex of 0: IdFTP.ProxySettings.ProxyType := fpcmNone; // none 1: IdFTP.ProxySettings.ProxyType := fpcmHttpProxyWithFtp; // HTTP Proxy with FTP 2: IdFTP.ProxySettings.ProxyType := fpcmOpen; // Open 3: IdFTP.ProxySettings.ProxyType := fpcmSite; // Site 4: IdFTP.ProxySettings.ProxyType := fpcmTransparent; // Transparent 5: IdFTP.ProxySettings.ProxyType := fpcmUserPass; // User (Password) 6: IdFTP.ProxySettings.ProxyType := fpcmUserSite; // User (Site) end; IdFTP.ProxySettings.Host := frmProxy.txtHost.Text; IdFTP.ProxySettings.UserName := frmProxy.txtPort.Text; IdFTP.ProxySettings.Password := frmProxy.txtPassword.Text; IdFTP.ProxySettings.Port := StrToInt(frmProxy.txtPort.Text); end; procedure TfrmMain.txtPortChange(Sender: TObject); var i: integer; begin if txtPort.Text = '' then txtPort.Text := '21' else begin // check if value is numeric... for i := Length(txtPort.Text) downto 1 do begin if Pos(txtPort.Text[i], '0123456789') = 0 then begin txtPort.Text := '21'; txtPort.SelStart := 4; exit; end; end; end; end; procedure TfrmMain.trvDirectoriesExpanded(Sender: TObject; Node: TTreeNode); var ePath: String; CurNode: TTreeNode; i: integer; begin if Node.Item[0].Text = 'Scanning...' then begin // no directories added yet Screen.Cursor := crHourGlass; // get complete path ePath := '/'; CurNode := Node; repeat ePath := '/' + CurNode.Text + ePath; CurNode := CurNode.Parent; until (not Assigned(CurNode)); // change dir and add directories in it try Repaint; IdFTP.ChangeDir(ePath); with GetAllDirs do begin Node.Item[0].Free; for i := 0 to Count -1 do begin trvDirectories.Items.AddChild(trvDirectories.Items.AddChild(Node, Strings[i]), 'Scanning...'); end; Free; end; finally Application.ProcessMessages; end; Screen.Cursor := crDefault; end; end; procedure TfrmMain.trvDirectoriesChange(Sender: TObject; Node: TTreeNode); begin cmdNext.Enabled := Assigned(trvDirectories.Selected); end; procedure TfrmMain.IdFTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin if AWorkCount > 15 then begin ggeItem.Progress := AWorkCount; CurrProgress := AWorkCount; end; if Cancel then IdFTP.Abort; Application.ProcessMessages; end; procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); begin if (jplWizard.ActivePage = jspFTP) and (IdFTP.Connected) then IdFTP.Quit; if (jplWizard.ActivePage = jspInstallProgress) and (ggeAll.Progress <> ggeAll.MaxValue) and (not Cancel) then begin if MessageBox(Handle, 'Do you really want to cancel the installation?', PChar(Application.Title), MB_ICONQUESTION + MB_YESNO) = mrYes then begin Screen.Cursor := crDefault; Application.OnException := ExceptionHandler; Cancel := True; if IdFTP.Connected then IdFTP.Quit; end else Action := caNone; end; end; procedure TfrmMain.ExceptionHandler(Sender: TObject; E: Exception); begin // IF any exceptions were raised after close, nobody would want them so leave this empty end; procedure TfrmMain.tmrSpeedTimer(Sender: TObject); begin Caption := CalcSpeed(OldProgress, CurrProgress); OldProgress := CurrProgress; end; procedure TfrmMain.trvDirectoriesExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); begin Node.ImageIndex := 1; Node.SelectedIndex := 1; end; procedure TfrmMain.trvDirectoriesCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); begin Node.ImageIndex := 0; Node.SelectedIndex := 0; end; end.