unit uMain1; {$mode objfpc}{$H+} ///

/// uMain1 — Main form for HC Launcher (Lazarus/FPC port). /// /// Provides a GUI for configuring and launching the Harpoon Classic (HC) /// Game Engine (GE) with complex command-line argument assembly. /// /// This is a ONE-WAY migration from the Delphi/VCL/TMS original to /// Lazarus/LCL with standard controls. ///

interface uses LCLIntf, LCLType, Classes, SysUtils, Forms, Controls, StdCtrls, ComCtrls, Dialogs, ExtCtrls, Spin, CheckLst, FileUtil, Menus, Clipbrd, StrUtils, {$IFDEF MSWINDOWS}Registry,{$ENDIF} IniFiles, Math, uHCLProcessUtils, uCICVersionInformation, uHCLCmdLineBuilder, uHCLFileOrganization, uHCLCatalog, uHCLDownloader, uHCLArchive, uHCLImport, uHCLBattleSets, uHCLDatabaseMatch, uHCLAutosaveCleanup; type ///

/// Main application form. Hosts all HC GE command-line configuration /// controls, assembles the argument string via , /// and launches the GE executable. ///

TfrmMain1 = class(TForm) // ----------------------------------------------------------------------- // Top-bar controls (above the page control) // ----------------------------------------------------------------------- lblHCDirGE: TLabel; edtHCDirGE: TEdit; btnHCDirGE: TButton; lblGEName: TLabel; edtGEName: TEdit; btnLaunchGE: TButton; lblSEName: TLabel; edtSEName: TEdit; btnLaunchSE: TButton; lblBaseDir: TLabel; edtBaseDir: TEdit; btnBaseDir: TButton; ckbBaseDirOverride: TCheckBox; // ----------------------------------------------------------------------- // Page control // ----------------------------------------------------------------------- pct1: TPageControl; tshGE: TTabSheet; // ----------------------------------------------------------------------- // Downloads tab controls // ----------------------------------------------------------------------- tshDownloads: TTabSheet; tvCategories: TTreeView; splDownloads: TSplitter; pnlDownloadsRight: TPanel; pnlDownloadsToolbar: TPanel; edtSearch: TEdit; btnRefreshCatalog: TButton; btnOpenInBrowser: TButton; btnDownload: TButton; btnPlayScenario: TButton; pmFiles: TPopupMenu; mniPlayScenario: TMenuItem; mniDownloadAgain: TMenuItem; mniEditScenario: TMenuItem; lvFiles: TListView; pnlFileDetail: TPanel; splFileDetail: TSplitter; lblFileTitle: TLabel; lblFileMeta: TLabel; lblFileDeps: TLabel; lblFileVersion: TLabel; cbxFileVersion: TComboBox; mmoFileDesc: TMemo; prgDownload: TProgressBar; // ----------------------------------------------------------------------- // Scroll box inside tshGE // ----------------------------------------------------------------------- scbGE: TScrollBox; // ----------------------------------------------------------------------- // Group: Command Line Options // ----------------------------------------------------------------------- grpCmdOptsGE: TGroupBox; // Simple flag checkboxes ckbAutoPlayGE: TCheckBox; ckbIgnoreRegGE: TCheckBox; ckbSubAIGE: TCheckBox; ckbEff115GE: TCheckBox; ckbIterSaveGE: TCheckBox; // Battleset by filename ckbBSFNGE: TCheckBox; edtBSFNGE: TEdit; btnBSFNGE: TButton; // Battleset by number ckbBSNumGE: TCheckBox; cbxBSNumGE: TComboBox; // Scenario by filename ckbScenFNGE: TCheckBox; edtScenFNGE: TEdit; btnScenFNGE: TButton; // Scenario by number ckbScenNumGE: TCheckBox; cbxScenNumGE: TComboBox; // CDB res filename ckbCDBresFNGE: TCheckBox; edtCDBresFNGE: TEdit; btnCDBresFNGE: TButton; // CDB rsr filename ckbCDBrsrFNGE: TCheckBox; edtCDBrsrFNGE: TEdit; btnCDBrsrFNGE: TButton; // Save game filename ckbSavFNGE: TCheckBox; edtSavFNGE: TEdit; btnSavFNGE: TButton; // Log filename ckbLogFNGE: TCheckBox; edtLogFNGE: TEdit; btnLogFNGE: TButton; // Auto save interval ckbSavIntGE: TCheckBox; edtSavIntGE: TEdit; // Iterative saving (GT) ckbIterSaveGTGE: TCheckBox; edtIterSaveGTIntervalGE: TSpinEdit; edtIterSaveGTSavesGE: TSpinEdit; lblIterSaveGTIntervalGE: TLabel; lblIterSaveGTSavesGE: TLabel; // Iterative save base filename (version-gated >= 2022.0.2.5) ckbIterSaveGTFNGE: TCheckBox; edtIterFNGE: TEdit; btnIterFNGE: TButton; btnCleanupAutosavesGE: TButton; // Message log filename (version-gated >= 2022.0.2.5) ckbLogMLFNGE: TCheckBox; edtLogMLFNGE: TEdit; btnLogMLFNGE: TButton; // CPU Affinity ckbAffinityGE: TCheckBox; cbxAffinityGE: TComboBox; // Process Priority ckbPriorityGE: TCheckBox; cbxPriorityGE: TComboBox; // ----------------------------------------------------------------------- // Group: Game Play Options // ----------------------------------------------------------------------- grpGameOptsGE: TGroupBox; ckbGOGE: TCheckBox; lblGOSideGE: TLabel; cbxGOSideGE: TComboBox; chkGOSidesGE: TCheckListBox; lblGONukeRelGE: TLabel; cbxGONukeRelGE: TComboBox; lblGOSnorkSubGE: TLabel; cbxGOSnorkSubGE: TComboBox; lblGORealWeathGE: TLabel; cbxGORealWeathGE: TComboBox; lblGOMaintFailGE: TLabel; cbxGOMaintFailGE: TComboBox; lblGOFullOrdGE: TLabel; cbxGOFullOrdGE: TComboBox; lblGOFormPatGE: TLabel; cbxGOFormPatGE: TComboBox; lblGOExitGE: TLabel; cbxGOExitGE: TComboBox; lblGOTimeCompGE: TLabel; cbxGOTimeCompGE: TComboBox; // ----------------------------------------------------------------------- // Group: Logging Options // ----------------------------------------------------------------------- grpLogOptsGE: TGroupBox; ckbLOGE: TCheckBox; ckbLOinit_annexGE: TCheckBox; ckbLOac_aiGE: TCheckBox; ckbLOsub_aiGE: TCheckBox; ckbLOemcon_aiGE: TCheckBox; ckbLOsonarGE: TCheckBox; ckbLOrefuelGE: TCheckBox; ckbLOmissionGE: TCheckBox; ckbLOinterceptGE: TCheckBox; ckbLOres_fileGE: TCheckBox; ckbLOloadGE: TCheckBox; ckbLOradarGE: TCheckBox; ckbLOecmGE: TCheckBox; ckbLOmissileGE: TCheckBox; ckbLOareadefGE: TCheckBox; ckbLOperfGE: TCheckBox; ckbLObad_dbGE: TCheckBox; ckbLOgraphicGE: TCheckBox; ckbLOunitGE: TCheckBox; ckbLOallGE: TCheckBox; // ----------------------------------------------------------------------- // Group: Hide specified default game windows // ----------------------------------------------------------------------- grpWindowHideGE: TGroupBox; ckbWHGE: TCheckBox; ckbWHGroupGE: TCheckBox; ckbWHUnitGE: TCheckBox; ckbWHStratMapGE: TCheckBox; ckbWHMiniReportGE: TCheckBox; ckbWHMessageLogGE: TCheckBox; // ----------------------------------------------------------------------- // Group: Issue specific debugging and logging (version-gated >= 2022.0.1.5) // ----------------------------------------------------------------------- grpDebugOptsGE: TGroupBox; ckbIDLGE: TCheckBox; ckbIDLI32501GE: TCheckBox; // ----------------------------------------------------------------------- // Command line preview // ----------------------------------------------------------------------- edtCmdLineGE: TEdit; edtCmdLineSE: TEdit; // ----------------------------------------------------------------------- // Status bar // ----------------------------------------------------------------------- StatusBar1: TStatusBar; // ----------------------------------------------------------------------- // Open dialogs (8 file pickers) // ----------------------------------------------------------------------- dlgBSFNGE: TOpenDialog; dlgScenFNGE: TOpenDialog; dlgCDBresFNGE: TOpenDialog; dlgCDBrsrFNGE: TOpenDialog; dlgSavFNGE: TOpenDialog; dlgLogFNGE: TOpenDialog; dlgIterFNGE: TOpenDialog; dlgLogMLFNGE: TOpenDialog; // ----------------------------------------------------------------------- // Event handlers — form lifecycle // ----------------------------------------------------------------------- procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); // ----------------------------------------------------------------------- // Event handlers — top-bar // ----------------------------------------------------------------------- ///

Opens a directory picker to select the HC install directory.

procedure btnHCDirGEClick(Sender: TObject); ///

Triggers version detection and command-line rebuild.

procedure edtGENameChange(Sender: TObject); ///

Launches the configured GE executable.

procedure btnLaunchGEClick(Sender: TObject); procedure btnLaunchSEClick(Sender: TObject); procedure edtSENameChange(Sender: TObject); ///

Rebuilds the command line when the HC directory changes.

procedure edtHCDirGEChange(Sender: TObject); ///

Opens a directory picker for the managed files base directory.

procedure btnBaseDirClick(Sender: TObject); ///

Toggles custom basedir override on/off.

procedure ckbBaseDirOverrideChange(Sender: TObject); // ----------------------------------------------------------------------- // Event handlers — mutual-exclusion checkboxes // ----------------------------------------------------------------------- ///

Ensures BS-by-filename and BS-by-number are mutually exclusive.

procedure ckbBSNumGEChange(Sender: TObject); ///

Ensures BS-by-filename and BS-by-number are mutually exclusive.

procedure ckbBSFNGEChange(Sender: TObject); ///

Ensures Scen-by-filename and Scen-by-number are mutually exclusive.

procedure ckbScenNumGEChange(Sender: TObject); ///

Ensures Scen-by-filename and Scen-by-number are mutually exclusive.

procedure ckbScenFNGEChange(Sender: TObject); ///

When "all" is checked, clears individual log checkboxes.

procedure ckbLOallGEChange(Sender: TObject); ///

When any individual log checkbox is checked, clears the "all" checkbox.

procedure ckbLOIndividualChange(Sender: TObject); ///

Sets the master debug checkbox when the I32501 sub-checkbox changes.

procedure ckbIDLI32501GEChange(Sender: TObject); ///

Sets the master window-hide checkbox when any sub-checkbox is enabled.

procedure ckbWHSubChange(Sender: TObject); // ----------------------------------------------------------------------- // Event handlers — generic rebuild triggers // ----------------------------------------------------------------------- ///

Rebuilds the command line when any plain checkbox changes.

procedure AnyCheckBoxChange(Sender: TObject); ///

Rebuilds the command line when any combobox selection changes.

procedure AnyComboBoxChange(Sender: TObject); ///

Rebuilds the command line when any spin edit value changes.

procedure AnySpinEditChange(Sender: TObject); ///

Rebuilds the command line when any text edit changes.

procedure AnyEditChange(Sender: TObject); // ----------------------------------------------------------------------- // Event handlers — side checklist (old GE) // ----------------------------------------------------------------------- ///

Recomputes the side bitmask when checklist items are toggled.

procedure chkGOSidesGEClickCheck(Sender: TObject); // ----------------------------------------------------------------------- // Event handlers — file browse buttons // ----------------------------------------------------------------------- procedure btnBSFNGEClick(Sender: TObject); procedure btnScenFNGEClick(Sender: TObject); procedure btnCDBresFNGEClick(Sender: TObject); procedure btnCDBrsrFNGEClick(Sender: TObject); procedure btnSavFNGEClick(Sender: TObject); procedure btnLogFNGEClick(Sender: TObject); procedure btnIterFNGEClick(Sender: TObject); procedure btnCleanupAutosavesGEClick(Sender: TObject); procedure btnLogMLFNGEClick(Sender: TObject); // ----------------------------------------------------------------------- // Event handlers — Downloads tab // ----------------------------------------------------------------------- procedure tvCategoriesSelectionChanged(Sender: TObject); procedure edtSearchChange(Sender: TObject); procedure btnRefreshCatalogClick(Sender: TObject); procedure btnOpenInBrowserClick(Sender: TObject); procedure btnDownloadClick(Sender: TObject); procedure lvFilesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure lvFilesColumnClick(Sender: TObject; Column: TListColumn); procedure cbxFileVersionChange(Sender: TObject); procedure btnPlayScenarioClick(Sender: TObject); procedure mniDownloadAgainClick(Sender: TObject); procedure mniEditScenarioClick(Sender: TObject); procedure pmFilesPopup(Sender: TObject); procedure lvFilesDblClick(Sender: TObject); private ///

Builder that assembles the GE command-line string from a snapshot record.

FBuilder: IHCLCmdLineBuilder; ///

Managed file organization interface.

FFileOrg: IHCLFileOrganization; ///

Bitmask for the old-GE side checklist (Blue=1, Red=2, Green=4).

FIntGOSidesGE: Integer; ///

Most recently assembled command-line argument string.

FStrCmdLine: String; ///

The same options as the SE understands them (BuildCommandLineSE).

FStrCmdLineSE: String; ///

True when Launcher.ini has no SE name yet, so the stock one may be offered.

FSENameUnsaved: Boolean; ///

HC directory whose battlesets label cbxBSNumGE; '' = built-in names.

FBattleSetsDir: String; // Downloads tab state ///

Catalog manager for fetching/caching/querying HC artifact manifests.

FCatalog: IHCLCatalog; ///

Downloader for retrieving artifact files from catalog sources.

FDownloader: IHCLDownloader; ///

ZIP handler used to extract downloaded archives.

FArchive: IHCLArchive; ///

Resolves and performs imports of archives into the managed tree.

FImport: IHCLImport; ///

Files currently displayed in lvFiles.

FCurrentFiles: THCLCatalogFileArray; ///

Column index last sorted by (-1 = none).

FSortColumn: Integer; ///

True when the last sort was ascending.

FSortAscending: Boolean; ///

Assembles the command line from current control states and updates the preview.

procedure BuildCommandLineGE; ///

Labels cbxBSNumGE with number, abbreviation and name from the HC directory.

procedure PopulateBattleSetList; ///

Captures all control values into a flat record for the builder.

function SnapshotInputs: THCGECmdLineInputs; ///

Loads persisted settings from Launcher.ini.

procedure SettingsLoad; ///

Saves current control states to Launcher.ini.

procedure SettingsSave; ///

Rebuilds FFileOrg from current basedir state and updates dialog defaults.

procedure UpdateFileOrganization; // Downloads tab helpers ///

Initialises the Downloads tab: creates catalog/downloader, loads cached catalog.

procedure InitDownloadsTab; ///

Rebuilds the category tree from the in-memory catalog.

procedure PopulateCategoryTree; ///

Populates lvFiles from the supplied file array.

procedure PopulateFileList(const AFiles: THCLCatalogFileArray); ///

Shows metadata for a single file in the detail panel.

procedure ShowFileDetail(const AFile: THCLCatalogFile); ///

Clears all fields in the detail panel.

procedure ClearFileDetail; ///

Progress callback forwarded to prgDownload.

procedure OnDownloadProgress(ASender: TObject; ABytesReceived, ATotalBytes: Int64); ///

Progress callback forwarded to prgDownload during extraction.

procedure OnExtractProgress(ASender: TObject; const AEntryName: String; AEntryIndex, AEntryCount: Integer); ///

/// Returns the managed cache directory a catalog file should download into, /// falling back to the application directory when no managed tree exists. ///

/// Catalog entry being downloaded. /// An existing directory path. function ResolveCacheDir(const AFile: THCLCatalogFile): String; ///

The cache directory for AFile within ACategory (with a versions\ subfolder for earlier versions).

/// Catalog entry. /// Category whose cache\ to use. /// The directory path. function CacheDirFor(const AFile: THCLCatalogFile; ACategory: THCLCategory): String; ///

/// Finds a downloaded copy of a catalog file in the managed caches. ///

/// The file, in the version wanted. /// The cached file's path; '' when none. Every category's cache /// is searched (downloads made under an earlier placement rule count), /// and a copy only counts when its size matches the catalog's. function FindDownloadedCopy(const AFile: THCLCatalogFile): String; ///

A version picker line, marked " - downloaded" when that version is cached.

/// The catalog file. /// -1 for the current version, else an index into Versions. /// The caption. function VersionItemCaption(const AFile: THCLCatalogFile; AIndex: Integer): String; ///

Updates the Have column and the selected file's details after a download.

procedure RefreshHaveMarks; ///

/// Sets the main button to Install (selected version already downloaded: /// works from the cached copy) or Download, and enables Play for an /// installed scenario. ///

procedure UpdateDownloadActions; ///

/// Finds where a catalog scenario was installed. ///

/// The scenario, in the version wanted. /// Receives its platform database directory when it /// sits under PlatformDBs; '' under a BattleSet. /// The scenario file (.SC?) in /// PlatformDBs\*\Scenarios\<name>\ or BattleSets\*\Scenarios\<name>\; /// '' when not installed. function FindInstalledScenario(const AFile: THCLCatalogFile; out ADBDir: String): String; ///

Imports the selected version: from its cached copy when there is one, else downloaded.

/// True to discard any cached copy and download afresh. procedure DownloadOrInstallSelected(AForceDownload: Boolean); ///

The file list's Have column: "Yes", "Older" (only an earlier version), or ''.

/// A catalog file. /// The column text. function HaveText(const AFile: THCLCatalogFile): String; ///

/// Works out which platform database a scenario goes with, and whether /// it has to be downloaded first. ///

/// The database named by the scenario file or the catalog. /// Receives the PlatformDBs folder name to install under. /// Receives a sentence for the confirmation. /// True when ADBFile must be downloaded and installed first. /// The database's catalog file (in its version). /// False when ARequired is not a recognisable name or neither it nor /// a newer build of its family is installed or in the catalog. function ResolveScenarioDatabase(const ARequired: String; out AParent, ANote: String; out ANeedsDownload: Boolean; out ADBFile: THCLCatalogFile): Boolean; ///

Downloads and installs a platform database without asking, with its pictures.

/// The database's catalog file (in its version). /// Receives why it failed. /// True when it is installed. function InstallDatabase(const AFile: THCLCatalogFile; out AError: String): Boolean; ///

Moves a downloaded archive into another category's cache.

/// Catalog entry the archive came from. /// Where it was downloaded. /// The category it belongs to. /// The new path, or APath when unmoved. function MoveToCategoryCache(const AFile: THCLCatalogFile; const APath: String; ACategory: THCLCategory): String; ///

/// Offers to extract a freshly downloaded archive into the managed tree, /// prompting for a parent BattleSet or PlatformDB when the plan needs one. ///

/// Catalog entry the archive came from. /// Full path to the downloaded file. procedure OfferImport(const AFile: THCLCatalogFile; const AArchivePath: String); ///

/// Imports an archive holding several platform databases as one /// PlatformDB each, then supplies any missing pictures. ///

/// Catalog entry the archive came from. /// Full path to the downloaded archive. /// Its databases, from HCLFindBundledDBs. procedure ImportPlatformDBCollection(const AFile: THCLCatalogFile; const AArchivePath: String; const ABundles: THCLBundledDBArray); ///

/// Supplies the commondb.rsr AFile's companion entry provides to each /// of ADirs that lacks one, downloading the companion when needed. ///

/// The catalog file that was imported. /// The PlatformDB directories it was imported into. procedure PlaceCompanionFiles(const AFile: THCLCatalogFile; const ADirs: array of String); ///

Finds the catalog entry that supplies AFile's commondb.rsr.

/// A PlatformDB catalog file. /// Receives the supplying entry. /// True when AFile names one and the loaded catalog has it. function FindPicturesCompanion(const AFile: THCLCatalogFile; out ACompanion: THCLCatalogFile): Boolean; ///

Confirmation-dialog sentence about databases arriving without pictures.

/// The PlatformDB catalog file being imported. /// How many of its databases lack commondb.rsr. /// What will be fetched, or what the user must supply. function PicturesNote(const AFile: THCLCatalogFile; ACount: Integer): String; ///

/// Downloads a catalog file into its managed cache directory, showing /// progress in prgDownload. ///

/// The file, in the version wanted. /// Receives the downloaded file's path. /// Receives why the download failed. /// True on success. function DownloadCatalogFile(const F: THCLCatalogFile; out AFilePath, AErrorMessage: String): Boolean; ///

Enables or disables the Downloads tab controls as a group.

/// True to enable, False to disable during a long operation. procedure SetDownloadsBusy(AEnabled: Boolean); ///

Returns a human-readable file size string.

function FormatFileSize(ABytes: Int64): String; ///

Returns the THCLCatalogFile for the currently selected lvFiles row.

function GetSelectedFile: THCLCatalogFile; ///

/// The selected file in the version chosen in cbxFileVersion (item 0 is /// the current version, item N is Versions[N-1]). ///

/// The file as HCLSelectVersion describes that version; /// an empty record when no row is selected. function GetSelectedFileVersion: THCLCatalogFile; ///

/// Shows size, date and file name of the version chosen in cbxFileVersion, /// with its changelog above the description when it has one. ///

procedure ShowVersionDetail; public end; var frmMain1: TfrmMain1; implementation {$R *.lfm} const ///

The Scenario Editor's stock executable name, offered until one is saved.

HCL_DEFAULT_SE_EXE = 'Wscenedt32.exe'; // --------------------------------------------------------------------------- // FormCreate // --------------------------------------------------------------------------- ///

Formats a 4-part version string (e.g. '2026.0.0.3') as 'yyyy.###' (e.g. '2026.3').

/// Runs the Scenario Editor with the options it understands /// (IHCLCmdLineBuilder.BuildCommandLineSE), in the HC directory. ///

procedure TfrmMain1.btnLaunchSEClick(Sender: TObject); var FullPath: String; begin FullPath := edtHCDirGE.Text + PathDelim + edtSEName.Text; if (Trim(edtSEName.Text) <> '') and FileExists(FullPath) then ExecuteFile('"' + FullPath + '"', FStrCmdLineSE, edtHCDirGE.Text, 1) else MessageDlg('Listed SE file does not exist, please enter a valid exe', mtInformation, [mbOK], 0); end; ///

Refreshes the SE command-line preview for the new name.

procedure TfrmMain1.edtSENameChange(Sender: TObject); begin BuildCommandLineGE; end; // --------------------------------------------------------------------------- // btnHCDirGEClick // --------------------------------------------------------------------------- procedure TfrmMain1.btnHCDirGEClick(Sender: TObject); var Dir: String; begin Dir := edtHCDirGE.Text; if SelectDirectory('Select HC Directory', '', Dir) then edtHCDirGE.Text := Dir; end; // --------------------------------------------------------------------------- // edtHCDirGEChange // --------------------------------------------------------------------------- procedure TfrmMain1.edtHCDirGEChange(Sender: TObject); begin if not ckbBaseDirOverride.Checked then UpdateFileOrganization; PopulateBattleSetList; BuildCommandLineGE; end; // --------------------------------------------------------------------------- // PopulateBattleSetList // --------------------------------------------------------------------------- ///

/// Labels cbxBSNumGE with each battleset's number, abbreviation and name, /// read from the .res files in the HC directory (uHCLBattleSets). ///

/// /// The items stay the same battleset numbers in the same order /// (BS_INDEX_TO_ID), so the saved selection and the -b value /// are unchanged; only the labels are rewritten. Runs only when the HC /// directory exists and differs from the one last read, since the edit box /// fires on every keystroke. /// procedure TfrmMain1.PopulateBattleSetList; var Dir: String; I, Keep: Integer; begin Dir := Trim(edtHCDirGE.Text); if (FBattleSetsDir <> '') and ((Dir = FBattleSetsDir) or not DirectoryExists(Dir)) then Exit; if not DirectoryExists(Dir) then Dir := ''; // first fill: built-in names FBattleSetsDir := Dir; Keep := cbxBSNumGE.ItemIndex; cbxBSNumGE.Items.BeginUpdate; try cbxBSNumGE.Items.Clear; for I := Low(BS_INDEX_TO_ID) to High(BS_INDEX_TO_ID) do cbxBSNumGE.Items.Add(HCLBattleSetCaption(HCLBattleSetInfo(Dir, BS_INDEX_TO_ID[I]))); finally cbxBSNumGE.Items.EndUpdate; end; if (Keep >= 0) and (Keep < cbxBSNumGE.Items.Count) then cbxBSNumGE.ItemIndex := Keep; end; // --------------------------------------------------------------------------- // Mutual-exclusion checkbox handlers // --------------------------------------------------------------------------- procedure TfrmMain1.ckbBSNumGEChange(Sender: TObject); begin if ckbBSNumGE.Checked then ckbBSFNGE.Checked := False; BuildCommandLineGE; end; procedure TfrmMain1.ckbBSFNGEChange(Sender: TObject); begin if ckbBSFNGE.Checked then ckbBSNumGE.Checked := False; BuildCommandLineGE; end; procedure TfrmMain1.ckbScenNumGEChange(Sender: TObject); begin if ckbScenNumGE.Checked then ckbScenFNGE.Checked := False; BuildCommandLineGE; end; procedure TfrmMain1.ckbScenFNGEChange(Sender: TObject); begin if ckbScenFNGE.Checked then ckbScenNumGE.Checked := False; BuildCommandLineGE; end; procedure TfrmMain1.ckbLOallGEChange(Sender: TObject); begin if ckbLOallGE.Checked then begin ckbLOinit_annexGE.Checked := False; ckbLOac_aiGE.Checked := False; ckbLOsub_aiGE.Checked := False; ckbLOemcon_aiGE.Checked := False; ckbLOsonarGE.Checked := False; ckbLOrefuelGE.Checked := False; ckbLOmissionGE.Checked := False; ckbLOinterceptGE.Checked := False; ckbLOres_fileGE.Checked := False; ckbLOloadGE.Checked := False; ckbLOradarGE.Checked := False; ckbLOecmGE.Checked := False; ckbLOmissileGE.Checked := False; ckbLOareadefGE.Checked := False; ckbLOperfGE.Checked := False; ckbLObad_dbGE.Checked := False; ckbLOgraphicGE.Checked := False; ckbLOunitGE.Checked := False; end; BuildCommandLineGE; end; procedure TfrmMain1.ckbLOIndividualChange(Sender: TObject); begin if (Sender is TCheckBox) and TCheckBox(Sender).Checked then ckbLOallGE.Checked := False; BuildCommandLineGE; end; procedure TfrmMain1.ckbIDLI32501GEChange(Sender: TObject); begin ckbIDLGE.Checked := ckbIDLI32501GE.Checked; BuildCommandLineGE; end; procedure TfrmMain1.ckbWHSubChange(Sender: TObject); begin if (Sender is TCheckBox) and TCheckBox(Sender).Checked then ckbWHGE.Checked := True; BuildCommandLineGE; end; // --------------------------------------------------------------------------- // Generic rebuild triggers // --------------------------------------------------------------------------- procedure TfrmMain1.AnyCheckBoxChange(Sender: TObject); begin BuildCommandLineGE; end; procedure TfrmMain1.AnyComboBoxChange(Sender: TObject); begin BuildCommandLineGE; end; procedure TfrmMain1.AnySpinEditChange(Sender: TObject); begin BuildCommandLineGE; end; procedure TfrmMain1.AnyEditChange(Sender: TObject); begin BuildCommandLineGE; end; // --------------------------------------------------------------------------- // chkGOSidesGEClickCheck — side checklist bitmask // --------------------------------------------------------------------------- procedure TfrmMain1.chkGOSidesGEClickCheck(Sender: TObject); var i: Integer; Mask: Integer; begin Mask := 0; for i := 0 to chkGOSidesGE.Items.Count - 1 do if chkGOSidesGE.Checked[i] then Mask := Mask or (1 shl i); FIntGOSidesGE := Mask; BuildCommandLineGE; end; // --------------------------------------------------------------------------- // File browse button handlers // --------------------------------------------------------------------------- procedure TfrmMain1.btnBSFNGEClick(Sender: TObject); begin if dlgBSFNGE.Execute then edtBSFNGE.Text := dlgBSFNGE.FileName; end; procedure TfrmMain1.btnScenFNGEClick(Sender: TObject); begin if dlgScenFNGE.Execute then edtScenFNGE.Text := dlgScenFNGE.FileName; end; procedure TfrmMain1.btnCDBresFNGEClick(Sender: TObject); begin if dlgCDBresFNGE.Execute then edtCDBresFNGE.Text := dlgCDBresFNGE.FileName; end; procedure TfrmMain1.btnCDBrsrFNGEClick(Sender: TObject); begin if dlgCDBrsrFNGE.Execute then edtCDBrsrFNGE.Text := dlgCDBrsrFNGE.FileName; end; procedure TfrmMain1.btnSavFNGEClick(Sender: TObject); begin if dlgSavFNGE.Execute then edtSavFNGE.Text := dlgSavFNGE.FileName; end; procedure TfrmMain1.btnLogFNGEClick(Sender: TObject); begin if dlgLogFNGE.Execute then edtLogFNGE.Text := dlgLogFNGE.FileName; end; procedure TfrmMain1.btnIterFNGEClick(Sender: TObject); begin if dlgIterFNGE.Execute then edtIterFNGE.Text := dlgIterFNGE.FileName; end; procedure TfrmMain1.btnLogMLFNGEClick(Sender: TObject); begin if dlgLogMLFNGE.Execute then edtLogMLFNGE.Text := dlgLogMLFNGE.FileName; end; // --------------------------------------------------------------------------- // Managed files base directory // --------------------------------------------------------------------------- procedure TfrmMain1.btnBaseDirClick(Sender: TObject); var Dir: String; begin Dir := edtBaseDir.Text; if SelectDirectory('Select Managed Files Base Directory', '', Dir) then begin edtBaseDir.Text := Dir; UpdateFileOrganization; end; end; procedure TfrmMain1.ckbBaseDirOverrideChange(Sender: TObject); begin btnBaseDir.Enabled := ckbBaseDirOverride.Checked; edtBaseDir.ReadOnly := not ckbBaseDirOverride.Checked; UpdateFileOrganization; end; // --------------------------------------------------------------------------- // UpdateFileOrganization // --------------------------------------------------------------------------- procedure TfrmMain1.UpdateFileOrganization; var BaseDir: String; function ResolveInitialDir(const AManagedPath, AFallback: String): String; begin if DirectoryExists(AManagedPath) then Result := AManagedPath else Result := AFallback; end; begin // Resolve basedir: custom override or HC directory if ckbBaseDirOverride.Checked and (edtBaseDir.Text <> '') then BaseDir := edtBaseDir.Text else begin BaseDir := edtHCDirGE.Text; if not ckbBaseDirOverride.Checked then edtBaseDir.Text := BaseDir; end; FFileOrg := CreateFileOrganization(BaseDir); // Update file dialog initial directories to use managed paths dlgBSFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclBattleSets), edtHCDirGE.Text); dlgScenFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclBattleSets), edtHCDirGE.Text); dlgCDBresFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclPlatformDBs), edtHCDirGE.Text); dlgCDBrsrFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclPlatformDBs), edtHCDirGE.Text); dlgSavFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclBattleSets), edtHCDirGE.Text); dlgLogFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclLogs), edtHCDirGE.Text); dlgIterFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclBattleSets), edtHCDirGE.Text); dlgLogMLFNGE.InitialDir := ResolveInitialDir(FFileOrg.GetCategoryPath(hclLogs), edtHCDirGE.Text); end; // --------------------------------------------------------------------------- // Downloads tab — CompareListItems (standalone, matches TListSortCompare) // --------------------------------------------------------------------------- ///

/// Comparison function for TListView.CustomSort (stdcall as required by TLVCompare). /// Data encodes column and direction: positive = ascending, negative = descending. /// Column index is abs(Data), where 0 = Caption, 1+ = SubItems[n-1]. /// Numeric comparison is used for columns 4 (Size) and 5 (Downloads). ///

function CompareListItems(Item1, Item2: TListItem; Data: PtrInt): Integer; stdcall; var S1, S2: String; Col: Integer; Ascending: Boolean; begin // Positive Data = ascending, negative = descending Ascending := Data >= 0; if Ascending then Col := Data else Col := -(Data + 1); // decode: -1 -> 0, -2 -> 1, etc. if Col = 0 then begin S1 := Item1.Caption; S2 := Item2.Caption; end else begin S1 := Item1.SubItems[Col - 1]; S2 := Item2.SubItems[Col - 1]; end; // Numeric comparison for Size (4) and Downloads (5) columns if Col in [4, 5] then Result := StrToIntDef(S1, 0) - StrToIntDef(S2, 0) else Result := CompareText(S1, S2); if not Ascending then Result := -Result; end; // --------------------------------------------------------------------------- // InitDownloadsTab // --------------------------------------------------------------------------- ///

/// Creates the catalog and downloader, loads any cached catalog from disk, /// and populates the category tree. Called once from FormCreate. ///

procedure TfrmMain1.InitDownloadsTab; var CacheDir: String; begin FCatalog := CreateCatalog; FDownloader := CreateDownloader; FArchive := CreateArchive; FImport := CreateImport(FFileOrg, FArchive); FSortColumn := -1; FSortAscending := True; // Load cached catalog if managed root exists if Assigned(FFileOrg) then begin CacheDir := FFileOrg.GetManagedRoot + PathDelim + 'catalogs'; ForceDirectories(CacheDir); if FCatalog.LoadSourceFromCache(CacheDir + PathDelim + 'harpgamer.json') then begin PopulateCategoryTree; StatusBar1.SimpleText := 'Catalog: ' + IntToStr(FCatalog.GetTotalFileCount) + ' files available'; end; end; end; // --------------------------------------------------------------------------- // PopulateCategoryTree // --------------------------------------------------------------------------- ///

/// Rebuilds the tvCategories tree from the in-memory catalog sources. /// Each source becomes a root node; top-level categories are its children; /// subcategories are nested further. ///

procedure TfrmMain1.PopulateCategoryTree; var Sources: THCLCatalogSourceArray; Cats: THCLCatalogCategoryArray; I, J, K: Integer; SourceNode, CatNode: TTreeNode; begin tvCategories.Items.BeginUpdate; try tvCategories.Items.Clear; Sources := FCatalog.GetSources; for I := 0 to High(Sources) do begin SourceNode := tvCategories.Items.AddChild(nil, Sources[I].Name); Cats := Sources[I].Categories; for J := 0 to High(Cats) do begin CatNode := tvCategories.Items.AddChild(SourceNode, Cats[J].Name + ' (' + IntToStr(Length(Cats[J].Files)) + ')'); for K := 0 to High(Cats[J].Subcategories) do tvCategories.Items.AddChild(CatNode, Cats[J].Subcategories[K].Name + ' (' + IntToStr(Length(Cats[J].Subcategories[K].Files)) + ')'); end; SourceNode.Expand(False); end; finally tvCategories.Items.EndUpdate; end; end; // --------------------------------------------------------------------------- // tvCategoriesSelectionChanged // --------------------------------------------------------------------------- ///

/// Fired when the user selects a node in the category tree. /// Walks the catalog tree to find matching files and displays them. ///

procedure TfrmMain1.tvCategoriesSelectionChanged(Sender: TObject); var Node: TTreeNode; Sources: THCLCatalogSourceArray; I, J, K: Integer; NodeText, CatText: String; Files: THCLCatalogFileArray; procedure AppendFiles(const AExtra: THCLCatalogFileArray); var OldLen, ExLen, N: Integer; begin OldLen := Length(Files); ExLen := Length(AExtra); if ExLen = 0 then Exit; SetLength(Files, OldLen + ExLen); // Must copy element-by-element — records contain managed String fields; // raw Move would corrupt reference counts. for N := 0 to ExLen - 1 do Files[OldLen + N] := AExtra[N]; end; begin Node := tvCategories.Selected; if Node = nil then Exit; // If a source root node is selected, show nothing (or all — keep empty) if Node.Parent = nil then begin PopulateFileList(nil); Exit; end; // Extract the display name without the trailing " (n)" count NodeText := Node.Text; if NodeText <> '' then begin // Strip trailing " (nnn)" if present if NodeText[Length(NodeText)] = ')' then begin J := Length(NodeText); while (J > 0) and (NodeText[J] <> '(') do Dec(J); if J > 1 then NodeText := Trim(Copy(NodeText, 1, J - 1)); end; end; SetLength(Files, 0); Sources := FCatalog.GetSources; for I := 0 to High(Sources) do begin for J := 0 to High(Sources[I].Categories) do begin // Strip count from category name for comparison CatText := Sources[I].Categories[J].Name; if Node.Parent.Parent = nil then begin // Node is a direct child of a source root — match top-level category if CompareText(CatText, NodeText) = 0 then begin AppendFiles(Sources[I].Categories[J].Files); for K := 0 to High(Sources[I].Categories[J].Subcategories) do AppendFiles(Sources[I].Categories[J].Subcategories[K].Files); end; end else begin // Node is a subcategory — match against subcategory names for K := 0 to High(Sources[I].Categories[J].Subcategories) do begin if CompareText(Sources[I].Categories[J].Subcategories[K].Name, NodeText) = 0 then AppendFiles(Sources[I].Categories[J].Subcategories[K].Files); end; end; end; end; PopulateFileList(Files); end; // --------------------------------------------------------------------------- // PopulateFileList // --------------------------------------------------------------------------- ///

/// Fills lvFiles with one row per entry in AFiles. /// Stores the array index as Item.Data for fast retrieval. ///

procedure TfrmMain1.PopulateFileList(const AFiles: THCLCatalogFileArray); var I: Integer; Item: TListItem; SourceID, VerText: String; ColonPos: Integer; begin // Suppress OnSelectItem during Clear to prevent stale Data access (Bug 1+2) lvFiles.OnSelectItem := nil; lvFiles.Items.BeginUpdate; try lvFiles.Items.Clear; finally lvFiles.Items.EndUpdate; end; // Assign new array only after old items are gone FCurrentFiles := AFiles; lvFiles.Items.BeginUpdate; try for I := 0 to High(AFiles) do begin Item := lvFiles.Items.Add; Item.Caption := AFiles[I].Title; // The label, since few authors fill in the version field; and how many // earlier versions there are to choose from. if AFiles[I].VersionLabel <> '' then VerText := AFiles[I].VersionLabel else VerText := AFiles[I].Version; if Length(AFiles[I].Versions) > 0 then VerText := Format('%s (+%d older)', [VerText, Length(AFiles[I].Versions)]); Item.SubItems.Add(VerText); Item.SubItems.Add(AFiles[I].Author); // Extract source prefix before ':' ColonPos := Pos(':', AFiles[I].ID); if ColonPos > 0 then SourceID := Copy(AFiles[I].ID, 1, ColonPos - 1) else SourceID := AFiles[I].ID; Item.SubItems.Add(SourceID); Item.SubItems.Add(FormatFileSize(AFiles[I].Size)); Item.SubItems.Add(IntToStr(AFiles[I].Downloads)); Item.SubItems.Add(HaveText(AFiles[I])); Item.Data := Pointer(PtrInt(I)); end; finally lvFiles.Items.EndUpdate; lvFiles.OnSelectItem := @lvFilesSelectItem; end; ClearFileDetail; btnDownload.Enabled := False; btnOpenInBrowser.Enabled := False; end; // --------------------------------------------------------------------------- // lvFilesSelectItem // --------------------------------------------------------------------------- ///

/// Updates the detail panel and button states when a list row is selected or /// deselected. ///

procedure TfrmMain1.lvFilesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); begin if Selected and (Item <> nil) then begin ShowFileDetail(GetSelectedFile); btnDownload.Enabled := True; btnOpenInBrowser.Enabled := True; end else begin ClearFileDetail; btnDownload.Enabled := False; btnOpenInBrowser.Enabled := False; end; UpdateDownloadActions; end; // --------------------------------------------------------------------------- // ShowFileDetail / ClearFileDetail // --------------------------------------------------------------------------- ///

/// Populates the detail panel labels and memo with metadata from AFile. ///

procedure TfrmMain1.ShowFileDetail(const AFile: THCLCatalogFile); var I: Integer; begin lblFileTitle.Caption := AFile.Title; // Current version first, then the earlier ones the source still offers. cbxFileVersion.Items.BeginUpdate; try cbxFileVersion.Items.Clear; cbxFileVersion.Items.Add(VersionItemCaption(AFile, -1)); for I := 0 to High(AFile.Versions) do cbxFileVersion.Items.Add(VersionItemCaption(AFile, I)); finally cbxFileVersion.Items.EndUpdate; end; cbxFileVersion.ItemIndex := 0; cbxFileVersion.Enabled := Length(AFile.Versions) > 0; if Length(AFile.Versions) > 0 then lblFileVersion.Caption := Format('Version (%d):', [Length(AFile.Versions) + 1]) else lblFileVersion.Caption := 'Version:'; if (AFile.Dependencies.PlatformDB <> '') or (AFile.Dependencies.BattleSet <> '') or (AFile.Dependencies.GameVersion <> '') then begin lblFileDeps.Caption := 'Requires:'; if AFile.Dependencies.PlatformDB <> '' then lblFileDeps.Caption := lblFileDeps.Caption + ' DB: ' + AFile.Dependencies.PlatformDB; if AFile.Dependencies.BattleSet <> '' then lblFileDeps.Caption := lblFileDeps.Caption + ' BS: ' + AFile.Dependencies.BattleSet; if AFile.Dependencies.GameVersion <> '' then lblFileDeps.Caption := lblFileDeps.Caption + ' GE: ' + AFile.Dependencies.GameVersion; end else lblFileDeps.Caption := ''; ShowVersionDetail; end; ///

/// Shows size, date and file name of the version chosen in cbxFileVersion, /// with its changelog above the description when it has one. ///

procedure TfrmMain1.ShowVersionDetail; var F: THCLCatalogFile; Meta: String; Changelog: String; begin F := GetSelectedFileVersion; if F.ID = '' then Exit; Meta := 'By ' + F.Author + ' | ' + FormatFileSize(F.Size); if not F.IsPreviousVersion then Meta := Meta + ' | ' + IntToStr(F.Downloads) + ' downloads'; if F.IsPreviousVersion then Meta := Meta + ' | Published: ' + F.Updated else Meta := Meta + ' | Updated: ' + F.Updated; if F.FileName <> '' then Meta := Meta + ' | ' + F.FileName; if FindDownloadedCopy(F) <> '' then Meta := Meta + ' | Downloaded'; lblFileMeta.Caption := Meta; Changelog := ''; if F.IsPreviousVersion and (cbxFileVersion.ItemIndex >= 1) then Changelog := F.Versions[cbxFileVersion.ItemIndex - 1].Changelog; if Changelog <> '' then mmoFileDesc.Text := 'Changes in ' + F.VersionLabel + ':' + LineEnding + Changelog + LineEnding + LineEnding + F.Description else mmoFileDesc.Text := F.Description; end; ///

Shows the details of the version just chosen.

procedure TfrmMain1.cbxFileVersionChange(Sender: TObject); begin ShowVersionDetail; UpdateDownloadActions; end; ///

Clears all detail panel labels and the memo.

procedure TfrmMain1.ClearFileDetail; begin lblFileTitle.Caption := ''; lblFileMeta.Caption := ''; lblFileDeps.Caption := ''; mmoFileDesc.Text := ''; cbxFileVersion.Items.Clear; cbxFileVersion.Enabled := False; lblFileVersion.Caption := 'Version:'; end; // --------------------------------------------------------------------------- // btnRefreshCatalogClick // --------------------------------------------------------------------------- ///

/// Fetches the catalog manifest from the configured URL, saves a local cache, /// and rebuilds the category tree. ///

procedure TfrmMain1.btnRefreshCatalogClick(Sender: TObject); const CatalogURL = 'https://www.harpgamer.com/util/hcl-catalog-serve.php'; // TODO: read from INI [CatalogSources] section to support multiple sources var CacheDir: String; begin StatusBar1.SimpleText := 'Fetching catalog...'; Application.ProcessMessages; if FCatalog.FetchSource(CatalogURL) then begin if Assigned(FFileOrg) then begin CacheDir := FFileOrg.GetManagedRoot + PathDelim + 'catalogs'; ForceDirectories(CacheDir); FCatalog.SaveSourceToCache('harpgamer', CacheDir + PathDelim + 'harpgamer.json'); end; PopulateCategoryTree; StatusBar1.SimpleText := 'Catalog: ' + IntToStr(FCatalog.GetTotalFileCount) + ' files available'; end else StatusBar1.SimpleText := 'Failed to fetch catalog'; end; // --------------------------------------------------------------------------- // btnOpenInBrowserClick // --------------------------------------------------------------------------- ///

Opens the selected file's detail page in the system browser.

procedure TfrmMain1.btnOpenInBrowserClick(Sender: TObject); var F: THCLCatalogFile; begin F := GetSelectedFile; if F.PageUrl <> '' then OpenURL(F.PageUrl); end; // --------------------------------------------------------------------------- // btnDownloadClick // --------------------------------------------------------------------------- ///

/// Downloads the selected artifact to its appropriate managed cache directory. /// Shows progress in prgDownload and reports the result in the status bar. ///

procedure TfrmMain1.btnDownloadClick(Sender: TObject); begin DownloadOrInstallSelected(False); end; ///

Right-click "Download again": a fresh copy, replacing the cached one.

procedure TfrmMain1.mniDownloadAgainClick(Sender: TObject); begin DownloadOrInstallSelected(True); end; procedure TfrmMain1.DownloadOrInstallSelected(AForceDownload: Boolean); var F: THCLCatalogFile; FilePath, ErrorMessage: String; begin F := GetSelectedFileVersion; if F.ID = '' then Exit; // An entry whose download is a link to another site has no file to fetch: // downloading would only save that site's web page. Open it instead. if F.ExternalLink then begin OpenURL(F.PageUrl); StatusBar1.SimpleText := F.Title + ' is an external link - opened its page in your browser'; Exit; end; // The cached ZIP is the authoritative copy: installing again needs no // network. "Download again" throws it away first, so a damaged copy or // a file replaced under the same name is fetched afresh. FilePath := FindDownloadedCopy(F); if AForceDownload and (FilePath <> '') then begin if not DeleteFile(FilePath) then begin StatusBar1.SimpleText := 'Could not remove the cached copy: ' + FilePath; Exit; end; FilePath := ''; end; if FilePath <> '' then StatusBar1.SimpleText := 'Using the downloaded copy: ' + FilePath else begin if not DownloadCatalogFile(F, FilePath, ErrorMessage) then begin StatusBar1.SimpleText := 'Download failed: ' + ErrorMessage; RefreshHaveMarks; Exit; end; StatusBar1.SimpleText := 'Downloaded: ' + FilePath; end; OfferImport(F, FilePath); // The import may have downloaded a database too. RefreshHaveMarks; end; // --------------------------------------------------------------------------- // Play an installed scenario // --------------------------------------------------------------------------- function TfrmMain1.FindInstalledScenario(const AFile: THCLCatalogFile; out ADBDir: String): String; begin Result := HCLFindInstalledScenario(FFileOrg, AFile, ADBDir); end; ///

/// Starts the GE on the selected installed scenario, using the Game Engine /// tab's options with that scenario (-c) and its platform database (-d/-r) /// swapped in. ///

procedure TfrmMain1.btnPlayScenarioClick(Sender: TObject); var F: THCLCatalogFile; Scenario, DBDir, GEPath, CmdLine, Warning: String; Inputs: THCGECmdLineInputs; BSInfo: THCLBattleSetInfo; begin F := GetSelectedFileVersion; Scenario := FindInstalledScenario(F, DBDir); if Scenario = '' then begin StatusBar1.SimpleText := F.Title + ' is not installed; install it first'; Exit; end; GEPath := edtHCDirGE.Text + PathDelim + edtGEName.Text; if (Trim(edtGEName.Text) = '') or not FileExists(GEPath) then begin MessageDlg('Listed GE file does not exist, please enter a valid exe on the Game Engine tab', mtInformation, [mbOK], 0); Exit; end; Inputs := SnapshotInputs; // This scenario, not whatever the Game Engine tab has selected. Inputs.ScenByFile := True; Inputs.ScenFilePath := Scenario; Inputs.ScenByNum := False; Inputs.BSByNum := False; Inputs.BSByFile := False; Inputs.SavFNEnabled := False; // The GE only goes straight into a -c scenario when -b skips its // battleset screen too; the scenario's extension names its battleset. Inputs.BSNumber := HCLScenarioBattleSetNumber(Scenario); // No -g: the GE then asks for side and game options (HC // libge/src/Select.c), whatever the Game Engine tab has set (Tony: the // prompts are wanted for now). Inputs.GameOptsEnabled := False; BSInfo := HCLBattleSetInfo(edtHCDirGE.Text, Inputs.BSNumber); if Inputs.BSNumber = 0 then Warning := ' - its battleset could not be told from ' + ExtractFileName(Scenario) + ', so the GE will ask for one' else if (BSInfo.FileStem <> '') and not BSInfo.Installed then Warning := Format(' - battleset %d (%s) is not installed in %s', [Inputs.BSNumber, BSInfo.FileStem, edtHCDirGE.Text]) else Warning := ''; // Its database; without one here the GE uses its own commondb files. Inputs.CDBresFNEnabled := (DBDir <> '') and FileExists(DBDir + PathDelim + HCL_COMMONDB_RES); Inputs.CDBresFNPath := DBDir + PathDelim + HCL_COMMONDB_RES; Inputs.CDBrsrFNEnabled := (DBDir <> '') and FileExists(DBDir + PathDelim + HCL_COMMONDB_RSR); Inputs.CDBrsrFNPath := DBDir + PathDelim + HCL_COMMONDB_RSR; CmdLine := FBuilder.BuildCommandLine(Inputs); ExecuteFile('"' + GEPath + '"', CmdLine, edtHCDirGE.Text, 1); if DBDir <> '' then StatusBar1.SimpleText := Format('Started %s (battleset %d) with %s%s', [F.Title, Inputs.BSNumber, ExtractFileName(DBDir), Warning]) else StatusBar1.SimpleText := Format('Started %s (battleset %d)%s', [F.Title, Inputs.BSNumber, Warning]); end; ///

/// Right-click "Edit Scenario": starts the Scenario Editor with the /// scenario's platform database, and puts the scenario's path on the /// clipboard for File > Open. ///

/// /// The SE cannot be told which scenario to open: it accepts -c but, unlike /// the GE, never reads it (HC SE/src/winmain.c; only libge uses /// strCLScenario). Once it does, pass -c here and drop the clipboard step. /// procedure TfrmMain1.mniEditScenarioClick(Sender: TObject); var F: THCLCatalogFile; Scenario, DBDir, SEPath: String; Inputs: THCGECmdLineInputs; begin F := GetSelectedFileVersion; Scenario := FindInstalledScenario(F, DBDir); if Scenario = '' then begin StatusBar1.SimpleText := F.Title + ' is not installed; install it first'; Exit; end; SEPath := edtHCDirGE.Text + PathDelim + edtSEName.Text; if (Trim(edtSEName.Text) = '') or not FileExists(SEPath) then begin MessageDlg('Listed SE file does not exist, please enter a valid SE Name', mtInformation, [mbOK], 0); Exit; end; Inputs := SnapshotInputs; Inputs.BSByNum := False; // The scenario's own battleset, from its extension. Inputs.BSNumber := HCLScenarioBattleSetNumber(Scenario); Inputs.CDBresFNEnabled := (DBDir <> '') and FileExists(DBDir + PathDelim + HCL_COMMONDB_RES); Inputs.CDBresFNPath := DBDir + PathDelim + HCL_COMMONDB_RES; Inputs.CDBrsrFNEnabled := (DBDir <> '') and FileExists(DBDir + PathDelim + HCL_COMMONDB_RSR); Inputs.CDBrsrFNPath := DBDir + PathDelim + HCL_COMMONDB_RSR; Clipboard.AsText := Scenario; ExecuteFile('"' + SEPath + '"', FBuilder.BuildCommandLineSE(Inputs), edtHCDirGE.Text, 1); StatusBar1.SimpleText := 'Scenario Editor started' + IfThen(DBDir <> '', ' with ' + ExtractFileName(DBDir), '') + '. The scenario''s path is on the clipboard: File > Open, then paste it.'; end; ///

/// Opens the autosave cleanup window. The GE writes iterative saves beside /// itself, in ITER_SAVE_GAMETIME; manual only, and removals go to the /// Recycle Bin. ///

procedure TfrmMain1.btnCleanupAutosavesGEClick(Sender: TObject); begin HCLShowAutosaveCleanup(ExtractFileDir(edtHCDirGE.Text + PathDelim + edtGEName.Text), edtHCDirGE.Text, FFileOrg); StatusBar1.SimpleText := ''; end; ///

Double-click: play an installed scenario, else the main button's action.

procedure TfrmMain1.lvFilesDblClick(Sender: TObject); begin if lvFiles.Selected = nil then Exit; if btnPlayScenario.Enabled then btnPlayScenarioClick(Sender) else if btnDownload.Enabled then btnDownloadClick(Sender); end; ///

Enables the right-click items that apply to the selected row.

procedure TfrmMain1.pmFilesPopup(Sender: TObject); var F: THCLCatalogFile; begin F := GetSelectedFileVersion; mniPlayScenario.Enabled := btnPlayScenario.Enabled; mniEditScenario.Enabled := btnPlayScenario.Enabled and (Trim(edtSEName.Text) <> ''); mniDownloadAgain.Enabled := (F.ID <> '') and not F.ExternalLink and btnDownload.Enabled; end; procedure TfrmMain1.UpdateDownloadActions; var F: THCLCatalogFile; DBDir: String; begin F := GetSelectedFileVersion; if (F.ID <> '') and not F.ExternalLink and (FindDownloadedCopy(F) <> '') then begin btnDownload.Caption := 'Install'; btnDownload.Hint := 'Already downloaded: install from the cached copy (right-click to download again)'; end else begin btnDownload.Caption := 'Download'; btnDownload.Hint := 'Download, then offer to install'; end; btnDownload.ShowHint := True; btnPlayScenario.Enabled := btnDownload.Enabled and (FindInstalledScenario(F, DBDir) <> ''); end; // --------------------------------------------------------------------------- // Downloaded markers // --------------------------------------------------------------------------- ///

A version picker line, marked when that version is already downloaded.

/// The catalog file. /// -1 for the current version, else an index into Versions. /// HCLVersionCaption, plus " - downloaded". function TfrmMain1.VersionItemCaption(const AFile: THCLCatalogFile; AIndex: Integer): String; begin Result := HCLVersionCaption(AFile, AIndex); if FindDownloadedCopy(HCLSelectVersion(AFile, AIndex)) <> '' then Result := Result + ' - downloaded'; end; ///

/// Updates the Have column for every listed file and the details of the /// selected one, keeping the chosen version. ///

procedure TfrmMain1.RefreshHaveMarks; var I, Idx, Keep: Integer; begin for I := 0 to lvFiles.Items.Count - 1 do begin Idx := PtrInt(lvFiles.Items[I].Data); if (Idx >= 0) and (Idx <= High(FCurrentFiles)) and (lvFiles.Items[I].SubItems.Count >= 6) then lvFiles.Items[I].SubItems[5] := HaveText(FCurrentFiles[Idx]); end; if lvFiles.Selected <> nil then begin Keep := cbxFileVersion.ItemIndex; ShowFileDetail(GetSelectedFile); if (Keep >= 0) and (Keep < cbxFileVersion.Items.Count) then begin cbxFileVersion.ItemIndex := Keep; ShowVersionDetail; end; end; UpdateDownloadActions; end; // --------------------------------------------------------------------------- // DownloadCatalogFile // --------------------------------------------------------------------------- ///

/// Downloads a catalog file into its managed cache directory, showing /// progress in prgDownload. ///

/// The file, in the version wanted. /// Receives the downloaded file's path. /// Receives why the download failed. /// True on success. function TfrmMain1.DownloadCatalogFile(const F: THCLCatalogFile; out AFilePath, AErrorMessage: String): Boolean; var DestDir, SourceID: String; ColonPos: Integer; Method: TDownloadMethod; DownResult: THCLDownloadResult; begin AFilePath := ''; AErrorMessage := ''; // Determine download method from source prefix ColonPos := Pos(':', F.ID); if ColonPos > 0 then SourceID := Copy(F.ID, 1, ColonPos - 1) else SourceID := ''; if SourceID = 'harpgamer' then Method := dmIpsCsrf else Method := dmDirect; DestDir := ResolveCacheDir(F); ForceDirectories(DestDir); prgDownload.Visible := True; prgDownload.Position := 0; SetDownloadsBusy(False); if F.IsPreviousVersion then StatusBar1.SimpleText := 'Downloading ' + F.Title + ' (' + F.VersionLabel + ')...' else StatusBar1.SimpleText := 'Downloading ' + F.Title + '...'; try DownResult := FDownloader.Download(F.PageUrl, DestDir, F.FileName, Method, F.SHA256, @OnDownloadProgress, F.DownloadUrl); finally prgDownload.Visible := False; SetDownloadsBusy(True); end; Result := DownResult.Success; AFilePath := DownResult.FilePath; AErrorMessage := DownResult.ErrorMessage; end; // --------------------------------------------------------------------------- // ResolveCacheDir // --------------------------------------------------------------------------- ///

/// Maps the artifact type onto its managed category cache directory. ///

/// Catalog entry being downloaded. /// The category cache path, or the application directory when the /// managed tree is unavailable or the artifact type is unrecognised. function TfrmMain1.ResolveCacheDir(const AFile: THCLCatalogFile): String; var Cat: THCLCategory; begin // Scenarios follow their install: PlatformDBs\cache when they declare a // platform database, BattleSets\cache otherwise (HCLDownloadCategory). if Assigned(FFileOrg) and HCLDownloadCategory(AFile, Cat) then Result := CacheDirFor(AFile, Cat) else if Assigned(FFileOrg) then // Known managed tree but an artifact type we do not classify: keep the // download rather than losing it, and park it with the other tools. Result := CacheDirFor(AFile, hclTools) else Result := ExtractFilePath(Application.ExeName); end; ///

/// The cache directory for AFile within a given category. ///

/// Catalog entry being downloaded. /// Category whose cache\ to use. /// That category's cache path, with a versions\<name> subfolder /// for an earlier version. function TfrmMain1.CacheDirFor(const AFile: THCLCatalogFile; ACategory: THCLCategory): String; begin Result := FFileOrg.GetCachePath(ACategory); // Versions of one entry can share a file name (every BSBuilder BattleSet // ships as hdsu.*), and a cached copy of one must never be taken for, or // resumed into, another. Earlier versions get a folder each. if AFile.IsPreviousVersion then Result := IncludeTrailingPathDelimiter(Result) + 'versions' + PathDelim + HCLSanitizeDirName(HCLVersionedName(AFile.Title, AFile)); end; function TfrmMain1.FindDownloadedCopy(const AFile: THCLCatalogFile): String; var First, Cat: THCLCategory; Path: String; function Check(ACat: THCLCategory): Boolean; var SR: TSearchRec; begin Result := False; Path := IncludeTrailingPathDelimiter(CacheDirFor(AFile, ACat)) + AFile.FileName; if FindFirst(Path, faAnyFile and not faDirectory, SR) = 0 then try Result := (AFile.Size <= 0) or (SR.Size = AFile.Size); finally FindClose(SR); end; end; begin Result := ''; if (not Assigned(FFileOrg)) or (AFile.FileName = '') then Exit; // Where it would be downloaded now, then everywhere else. if HCLDownloadCategory(AFile, First) and Check(First) then Exit(Path); for Cat := Low(THCLCategory) to High(THCLCategory) do if (Cat <> hclLogs) and Check(Cat) then Exit(Path); end; function TfrmMain1.HaveText(const AFile: THCLCatalogFile): String; var V: Integer; begin if FindDownloadedCopy(AFile) <> '' then Exit('Yes'); for V := 0 to High(AFile.Versions) do if FindDownloadedCopy(HCLSelectVersion(AFile, V)) <> '' then Exit('Older'); Result := ''; end; function TfrmMain1.ResolveScenarioDatabase(const ARequired: String; out AParent, ANote: String; out ANeedsDownload: Boolean; out ADBFile: THCLCatalogFile): Boolean; var Needed: THCLDBId; Chosen: THCLDBCandidate; Exact: Boolean; PlatformDBs, Installed: String; DBPlan: THCLImportPlan; begin AParent := ''; ANote := ''; ANeedsDownload := False; ADBFile := Default(THCLCatalogFile); Result := False; if not (Assigned(FFileOrg) and Assigned(FCatalog) and HCLParseDBId(ARequired, Needed)) then Exit; PlatformDBs := FFileOrg.GetCategoryPath(hclPlatformDBs); // Installed already, under whatever folder name. Installed := HCLFindInstalledDatabase(PlatformDBs, Needed); if Installed <> '' then begin AParent := Installed; ANote := Format('It needs the %s platform database, which is installed (%s).', [ARequired, Installed]); Exit(True); end; // Else the build itself from the catalog, or the nearest newer one. if not HCLChooseDatabase(Needed, HCLDBCandidates(FCatalog.GetFilesByArtifactType(HCL_ARTIFACT_PLATFORMDB)), Chosen, Exact) then begin ANote := Format('It needs the %s platform database, which is not installed, and the ' + 'catalog has neither it nor a newer %s build.', [ARequired, Needed.Family]); Exit; end; Installed := HCLFindInstalledDatabase(PlatformDBs, Chosen.Id); if Installed <> '' then begin AParent := Installed; ANote := Format('It needs the %s platform database, which is not available; the nearest ' + 'newer %s build, %s, is installed and will be used.', [ARequired, Needed.Family, Installed]); Exit(True); end; DBPlan := FImport.PlanImport(Chosen.CatalogFile); if not DBPlan.Valid then Exit; AParent := DBPlan.ArtifactName; ADBFile := Chosen.CatalogFile; ANeedsDownload := True; if Exact then ANote := Format('It needs the %s platform database, which is not installed: "%s" (%s, %s) ' + 'will be downloaded and installed first.', [ARequired, Chosen.CatalogFile.Title, Chosen.Name, FormatFileSize(Chosen.CatalogFile.Size)]) else ANote := Format('It needs the %s platform database, which the catalog does not have: the ' + 'nearest newer %s build, %s ("%s", %s), will be downloaded and installed first, and the ' + 'scenario placed with it.', [ARequired, Needed.Family, Chosen.Name, Chosen.CatalogFile.Title, FormatFileSize(Chosen.CatalogFile.Size)]); Result := True; end; function TfrmMain1.InstallDatabase(const AFile: THCLCatalogFile; out AError: String): Boolean; var ZipPath: String; Plan: THCLImportPlan; Res: THCLImportResult; begin Result := False; AError := ''; ZipPath := FindDownloadedCopy(AFile); if (ZipPath = '') and not DownloadCatalogFile(AFile, ZipPath, AError) then Exit; Plan := FImport.PlanImport(AFile); if not Plan.Valid then begin AError := Plan.Reason; Exit; end; SetDownloadsBusy(False); StatusBar1.SimpleText := 'Installing ' + Plan.ArtifactName + '...'; StatusBar1.Repaint; try Res := FImport.Execute(Plan, ZipPath, omOverwrite, nil); finally SetDownloadsBusy(True); end; if not Res.Success then begin AError := Res.ErrorMessage; Exit; end; PlaceCompanionFiles(AFile, [Res.DestDir]); Result := True; end; ///

/// Moves a downloaded archive to another category's cache, once its contents /// show it belongs there (a scenario whose own file names a platform /// database the catalog did not declare). ///

/// Catalog entry the archive came from. /// Where it was downloaded. /// The category it belongs to. /// The new path, or APath unchanged when it is already there or /// could not be moved (the import then works from where it is). function TfrmMain1.MoveToCategoryCache(const AFile: THCLCatalogFile; const APath: String; ACategory: THCLCategory): String; var Dir, Target: String; begin Result := APath; if not Assigned(FFileOrg) then Exit; Dir := CacheDirFor(AFile, ACategory); if SameFileName(ExcludeTrailingPathDelimiter(ExtractFileDir(APath)), ExcludeTrailingPathDelimiter(Dir)) then Exit; if not ForceDirectories(Dir) then Exit; Target := IncludeTrailingPathDelimiter(Dir) + ExtractFileName(APath); // The fresh download replaces any older copy there. if FileExists(Target) and not DeleteFile(Target) then Exit; if RenameFile(APath, Target) then Result := Target; end; // --------------------------------------------------------------------------- // SetDownloadsBusy // --------------------------------------------------------------------------- ///

/// Enables or disables every Downloads tab control that must not be touched /// while a download or extraction is running. ///

/// True to enable, False to disable. procedure TfrmMain1.SetDownloadsBusy(AEnabled: Boolean); begin btnDownload.Enabled := AEnabled; btnRefreshCatalog.Enabled := AEnabled; btnOpenInBrowser.Enabled := AEnabled; tvCategories.Enabled := AEnabled; edtSearch.Enabled := AEnabled; lvFiles.Enabled := AEnabled; // Re-enabled only where there is a choice to make. cbxFileVersion.Enabled := AEnabled and (cbxFileVersion.Items.Count > 1); if AEnabled then UpdateDownloadActions else btnPlayScenario.Enabled := False; end; // --------------------------------------------------------------------------- // OfferImport // --------------------------------------------------------------------------- ///

/// Offers to extract a freshly downloaded archive into the managed directory /// tree, prompting for a parent when a scenario declares none. ///

/// Catalog entry the archive came from. /// Full path to the downloaded file. /// /// Extraction is offered rather than automatic: the cached ZIP is the /// authoritative copy, and a user who only wanted the download should not /// have files appear in their game tree unasked. /// procedure TfrmMain1.OfferImport(const AFile: THCLCatalogFile; const AArchivePath: String); var Plan: THCLImportPlan; ImpResult: THCLImportResult; ParentName: String; IsCommonDB: Boolean; DLLTarget: THCLDLLTarget; Msg: String; I: Integer; Cat: THCLCategory; Bundles: THCLBundledDBArray; IsPlatformDB: Boolean; ScenarioDB, ArchivePath: String; DBRequired, DBParent, DBNote, DBError: String; DBNeedsDownload: Boolean; DBFile: THCLCatalogFile; begin if not (Assigned(FImport) and Assigned(FFileOrg)) then Exit; ArchivePath := AArchivePath; if not SameText(ExtractFileExt(AArchivePath), '.zip') then begin StatusBar1.SimpleText := 'Downloaded (not a ZIP archive, so not extracted): ' + AArchivePath; Exit; end; // Platform databases: a collection (several commondb.res directories) // becomes one PlatformDB each; a single one may lack its pictures. Bundles := nil; if HCLArtifactTypeToCategory(AFile.ArtifactType, Cat) and (Cat = hclPlatformDBs) then begin Bundles := HCLFindBundledDBs(FArchive.ListEntries(AArchivePath)); if Length(Bundles) > 1 then begin ImportPlatformDBCollection(AFile, AArchivePath, Bundles); Exit; end; end; // An ExportDLL goes in one of three places. Ask only when the archive does // not already say, by laying its DLLs out under GE\ and/or SE\ itself. DLLTarget := dtUnspecified; if SameText(Trim(AFile.ArtifactType), HCL_ARTIFACT_EXPORTDLL) then begin DLLTarget := HCLDetectDLLTarget(FArchive.ListEntries(AArchivePath)); if DLLTarget = dtUnspecified then case QuestionDlg('Install ExportDLL', AFile.Title + ' does not say whether it is for the GE, the SE, ' + 'or both.' + LineEnding + LineEnding + 'Where should it be installed?', mtConfirmation, [mrYes, 'GE only', mrNo, 'SE only', mrAll, 'Both GE and SE', mrCancel, 'Cancel'], 0) of mrYes: DLLTarget := dtGE; mrNo: DLLTarget := dtSE; mrAll: DLLTarget := dtCommon; else Exit; end; end; // A scenario file records the exact platform database it was built with // ("HCDB-060103"), which beats the catalog's often generic "HCDB". ScenarioDB := ''; DBParent := ''; DBNote := ''; DBNeedsDownload := False; if SameText(Trim(AFile.ArtifactType), HCL_ARTIFACT_SCENARIO) then begin ScenarioDB := HCLScenarioDatabase(FArchive, AArchivePath); // Which database it goes with: the one it names if installed or in the // catalog, else the nearest newer build of that family, downloaded first. if ScenarioDB <> '' then DBRequired := ScenarioDB else DBRequired := Trim(AFile.Dependencies.PlatformDB); if not ResolveScenarioDatabase(DBRequired, DBParent, DBNote, DBNeedsDownload, DBFile) then DBParent := ScenarioDB; // unresolvable: as named, if the scenario named one end; if DBParent <> '' then Plan := FImport.PlanImport(AFile, DBParent, True) else Plan := FImport.PlanImport(AFile, '', False, DLLTarget); if Plan.Valid and (Plan.Kind = ikScenario) and Plan.IsCommonDB then ArchivePath := MoveToCategoryCache(AFile, AArchivePath, hclPlatformDBs); // A scenario with no declared BattleSet or PlatformDB cannot be placed // without asking which one it belongs under. if Plan.RequiresParent then begin ParentName := ''; if not InputQuery('Install Scenario', 'This scenario does not declare a BattleSet or PlatformDB.' + LineEnding + 'Enter the BattleSet name (or PlatformDB version) to install it under:', ParentName) then Exit; ParentName := Trim(ParentName); if ParentName = '' then Exit; IsCommonDB := MessageDlg('Install Scenario', 'Is "' + ParentName + '" a PlatformDB version?' + LineEnding + LineEnding + 'Yes — install under PlatformDBs' + LineEnding + 'No — install under BattleSets', mtConfirmation, [mbYes, mbNo], 0) = mrYes; Plan := FImport.PlanImport(AFile, ParentName, IsCommonDB); end; if not Plan.Valid then begin StatusBar1.SimpleText := 'Downloaded (not extracted): ' + Plan.Reason; Exit; end; IsPlatformDB := (Plan.Category = hclPlatformDBs) and (Plan.Kind = ikNamedArtifact); Msg := 'Extract ' + AFile.Title + ' into:' + LineEnding + LineEnding + Plan.DestDir + '?'; if ScenarioDB <> '' then Msg := Msg + LineEnding + LineEnding + Format('The scenario file says it was built ' + 'with the %s platform database.', [ScenarioDB]); if DBNote <> '' then Msg := Msg + LineEnding + LineEnding + DBNote else if (Plan.Kind = ikScenario) and Plan.IsCommonDB and not FileExists(FFileOrg.GetPlatformDBPath(Plan.ParentName) + PathDelim + HCL_COMMONDB_RES) then Msg := Msg + LineEnding + LineEnding + Plan.ParentName + ' is not in ' + FFileOrg.GetCategoryPath(hclPlatformDBs) + ' yet.'; if IsPlatformDB and (Length(Bundles) = 1) and not Bundles[0].HasRsr and (PicturesNote(AFile, 1) <> '') then Msg := Msg + LineEnding + LineEnding + PicturesNote(AFile, 1); if MessageDlg('Extract Archive', Msg, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then Exit; // The database first, so the scenario lands beside a database it can use. // A failure is reported but does not stop the scenario itself. if DBNeedsDownload and not InstallDatabase(DBFile, DBError) then MessageDlg('Platform Database Not Installed', Format('%s could not be downloaded or ' + 'installed:' + LineEnding + '%s' + LineEnding + LineEnding + 'The scenario will still be ' + 'placed in %s; download the database from the Downloads tab later.', [DBParent, DBError, Plan.DestDir]), mtWarning, [mbOK], 0); prgDownload.Visible := True; prgDownload.Position := 0; SetDownloadsBusy(False); StatusBar1.SimpleText := 'Extracting ' + AFile.Title + '...'; try ImpResult := FImport.Execute(Plan, ArchivePath, omOverwrite, @OnExtractProgress); finally prgDownload.Visible := False; SetDownloadsBusy(True); end; if not ImpResult.Success then begin StatusBar1.SimpleText := 'Extract failed: ' + ImpResult.ErrorMessage; MessageDlg('Extract Failed', ImpResult.ErrorMessage, mtError, [mbOK], 0); Exit; end; Msg := Format('Extracted %d file(s) to %s', [ImpResult.FilesExtracted, ImpResult.DestDir]); if ImpResult.FilesSkipped > 0 then Msg := Msg + Format(' (%d skipped)', [ImpResult.FilesSkipped]); StatusBar1.SimpleText := Msg; if IsPlatformDB then PlaceCompanionFiles(AFile, [ImpResult.DestDir]); // A hostile archive is worth telling the user about explicitly rather than // leaving it to a status-bar line they may never read. if Length(ImpResult.UnsafeEntries) > 0 then begin Msg := ''; for I := 0 to High(ImpResult.UnsafeEntries) do Msg := Msg + LineEnding + ImpResult.UnsafeEntries[I]; MessageDlg('Unsafe Archive Entries', Format('%d entry/entries in this archive named a path outside the ' + 'destination directory and were not extracted:' + LineEnding + '%s', [Length(ImpResult.UnsafeEntries), Msg]), mtWarning, [mbOK], 0); end; end; // --------------------------------------------------------------------------- // Platform database collections and companion files // --------------------------------------------------------------------------- ///

/// Looks up the catalog entry that supplies commondb.rsr for AFile. ///

/// A PlatformDB catalog file. /// Receives the supplying entry. /// True when AFile names one and it is in the loaded catalog. function TfrmMain1.FindPicturesCompanion(const AFile: THCLCatalogFile; out ACompanion: THCLCatalogFile): Boolean; var I: Integer; begin ACompanion := Default(THCLCatalogFile); for I := 0 to High(AFile.Companions) do if SameText(AFile.Companions[I].Provides, HCL_COMMONDB_RSR) then begin ACompanion := FCatalog.FindFile(AFile.Companions[I].ID); if (ACompanion.ID <> '') and not ACompanion.ExternalLink then Exit(True); end; Result := False; end; ///

/// One sentence for a confirmation dialog about the picture file that will /// be fetched for databases that name one. ///

/// The PlatformDB catalog file being imported. /// How many databases lack commondb.rsr. /// What will be fetched; '' when AFile names no picture file, since /// such a database uses the stock commondb.rsr and needs nothing. function TfrmMain1.PicturesNote(const AFile: THCLCatalogFile; ACount: Integer): String; var Companion: THCLCatalogFile; begin Result := ''; if not FindPicturesCompanion(AFile, Companion) then Exit; Result := Format('It uses its own pictures: "%s" (%s) will also be downloaded, ' + 'and a copy of its %s placed with ', [Companion.Title, FormatFileSize(Companion.Size), HCL_COMMONDB_RSR]); if ACount > 1 then Result := Result + Format('each of the %d databases.', [ACount]) else Result := Result + 'it.'; end; ///

/// Supplies the files that AFile's catalog entry says come from another /// entry, such as the shared commondb.rsr, to each directory in ADirs /// that lacks them. Downloads the supplying entry when needed. ///

/// The catalog file that was imported. /// The PlatformDB directories it was imported into. procedure TfrmMain1.PlaceCompanionFiles(const AFile: THCLCatalogFile; const ADirs: array of String); var Needy: array of String; Companion: THCLCatalogFile; ZipPath, ErrorMessage, Staging: String; I, Placed: Integer; begin Needy := nil; for I := 0 to High(ADirs) do if HCLPlatformDBNeedsRsr(ADirs[I]) then begin SetLength(Needy, Length(Needy) + 1); Needy[High(Needy)] := ADirs[I]; end; // Without a named picture file the database uses the stock commondb.rsr // in the game directory: nothing to place. if (Length(Needy) = 0) or not FindPicturesCompanion(AFile, Companion) then Exit; // The companion's cached ZIP is reused if it is already there and intact. if not DownloadCatalogFile(Companion, ZipPath, ErrorMessage) then begin StatusBar1.SimpleText := Format('Imported, but %s could not be downloaded: %s', [Companion.Title, ErrorMessage]); MessageDlg('Pictures Missing', Format('The %s for %s could not be downloaded:' + LineEnding + '%s' + LineEnding + LineEnding + 'Download "%s" and try again.', [HCL_COMMONDB_RSR, AFile.Title, ErrorMessage, Companion.Title]), mtWarning, [mbOK], 0); Exit; end; // Extracted once beside the cached ZIP; each database gets its own copy // so every PlatformDB directory is complete on its own. Staging := ExtractFilePath(ZipPath) + 'extracted' + PathDelim + HCLSanitizeDirName(ChangeFileExt(ExtractFileName(ZipPath), '')); SetDownloadsBusy(False); StatusBar1.SimpleText := Format('Placing %s from %s...', [HCL_COMMONDB_RSR, Companion.Title]); StatusBar1.Repaint; try Placed := HCLPlaceCompanionFile(FArchive, ZipPath, HCL_COMMONDB_RSR, Staging, Needy, ErrorMessage); finally SetDownloadsBusy(True); end; if ErrorMessage <> '' then begin StatusBar1.SimpleText := Format('Placed %s in %d of %d database(s): %s', [HCL_COMMONDB_RSR, Placed, Length(Needy), ErrorMessage]); MessageDlg('Pictures Missing', StatusBar1.SimpleText, mtWarning, [mbOK], 0); end else StatusBar1.SimpleText := Format('Imported; %s from %s placed in %d database(s)', [HCL_COMMONDB_RSR, Companion.Title, Placed]); end; ///

/// Imports an archive holding several platform databases, such as the /// hc-timelines-db collection, as one PlatformDB each. ///

/// Catalog entry the archive came from. /// Full path to the downloaded archive. /// Its databases, from HCLFindBundledDBs. procedure TfrmMain1.ImportPlatformDBCollection(const AFile: THCLCatalogFile; const AArchivePath: String; const ABundles: THCLBundledDBArray); var Plans: array of THCLImportPlan; Dirs: array of String; Plan: THCLImportPlan; ImpResult: THCLImportResult; Msg, Failures: String; I, NoPictures, Extracted, Unsafe: Integer; begin Plans := nil; NoPictures := 0; Msg := ''; for I := 0 to High(ABundles) do begin Plan := FImport.PlanBundledDB(AFile, ABundles[I]); if not Plan.Valid then Continue; SetLength(Plans, Length(Plans) + 1); Plans[High(Plans)] := Plan; Msg := Msg + LineEnding + ' ' + Plan.ArtifactName; if not ABundles[I].HasRsr then Inc(NoPictures); end; if Length(Plans) = 0 then begin StatusBar1.SimpleText := 'Downloaded (not extracted): no database in ' + AFile.Title + ' could be named'; Exit; end; Msg := Format('%s contains %d platform databases:%s' + LineEnding + LineEnding + 'Import each into its own folder under' + LineEnding + '%s?', [AFile.Title, Length(Plans), Msg, FFileOrg.GetCategoryPath(hclPlatformDBs)]); if (NoPictures > 0) and (PicturesNote(AFile, NoPictures) <> '') then Msg := Msg + LineEnding + LineEnding + PicturesNote(AFile, NoPictures); if MessageDlg('Import Platform Databases', Msg, mtConfirmation, [mbYes, mbNo], 0) <> mrYes then Exit; Dirs := nil; Failures := ''; Extracted := 0; Unsafe := 0; prgDownload.Visible := True; SetDownloadsBusy(False); try for I := 0 to High(Plans) do begin prgDownload.Position := 0; StatusBar1.SimpleText := Format('Extracting %s (%d of %d)...', [Plans[I].ArtifactName, I + 1, Length(Plans)]); StatusBar1.Repaint; ImpResult := FImport.Execute(Plans[I], AArchivePath, omOverwrite, @OnExtractProgress); Unsafe := Unsafe + Length(ImpResult.UnsafeEntries); if ImpResult.Success then begin Inc(Extracted, ImpResult.FilesExtracted); SetLength(Dirs, Length(Dirs) + 1); Dirs[High(Dirs)] := ImpResult.DestDir; end else Failures := Failures + LineEnding + Plans[I].ArtifactName + ': ' + ImpResult.ErrorMessage; end; finally prgDownload.Visible := False; SetDownloadsBusy(True); end; StatusBar1.SimpleText := Format('Imported %d of %d databases (%d files) into %s', [Length(Dirs), Length(Plans), Extracted, FFileOrg.GetCategoryPath(hclPlatformDBs)]); if Failures <> '' then MessageDlg('Import Failed', 'Some databases could not be imported:' + Failures, mtError, [mbOK], 0); if Unsafe > 0 then MessageDlg('Unsafe Archive Entries', Format('%d entry/entries in this archive named ' + 'a path outside the destination directory and were not extracted.', [Unsafe]), mtWarning, [mbOK], 0); if Length(Dirs) > 0 then PlaceCompanionFiles(AFile, Dirs); end; // --------------------------------------------------------------------------- // OnExtractProgress // --------------------------------------------------------------------------- ///

/// Forwarded from the archive handler; advances prgDownload as each entry is /// written. ///

/// The archive handler raising the event. /// Archive-relative name of the current entry. /// 1-based index of the current entry. /// Total number of entries being extracted. procedure TfrmMain1.OnExtractProgress(ASender: TObject; const AEntryName: String; AEntryIndex, AEntryCount: Integer); begin if AEntryCount > 0 then begin prgDownload.Max := 100; prgDownload.Position := Integer((Int64(AEntryIndex) * 100) div AEntryCount); prgDownload.Repaint; end; // Do NOT call Application.ProcessMessages — causes re-entrancy (Bug 3) end; // --------------------------------------------------------------------------- // OnDownloadProgress // --------------------------------------------------------------------------- ///

/// Forwarded from the downloader; updates prgDownload and pumps the message /// loop so the UI remains responsive. ///

procedure TfrmMain1.OnDownloadProgress(ASender: TObject; ABytesReceived, ATotalBytes: Int64); begin if ATotalBytes > 0 then begin prgDownload.Max := 100; prgDownload.Position := Integer((ABytesReceived * 100) div ATotalBytes); prgDownload.Repaint; end; // Do NOT call Application.ProcessMessages — causes re-entrancy (Bug 3) end; // --------------------------------------------------------------------------- // edtSearchChange // --------------------------------------------------------------------------- ///

/// Filters the file list to entries whose title contains the search text. /// Clears back to the category selection when the search box is empty. ///

procedure TfrmMain1.edtSearchChange(Sender: TObject); var Files: THCLCatalogFileArray; begin if edtSearch.Text = '' then begin tvCategoriesSelectionChanged(nil); Exit; end; Files := FCatalog.SearchFiles(edtSearch.Text); PopulateFileList(Files); end; // --------------------------------------------------------------------------- // lvFilesColumnClick — sort by clicked column // --------------------------------------------------------------------------- ///

/// Sorts lvFiles by the clicked column, toggling direction on a repeated click. /// Encodes direction into the Data parameter: non-negative = ascending, /// negative (-(col+1)) = descending. ///

procedure TfrmMain1.lvFilesColumnClick(Sender: TObject; Column: TListColumn); var SortData: PtrInt; begin if FSortColumn = Column.Index then FSortAscending := not FSortAscending else begin FSortColumn := Column.Index; FSortAscending := True; end; if FSortAscending then SortData := FSortColumn else SortData := -(FSortColumn + 1); // encode: col 0 asc -> 0, col 0 desc -> -1 lvFiles.CustomSort(@CompareListItems, SortData); end; // --------------------------------------------------------------------------- // FormatFileSize // --------------------------------------------------------------------------- ///

Returns a human-readable representation of a byte count.

function TfrmMain1.FormatFileSize(ABytes: Int64): String; begin if ABytes = 0 then Result := '' else if ABytes < 1024 then Result := IntToStr(ABytes) + ' B' else if ABytes < 1024 * 1024 then Result := Format('%.1f KB', [ABytes / 1024.0]) else Result := Format('%.1f MB', [ABytes / (1024.0 * 1024.0)]); end; // --------------------------------------------------------------------------- // GetSelectedFile // --------------------------------------------------------------------------- ///

/// Returns the for the currently highlighted /// row in lvFiles, or a default (empty) record when nothing is selected. ///

function TfrmMain1.GetSelectedFile: THCLCatalogFile; var Sel: TListItem; Idx: Integer; begin Result := Default(THCLCatalogFile); Sel := lvFiles.Selected; if Sel <> nil then begin Idx := PtrInt(Sel.Data); if (Idx >= 0) and (Idx <= High(FCurrentFiles)) then Result := FCurrentFiles[Idx]; end; end; ///

/// The selected file in the version chosen in cbxFileVersion (item 0 is the /// current version, item N is Versions[N-1]). ///

function TfrmMain1.GetSelectedFileVersion: THCLCatalogFile; begin Result := GetSelectedFile; if (Result.ID <> '') and (cbxFileVersion.ItemIndex >= 1) then Result := HCLSelectVersion(Result, cbxFileVersion.ItemIndex - 1); end; end.