From 5f636a90f1d0199823a2e52575dd7526b395633e Mon Sep 17 00:00:00 2001 From: Claude Date: Wed, 1 Apr 2026 23:46:18 +0000 Subject: [PATCH 1/4] Fix config CreateInf (and other context settings) having no effect in CLI TCLICommandProcessor.Create initialised TDiscImageContext with hardcoded defaults and never read the saved values back from TRegistrySettings, so settings like CreateINF were always reset to True on startup. A second gap meant that running 'config CreateInf False' within a session also had no effect: CmdConfig only wrote to FSettings but never updated the live FContext. Fix: add LoadContextSettings which copies all relevant boolean/integer settings from FSettings into FContext, and call it from both constructors (so saved settings apply at startup) and from CmdConfig after a successful set (so changes take effect immediately in the current session). https://claude.ai/code/session_01XLd69sGHEVkNG7xYN2nFLW --- LazarusSource/CLICommands.pas | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/LazarusSource/CLICommands.pas b/LazarusSource/CLICommands.pas index b02d55f..f964ab7 100644 --- a/LazarusSource/CLICommands.pas +++ b/LazarusSource/CLICommands.pas @@ -54,6 +54,7 @@ TCLICommandProcessor = class function GetDriveSize(const GivenSize: String): Cardinal; procedure ShowHelp; procedure ListCatalogueEx(const Mode: String); + procedure LoadContextSettings; // Command handlers procedure CmdAccess(const Params: TStringArray); procedure CmdAdd(const Params: TStringArray); @@ -174,6 +175,21 @@ implementation { TCLICommandProcessor } +procedure TCLICommandProcessor.LoadContextSettings; +begin + FContext.CreateINF := FSettings.GetBool('CreateINF', True); + FContext.AddImpliedAttributes := FSettings.GetBool('AddImpliedAttributes', True); + FContext.HideDEL := FSettings.GetBool('Hide_CDR_DEL', True); + FContext.ScanSubDirs := FSettings.GetBool('Scan_SubDirs', True); + FContext.OpenDOS := FSettings.GetBool('Open_DOS', True); + FContext.CreateDSC := FSettings.GetBool('Create_DSC', False); + FContext.DFSZeroSecs := FSettings.GetBool('DFS_Zero_Sectors', False); + FContext.DFSBeyondEdge := FSettings.GetBool('DFS_Beyond_Edge', True); + FContext.DFSAllowBlank := FSettings.GetBool('DFS_Allow_Blanks', False); + FContext.SparkIsFS := FSettings.GetBool('Spark_Is_FS', True); + FContext.ADFSInterleave := FSettings.GetInt ('ADFS_L_Interleave', 0); +end; + constructor TCLICommandProcessor.Create; begin inherited Create; @@ -183,6 +199,7 @@ constructor TCLICommandProcessor.Create; FOwnsSettings := True; FConsoleWidth := 80; FUseColors := True; + LoadContextSettings; end; constructor TCLICommandProcessor.Create(AContext: TDiscImageContext; @@ -195,6 +212,7 @@ constructor TCLICommandProcessor.Create(AContext: TDiscImageContext; FOwnsSettings := False; FConsoleWidth := 80; FUseColors := True; + LoadContextSettings; end; destructor TCLICommandProcessor.Destroy; @@ -1561,7 +1579,10 @@ procedure TCLICommandProcessor.CmdConfig(const Params: TStringArray); end; end; if Ok then + begin + LoadContextSettings; WriteLn('Configuration option set.') + end else WriteLnColored('Invalid configuration option.', clRed); end From 2a984eb3f6782161be1024b36eeb80250487ce8f Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 2 Feb 2026 05:12:40 +0000 Subject: [PATCH 2/4] Remove console mode from GUI build The CLI functionality is now provided by the standalone DiscImageManagerCLI binary, eliminating code duplication between the GUI console mode and CLI. Changes: - Remove ConsoleAppUnit.pas from GUI project - Remove MainUnit_Console.pas include from MainUnit.pas - Remove ParseCommand declaration from TMainForm - Remove CheckConsole call from main program - Update project file to remove ConsoleAppUnit Users wanting command-line access should use the separate CLI build which doesn't require X11/GUI dependencies. https://claude.ai/code/session_01H1suvkNPi2MVsX1y9Qy86P --- LazarusSource/DiscImageManager.lpi | 12 ++++-------- LazarusSource/DiscImageManager.lpr | 13 +++---------- LazarusSource/MainUnit.pas | 5 +---- 3 files changed, 8 insertions(+), 22 deletions(-) diff --git a/LazarusSource/DiscImageManager.lpi b/LazarusSource/DiscImageManager.lpi index a10c428..a872d4e 100644 --- a/LazarusSource/DiscImageManager.lpi +++ b/LazarusSource/DiscImageManager.lpi @@ -382,7 +382,7 @@ - + @@ -519,20 +519,16 @@ - - - - - - + + - + diff --git a/LazarusSource/DiscImageManager.lpr b/LazarusSource/DiscImageManager.lpr index 269c2b1..75618ba 100644 --- a/LazarusSource/DiscImageManager.lpr +++ b/LazarusSource/DiscImageManager.lpr @@ -22,7 +22,7 @@ {$MODE objFPC}{$H+} uses - Forms,Interfaces,ConsoleAppUnit, + Forms,Interfaces, MainUnit in 'MainUnit.pas', DiscImage in 'DiscImage.pas', AboutUnit in 'AboutUnit.pas', @@ -69,13 +69,6 @@ Application.CreateForm(TChangeInterleaveForm, ChangeInterleaveForm); Application.CreateForm(TCSVPrefForm, CSVPrefForm); Application.CreateForm(TImageReportForm, ImageReportForm); - //Check if console needs to be run - if not CheckConsole then - begin - {$IFDEF Windows} - IsConsole:=False; - {$ENDIF} - Application.CreateForm(TRFSDetailForm, RFSDetailForm); - Application.Run; //Open as normal - end; + Application.CreateForm(TRFSDetailForm, RFSDetailForm); + Application.Run; end. diff --git a/LazarusSource/MainUnit.pas b/LazarusSource/MainUnit.pas index 04e769e..9291655 100755 --- a/LazarusSource/MainUnit.pas +++ b/LazarusSource/MainUnit.pas @@ -410,7 +410,6 @@ TMainForm = class(TForm) Errors: Boolean=True): Integer; function IntToStrComma(size: Int64): String; procedure OpenImage(filename: String); - procedure ParseCommand(var Command: TStringArray); function QueryUnsaved: Boolean; procedure ReadInDirectory(Node: TTreeNode); procedure ReportError(error: String); @@ -620,7 +619,7 @@ implementation AboutUnit,NewImageUnit,ImageDetailUnit,ProgressUnit,SearchUnit, CustomDialogueUnit,ErrorLogUnit,SettingsUnit,ImportSelectorUnit, PWordEditorUnit,AFSPartitionUnit,ChangeInterleaveUnit,CSVPrefUnit, - ImageReportUnit,ConsoleAppUnit; + ImageReportUnit; {------------------------------------------------------------------------------- Add a new file to the disc image @@ -3087,8 +3086,6 @@ procedure TMainForm.DisableControls; // HasChanged :=False; end; -{$INCLUDE 'MainUnit_Console.pas'} - {------------------------------------------------------------------------------} //Rescale all the components {------------------------------------------------------------------------------} From a2eb818433b580d62e8b8dc37a58bf1c79d3dfcc Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 2 Feb 2026 05:20:46 +0000 Subject: [PATCH 3/4] Remove console mode files and fix remaining console references - Delete ConsoleAppUnit.pas (no longer used by GUI) - Delete MainUnit_Console.pas (no longer used by GUI) - Remove console fallback in ReportError that used cmdRed/cmdNormal - Simplify ReportError to always use GUI dialogs The CLI functionality is now provided by the standalone DiscImageManagerCLI binary. These old console mode files are no longer needed. https://claude.ai/code/session_01H1suvkNPi2MVsX1y9Qy86P --- LazarusSource/ConsoleAppUnit.pas | 318 -------- LazarusSource/MainUnit.pas | 18 +- LazarusSource/MainUnit_Console.pas | 1092 ---------------------------- 3 files changed, 7 insertions(+), 1421 deletions(-) delete mode 100644 LazarusSource/ConsoleAppUnit.pas delete mode 100644 LazarusSource/MainUnit_Console.pas diff --git a/LazarusSource/ConsoleAppUnit.pas b/LazarusSource/ConsoleAppUnit.pas deleted file mode 100644 index 8fa1e24..0000000 --- a/LazarusSource/ConsoleAppUnit.pas +++ /dev/null @@ -1,318 +0,0 @@ -unit ConsoleAppUnit; - -{$IFDEF Darwin} -{$modeswitch objectivec1} -{$ENDIF} - -{ -Copyright (C) 2018-2025 Gerald Holdsworth gerald@hollypops.co.uk - -This source is free software; you can redistribute it and/or modify it under -the terms of the GNU General Public Licence as published by the Free -Software Foundation; either version 3 of the Licence, or (at your option) -any later version. - -This code is distributed in the hope that it will be useful, but WITHOUT ANY -WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU General Public Licence for more -details. - -A copy of the GNU General Public Licence is available on the World Wide Web -at . You can also obtain it by writing -to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, -Boston, MA 02110-1335, USA. -} - -interface - -uses - {$IFDEF Windows}Windows,{$ENDIF} //For Windows console - {$IFDEF Linux}BaseUnix,{$ENDIF} //For Linux console - {$IFDEF Darwin}typinfo,CocoaAll,{$ENDIF} //For macOS console - Classes, SysUtils, CustApp, MainUnit, Forms, DiscImage; - -type - - { TConsoleApp } - - TConsoleApp = class(TCustomApplication) - public - constructor Create(TheOwner: TComponent); override; - destructor Destroy; override; - function UserInterface: Boolean; - procedure ReadInput(var input: String); - private - ScriptOpen: Boolean; - ScriptFile: TFileStream; - function ProcessInput(Input: String): TStringArray; - end; - -function CheckConsole: Boolean; -var - ConsoleApp: TConsoleApp; - //Command line style modifiers - cmdNormal : String=''; - cmdBold : String=''; - cmdItalic : String=''; - cmdInverse : String=''; - cmdRed : String=''; - cmdGreen : String=''; - cmdYellow : String=''; - cmdBlue : String=''; - cmdMagenta : String=''; - cmdCyan : String=''; -const - //Command line font modifiers - FcmdNormal = #$1B'[0m'; - FcmdBold = #$1B'[1m'; - FcmdItalic = #$1B'[3m'; - FcmdInverse= #$1B'[7m'; - FcmdRed = #$1B'[91m'; - FcmdGreen = #$1B'[92m'; - FcmdYellow = #$1B'[93m'; - FcmdBlue = #$1B'[94m'; - FcmdMagenta= #$1B'[95m'; - FcmdCyan = #$1B'[96m'; - //Number of rows for the console - ConsoleWidth=80; - -implementation - -{------------------------------------------------------------------------------- -Create the class instance --------------------------------------------------------------------------------} -function CheckConsole: Boolean; - function IsRunFromConsole: Boolean; - {$IFDEF Windows} - var - StartUp: StartUpInfoA; - {$ENDIF} - begin - Result:=False;//Default, if not covered by Windows, Linux or Darwin - {$IFDEF Windows} - StartUp.dwFlags:=0;//Prevents 'variable not initialised' message - GetStartupInfo(StartUp); - Result:=(StartUp.dwFlags AND 1)<>1; - {$ENDIF} - {$IFDEF Linux} - Result:=fpReadLink('/proc/'+fpGetppid.ToString+'/exe')<>''; - {$ENDIF} - {$IFDEF Darwin} - Result:=NSProcessInfo.ProcessInfo.environment.objectForKey(NSStr('XPC_SERVICE_NAME')).UTF8String='0'; - {$ENDIF} - end; -{$IFDEF Windows} -var - hwConsole : hWnd; - lwMode : LongWord; -{$ENDIF} -begin - Result:=False; - //'console' passed as a parameter - if((Application.HasOption('c','console')) - or(IsRunFromConsole)) - and(not Application.HasOption('g','gui'))then - begin - //Windows does not create a console for GUI applications, so we need to - {$IFDEF Windows} - //Blank the styles for older versions of Windows - cmdNormal :=''; - cmdBold :=''; - cmdItalic :=''; - cmdInverse:=''; - cmdRed :=''; - cmdGreen :=''; - cmdYellow :=''; - cmdBlue :=''; - cmdMagenta:=''; - cmdCyan :=''; - //Create the console - AllocConsole; - IsConsole:=True; - SysInitStdIO; - SetConsoleOutputCP(CP_UTF8);//So that the escape sequences will work - //Try and enable virtual terminal processing - hwConsole:=GetStdHandle(STD_OUTPUT_HANDLE); - If GetConsoleMode(hwConsole,@lwMode)then - begin - lwMode:=lwMode or ENABLE_VIRTUAL_TERMINAL_PROCESSING; - if SetConsoleMode(hwConsole,lwMode)then - begin - {$ENDIF} - //Set the styles for Windows that does support it, as well as macOS and Linux - cmdNormal :=FcmdNormal; - cmdBold :=FcmdBold; - cmdItalic :=FcmdItalic;//Ignored by Windows - cmdInverse:=FcmdInverse; - cmdRed :=FcmdRed; - cmdGreen :=FcmdGreen; - cmdYellow :=FcmdYellow; - cmdBlue :=FcmdBlue; - cmdMagenta:=FcmdMagenta; - cmdCyan :=FcmdCyan; - {$IFDEF Windows} - end; - end; - {$ENDIF} - //Create the console application - ConsoleApp:=TConsoleApp.Create(nil); - ConsoleApp.Title:=MainForm.ApplicationTitle+' Console'; - //Run the user interface - Result:=ConsoleApp.UserInterface; - //Close the console application - ConsoleApp.Free; - //Close the GUI application if not needed, otherwise open the GUI application - if Result then Application.Terminate; - end; -end; - -{------------------------------------------------------------------------------- -Create the class instance --------------------------------------------------------------------------------} -constructor TConsoleApp.Create(TheOwner: TComponent); -begin - inherited Create(TheOwner); - StopOnException:=True; -end; - -{------------------------------------------------------------------------------- -Destroy the class instance --------------------------------------------------------------------------------} -destructor TConsoleApp.Destroy; -begin - inherited Destroy; -end; - -{------------------------------------------------------------------------------- -The user interface (this passes the actual code back to the GUI unit) --------------------------------------------------------------------------------} -function TConsoleApp.UserInterface: Boolean; -var - input : String=''; - Lparams : TStringArray; - procedure OpenScript(script: String); - begin - if script<>'' then - if ScriptOpen then - WriteLn(cmdRed+'Script already running.'+cmdNormal) - else - if not FileExists(script) then - WriteLn(cmdRed+ - 'File '''+script+''' does not exist.'+cmdNormal) - else - begin - WriteLn('Running script '''+script+'''.'); - //Open the script file - ScriptFile:=TFileStream.Create(script,fmOpenRead or fmShareDenyNone); - ScriptOpen:=True; - end; - end; -begin - ScriptFile:=nil; - ScriptOpen:=False; - //Write out a header - Write(cmdRed+cmdInverse); - WriteLn(StringOfChar('*',ConsoleWidth)); - Write(cmdNormal+cmdBold); - Write(MainForm.ApplicationTitle+' Console V'+MainForm.ApplicationVersion); - WriteLn(' by Gerald J Holdsworth'); - WriteLn(); - WriteLn(MainForm.platform+' '+MainForm.arch); - WriteLn(cmdNormal); - //Did the user supply a file for commands to run? - OpenScript(Application.GetOptionValue('c','console')); - //Intialise the array - Lparams:=nil; - WriteLn(cmdBold+'Ready'+cmdNormal); - repeat - //Prompt for input - if MainForm.Image.FormatNumber<>diInvalidImg then //Change the colour depending on whether changed or not - if MainForm.HasChanged then Write(cmdRed) else Write(cmdBlue); - write(cmdBold+'>'+cmdNormal); - //Read a line of input from the user - ReadInput(input); - //Process the input - Lparams:=ProcessInput(input); - if Lparams[0]='runscript' then - if Length(Lparams)>1 then - OpenScript(Lparams[1]); - //Parse the command - MainForm.ParseCommand(Lparams); - //End of the script? Then close the file - if ScriptOpen then - if ScriptFile.Position=ScriptFile.Size then - begin - ScriptFile.Free; - ScriptOpen:=False; - end; - //Continue until the user specifies to exit - until(Lparams[0]='exit')or(Lparams[0]='exittogui'); - //Script file still open? Then close it - if ScriptOpen then ScriptFile.Free; - //Footer at close of console - Write(cmdRed+cmdInverse); - Write(StringOfChar('*',ConsoleWidth)); - WriteLn(cmdNormal); - //Exit or not? - Result:=LowerCase(Lparams[0])='exit'; -end; - -{------------------------------------------------------------------------------- -Get a line of input --------------------------------------------------------------------------------} -procedure TConsoleApp.ReadInput(var input: String); -var - B: Byte=0; -begin - if not ScriptOpen then ReadLn(input) - else - begin //Or from the file - input:=''; - B:=0; - repeat - if ScriptFile.Position31)and(B<127)then input:=input+Chr(B); //Valid printable character? - until(B=$0A)or(ScriptFile.Position=ScriptFile.Size); //End of line with $0A or end of file - WriteLn(input); //Output the line, as if entered by the user - end; -end; - -{------------------------------------------------------------------------------- -Process the input string --------------------------------------------------------------------------------} -function TConsoleApp.ProcessInput(Input: String): TStringArray; -var - Index : Integer=0; - j : Integer=0; -begin - //Split the string at each space, unless enclosed by quotes - Result:=Input.Split(' ','"'); - //Anything entered? - if Length(Result)>0 then - begin //Remove any blank entries - Index:=0; - while Index0 then - //Remove the quotes - for Index:=0 to Length(Result)-1 do - Result[Index]:=Result[Index].DeQuotedString('"') - else //Input was empty, so create a blank entry - begin - SetLength(Result,1); - Result[0]:=''; - end; -end; - -end. diff --git a/LazarusSource/MainUnit.pas b/LazarusSource/MainUnit.pas index 9291655..c46c07b 100755 --- a/LazarusSource/MainUnit.pas +++ b/LazarusSource/MainUnit.pas @@ -7350,18 +7350,14 @@ procedure TMainForm.ReportError(error: String); begin //Remove the top bit, if present RemoveTopBit(error); - if Fguiopen then - begin - WriteToDebug('MainForm.ReportError('+error+')'); - if ErrorReporting then - if Fstyling=RISCOSStyle then - CustomDialogue.ShowError(error,'') - else - MessageDlg(error,mtError,[mbOK],0) + WriteToDebug('MainForm.ReportError('+error+')'); + if ErrorReporting then + if Fstyling=RISCOSStyle then + CustomDialogue.ShowError(error,'') else - ErrorLogForm.ErrorLog.Lines.Add(error); - end - else if ErrorReporting then WriteLn(cmdRed+error+cmdNormal); + MessageDlg(error,mtError,[mbOK],0) + else + ErrorLogForm.ErrorLog.Lines.Add(error); end; {------------------------------------------------------------------------------} diff --git a/LazarusSource/MainUnit_Console.pas b/LazarusSource/MainUnit_Console.pas deleted file mode 100644 index 0d389da..0000000 --- a/LazarusSource/MainUnit_Console.pas +++ /dev/null @@ -1,1092 +0,0 @@ -{------------------------------------------------------------------------------- -Parse commands sent through via the console --------------------------------------------------------------------------------} -procedure TMainForm.ParseCommand(var Command: TStringArray); -type - searchresult = Record - Filename: String; - Directory: Boolean; - end; -var - error : Integer=0; - Lcurrdir : Integer=0; - opt : Integer=0; - Index : Integer=0; - ptr : Integer=0; - Lparent : String=''; - temp : String=''; - format : String=''; - dir : Cardinal=0; - entry : Cardinal=0; - harddrivesize: Cardinal=0; - dirtype : Byte=0; - known : Boolean=False; - ok : Boolean=False; - newmap : Boolean=False; - searchlist : TSearchRec; - Files : TSearchResults; - OSFiles : array of searchresult; - filedetails : TDirEntry=(); - filelist : TStringList; -const - DiscFormats = //Accepted format strings - 'DFSS80 DFSS40 DFSD80 DFSD40 WDFSS40 WDFSS40 WDFSD80 WDFSD40 ADFSS ADFSM '+ - 'ADFSL ADFSD ADFSE ADFSE+ ADFSF ADFSF+ C1541 C1571 C1581 AMIGADD '+ - 'AMIGAHD CFS DOS+640 DOS+800 DOS360 DOS720 DOS1440 DOS2880 '; - DiscNumber : array[1..28] of Integer = //Accepted format numbers - ($001 ,$000 ,$011 ,$010 ,$021 ,$020 ,$031 ,$030 ,$100 ,$110, - $120 ,$130 ,$140 ,$150 ,$160 ,$170 ,$200 ,$210 ,$220 ,$400, - $410 ,$500 ,$A00 ,$A01 ,$A02 ,$A03 ,$A04 ,$A05); - Options : array[0..3] of String = ('none','load','run','exec'); //Boot options - Inter : array[0..3] of String = ('auto','seq', 'int','mux' ); //Interleave - //Configuration settings (registry) - Configs : array[0..42] of array[0..2] of String = ( - ('AddImpliedAttributes' ,'B','Add Implied Attributes for DFS/CFS/RFS'), - ('ADFS_L_Interleave' ,'I','0=Automatic; 1=Sequential; 2=Interleave; 3=Multiplex'), - ('Create_DSC' ,'B','Create *.dsc file with hard drives'), - ('CreateINF' ,'B','Create a *.inf file when extracting'), - ('CSVAddress' ,'B','Include the disc address in CSV file'), - ('CSVAttributes' ,'B','Include the file attributes in CSV file'), - ('CSVCRC32' ,'B','Include the CRC-32 in CSV file'), - ('CSVExecAddr' ,'B','Include the execution address in CSV file'), - ('CSVFilename' ,'B','Include the filename in CSV file'), - ('CSVIncDir' ,'B','Include directories in CSV file'), - ('CSVIncFilename' ,'B','Include image filename in CSV file'), - ('CSVIncReport' ,'B','Include image report in CSV file'), - ('CSVLength' ,'B','Include the file length in CSV file'), - ('CSVLoadAddr' ,'B','include the load address in CSV file'), - ('CSVMD5' ,'B','Include the MD5 in CSV file'), - ('CSVParent' ,'B','Include the parent in CSV file'), - ('Debug_Mode' ,'B','Is debug mode on?'), - ('DefaultADFSOptions' ,'I','Which ADFS format for new image dialogue'), - ('DefaultAFSCreatePWord','B','Whether to create password file for new AFS'), - ('DefaultAFSImageSize' ,'I','Default AFS image size'), - ('DefaultAFSOptions' ,'I','Which Acorn FS format for new image dialogue'), - ('DefaultAmigaOptions' ,'I','Which Amiga format for new image dialogue'), - ('DefaultC64Options' ,'I','Which Commodore 64 format for new image dialogue'), - ('DefaultDFSOptions' ,'I','Which DFS format for new image dialogue'), - ('DefaultDFSTOptions' ,'I','Which DFS track setting for new image dialogue'), - ('DefaultDOSOptions' ,'I','Which DOS format for new image dialogue'), - ('DefaultROMFSBinVers' ,'I','Default binary version number for new ROM FS'), - ('DefaultROMFSCopy' ,'S','Default copyright string to use for new ROM FS'), - ('DefaultROMFSTitle' ,'S','Default title to use for new ROM FS'), - ('DefaultROMFSVersion' ,'S','Default version to use for new ROM FS'), - ('DefaultSpecOptions' ,'I','Which Spectrum format for new image dialogue'), - ('DefaultSystemOptions' ,'I','Which system for new image dialogue'), - ('DFS_Allow_Blanks' ,'B','Allow blank filenames in DFS'), - ('DFS_Beyond_Edge' ,'B','Check for files going over the DFS disc edge'), - ('DFS_Zero_Sectors' ,'B','Allow DFS images with zero sectors'), - ('Hide_CDR_DEL' ,'B','Hide DEL files in Commodore images'), - ('Open_DOS' ,'B','Automatically open DOS partitions in ADFS'), - ('Scan_SubDirs' ,'B','Automatically scan sub-directories'), - ('Spark_Is_FS' ,'B','Treat Spark archives as file system'), - ('Texture' ,'I','Which texture background to use'), - ('UEF_Compress' ,'B','Compress UEF images when saving'), - ('View_Options' ,'I','Displays which menus are visible'), - ('WindowStyle' ,'I','Native or RISC OS styling')); - //Validate a filename, building a complete path if required - function ValidFile(thisfile: String): Boolean; - begin - //Build a complete path to the file, if required - if Image.FileExists(thisfile,dir,entry) then - temp:=thisfile - else - temp:=Image.GetParent(Fcurrdir) - +Image.GetDirSep(Image.Disc[Fcurrdir].Partition) - +thisfile; - //Does it exist? - Result:=Image.FileExists(temp,dir,entry); - end; - //Report the free space - procedure ReportFreeSpace; - var - free : QWord=0; - used : QWord=0; - total: QWord=0; - begin - free:=Image.FreeSpace(Image.Disc[Fcurrdir].Partition); - total:=Image.DiscSize(Image.Disc[Fcurrdir].Partition); - used:=total-free; - Write(cmdBold+IntToStr(free)+cmdNormal+' bytes free. '); - Write(cmdBold+IntToStr(used)+cmdNormal+' bytes used. '); - WriteLn(cmdBold+IntToStr(total)+cmdNormal+' bytes total.'); - end; - //Check for modified image - function Confirm: Boolean; - var - Lconfirm: String=''; - begin - Result:=True; - if HasChanged then - begin - Result:=False; - WriteLn('Image has been modified.'); - Write('Are you sure you want to continue? (yes/no): '); - ConsoleApp.ReadInput(Lconfirm); - if Length(Lconfirm)>0 then if LowerCase(Lconfirm[1])='y' then Result:=True; - end; - end; - //Get the image size - function GetDriveSize(GivenSize: String): Cardinal; - begin - //Default in Kilobytes - Result:=StrToIntDef(GivenSize,0); - //Has it been specified in Megabytes? - if UpperCase(RightStr(GivenSize,1))='M' then - Result:=StrToIntDef(LeftStr(GivenSize,Length(GivenSize)-1),0)*1024; - end; - //Wildcard filename search - function GetListOfFiles(Lfilesearch: String; LFiles: TSearchResults=nil): TSearchResults; - begin - ResetDirEntry(filedetails); - //Select the file - filedetails.Filename:=Lfilesearch; - filedetails.Parent:=Image.GetParent(Fcurrdir); - //First we look for the files - this will allow wildcarding - Result:=Image.FileSearch(filedetails,LFiles); - end; - //Build the filename - function BuildFilename(Lfile: TDirEntry): String; - begin - Result:=''; - if Lfile.Parent<>'' then - Result:=Lfile.Parent - +Image.GetDirSep(Image.Disc[Fcurrdir].Partition); - Result:=Result+Lfile.Filename; - end; -//Main procedure definition starts here -begin - ResetDirEntry(filedetails); - if Length(Command)=0 then exit; - //Convert the command to lower case - Command[0]:=LowerCase(Command[0]); - //'ls' command is the same as 'find *' - if Command[0]='ls' then - begin - SetLength(Command,2); - Command[0]:='find'; - Command[1]:='*'; - end; - //Error number - error:=0; - //Parse the command - case Command[0] of - //Change the access rights of a file +++++++++++++++++++++++++++++++++++++++++ - 'access': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then - begin - //No attributes given? Then pass none - if Length(Command)<3 then - begin - SetLength(Command,3); - Command[2]:=''; - end; - Files:=nil; - Files:=GetListOfFiles(Command[1]); - if Length(Files)>0 then - for Index:=0 to Length(Files)-1 do - begin - temp:=BuildFilename(Files[Index]); - Write('Changing attributes for '+temp+' '); - if Image.UpdateAttributes(temp,Command[2])then - begin - WriteLn(cmdGreen+'success.'+cmdNormal); - HasChanged:=True; - end else WriteLn(cmdRed+'failed.'+cmdNormal); - end - else WriteLn(cmdRed+'No files not found.'+cmdNormal) - end - else error:=2 - else error:=1; - //Add files ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'add','find': - if((Image.FormatNumber<>diInvalidImg)and(Command[0]='add')) - or (Command[0]='find')then - if Length(Command)>1 then //Are there any files given? - begin - SetLength(OSFiles,0); - for Index:=1 to Length(Command)-1 do //Just add a file - begin - ok:=True; //Add to list - if Command[Index][1]='|' then //Remove from list - begin - ok:=False; - Command[Index]:=Copy(Command[Index],2); - end; - //Can contain a wild card - FindFirst(Command[Index],faDirectory,searchlist); - //First thing we do is collate a list of files/directories - repeat - //These are previous and top directories, and nothing found - if (searchlist.Name<>'.') - and(searchlist.Name<>'..') - and(searchlist.Name<>'')then - begin - //New entry - if ok then - begin - ptr:=Length(OSFiles); - SetLength(OSFiles,ptr+1); - //Make a note of the filename - OSFiles[ptr].Filename:=ExtractFilePath(Command[Index])+searchlist.Name; - //And whether it is a directory or not - if(searchlist.Attr AND faDirectory)=faDirectory then - OSFiles[ptr].Directory:=True - else - OSFiles[ptr].Directory:=False; - end - else //Remove an entry - begin - temp:=ExtractFilePath(Command[Index])+searchlist.Name; - for ptr:=0 to Length(OSFiles)-1 do - if (OSFiles[ptr].Filename=temp) - and(OSFiles[ptr].Directory=((searchlist.Attr AND faDirectory)=faDirectory))then - OSFiles[ptr].Filename:=''; - end; - end; - //Next entry - until FindNext(searchlist)<>0; - //All done, then close the search - FindClose(searchlist); - //Next parameter - end; - //Now remove blank entries - ptr:=0; - while ptr=0; - end //Or list the file - else WriteLn(cmdBlue+'File'+cmdNormal+': ''' - +OSFiles[ptr].Filename+'''.'); - end; - //Write was a success - if(Command[0]='add')and(ok)then - begin - HasChanged:=True; - WriteLn(cmdGreen+' Success.'+cmdNormal); - end; - //Write was a failure - if(Command[0]='add')and(not ok)then WriteLn(cmdRed+' Failed.'+cmdNormal); - end; - end - else error:=2//Nothing has been passed - else error:=1;//No image - //Display a catalogue of the current directory +++++++++++++++++++++++++++++++ - 'cat': - if Image.FormatNumber<>diInvalidImg then - begin - //Default option - just catalogue the current directory - opt:=Fcurrdir; - ptr:=Fcurrdir; - //Has a parameter been passed? - if Length(Command)>1 then - if(LowerCase(Command[1])='all') //Cat all directories and entries - or(LowerCase(Command[1])='dir') //Just show all the directories - or(LowerCase(Command[1])='root')then//Just show the roots - begin - opt:=0; - ptr:=Length(Image.Disc)-1; - end - else Command[1]:='' //Invalid entry, so blank it - else //No parameter passed, so create a blank one - begin - SetLength(Command,2); - Command[1]:=''; - end; - for Lcurrdir:=opt to ptr do - begin - //List the catalogue - if(Command[1]='')or(LowerCase(Command[1])='all')then - begin - WriteLn(cmdBlue+StringOfChar('-',80)+cmdNormal); - WriteLn(cmdBold+'Catalogue listing for directory ' - +Image.GetParent(Lcurrdir)); - Write(PadRight(Image.Disc[Lcurrdir].Title,40)); - WriteLn('Option: '+IntToStr(Image.BootOpt[Image.Disc[Lcurrdir].Partition]) - +' (' - +UpperCase(Options[Image.BootOpt[Image.Disc[Lcurrdir].Partition]]) - +')'); - WriteLn('Number of entries: ' - +IntToStr(Length(Image.Disc[Lcurrdir].Entries))); - WriteLn(cmdNormal); - if Length(Image.Disc[Lcurrdir].Entries)>0 then - for Index:=0 to Length(Image.Disc[Lcurrdir].Entries)-1 do - begin - //Filename - Write(PadRight(Image.Disc[Lcurrdir].Entries[Index].Filename,10)); - //Attributes - Write(' ('+Image.Disc[Lcurrdir].Entries[Index].Attributes+')'); - //Files - if Image.Disc[Lcurrdir].Entries[Index].DirRef=-1 then - begin - //Filetype - ADFS, Spark only - if (Image.Disc[Lcurrdir].Entries[Index].FileType<>'') - and((Image.MajorFormatNumber=diAcornADFS) - or (Image.MajorFormatNumber=diSpark))then - Write(' '+Image.Disc[Lcurrdir].Entries[Index].FileType); - //Timestamp - ADFS, Spark, FileStore, Amiga and DOS only - if (Image.Disc[Lcurrdir].Entries[Index].TimeStamp>0) - and((Image.MajorFormatNumber=diAcornADFS) - or (Image.MajorFormatNumber=diSpark) - or (Image.MajorFormatNumber=diAcornFS) - or (Image.MajorFormatNumber=diAmiga) - or (Image.MajorFormatNumber=diDOSPlus))then - Write(' '+FormatDateTime(TimeDateFormat, - Image.Disc[Lcurrdir].Entries[Index].TimeStamp)); - if(Image.Disc[Lcurrdir].Entries[Index].TimeStamp=0) - or(Image.MajorFormatNumber=diAcornFS)then - begin - //Load address - Write(' '+IntToHex(Image.Disc[Lcurrdir].Entries[Index].LoadAddr,8)); - //Execution address - Write(' '+IntToHex(Image.Disc[Lcurrdir].Entries[Index].ExecAddr,8)); - end; - //Length - Write(' '+ConvertToKMG(Image.Disc[Lcurrdir].Entries[Index].Length)+ - ' ('+IntToHex(Image.Disc[Lcurrdir].Entries[Index].Length,8)+')'); - end; - //New line - WriteLn(); - end; - end; - //List only the directories or roots - if(LowerCase(Command[1])='dir')or(LowerCase(Command[1])='root')then - begin - //Roots have no parent, so will be '-1' - Write(cmdBold); - if Image.Disc[Lcurrdir].Parent=-1 then Write('Root: ') - else if LowerCase(Command[1])='dir' then Write('Directory: '); - Write(cmdNormal); - if(LowerCase(Command[1])='dir') - or((LowerCase(Command[1])='root')and(Image.Disc[Lcurrdir].Parent=-1))then - WriteLn(Image.GetParent(Lcurrdir)); - end; - end; - end else error:=1; - //Change the host directory ++++++++++++++++++++++++++++++++++++++++++++++++++ - 'chdir': if Length(Command)>1 then SetCurrentDir(Command[1]) else error:=2; - //Defrag +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'compact','defrag': - if Image.FormatNumber<>diInvalidImg then //Image inserted? - begin - //Get the drive/partition specification, default to 0 if none specified - if Length(Command)>1 then ptr:=StrToIntDef(Command[1],-1) - else ptr:=Image.Disc[Fcurrdir].Partition; - //Count number of sides/partitions - dir:=0; - for Index:=0 to Length(Image.Disc)-1 do - if Image.Disc[Index].Parent=-1 then inc(dir); - //Is it valid? - if(ptr>=0)and(ptr2)then - begin - ok:=False; - for Index:=0 to Length(Configs)-1 do - if UpperCase(Command[1])=UpperCase(Configs[Index,0]) then - begin - ok:=True; - case Configs[Index,1] of - 'B' : if LowerCase(Command[2])='true' then - DIMReg.SetRegValB(Configs[Index,0],True) - else - DIMReg.SetRegValB(Configs[Index,0],False); - 'I' : - begin - dir:=0; - if LowerCase(LeftStr(Command[2],2))='0x' then - dir:=StrToIntDef('$'+Copy(Command[2],3),0); - if(Command[2][1]='$')or(Command[2][1]='&')then - dir:=StrToIntDef('$'+Copy(Command[2],2),0); - if dir=0 then dir:=StrToIntDef(Command[2],0); - DIMReg.SetRegValI(Configs[Index,0],dir); - end; - 'S' : DIMReg.SetRegValS(Configs[Index,0],Command[2]); - end; - end; - if ok then WriteLn('Configuration option set.') - else WriteLn(cmdRed+'Invalid configuration option.'+cmdNormal); - end else - //Not enough parameters, so list the config options or current settings - begin - Write(cmdBold+cmdBlue); - if Command[0]='config' then Write('Valid configuration options') - else Write('Current configuration settings'); - WriteLn(cmdNormal); - WriteLn('Not all configurations are used by the console.'); - //Get the longest string - ptr:=1; - for Index:=0 to Length(Configs)-1 do - if Length(Configs[Index,0])>ptr then ptr:=Length(Configs[Index,0]); - //Display the current configs, or current settings - for Index:=0 to Length(Configs)-1 do - begin - Write(cmdRed+cmdBold+PadRight(Configs[Index,0],ptr)+cmdNormal+': '); - if Command[0]='config' then //Available settings - begin - Write(cmdRed); - case Configs[Index,1] of - 'B': Write('True|False'); - 'I': Write(''); - 'S': Write(''); - end; - WriteLn(cmdNormal); - if Configs[Index,2]<>'' then - WriteLn(StringOfChar(' ',ptr+2)+Configs[Index,2]); - end - else //Current settings - begin - if DIMReg.DoesKeyExist(Configs[Index,0]) then - case Configs[Index,1] of - 'B' : WriteLn(DIMReg.GetRegValB(Configs[Index,0])); - 'I' : WriteLn('0x'+IntToHex(DIMReg.GetRegValI(Configs[Index,0]),4)); - 'S' : WriteLn(DIMReg.GetRegValS(Configs[Index,0])); - end - else WriteLn(cmdRed+'Not set'+cmdNormal); - end; - end; - end; - //Creates a directory ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'create': - if Image.FormatNumber<>diInvalidImg then - begin - //Default directory name, if none given - temp:='NewDir'; - //See if there was a directory name given - if Length(Command)>1 then temp:=Command[1]; - Write('Create new directory '''+temp+''' '); - //Get the parent and set the attributes - Lparent:=Image.GetParent(Fcurrdir); - format:='DLR'; - //Create the directory - if Image.CreateDirectory(temp,Lparent,format)>=0 then - begin - WriteLn(cmdGreen+'success.'+cmdNormal); - HasChanged:=True; - end - else WriteLn(cmdRed+'failed.'+cmdNormal); - end - else error:=1;//No image - //Delete a specified file or directory +++++++++++++++++++++++++++++++++++++++ - 'delete': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then //Are there any files given? - for Index:=1 to Length(Command)-1 do - begin - //Try in the local directory - temp:=Image.GetParent(Fcurrdir) - +Image.GetDirSep(Image.Disc[Fcurrdir].Partition) - +Command[Index]; - ok:=Image.FileExists(temp,dir,entry); - //Nothing, so try fully qualified path - if not ok then - begin - temp:=Command[Index]; - ok:=Image.FileExists(temp,dir,entry); - end; - //Have we found something? - if ok then - begin - //Perform the deletion - if (Image.MajorFormatNumber<>diAcornUEF) - and(Image.MajorFormatNumber<>diAcornRFS)then - ok:=Image.DeleteFile(temp) - else - ok:=Image.DeleteFile(entry); - //Report findings - if ok then - begin - WriteLn(''''+Command[Index]+''' deleted.'); - HasChanged:=True; - end - else WriteLn(cmdRed+'Could not delete '''+Command[Index]+'''.'+cmdNormal); - end - else WriteLn(cmdRed+''''+Command[Index]+''' not found.'+cmdNormal); - end - else error:=2//Nothing has been passed - else error:=1;//No image - //Change directory +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'dir': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then - begin - temp:=Command[1]; - //Parent ? - if temp[1]='^' then - if Image.Disc[Fcurrdir].Parent>=0 then - temp:=Image.GetParent(Image.Disc[Fcurrdir].Parent)+Copy(temp,2) - else - temp:=Image.GetParent(0)+Copy(temp,2); - //Are there more parent specifiers? - Lparent:=Image.GetDirSep(Image.Disc[Fcurrdir].Partition)+'^'; - while Pos(Lparent,temp)>1 do - begin - ptr:=Pos(Lparent,temp)-1; - while(ptr>1) - and(temp[ptr]<>Image.GetDirSep(Image.Disc[Fcurrdir].Partition))do - dec(ptr); - if ptr>1 then - temp:=LeftStr(temp,ptr-1)+Copy(temp,Pos(Lparent,temp)+Length(Lparent)); - if ptr=1 then - temp:=LeftStr(temp,ptr)+Copy(temp,Pos(Lparent,temp)+Length(Lparent)); - end; - //Found, so make sure that dir and entry are within bounds - if ValidFile(temp) then - begin - if dir>=Length(Image.Disc) then Fcurrdir:=0; //Root - if dir=0 then - Fcurrdir:=Image.Disc[dir].Entries[entry].DirRef - else WriteLn(cmdRed+''''+temp+''' is a file.'+cmdNormal) - else Fcurrdir:=dir; - end; - //Are we on DFS and we have a drive specifier? - if Image.MajorFormatNumber=diAcornDFS then - begin - opt:=0;//Default drive 0 - if Length(temp)>1 then - if temp[1]=':' then opt:=StrToIntDef(temp[2],0); - if(Image.DoubleSided)and(opt=2)then - opt:=Length(Image.Disc)-1; //Only select if double sided - //We'll ignore anything after the drive specifier - Fcurrdir:=opt; - ok:=True; - end; - //Report back to the user - if ok then - WriteLn('Directory '''+Image.GetParent(Fcurrdir)+''' selected.') - else WriteLn(cmdRed+''''+temp+''' does not exist.'+cmdNormal); - end - else error:=2//Nothing has been passed - else error:=1;//No image - //Changes the directory title ++++++++++++++++++++++++++++++++++++++++++++++++ - 'dirtitle': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then - begin - temp:=Image.GetParent(Fcurrdir); - Write('Retitle directory '+temp+' '); - if Image.RetitleDirectory(temp,Command[1]) then - begin - WriteLn(cmdGreen+'success.'+cmdNormal); - HasChanged:=True; - end - else WriteLn(cmdRed+'failed.'+cmdNormal); - end - else error:=2//Nothing has been passed - else error:=1;//No image - //Change exec or load address ++++++++++++++++++++++++++++++++++++++++++++++++ - 'exec','load','type': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>2 then - if IntToHex(StrToIntDef('$'+Command[2],0),8) - =UpperCase(RightStr('00000000'+Command[2],8)) then - begin - Files:=nil; - Files:=GetListOfFiles(Command[1]); - if Length(Files)>0 then - for Index:=0 to Length(Files)-1 do - begin - temp:=BuildFilename(Files[Index]); - ok:=False; - //Print the text - Load or Exec - if(Command[0]='load')or(Command[0]='exec')then - begin - if format='exec' then format:='execution'; //Expand exec - Write('Change '+format+' address for '+temp - +' to 0x'+IntToHex(StrToIntDef('$'+Command[2],0),8)+' '); - end; - //Print the text - Filetype - if Command[0]='type' then - begin - Command[2]:=RightStr('000'+Command[2],3); //Ensure filetype is 12 bits - Write('Change filetype for '+temp+' to 0x' - +IntToHex(StrToIntDef('$'+Command[2],0),3)+' '); - end; - //Attempt to update details - if LowerCase(Command[0])='exec' then //Execution address - ok:=Image.UpdateExecAddr(temp,StrToIntDef('$'+Command[2],0)); - if LowerCase(Command[0])='load' then //Load address - ok:=Image.UpdateLoadAddr(temp,StrToIntDef('$'+Command[2],0)); - if LowerCase(Command[0])='type' then //Filetype - ok:=Image.ChangeFileType(temp,Command[2]); //We can take a filetype name here - //Report back - if ok then - begin - HasChanged:=True; - WriteLn(cmdGreen+'success.'+cmdNormal); - end - else WriteLn(cmdRed+'failed.'+cmdNormal); - end - else WriteLn(cmdRed+'No files found'+cmdNormal); - end - else WriteLn(cmdRed+'Invalid hex number.'+cmdNormal) - else error:=2//Nothing has been passed - else error:=1;//No image - //Exit the console application +++++++++++++++++++++++++++++++++++++++++++++++ - 'exit': if not Confirm then Command[0]:=''; - //Enter the GUI application ++++++++++++++++++++++++++++++++++++++++++++++++++ - 'exittogui': WriteLn('Entering GUI.'); - //Extract and search commands ++++++++++++++++++++++++++++++++++++++++++++++++ - 'extract','search': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then - begin - Files:=nil; - for Index:=1 to Length(Command)-1 do - Files:=GetListOfFiles(Command[Index],Files); - if Command[0]='search' then - WriteLn(IntToStr(Length(Files))+' file(s) found.'); - //Now go through all the results, if any, and extract each of them - if Length(Files)>0 then //If there are any, of course - for opt:=0 to Length(Files)-1 do - begin - temp:=BuildFilename(Files[opt]); - //And extract or print it - if Image.FileExists(temp,dir,entry) then - if Command[0]='extract' then //Extract - begin - Write('Extracting '+temp+' '); - //Ensure we are within range - if dirLength(Image.Disc)then - begin - Write(cmdRed+'Cannot extract the root in this way. '); - WriteLn('Try selecting the root and entering ''extract *''.'+cmdNormal); - end; - end - else WriteLn(temp); //Print - end - else - if Command[0]='extract' then WriteLn(cmdRed+'No files found.'+cmdNormal); - end - else error:=2//Nothing has been passed - else error:=1;//No image - //Multi CSV output of files ++++++++++++++++++++++++++++++++++++++++++++++++++ - 'filetocsv': - if Length(Command)>1 then //Are there any files given? - begin - filelist:=TStringList.Create; - for Index:=1 to Length(Command)-1 do//Just add a file - begin - //Can contain a wild card - FindFirst(Command[Index],faDirectory,searchlist); - repeat - //These are previous and top directories - if(searchlist.Name<>'.')and(searchlist.Name<>'..')then - //We can't open directories - if(searchlist.Attr AND faDirectory)<>faDirectory then - //Make sure the file exists - if FileExists(searchlist.Name) then - //Add it to our list - filelist.Add(ExtractFilePath(Command[Index])+searchlist.Name); - until FindNext(searchlist)<>0; - FindClose(searchlist); - end; - WriteLn('Processing images.'); - if filelist.Count>0 then SaveAsCSV(filelist) //Send to the procedure - else WriteLn('No images found.'); - filelist.Free; - end - else error:=2;//Nothing has been passed - //Translate filetype +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'filetype': - //List all filetypes - if Length(Command)>1 then - //Name passed? - if IntToHex(StrToIntDef('$'+Command[1],0),3)<>UpperCase(Command[1]) then - begin - ptr:=Image.GetFileType(Command[1]); - if ptr<>-1 then WriteLn('0x'+IntToHex(ptr,3)) - else WriteLn('Unknown filetype'); - end //No, hex number passed - else WriteLn(Image.GetFileType(StrToInt('$'+Command[1]))) - else error:=2; - //Get the free space +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'free': - if Image.FormatNumber<>diInvalidImg then ReportFreeSpace - else error:=1;//No image - //Help command +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'help': - begin - WriteLn(cmdBlue+cmdBold+'Console Help'+cmdNormal); - for Index:=0 to Help.Lines.Count-1 do - begin - temp:=Help.Lines[Index]; - if Length(temp)>1 then - if temp[1]<>' ' then temp:=cmdRed+cmdBold+temp - else temp:=Copy(temp,2); - WriteLn(WrapText(temp,ConsoleWidth)+cmdNormal); - end; - end; - //Open command +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'insert': - if Confirm then - if Length(Command)>1 then - if FileExists(Command[1]) then - begin - WriteLn('Reading image.'); - if Image.LoadFromFile(Command[1]) then - begin - WriteLn(cmdBold+Image.FormatString+cmdNormal+' image read OK.'); - Fcurrdir:=0; - ReportFreeSpace; - end - else WriteLn(cmdRed+'Image not read.'+cmdNormal); - end - else WriteLn(cmdRed+'File not found.'+cmdNormal) - else error:=2; - //Change Interleave Method +++++++++++++++++++++++++++++++++++++++++++++++++++ - 'interleave': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then - if(Image.FormatNumber=diAcornADFS<<4+2) - or(Image.FormatNumber=diAcornADFS<<4+$E) - or(Image.MajorFormatNumber=diAcornFS)then - begin - //The option may have been supplied as a word or a number - opt:=0; - //First check for a word - while(LowerCase(Command[1])<>Inter[opt])and(optInter[opt] then opt:=StrToIntDef(Command[1],-1); - //Can't be higher than what we know - if(opt>=0)and(opt<=High(Inter))then - if Image.ChangeInterleaveMethod(opt) then - begin - HasChanged:=True; - WriteLn('Interleave changed to ' - +UpperCase(Inter[opt])+'.'); - end - else WriteLn(cmdRed+'Failed to change interleave.'+cmdNormal) - else WriteLn(cmdRed+'Invalid Interleave option.'+cmdNormal); - end - else WriteLn(cmdRed+'Not possible in this format.'+cmdNormal) - else error:=2 - else error:=1; - //Join partitions ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'join':WriteLn(cmdRed+'This command has not been implemented yet.'+cmdNormal); - //Show the contents of a file ++++++++++++++++++++++++++++++++++++++++++++++++ - 'list': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then - if ValidFile(Command[1])then - begin - //We'll need to create a container - SetLength(HexDump,1); - HexDump[0]:=THexDumpForm.Create(nil); - //Extract the file into this container - if Image.ExtractFile(temp,HexDump[0].buffer,entry) then - begin - //Only display if it is text or BASIC - if(HexDump[0].IsBasicFile)or(HexDump[0].IsTextFile)then - HexDump[0].DecodeBasicFile - else - HexDump[0].btnSaveTextClick(nil); - //Free up the container - HexDump[0].Free; - SetLength(HexDump,0); - end - else WriteLn(cmdRed+'Failed to extract file.'+cmdNormal) - end - else WriteLn(cmdRed+'Cannot find file '''+Command[1]+'''.'+cmdNormal) - else error:=2 - else error:=1; - //New Image ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'new': - if Confirm then - if Length(Command)>1 then - begin - known:=False; - ok:=False; - format:=UpperCase(Command[1]); - if Length(Command)>2 then format:=format+UpperCase(Command[2]); - //Create ADFS HDD - if UpperCase(format)='ADFSHDD' then - begin - newmap:=False; //Default - dirtype:=0; //Default - harddrivesize:=20*1024*1024; //20MB default size - if Length(Command)>3 then - if Length(Command[3])>3 then - begin - if UpperCase(Command[3][1])='N' then newmap:=True; - if UpperCase(Command[3][2])='N' then dirtype:=1;//New dir - if UpperCase(Command[3][2])='B' then dirtype:=2;//Big dir - if(newmap)and(dirtype=0)then - dirtype:=1; //Can't have old dir on new map - if(not newmap)and(dirtype=2)then - dirtype:=1; //Can't have big dir on old map - //Get the image size - harddrivesize:=GetDriveSize(Command[3]); - //Check that it is not over, or under, the limits - if harddrivesize<20*1024*1024 then - harddrivesize:=20*1024*1024; //20MB min - if harddrivesize>1000*1024*1024 then - harddrivesize:=1000*1024*1024;//1000MB max - if(not newmap)and(harddrivesize>512*1024*1024)then - harddrivesize:=512*1024*1024; //512MB max for old map - end; - //OK, now create it - ok:=Image.FormatHDD(diAcornADFS,harddrivesize,True,newmap,dirtype,False); - known:=True; - end; - //Create AFS HDD - if UpperCase(Command[1])='AFS' then - if Length(Command)>3 then - begin - //Get the image size - harddrivesize:=GetDriveSize(Command[3]); - //Get the AFS level (second parameter) - dirtype:=StrToIntDef(RightStr(Command[2],1),2); - //Is the specified image size big enough - if(dirtype=2)and(harddrivesize<400)then harddrivesize:=400; - if(dirtype=3)and(harddrivesize<640)then harddrivesize:=640; - //But not too big - if harddrivesize>512*1024 then harddrivesize:=512*1024; - //Create it - ok:=Image.FormatHDD(diAcornFS, - harddrivesize*1024, - True,False,dirtype,False); - known:=True; - end else error:=2; - if UpperCase(format)='DOSHDD' then //Create DOS HDD - if Length(Command)>3 then - begin - //Get the image size - harddrivesize:=GetDriveSize(Command[3]); - //Work the most appropriate FAT - if harddrivesize<33300 then dirtype:=diFAT16 else dirtype:=diFAT32; - //Is the specified image size big enough - if harddrivesize<20*1024 then harddrivesize:=20*1024; - //But not too big - if harddrivesize>1024*1024 then harddrivesize:=512*1024; - //Create it - ok:=Image.FormatHDD(diDOSPlus, - harddrivesize*1024,True,False,dirtype,False); - known:=True; - end else error:=2; - if UpperCase(format)='AMIGAHDD' then //Create Amiga HDD - if Length(Command)>3 then - begin - //Get the image size - harddrivesize:=GetDriveSize(Command[3]); - //Is the specified image size big enough - if harddrivesize<20*1024 then harddrivesize:=20*1024; - //But not too big - if harddrivesize>1024*1024 then harddrivesize:=512*1024; - //Create it - ok:=Image.FormatHDD(diAmiga,harddrivesize*1024,True,False,0,False); - known:=True; - end else error:=2; - if Pos(format,DiscFormats)>0 then //Create other - begin - Index:=(Pos(format,DiscFormats) DIV 8)+1; - //Create new image - if(Index>=Low(DiscNumber))and(Index<=High(DiscNumber))then - ok:=Image.FormatFDD(DiscNumber[Index] DIV $100, - (DiscNumber[Index] DIV $10)MOD $10, - DiscNumber[Index] MOD $10); - known:=True; - end; - if ok then - begin - WriteLn(UpperCase(Command[1])+' Image created OK.'); - ReportFreeSpace; - HasChanged:=True; - Fcurrdir:=0; - end - else - if known then WriteLn(cmdRed+'Failed to create image.'+cmdNormal) - else WriteLn(cmdRed+'Unknown format.'+cmdNormal) - end else error:=2; - //Change the disc boot option ++++++++++++++++++++++++++++++++++++++++++++++++ - 'opt': - if Image.FormatNumber<>diInvalidImg then - begin - //Has a side/partition been specified? - if Length(Command)>2 then - ptr:=StrToIntDef(Command[2],Image.Disc[Fcurrdir].Partition) - else ptr:=Image.Disc[Fcurrdir].Partition; //Default is current side - //Needs an option, of course - if Length(Command)>1 then - begin - //The option may have been supplied as a word or a number - opt:=0; - //First check for a word - while(LowerCase(Command[1])<>Options[opt]) - and(optOptions[opt]then opt:=StrToIntDef(Command[1],-1); - //Can't be higher than what we know - if(opt>=0)and(opt<=High(Options))then - begin - Write('Update boot option to '+UpperCase(Options[opt])+' '); - if Image.UpdateBootOption(opt,ptr) then - begin - HasChanged:=True; - WriteLn(cmdGreen+'success.'+cmdNormal); - end - else WriteLn(cmdRed+'failed.'+cmdNormal) - end - else WriteLn(cmdRed+'Invalid boot option.'+cmdNormal) - end - else error:=2 - end - else error:=1; - //Rename a file ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'rename': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>2 then - if ValidFile(Command[1]) then//Does it exist? - begin - //Attempt to rename - Write('Rename '+temp+' to '+Command[2]+' '); - opt:=Image.RenameFile(temp,Command[2]); - if opt>=0 then - begin - WriteLn(cmdGreen+'success.'+cmdNormal); - HasChanged:=True; - end - else WriteLn(cmdRed+'failed ('+IntToStr(opt)+').'+cmdNormal); - end else WriteLn(cmdRed+''''+Command[1]+''' not found.'+cmdNormal) - else error:=2 - else error:=1; - //Show image report ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'report': - if Image.FormatNumber<>diInvalidImg then btn_ShowReportClick(nil) - else error:=1; - //Run a script +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'runscript': if Length(Command)<2 then error:=2; - //Save image +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'save': - if Image.FormatNumber<>diInvalidImg then - begin - //Get the filename - if Length(Command)>1 then temp:=Command[1] - else temp:=Image.Filename; //None given, so use the image one - //Compressed UEF? - if Length(Command)>2 then ok:=UpperCase(Command[2])='TRUE' else ok:=False; - //Save - if Image.SaveToFile(temp,ok) then - begin - WriteLn('Image saved OK.'); - HasChanged:=False; - end else WriteLn(cmdRed+'Image failed to save.'+cmdNormal); - end - else error:=1; - //Save image as CSV ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'savecsv': - if Image.FormatNumber<>diInvalidImg then - begin - //Get the filename - if Length(Command)>1 then temp:=Command[1] - else temp:=Image.Filename; //None given, so use the image one - //Make sure it has a csv extension - temp:=LeftStr(temp,Length(temp)-Length(ExtractFileExt(temp)))+'.csv'; - SaveAsCSV(temp); - WriteLn('CSV output complete.'); - end - else error:=1; - //Split partitions +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'split':WriteLn(cmdRed+'This command has not been implemented yet.'+cmdNormal); - //Change the timestamp +++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'stamp': - if Image.FormatNumber<>diInvalidImg then - if Length(Command)>1 then - begin - Files:=nil; - Files:=GetListOfFiles(Command[1]); - if Length(Files)>0 then - for Index:=0 to Length(Files)-1 do - begin - temp:=BuildFilename(Files[Index]); - Write('Setting date/time stamp for '+temp); - if Image.TimeStampFile(temp,Now) then - begin - HasChanged:=True; - WriteLn(cmdGreen+' Success'+cmdNormal); - end - else WriteLn(cmdRed+' Failed'+cmdNormal); - end - else WriteLn(cmdRed+'No files found'+cmdNormal); - end - else error:=2 - else error:=1; - //Change the disc title ++++++++++++++++++++++++++++++++++++++++++++++++++++++ - 'title': - if Image.FormatNumber<>diInvalidImg then - begin - //Has a side/partition been specified? - if Length(Command)>2 then - ptr:=StrToIntDef(Command[2],Image.Disc[Fcurrdir].Partition) - else ptr:=Image.Disc[Fcurrdir].Partition; //Default is current side - //Needs a title, of course - if Length(Command)>1 then - begin - Write('Update disc title '); - if Image.UpdateDiscTitle(Command[1],ptr) then - begin - HasChanged:=True; - WriteLn(cmdGreen+'success.'+cmdNormal); - end - else WriteLn(cmdRed+'failed.'+cmdNormal) - end - else error:=2 - end - else error:=1; - //Blank entry ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - '' :;//Just ignore - //Something not recognised +++++++++++++++++++++++++++++++++++++++++++++++++++ - otherwise WriteLn(cmdRed+'Unknown command.'+cmdNormal); - end; - //Report any errors +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - case error of - 1: WriteLn(cmdRed+'No Image loaded.'+cmdNormal); - 2: WriteLn(cmdRed+'Not enough parameters.'+cmdNormal); - end; -end; From 925051e85278bbe12beb5ea099f0f334e7eee3ae Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 2 Feb 2026 05:25:41 +0000 Subject: [PATCH 4/4] Remove console mode from HexDumpUnit Remove ConsoleAppUnit dependency and all console output code paths that used ANSI color codes (cmd* variables). The GUI build no longer has embedded console mode, so this unit now operates purely in GUI mode. https://claude.ai/code/session_01H1suvkNPi2MVsX1y9Qy86P --- LazarusSource/HexDumpUnit.pas | 183 +++++++++++++--------------------- 1 file changed, 70 insertions(+), 113 deletions(-) diff --git a/LazarusSource/HexDumpUnit.pas b/LazarusSource/HexDumpUnit.pas index f738527..18c33bb 100644 --- a/LazarusSource/HexDumpUnit.pas +++ b/LazarusSource/HexDumpUnit.pas @@ -126,7 +126,7 @@ implementation {$R *.lfm} -uses MainUnit,ConsoleAppUnit; +uses MainUnit; { THexDumpForm } @@ -334,49 +334,38 @@ procedure THexDumpForm.btnSaveTextClick(Sender: TObject); len : Byte=0; i : Integer=0; pos : Integer=0; - ok : Boolean=False; begin - if MainForm.Fguiopen then - begin - //Adapt the filename - line:=Caption; - BBCToWin(line); - //Remove any dots - for i:=1 to Length(line) do if line[i]='.' then line[i]:='-'; - SaveFile.Filename:=line+'-dump.txt'; - //And open the dialogue box - ok:=SaveFile.Execute; - end else ok:=True; - if ok then + //Adapt the filename + line:=Caption; + BBCToWin(line); + //Remove any dots + for i:=1 to Length(line) do if line[i]='.' then line[i]:='-'; + SaveFile.Filename:=line+'-dump.txt'; + //And open the dialogue box + if SaveFile.Execute then begin - if MainForm.Fguiopen then - begin - //Show the progress bar - pbProgress.Visible:=True; - pbProgress.Position:=0; - //Create a new file (overwrite one if already exists) - F:=TFileStream.Create(SaveFile.Filename,fmCreate); - //Set to start of file - F.Position:=0; - //Write out the header - WriteLine(F,MainForm.ApplicationTitle+' V'+MainForm.ApplicationVersion); - WriteLine(F,'https://www.geraldholdsworth.co.uk https://github.com/geraldholdsworth/DiscImageManager'); - WriteLine(F,''); - WriteLine(F,'Filename : '+Caption); - WriteLine(F,'Total Filesize: '+IntToStr(Length(buffer)) - +' (0x'+IntToHex(Length(buffer),10)+') bytes'); - WriteLine(F,''); - end; + //Show the progress bar + pbProgress.Visible:=True; + pbProgress.Position:=0; + //Create a new file (overwrite one if already exists) + F:=TFileStream.Create(SaveFile.Filename,fmCreate); + //Set to start of file + F.Position:=0; + //Write out the header + WriteLine(F,MainForm.ApplicationTitle+' V'+MainForm.ApplicationVersion); + WriteLine(F,'https://www.geraldholdsworth.co.uk https://github.com/geraldholdsworth/DiscImageManager'); + WriteLine(F,''); + WriteLine(F,'Filename : '+Caption); + WriteLine(F,'Total Filesize: '+IntToStr(Length(buffer)) + +' (0x'+IntToHex(Length(buffer),10)+') bytes'); + WriteLine(F,''); line:='Address 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ASCII'; - if MainForm.Fguiopen then WriteLine(F,line) - else WriteLn(cmdBold+line+cmdNormal); + WriteLine(F,line); //Now the data pos:=0;//Start of the data repeat //Start the line off with the address, in hex, 10 digits long line:=IntToHex((pos div $10)*$10,10)+' '; - if not MainForm.Fguiopen then - line:=cmdBold+line+cmdNormal; //Set the amount of data to read to 16 bytes len:=$10; //If this will take us over the total size, then adjust accordingly @@ -392,10 +381,7 @@ procedure THexDumpForm.btnSaveTextClick(Sender: TObject); if p=$07 then line:=line+' '; //Split in the middle end; //Extra space to separate from the characters - if MainForm.Fguiopen then - line:=PadRight(line,62) - else - line:=PadRight(line,70); + line:=PadRight(line,62); //Now the characters for p:=0 to len-1 do if (buffer[p+pos]>31) AND (buffer[p+pos]<127) then @@ -403,24 +389,18 @@ procedure THexDumpForm.btnSaveTextClick(Sender: TObject); else line:=line+'.'; //Not printable //Write out the complete line - if MainForm.Fguiopen then WriteLine(F,line) else WriteLn(line); - end; - if MainForm.Fguiopen then - begin - //Update the progress bar - pbProgress.Position:=Round((pos/Length(buffer))*100); - Application.ProcessMessages; + WriteLine(F,line); end; + //Update the progress bar + pbProgress.Position:=Round((pos/Length(buffer))*100); + Application.ProcessMessages; //Continue until no more data inc(pos,len); until pos=Length(buffer); - if MainForm.Fguiopen then - begin - //Close the file and exit - F.Free; - //Hide the progress bar - pbProgress.Visible:=False; - end; + //Close the file and exit + F.Free; + //Hide the progress bar + pbProgress.Visible:=False; end; end; @@ -872,8 +852,6 @@ procedure THexDumpForm.DecodeBasicFile; +StringReplace(PadLeft(IntToStr(linenum),5),' ',' ',[rfReplaceAll]) +' '; basictxt:=PadLeft(IntToStr(linenum),5); - if not MainForm.Fguiopen then - basictxt:=cmdBlue+basictxt+cmdNormal; //Line length linelen:=buffer[ptr+3]; //Move our line pointer one @@ -917,8 +895,6 @@ procedure THexDumpForm.DecodeBasicFile; inc(lineptr,3); end; linetxt:=linetxt+''+tmp+''; - if not MainForm.Fguiopen then - tmp:=cmdBold+cmdMagenta+tmp+cmdNormal; basictxt:=basictxt+tmp; end else //Extended tokens (BASIC V) @@ -938,8 +914,6 @@ procedure THexDumpForm.DecodeBasicFile; if c=$C8 then if t-$8E<=High(exttokens3)then tmp:=exttokens3[t-$8E]; linetxt:=linetxt+''+tmp+''; - if not MainForm.Fguiopen then - tmp:=cmdBold+cmdMagenta+tmp+cmdNormal; basictxt:=basictxt+tmp; end; end; @@ -950,10 +924,7 @@ procedure THexDumpForm.DecodeBasicFile; if c>31 then begin if not rem then if(c=34)AND(detok)then - if MainForm.Fguiopen then - linetxt:=linetxt+'' - else - basictxt:=basictxt+cmdRed+cmdItalic; + linetxt:=linetxt+''; if(c<>32)and(c<>38)and(c<>60)and(c<>62)then linetxt:=linetxt+Chr(c AND$7F); if c=32 then linetxt:=linetxt+' '; @@ -962,8 +933,6 @@ procedure THexDumpForm.DecodeBasicFile; if c=62 then linetxt:=linetxt+'>'; if not rem then if(c=34)and(not detok)then linetxt:=linetxt+''; basictxt:=basictxt+Chr(c AND$7F); - if not rem then if(c=34)and(not detok)and(not MainForm.Fguiopen)then - basictxt:=basictxt+cmdNormal; //Do not detokenise within quotes if(c=34)and(not rem)then detok:=not detok; end; @@ -975,43 +944,36 @@ procedure THexDumpForm.DecodeBasicFile; inc(ptr,linelen); end; end; - if MainForm.Fguiopen then - begin - //Display the minimum compatible BASIC version - linetxt:=''; - case basicver of - 1: linetxt:=' I'; - 2: linetxt:=' II'; - 3: linetxt:=' III'; - 4: linetxt:=' IV'; - 5: linetxt:=' V'; - end; - BasicViewer.Caption:='BBC BASIC'+linetxt; - //Change the colour - BasicOutput.Color:=$FF0000; - BasicOutput.Font.Color:=$FFFFFF; - //Finish off the HTML - fs.WriteString(''); - //Now upload the document to the display - fs.Position:=0; - BasicOutput.SetHtmlFromStream(fs); - fs.Free; - //Make the tab visible - BasicViewer.TabVisible:=True; - //And switch to it - PageControl.ActivePage:=BasicViewer; - PageControlChange(nil); - end - else - if BasicTxtOutput.Count>0 then - for ptr:=0 to BasicTxtOutput.Count-1 do - WriteLn(BasicTxtOutput[ptr]); + //Display the minimum compatible BASIC version + linetxt:=''; + case basicver of + 1: linetxt:=' I'; + 2: linetxt:=' II'; + 3: linetxt:=' III'; + 4: linetxt:=' IV'; + 5: linetxt:=' V'; + end; + BasicViewer.Caption:='BBC BASIC'+linetxt; + //Change the colour + BasicOutput.Color:=$FF0000; + BasicOutput.Font.Color:=$FFFFFF; + //Finish off the HTML + fs.WriteString(''); + //Now upload the document to the display + fs.Position:=0; + BasicOutput.SetHtmlFromStream(fs); + fs.Free; + //Make the tab visible + BasicViewer.TabVisible:=True; + //And switch to it + PageControl.ActivePage:=BasicViewer; + PageControlChange(nil); end else //Display as text file, if it is a text file if IsTextFile then begin //Clear the container - if MainForm.Fguiopen then TextOutput.Clear; + TextOutput.Clear; linetxt:=''; while ptr$0D)) or((c=$0D)and(cn<>$0A))then begin - if MainForm.Fguiopen then TextOutput.Lines.Add(linetxt) - else WriteLn(linetxt); + TextOutput.Lines.Add(linetxt); linetxt:=''; end; end; //At the end, anything left then push to the output container if linetxt<>'' then - if MainForm.Fguiopen then TextOutput.Lines.Add(linetxt) - else WriteLn(linetxt); - if MainForm.Fguiopen then - begin - //Move the cursor to the beginning - TextOutput.SelStart:=0; - TextOutput.SelLength:=0; - //Make the tab visible - TextViewer.TabVisible:=True; - //And switch to it - PageControl.ActivePage:=TextViewer; - PageControlChange(nil); - end; + TextOutput.Lines.Add(linetxt); + //Move the cursor to the beginning + TextOutput.SelStart:=0; + TextOutput.SelLength:=0; + //Make the tab visible + TextViewer.TabVisible:=True; + //And switch to it + PageControl.ActivePage:=TextViewer; + PageControlChange(nil); end; end;