diff --git a/LazarusSource/CLICommands.pas b/LazarusSource/CLICommands.pas new file mode 100644 index 0000000..45576c2 --- /dev/null +++ b/LazarusSource/CLICommands.pas @@ -0,0 +1,1788 @@ +unit CLICommands; + +{ +CLI Command Processor - Command-line interface for disc image operations. +This unit provides command processing without requiring any GUI dependencies. + +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. +} + +{$MODE objFPC}{$H+} + +interface + +uses + Classes, SysUtils, DiscImage, DiscImageContext; + +type + { TCLICommandProcessor - Processes CLI commands } + TCLICommandProcessor = class + private + FContext: TDiscImageContext; + FSettings: TRegistrySettings; + FOwnsContext: Boolean; + FOwnsSettings: Boolean; + FConsoleWidth: Integer; + // ANSI style modifiers + FUseColors: Boolean; + procedure WriteColored(const S: String; const Color: String = ''); + procedure WriteLnColored(const S: String; const Color: String = ''); + function GetCurrentPath: String; + function ValidFile(const Filename: String; out Dir, Entry: Cardinal): Boolean; + function BuildFilename(const AFile: TDirEntry): String; + function GetListOfFiles(const FileSearch: String): TSearchResults; + procedure ReportFreeSpace; + function Confirm: Boolean; + function GetDriveSize(const GivenSize: String): Cardinal; + procedure ShowHelp; + procedure ListCatalogueEx(const Mode: String); + // Command handlers + procedure CmdAccess(const Params: TStringArray); + procedure CmdAdd(const Params: TStringArray); + procedure CmdCat(const Params: TStringArray); + procedure CmdCreate(const Params: TStringArray); + procedure CmdDelete(const Params: TStringArray); + procedure CmdDir(const Params: TStringArray); + procedure CmdExtract(const Params: TStringArray); + procedure CmdFree(const Params: TStringArray); + procedure CmdInsert(const Params: TStringArray); + procedure CmdNew(const Params: TStringArray); + procedure CmdOpt(const Params: TStringArray); + procedure CmdRename(const Params: TStringArray); + procedure CmdSave(const Params: TStringArray); + procedure CmdTitle(const Params: TStringArray); + procedure CmdConfig(const Params: TStringArray); + procedure CmdStatus(const Params: TStringArray); + procedure CmdSearch(const Params: TStringArray); + procedure CmdDefrag(const Params: TStringArray); + procedure CmdDirTitle(const Params: TStringArray); + procedure CmdExecLoadType(const Params: TStringArray); + procedure CmdFind(const Params: TStringArray); + procedure CmdFileToCSV(const Params: TStringArray); + procedure CmdFileType(const Params: TStringArray); + procedure CmdInterleave(const Params: TStringArray); + procedure CmdList(const Params: TStringArray); + procedure CmdReport(const Params: TStringArray); + procedure CmdRunScript(const Params: TStringArray); + procedure CmdSaveCSV(const Params: TStringArray); + procedure CmdStamp(const Params: TStringArray); + public + constructor Create; overload; + constructor Create(AContext: TDiscImageContext; ASettings: TRegistrySettings); overload; + destructor Destroy; override; + + function ProcessCommand(const Command: TStringArray): Boolean; + function ParseInput(const Input: String): TStringArray; + + property Context: TDiscImageContext read FContext; + property Settings: TRegistrySettings read FSettings; + property UseColors: Boolean read FUseColors write FUseColors; + property ConsoleWidth: Integer read FConsoleWidth write FConsoleWidth; + end; + + // ANSI color constants +const + clNormal = #$1B'[0m'; + clBold = #$1B'[1m'; + clRed = #$1B'[91m'; + clGreen = #$1B'[92m'; + clYellow = #$1B'[93m'; + clBlue = #$1B'[94m'; + clMagenta = #$1B'[95m'; + clCyan = #$1B'[96m'; + + // Disc format strings + DiscFormats = + 'DFSS80 DFSS40 DFSD80 DFSD40 WDFSS80 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 = ( + $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); + + BootOptions: array[0..3] of String = ('none', 'load', 'run', 'exec'); + Interleaves: array[0..3] of String = ('auto', 'seq', 'int', 'mux'); + +implementation + +{ TCLICommandProcessor } + +constructor TCLICommandProcessor.Create; +begin + inherited Create; + FContext := TDiscImageContext.Create; + FSettings := TRegistrySettings.Create('DiscImageManager'); + FOwnsContext := True; + FOwnsSettings := True; + FConsoleWidth := 80; + FUseColors := True; +end; + +constructor TCLICommandProcessor.Create(AContext: TDiscImageContext; + ASettings: TRegistrySettings); +begin + inherited Create; + FContext := AContext; + FSettings := ASettings; + FOwnsContext := False; + FOwnsSettings := False; + FConsoleWidth := 80; + FUseColors := True; +end; + +destructor TCLICommandProcessor.Destroy; +begin + if FOwnsContext then + FContext.Free; + if FOwnsSettings then + FSettings.Free; + inherited Destroy; +end; + +procedure TCLICommandProcessor.WriteColored(const S: String; const Color: String); +begin + if FUseColors and (Color <> '') then + Write(Color + S + clNormal) + else + Write(S); +end; + +procedure TCLICommandProcessor.WriteLnColored(const S: String; const Color: String); +begin + WriteColored(S, Color); + WriteLn; +end; + +function TCLICommandProcessor.GetCurrentPath: String; +begin + if FContext.Image.FormatNumber <> diInvalidImg then + Result := FContext.Image.GetParent(FContext.CurrentDir) + else + Result := ''; +end; + +function TCLICommandProcessor.ValidFile(const Filename: String; + out Dir, Entry: Cardinal): Boolean; +var + Temp: String; +begin + if FContext.Image.FileExists(Filename, Dir, Entry) then + Result := True + else + begin + Temp := FContext.Image.GetParent(FContext.CurrentDir) + + FContext.Image.GetDirSep(FContext.Image.Disc[FContext.CurrentDir].Partition) + + Filename; + Result := FContext.Image.FileExists(Temp, Dir, Entry); + end; +end; + +function TCLICommandProcessor.BuildFilename(const AFile: TDirEntry): String; +begin + Result := ''; + if AFile.Parent <> '' then + Result := AFile.Parent + + FContext.Image.GetDirSep(FContext.Image.Disc[FContext.CurrentDir].Partition); + Result := Result + AFile.Filename; +end; + +function TCLICommandProcessor.GetListOfFiles(const FileSearch: String): TSearchResults; +var + FileDetails: TDirEntry; +begin + ResetDirEntry(FileDetails); + FileDetails.Filename := FileSearch; + FileDetails.Parent := FContext.Image.GetParent(FContext.CurrentDir); + Result := FContext.Image.FileSearch(FileDetails); +end; + +procedure TCLICommandProcessor.ReportFreeSpace; +var + FreeBytes, UsedBytes, TotalBytes: QWord; +begin + FreeBytes := FContext.Image.FreeSpace(FContext.Image.Disc[FContext.CurrentDir].Partition); + TotalBytes := FContext.Image.DiscSize(FContext.Image.Disc[FContext.CurrentDir].Partition); + UsedBytes := TotalBytes - FreeBytes; + WriteColored(IntToStr(FreeBytes), clBold); + Write(' bytes free. '); + WriteColored(IntToStr(UsedBytes), clBold); + Write(' bytes used. '); + WriteColored(IntToStr(TotalBytes), clBold); + WriteLn(' bytes total.'); +end; + +function TCLICommandProcessor.Confirm: Boolean; +var + Response: String; +begin + Result := True; + if FContext.HasChanged then + begin + Result := False; + WriteLn('Image has been modified.'); + Write('Are you sure you want to continue? (yes/no): '); + ReadLn(Response); + if (Length(Response) > 0) and (LowerCase(Response[1]) = 'y') then + Result := True; + end; +end; + +function TCLICommandProcessor.GetDriveSize(const GivenSize: String): Cardinal; +begin + Result := StrToIntDef(GivenSize, 0); + if UpperCase(RightStr(GivenSize, 1)) = 'M' then + Result := StrToIntDef(LeftStr(GivenSize, Length(GivenSize) - 1), 0) * 1024; +end; + +procedure TCLICommandProcessor.ShowHelp; +begin + WriteLnColored('Disc Image Manager CLI Help', clBlue + clBold); + WriteLn; + WriteLnColored('Image Commands:', clBold); + WriteLn(' insert - Open a disc image'); + WriteLn(' new [size] - Create a new disc image'); + WriteLn(' save [file] [compress] - Save the current image'); + WriteLn(' savecsv [file] - Save image catalogue as CSV'); + WriteLn(' filetocsv - Export multiple images to CSV'); + WriteLn(' report - Show detailed image report'); + WriteLn; + WriteLnColored('Navigation:', clBold); + WriteLn(' dir - Change current directory'); + WriteLn(' cat [all|dir|root] - Show catalogue listing'); + WriteLn(' free - Show free space'); + WriteLn(' chdir - Change host directory'); + WriteLn; + WriteLnColored('File Operations:', clBold); + WriteLn(' add [files...] - Add file(s) to image'); + WriteLn(' extract - Extract file(s) from image'); + WriteLn(' delete - Delete file(s) from image'); + WriteLn(' rename - Rename a file'); + WriteLn(' access [attr] - Change file attributes'); + WriteLn(' search - Search for files in image'); + WriteLn(' find - Find files on host filesystem'); + WriteLn(' ls - List host files (same as find *)'); + WriteLn(' list - Display file contents (text/BASIC)'); + WriteLn(' exec - Change execution address'); + WriteLn(' load - Change load address'); + WriteLn(' type - Change filetype'); + WriteLn(' stamp - Set current timestamp on file'); + WriteLn; + WriteLnColored('Directory Operations:', clBold); + WriteLn(' create - Create a new directory'); + WriteLn(' dirtitle - Change current directory title'); + WriteLn; + WriteLnColored('Disc Properties:', clBold); + WriteLn(' title <name> [part] - Change disc title'); + WriteLn(' opt <option> [part] - Set boot option (none/load/run/exec)'); + WriteLn(' interleave <method> - Set interleave (auto/seq/int/mux)'); + WriteLn(' compact [partition] - Compact/defrag the image'); + WriteLn(' defrag [partition] - Alias for compact'); + WriteLn; + WriteLnColored('Utilities:', clBold); + WriteLn(' filetype <name|num> - Translate filetype name/number'); + WriteLn(' runscript <file> - Run commands from a script file'); + WriteLn; + WriteLnColored('Configuration:', clBold); + WriteLn(' config [key] [value] - Show/set configuration options'); + WriteLn(' status - Show current settings'); + WriteLn; + WriteLnColored('General:', clBold); + WriteLn(' help - Show this help'); + WriteLn(' exit - Exit the CLI'); + WriteLn(' exittogui - Exit to GUI mode'); + WriteLn; + WriteLnColored('Available Formats for new command:', clBold); + WriteLn(' DFSS80, DFSS40, DFSD80, DFSD40 - Acorn DFS'); + WriteLn(' WDFSS80, WDFSS40, WDFSD80, WDFSD40 - Watford DFS'); + WriteLn(' ADFSS, ADFSM, ADFSL, ADFSD - Acorn ADFS Floppy'); + WriteLn(' ADFSE, ADFSE+, ADFSF, ADFSF+ - Acorn ADFS Enhanced'); + WriteLn(' ADFSHDD [size] - Acorn ADFS Hard Drive'); + WriteLn(' AFS <level> <size> - Acorn FileStore'); + WriteLn(' C1541, C1571, C1581 - Commodore'); + WriteLn(' AMIGADD, AMIGAHDD [size] - Commodore Amiga'); + WriteLn(' CFS - Acorn CFS/UEF'); + WriteLn(' DOS+640, DOS+800 - DOS Plus'); + WriteLn(' DOS360, DOS720, DOS1440, DOS2880 - MS-DOS Floppy'); + WriteLn(' DOSHDD [size] - MS-DOS Hard Drive'); +end; + +procedure TCLICommandProcessor.ListCatalogueEx(const Mode: String); +var + StartDir, EndDir, Dir, Entry: Integer; + ShowDirOnly, ShowRootOnly, ShowFull: Boolean; + Partition: Integer; +const + TimeDateFormat = 'dd/mm/yyyy hh:nn:ss'; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + ShowDirOnly := (Mode = 'dir'); + ShowRootOnly := (Mode = 'root'); + ShowFull := (Mode = '') or (Mode = 'all'); + + if (Mode = 'all') or (Mode = 'dir') or (Mode = 'root') then + begin + StartDir := 0; + EndDir := Length(FContext.Image.Disc) - 1; + end + else + begin + StartDir := FContext.CurrentDir; + EndDir := FContext.CurrentDir; + end; + + for Dir := StartDir to EndDir do + begin + Partition := FContext.Image.Disc[Dir].Partition; + + // Show directory/root listing only + if ShowDirOnly or ShowRootOnly then + begin + if FContext.Image.Disc[Dir].Parent = -1 then + begin + WriteColored('Root: ', clBold); + WriteLn(FContext.Image.GetParent(Dir)); + end + else if ShowDirOnly then + begin + WriteColored('Directory: ', clBold); + WriteLn(FContext.Image.GetParent(Dir)); + end; + end + else if ShowFull then + begin + // Full catalogue listing + WriteLnColored(StringOfChar('-', FConsoleWidth), clBlue); + WriteColored('Catalogue listing for directory ', clBold); + WriteLn(FContext.Image.GetParent(Dir)); + Write(Format('%-40s', [FContext.Image.Disc[Dir].Title])); + WriteLn('Option: ' + IntToStr(FContext.Image.BootOpt[Partition]) + + ' (' + UpperCase(BootOptions[FContext.Image.BootOpt[Partition]]) + ')'); + WriteLn('Number of entries: ' + IntToStr(Length(FContext.Image.Disc[Dir].Entries))); + WriteLn; + + if Length(FContext.Image.Disc[Dir].Entries) > 0 then + begin + for Entry := 0 to Length(FContext.Image.Disc[Dir].Entries) - 1 do + begin + with FContext.Image.Disc[Dir].Entries[Entry] do + begin + // Filename - padded to 10 chars + Write(Format('%-10s', [Filename])); + // Attributes + Write(' (' + Attributes + ')'); + + // Files (not directories) + if DirRef = -1 then + begin + // Filetype - ADFS, Spark only + if (FileType <> '') and + ((FContext.Image.MajorFormatNumber = diAcornADFS) or + (FContext.Image.MajorFormatNumber = diSpark)) then + Write(' ' + FileType); + + // Timestamp - ADFS, Spark, FileStore, Amiga, DOS only + if (TimeStamp > 0) and + ((FContext.Image.MajorFormatNumber = diAcornADFS) or + (FContext.Image.MajorFormatNumber = diSpark) or + (FContext.Image.MajorFormatNumber = diAcornFS) or + (FContext.Image.MajorFormatNumber = diAmiga) or + (FContext.Image.MajorFormatNumber = diDOSPlus)) then + Write(' ' + FormatDateTime(TimeDateFormat, TimeStamp)); + + // Load/Exec addresses (if no timestamp or for AFS) + if (TimeStamp = 0) or (FContext.Image.MajorFormatNumber = diAcornFS) then + begin + Write(' ' + IntToHex(LoadAddr, 8)); + Write(' ' + IntToHex(ExecAddr, 8)); + end; + + // Length + Write(' ' + ConvertToKMG(Length) + + ' (' + IntToHex(Length, 8) + ')'); + end; + + WriteLn; + end; + end; + end; + end; + end; +end; + +// Command handlers + +procedure TCLICommandProcessor.CmdAccess(const Params: TStringArray); +var + Files: TSearchResults; + I: Integer; + Temp, Attr: String; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: access <filename> [attributes]', clRed); + Exit; + end; + + Attr := ''; + if Length(Params) > 2 then + Attr := Params[2]; + + Files := GetListOfFiles(Params[1]); + if Length(Files) > 0 then + begin + for I := 0 to Length(Files) - 1 do + begin + Temp := BuildFilename(Files[I]); + Write('Changing attributes for ' + Temp + ' '); + if FContext.Image.UpdateAttributes(Temp, Attr) then + begin + WriteLnColored('success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored('failed.', clRed); + end; + end + else + WriteLnColored('No files found.', clRed); +end; + +procedure TCLICommandProcessor.CmdAdd(const Params: TStringArray); +var + SearchList: TSearchRec; + I: Integer; + FileDetails: TDirEntry; + Buffer: TDIByteArray; + F: TFileStream; + FS: TSearchRec; + Ok: Boolean; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: add <filename> [filename2] ...', clRed); + Exit; + end; + + for I := 1 to Length(Params) - 1 do + begin + if FindFirst(Params[I], faAnyFile and not faDirectory, FS) = 0 then + begin + repeat + if (FS.Name <> '.') and (FS.Name <> '..') then + begin + Write('Adding file: ''' + ExtractFilePath(Params[I]) + FS.Name + ''''); + + // Read file contents + try + F := TFileStream.Create(ExtractFilePath(Params[I]) + FS.Name, fmOpenRead or fmShareDenyNone); + try + SetLength(Buffer, F.Size); + if F.Size > 0 then + F.ReadBuffer(Buffer[0], F.Size); + + // Set up file details + ResetDirEntry(FileDetails); + FileDetails.Filename := FS.Name; + FileDetails.Parent := FContext.Image.GetParent(FContext.CurrentDir); + FileDetails.Length := F.Size; + + // Try to add the file + Ok := FContext.Image.WriteFile(FileDetails, Buffer) >= 0; + finally + F.Free; + end; + + if Ok then + begin + WriteLnColored(' Success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored(' Failed.', clRed); + except + WriteLnColored(' Error reading file.', clRed); + end; + end; + until FindNext(FS) <> 0; + FindClose(FS); + end + else + WriteLnColored('File not found: ' + Params[I], clRed); + end; +end; + +procedure TCLICommandProcessor.CmdCat(const Params: TStringArray); +var + Mode: String; +begin + Mode := ''; + if Length(Params) > 1 then + Mode := LowerCase(Params[1]); + + ListCatalogueEx(Mode); +end; + +procedure TCLICommandProcessor.CmdCreate(const Params: TStringArray); +var + DirName, Parent, Attr: String; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + DirName := 'NewDir'; + if Length(Params) > 1 then + DirName := Params[1]; + + Parent := FContext.Image.GetParent(FContext.CurrentDir); + Attr := 'DLR'; + + Write('Creating directory ''' + DirName + ''' '); + if FContext.Image.CreateDirectory(DirName, Parent, Attr) >= 0 then + begin + WriteLnColored('success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored('failed.', clRed); +end; + +procedure TCLICommandProcessor.CmdDelete(const Params: TStringArray); +var + I: Integer; + Dir, Entry: Cardinal; + Temp: String; + Ok: Boolean; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: delete <filename> [filename2] ...', clRed); + Exit; + end; + + for I := 1 to Length(Params) - 1 do + begin + Temp := FContext.Image.GetParent(FContext.CurrentDir) + + FContext.Image.GetDirSep(FContext.Image.Disc[FContext.CurrentDir].Partition) + + Params[I]; + + Ok := FContext.Image.FileExists(Temp, Dir, Entry); + if not Ok then + begin + Temp := Params[I]; + Ok := FContext.Image.FileExists(Temp, Dir, Entry); + end; + + if Ok then + begin + Write('Deleting ''' + Params[I] + ''' '); + if FContext.Image.DeleteFile(Temp) then + begin + WriteLnColored('success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored('failed.', clRed); + end + else + WriteLnColored('''' + Params[I] + ''' not found.', clRed); + end; +end; + +procedure TCLICommandProcessor.CmdDir(const Params: TStringArray); +var + Temp: String; + Dir, Entry: Cardinal; + I: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: dir <path>', clRed); + Exit; + end; + + Temp := Params[1]; + + // Handle parent directory specifier + if (Length(Temp) > 0) and (Temp[1] = '^') then + begin + if FContext.Image.Disc[FContext.CurrentDir].Parent >= 0 then + Temp := FContext.Image.GetParent(FContext.Image.Disc[FContext.CurrentDir].Parent) + + Copy(Temp, 2) + else + Temp := FContext.Image.GetParent(0) + Copy(Temp, 2); + end; + + if FContext.Image.FileExists(Temp, Dir, Entry) then + begin + if Dir < Cardinal(Length(FContext.Image.Disc)) then + begin + if Entry < Cardinal(Length(FContext.Image.Disc[Dir].Entries)) then + begin + if FContext.Image.Disc[Dir].Entries[Entry].DirRef >= 0 then + FContext.CurrentDir := FContext.Image.Disc[Dir].Entries[Entry].DirRef + else + begin + WriteLnColored('''' + Temp + ''' is a file.', clRed); + Exit; + end; + end + else + FContext.CurrentDir := Dir; + end; + WriteLn('Directory ''' + FContext.Image.GetParent(FContext.CurrentDir) + ''' selected.'); + end + else + begin + // Check for root directories on DFS + if FContext.Image.MajorFormatNumber = diAcornDFS then + begin + if (Length(Temp) > 1) and (Temp[1] = ':') then + begin + I := StrToIntDef(Temp[2], 0); + if FContext.Image.DoubleSided and (I = 2) then + I := Length(FContext.Image.Disc) - 1; + FContext.CurrentDir := I; + WriteLn('Directory ''' + FContext.Image.GetParent(FContext.CurrentDir) + ''' selected.'); + Exit; + end; + end; + WriteLnColored('''' + Temp + ''' does not exist.', clRed); + end; +end; + +procedure TCLICommandProcessor.CmdExtract(const Params: TStringArray); +var + Files: TSearchResults; + I: Integer; + Temp: String; + Dir, Entry: Cardinal; + Buffer: TDIByteArray; + F: TFileStream; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: extract <filename> [filename2] ...', clRed); + Exit; + end; + + Files := nil; + for I := 1 to Length(Params) - 1 do + Files := GetListOfFiles(Params[I]); + + if Length(Files) = 0 then + begin + WriteLnColored('No files found.', clRed); + Exit; + end; + + for I := 0 to Length(Files) - 1 do + begin + Temp := BuildFilename(Files[I]); + if FContext.Image.FileExists(Temp, Dir, Entry) then + begin + Write('Extracting ' + Temp + ' '); + if (Dir < Cardinal(Length(FContext.Image.Disc))) and + (Entry < Cardinal(Length(FContext.Image.Disc[Dir].Entries))) then + begin + if FContext.Image.ExtractFile(Temp, Buffer, Entry) then + begin + try + // Get safe filename + F := TFileStream.Create(FContext.Image.GetWindowsFilename(Dir, Entry), + fmCreate); + try + if Length(Buffer) > 0 then + F.WriteBuffer(Buffer[0], Length(Buffer)); + WriteLnColored('success.', clGreen); + finally + F.Free; + end; + except + WriteLnColored('failed to write.', clRed); + end; + end + else + WriteLnColored('failed to extract.', clRed); + end; + end; + end; +end; + +procedure TCLICommandProcessor.CmdFree(const Params: TStringArray); +begin + if FContext.Image.FormatNumber = diInvalidImg then + WriteLnColored('No image loaded.', clRed) + else + ReportFreeSpace; +end; + +procedure TCLICommandProcessor.CmdInsert(const Params: TStringArray); +begin + if not Confirm then + Exit; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: insert <filename>', clRed); + Exit; + end; + + if not FileExists(Params[1]) then + begin + WriteLnColored('File not found.', clRed); + Exit; + end; + + WriteLn('Reading image...'); + if FContext.LoadImage(Params[1]) then + begin + WriteColored(FContext.Image.FormatString, clBold); + WriteLn(' image read OK.'); + FContext.CurrentDir := 0; + ReportFreeSpace; + end + else + WriteLnColored('Image not read.', clRed); +end; + +procedure TCLICommandProcessor.CmdNew(const Params: TStringArray); +var + Format: String; + Index: Integer; + Ok, Known, NewMap: Boolean; + HardDriveSize: Cardinal; + DirType: Byte; +begin + if not Confirm then + Exit; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: new <format> [size]', clRed); + Exit; + end; + + Known := False; + Ok := False; + Format := UpperCase(Params[1]); + if Length(Params) > 2 then + Format := Format + UpperCase(Params[2]); + + // ADFS HDD + if UpperCase(Format) = 'ADFSHDD' then + begin + NewMap := False; + DirType := 0; + HardDriveSize := 20 * 1024 * 1024; + + if Length(Params) > 3 then + begin + if Length(Params[3]) > 3 then + begin + if UpperCase(Params[3][1]) = 'N' then NewMap := True; + if UpperCase(Params[3][2]) = 'N' then DirType := 1; + if UpperCase(Params[3][2]) = 'B' then DirType := 2; + if NewMap and (DirType = 0) then DirType := 1; + if (not NewMap) and (DirType = 2) then DirType := 1; + HardDriveSize := GetDriveSize(Params[3]); + if HardDriveSize < 20 * 1024 * 1024 then HardDriveSize := 20 * 1024 * 1024; + if HardDriveSize > 1000 * 1024 * 1024 then HardDriveSize := 1000 * 1024 * 1024; + if (not NewMap) and (HardDriveSize > 512 * 1024 * 1024) then + HardDriveSize := 512 * 1024 * 1024; + end; + end; + + Ok := FContext.CreateHDDImage(diAcornADFS, HardDriveSize, DirType, NewMap, True); + Known := True; + end; + + // Standard floppy formats + if not Known then + begin + Index := Pos(Format, DiscFormats); + if Index > 0 then + begin + Index := (Index div 8) + 1; + if (Index >= Low(DiscNumber)) and (Index <= High(DiscNumber)) then + begin + Ok := FContext.CreateNewImage( + DiscNumber[Index] div $100, + (DiscNumber[Index] div $10) mod $10, + DiscNumber[Index] mod $10); + Known := True; + end; + end; + end; + + if Ok then + begin + WriteLn(UpperCase(Params[1]) + ' image created OK.'); + ReportFreeSpace; + FContext.CurrentDir := 0; + end + else + begin + if Known then + WriteLnColored('Failed to create image.', clRed) + else + WriteLnColored('Unknown format.', clRed); + end; +end; + +procedure TCLICommandProcessor.CmdOpt(const Params: TStringArray); +var + Opt, Partition: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: opt <none|load|run|exec> [partition]', clRed); + Exit; + end; + + Partition := FContext.Image.Disc[FContext.CurrentDir].Partition; + if Length(Params) > 2 then + Partition := StrToIntDef(Params[2], Partition); + + // Find option by name + Opt := 0; + while (LowerCase(Params[1]) <> BootOptions[Opt]) and (Opt < High(BootOptions)) do + Inc(Opt); + if LowerCase(Params[1]) <> BootOptions[Opt] then + Opt := StrToIntDef(Params[1], -1); + + if (Opt >= 0) and (Opt <= High(BootOptions)) then + begin + Write('Update boot option to ' + UpperCase(BootOptions[Opt]) + ' '); + if FContext.Image.UpdateBootOption(Opt, Partition) then + begin + WriteLnColored('success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored('failed.', clRed); + end + else + WriteLnColored('Invalid boot option.', clRed); +end; + +procedure TCLICommandProcessor.CmdRename(const Params: TStringArray); +var + Dir, Entry: Cardinal; + Temp, NewName: String; + Result: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 3 then + begin + WriteLnColored('Usage: rename <oldname> <newname>', clRed); + Exit; + end; + + if ValidFile(Params[1], Dir, Entry) then + begin + Temp := FContext.Image.GetParent(FContext.CurrentDir) + + FContext.Image.GetDirSep(FContext.Image.Disc[FContext.CurrentDir].Partition) + + Params[1]; + if not FContext.Image.FileExists(Temp, Dir, Entry) then + Temp := Params[1]; + + NewName := Params[2]; + Write('Rename ' + Temp + ' to ' + NewName + ' '); + Result := FContext.Image.RenameFile(Temp, NewName); + if Result >= 0 then + begin + WriteLnColored('success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored('failed (' + IntToStr(Result) + ').', clRed); + end + else + WriteLnColored('''' + Params[1] + ''' not found.', clRed); +end; + +procedure TCLICommandProcessor.CmdSave(const Params: TStringArray); +var + Filename: String; + Compress: Boolean; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) > 1 then + Filename := Params[1] + else + Filename := FContext.Filename; + + if Filename = '' then + begin + WriteLnColored('No filename specified.', clRed); + Exit; + end; + + Compress := False; + if Length(Params) > 2 then + Compress := UpperCase(Params[2]) = 'TRUE'; + + if FContext.SaveImage(Filename, Compress) then + WriteLn('Image saved OK.') + else + WriteLnColored('Image failed to save.', clRed); +end; + +procedure TCLICommandProcessor.CmdTitle(const Params: TStringArray); +var + Partition: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: title <newtitle> [partition]', clRed); + Exit; + end; + + Partition := FContext.Image.Disc[FContext.CurrentDir].Partition; + if Length(Params) > 2 then + Partition := StrToIntDef(Params[2], Partition); + + Write('Update disc title '); + if FContext.Image.UpdateDiscTitle(Params[1], Partition) then + begin + WriteLnColored('success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored('failed.', clRed); +end; + +procedure TCLICommandProcessor.CmdConfig(const Params: TStringArray); +begin + WriteLnColored('Configuration Options', clBlue + clBold); + WriteLn(' AddImpliedAttributes : Boolean - Add RW to inf for DFS/CFS/RFS'); + WriteLn(' Create_DSC : Boolean - Create *.dsc file with hard drives'); + WriteLn(' CreateINF : Boolean - Create *.inf file when extracting'); + WriteLn(' DFS_Allow_Blanks : Boolean - Allow blank filenames in DFS'); + WriteLn(' DFS_Beyond_Edge : Boolean - Check for files going over disc edge'); + WriteLn(' DFS_Zero_Sectors : Boolean - Allow DFS images with zero sectors'); + WriteLn(' Open_DOS : Boolean - Automatically open DOS partitions'); + WriteLn(' Scan_SubDirs : Boolean - Automatically scan sub-directories'); + WriteLn(' Spark_Is_FS : Boolean - Treat Spark archives as file system'); + WriteLn; + WriteLn('Use: config <key> <value> to set a configuration option'); +end; + +procedure TCLICommandProcessor.CmdStatus(const Params: TStringArray); +begin + WriteLnColored('Current Settings', clBlue + clBold); + WriteLn(' CreateINF : ' + BoolToStr(FContext.CreateINF, 'true', 'false')); + WriteLn(' AddImpliedAttributes : ' + BoolToStr(FContext.AddImpliedAttributes, 'true', 'false')); + WriteLn(' ScanSubDirs : ' + BoolToStr(FContext.ScanSubDirs, 'true', 'false')); + WriteLn(' OpenDOS : ' + BoolToStr(FContext.OpenDOS, 'true', 'false')); + WriteLn(' CreateDSC : ' + BoolToStr(FContext.CreateDSC, 'true', 'false')); + WriteLn(' DFSZeroSecs : ' + BoolToStr(FContext.DFSZeroSecs, 'true', 'false')); + WriteLn(' DFSBeyondEdge : ' + BoolToStr(FContext.DFSBeyondEdge, 'true', 'false')); + WriteLn(' DFSAllowBlank : ' + BoolToStr(FContext.DFSAllowBlank, 'true', 'false')); + WriteLn(' SparkIsFS : ' + BoolToStr(FContext.SparkIsFS, 'true', 'false')); + WriteLn(' ADFSInterleave : ' + IntToStr(FContext.ADFSInterleave)); +end; + +procedure TCLICommandProcessor.CmdSearch(const Params: TStringArray); +var + Files: TSearchResults; + I: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: search <pattern>', clRed); + Exit; + end; + + Files := nil; + for I := 1 to Length(Params) - 1 do + Files := GetListOfFiles(Params[I]); + + WriteLn(IntToStr(Length(Files)) + ' file(s) found.'); + + for I := 0 to Length(Files) - 1 do + WriteLn(' ' + BuildFilename(Files[I])); +end; + +procedure TCLICommandProcessor.CmdDefrag(const Params: TStringArray); +begin + // Defrag requires GUI infrastructure (progress display, node selection, etc.) + // and is not available in CLI mode + WriteLnColored('Defrag/compact is not available in CLI mode.', clRed); + WriteLn('Please use the GUI application for this operation.'); +end; + +procedure TCLICommandProcessor.CmdDirTitle(const Params: TStringArray); +var + DirPath: String; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: dirtitle <newtitle>', clRed); + Exit; + end; + + DirPath := FContext.Image.GetParent(FContext.CurrentDir); + Write('Retitle directory ' + DirPath + ' '); + if FContext.Image.RetitleDirectory(DirPath, Params[1]) then + begin + WriteLnColored('success.', clGreen); + FContext.HasChanged := True; + end + else + WriteLnColored('failed.', clRed); +end; + +procedure TCLICommandProcessor.CmdExecLoadType(const Params: TStringArray); +var + Files: TSearchResults; + I: Integer; + Temp, CmdType: String; + Ok: Boolean; + Value: Cardinal; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 3 then + begin + WriteLnColored('Usage: ' + Params[0] + ' <filename> <value>', clRed); + Exit; + end; + + CmdType := LowerCase(Params[0]); + + // Validate hex number for exec/load + if (CmdType = 'exec') or (CmdType = 'load') then + begin + if IntToHex(StrToIntDef('$' + Params[2], 0), 8) <> + UpperCase(RightStr('00000000' + Params[2], 8)) then + begin + WriteLnColored('Invalid hex number.', clRed); + Exit; + end; + end; + + Files := GetListOfFiles(Params[1]); + if Length(Files) > 0 then + begin + for I := 0 to Length(Files) - 1 do + begin + Temp := BuildFilename(Files[I]); + Ok := False; + + // Print the text + if CmdType = 'exec' then + begin + Write('Change execution address for ' + Temp + ' to 0x' + + IntToHex(StrToIntDef('$' + Params[2], 0), 8) + ' '); + Ok := FContext.Image.UpdateExecAddr(Temp, StrToIntDef('$' + Params[2], 0)); + end + else if CmdType = 'load' then + begin + Write('Change load address for ' + Temp + ' to 0x' + + IntToHex(StrToIntDef('$' + Params[2], 0), 8) + ' '); + Ok := FContext.Image.UpdateLoadAddr(Temp, StrToIntDef('$' + Params[2], 0)); + end + else if CmdType = 'type' then + begin + Write('Change filetype for ' + Temp + ' to 0x' + + IntToHex(StrToIntDef('$' + RightStr('000' + Params[2], 3), 0), 3) + ' '); + Ok := FContext.Image.ChangeFileType(Temp, Params[2]); + end; + + if Ok then + begin + FContext.HasChanged := True; + WriteLnColored('success.', clGreen); + end + else + WriteLnColored('failed.', clRed); + end; + end + else + WriteLnColored('No files found.', clRed); +end; + +procedure TCLICommandProcessor.CmdFind(const Params: TStringArray); +type + THostFile = record + Filename: String; + IsDirectory: Boolean; + end; +var + SearchList: TSearchRec; + I, J: Integer; + HostFiles: array of THostFile; + Ok: Boolean; + Temp: String; +begin + if Length(Params) < 2 then + begin + WriteLnColored('Usage: find <pattern> [pattern2] ...', clRed); + Exit; + end; + + SetLength(HostFiles, 0); + + for I := 1 to Length(Params) - 1 do + begin + Ok := True; + Temp := Params[I]; + + // Check for exclusion prefix + if (Length(Temp) > 0) and (Temp[1] = '|') then + begin + Ok := False; + Temp := Copy(Temp, 2); + end; + + if FindFirst(Temp, faAnyFile, SearchList) = 0 then + begin + repeat + if (SearchList.Name <> '.') and (SearchList.Name <> '..') and + (SearchList.Name <> '') then + begin + if Ok then + begin + // Add to list + J := Length(HostFiles); + SetLength(HostFiles, J + 1); + HostFiles[J].Filename := ExtractFilePath(Temp) + SearchList.Name; + HostFiles[J].IsDirectory := (SearchList.Attr and faDirectory) = faDirectory; + end + else + begin + // Remove from list + Temp := ExtractFilePath(Temp) + SearchList.Name; + for J := 0 to Length(HostFiles) - 1 do + if (HostFiles[J].Filename = Temp) and + (HostFiles[J].IsDirectory = ((SearchList.Attr and faDirectory) = faDirectory)) then + HostFiles[J].Filename := ''; + end; + end; + until FindNext(SearchList) <> 0; + FindClose(SearchList); + end; + end; + + // Remove blank entries + J := 0; + while J < Length(HostFiles) do + begin + if HostFiles[J].Filename = '' then + begin + if J < Length(HostFiles) - 1 then + for I := J to Length(HostFiles) - 2 do + HostFiles[I] := HostFiles[I + 1]; + SetLength(HostFiles, Length(HostFiles) - 1); + Dec(J); + end; + Inc(J); + end; + + WriteLn(IntToStr(Length(HostFiles)) + ' entries found.'); + + for J := 0 to Length(HostFiles) - 1 do + begin + if HostFiles[J].IsDirectory then + begin + WriteColored('Directory', clBlue); + WriteLn(': ''' + HostFiles[J].Filename + '''.'); + end + else + begin + WriteColored('File', clBlue); + WriteLn(': ''' + HostFiles[J].Filename + '''.'); + end; + end; +end; + +procedure TCLICommandProcessor.CmdFileToCSV(const Params: TStringArray); +var + SearchList: TSearchRec; + I: Integer; + FileList: TStringList; +begin + if Length(Params) < 2 then + begin + WriteLnColored('Usage: filetocsv <imagepattern> [pattern2] ...', clRed); + Exit; + end; + + FileList := TStringList.Create; + try + for I := 1 to Length(Params) - 1 do + begin + if FindFirst(Params[I], faAnyFile and not faDirectory, SearchList) = 0 then + begin + repeat + if (SearchList.Name <> '.') and (SearchList.Name <> '..') then + if FileExists(ExtractFilePath(Params[I]) + SearchList.Name) then + FileList.Add(ExtractFilePath(Params[I]) + SearchList.Name); + until FindNext(SearchList) <> 0; + FindClose(SearchList); + end; + end; + + WriteLn('Processing ' + IntToStr(FileList.Count) + ' image(s).'); + if FileList.Count > 0 then + WriteLnColored('filetocsv: CSV batch output not fully implemented in CLI.', clYellow) + else + WriteLn('No images found.'); + finally + FileList.Free; + end; +end; + +procedure TCLICommandProcessor.CmdFileType(const Params: TStringArray); +var + TypeNum: Integer; +begin + if Length(Params) < 2 then + begin + WriteLnColored('Usage: filetype <name|number>', clRed); + Exit; + end; + + // Check if name was passed (not a hex number) + if IntToHex(StrToIntDef('$' + Params[1], 0), 3) <> UpperCase(Params[1]) then + begin + // Name passed - look up number + TypeNum := FContext.Image.GetFileType(Params[1]); + if TypeNum <> -1 then + WriteLn('0x' + IntToHex(TypeNum, 3)) + else + WriteLn('Unknown filetype'); + end + else + begin + // Number passed - look up name + WriteLn(FContext.Image.GetFileType(StrToInt('$' + Params[1]))); + end; +end; + +procedure TCLICommandProcessor.CmdInterleave(const Params: TStringArray); +var + Opt: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: interleave <auto|seq|int|mux|0-3>', clRed); + Exit; + end; + + // Check if format supports interleave changes + if not ((FContext.Image.FormatNumber = diAcornADFS shl 4 + 2) or + (FContext.Image.FormatNumber = diAcornADFS shl 4 + $E) or + (FContext.Image.MajorFormatNumber = diAcornFS)) then + begin + WriteLnColored('Not possible in this format.', clRed); + Exit; + end; + + // Find option by name + Opt := 0; + while (LowerCase(Params[1]) <> Interleaves[Opt]) and (Opt < High(Interleaves)) do + Inc(Opt); + if LowerCase(Params[1]) <> Interleaves[Opt] then + Opt := StrToIntDef(Params[1], -1); + + if (Opt >= 0) and (Opt <= High(Interleaves)) then + begin + if FContext.Image.ChangeInterleaveMethod(Opt) then + begin + FContext.HasChanged := True; + WriteLn('Interleave changed to ' + UpperCase(Interleaves[Opt]) + '.'); + end + else + WriteLnColored('Failed to change interleave.', clRed); + end + else + WriteLnColored('Invalid interleave option.', clRed); +end; + +procedure TCLICommandProcessor.CmdList(const Params: TStringArray); +var + Dir, Entry: Cardinal; + Temp: String; + Buffer: TDIByteArray; + I: Integer; + BasicLength: Cardinal; + Ptr: Integer; + IsBasic, IsText: Boolean; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: list <filename>', clRed); + Exit; + end; + + if not ValidFile(Params[1], Dir, Entry) then + begin + WriteLnColored('Cannot find file ''' + Params[1] + '''.', clRed); + Exit; + end; + + // Build full path + Temp := FContext.Image.GetParent(FContext.CurrentDir) + + FContext.Image.GetDirSep(FContext.Image.Disc[FContext.CurrentDir].Partition) + + Params[1]; + if not FContext.Image.FileExists(Temp, Dir, Entry) then + Temp := Params[1]; + + if FContext.Image.ExtractFile(Temp, Buffer, Entry) then + begin + if Length(Buffer) = 0 then + begin + WriteLn('(empty file)'); + Exit; + end; + + // Check if it's a text file (simple check) + IsText := True; + for I := 0 to Length(Buffer) - 1 do + if ((Buffer[I] < 32) and (Buffer[I] <> 10) and (Buffer[I] <> 13) and (Buffer[I] <> 9)) or + (Buffer[I] > 126) then + begin + IsText := False; + Break; + end; + + // Check if it's a BASIC file + IsBasic := False; + if (Length(Buffer) > 0) and (Buffer[0] = $0D) then + begin + IsBasic := True; + BasicLength := Length(Buffer); + Ptr := 0; + while (Ptr + 3 < BasicLength) and IsBasic do + begin + if (Buffer[Ptr + 1] = $FF) and (Buffer[Ptr + 3] < 5) then + BasicLength := Ptr + 1 + else + begin + Inc(Ptr, Buffer[Ptr + 3]); + if Ptr < Length(Buffer) then + if Buffer[Ptr] <> $0D then + IsBasic := False; + end; + end; + end; + + if IsBasic then + WriteLnColored('BASIC file detected - use GUI for full decoding.', clYellow) + else if IsText then + begin + // Display as text + Temp := ''; + I := 0; + while I < Length(Buffer) do + begin + if (Buffer[I] >= 32) and (Buffer[I] < 127) then + Temp := Temp + Chr(Buffer[I]) + else if (Buffer[I] = 10) or (Buffer[I] = 13) then + begin + WriteLn(Temp); + Temp := ''; + // Skip CR+LF or LF+CR pairs + if (I + 1 < Length(Buffer)) and + (((Buffer[I] = 10) and (Buffer[I + 1] = 13)) or + ((Buffer[I] = 13) and (Buffer[I + 1] = 10))) then + Inc(I); + end + else if Buffer[I] = 9 then + Temp := Temp + ' '; + Inc(I); + end; + if Temp <> '' then + WriteLn(Temp); + end + else + WriteLnColored('Binary file - cannot display as text.', clYellow); + end + else + WriteLnColored('Failed to extract file.', clRed); +end; + +procedure TCLICommandProcessor.CmdReport(const Params: TStringArray); +var + I, J: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + WriteLnColored('Image Report', clBlue + clBold); + WriteLn(StringOfChar('=', 60)); + WriteLn; + + WriteLn('Format : ' + FContext.Image.FormatString); + WriteLn('Filename : ' + FContext.Filename); + if FContext.Image.MapTypeString <> '' then + WriteLn('Map Type : ' + FContext.Image.MapTypeString); + if FContext.Image.DirectoryTypeString <> '' then + WriteLn('Directory Type: ' + FContext.Image.DirectoryTypeString); + WriteLn('CRC32 : ' + FContext.Image.CRC32); + WriteLn; + + // Show disc structure + for I := 0 to Length(FContext.Image.Disc) - 1 do + begin + if FContext.Image.Disc[I].Parent = -1 then + begin + WriteLnColored('Partition/Side ' + IntToStr(I), clBold); + WriteLn(' Title : ' + FContext.Image.Disc[I].Title); + WriteLn(' Entries: ' + IntToStr(Length(FContext.Image.Disc[I].Entries))); + end; + end; + + WriteLn; + ReportFreeSpace; +end; + +procedure TCLICommandProcessor.CmdRunScript(const Params: TStringArray); +var + ScriptFile: TextFile; + Line: String; + CmdArray: TStringArray; +begin + if Length(Params) < 2 then + begin + WriteLnColored('Usage: runscript <filename>', clRed); + Exit; + end; + + if not FileExists(Params[1]) then + begin + WriteLnColored('Script file not found.', clRed); + Exit; + end; + + AssignFile(ScriptFile, Params[1]); + try + Reset(ScriptFile); + while not EOF(ScriptFile) do + begin + ReadLn(ScriptFile, Line); + Line := Trim(Line); + // Skip empty lines and comments + if (Line <> '') and (Line[1] <> '#') and (Line[1] <> ';') then + begin + WriteLn('> ' + Line); + CmdArray := ParseInput(Line); + if not ProcessCommand(CmdArray) then + Break; // Exit command was issued + end; + end; + CloseFile(ScriptFile); + except + on E: Exception do + WriteLnColored('Error reading script: ' + E.Message, clRed); + end; +end; + +procedure TCLICommandProcessor.CmdSaveCSV(const Params: TStringArray); +var + Filename: String; + CSVFile: TextFile; + I, J: Integer; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + // Get the filename + if Length(Params) > 1 then + Filename := Params[1] + else + Filename := FContext.Filename; + + if Filename = '' then + begin + WriteLnColored('No filename specified.', clRed); + Exit; + end; + + // Ensure .csv extension + Filename := ChangeFileExt(Filename, '.csv'); + + AssignFile(CSVFile, Filename); + try + Rewrite(CSVFile); + + // Write header + WriteLn(CSVFile, 'Parent,Filename,Attributes,LoadAddr,ExecAddr,Length,FileType'); + + // Write entries for all directories + for I := 0 to Length(FContext.Image.Disc) - 1 do + begin + for J := 0 to Length(FContext.Image.Disc[I].Entries) - 1 do + begin + with FContext.Image.Disc[I].Entries[J] do + begin + WriteLn(CSVFile, + '"' + Parent + '",' + + '"' + Filename + '",' + + '"' + Attributes + '",' + + IntToHex(LoadAddr, 8) + ',' + + IntToHex(ExecAddr, 8) + ',' + + IntToStr(Length) + ',' + + '"' + FileType + '"'); + end; + end; + end; + + CloseFile(CSVFile); + WriteLn('CSV output saved to ' + Filename); + except + on E: Exception do + WriteLnColored('Error writing CSV: ' + E.Message, clRed); + end; +end; + +procedure TCLICommandProcessor.CmdStamp(const Params: TStringArray); +var + Files: TSearchResults; + I: Integer; + Temp: String; +begin + if FContext.Image.FormatNumber = diInvalidImg then + begin + WriteLnColored('No image loaded.', clRed); + Exit; + end; + + if Length(Params) < 2 then + begin + WriteLnColored('Usage: stamp <filename> [filename2] ...', clRed); + Exit; + end; + + Files := GetListOfFiles(Params[1]); + if Length(Files) > 0 then + begin + for I := 0 to Length(Files) - 1 do + begin + Temp := BuildFilename(Files[I]); + Write('Setting date/time stamp for ' + Temp); + if FContext.Image.TimeStampFile(Temp, Now) then + begin + FContext.HasChanged := True; + WriteLnColored(' success.', clGreen); + end + else + WriteLnColored(' failed.', clRed); + end; + end + else + WriteLnColored('No files found.', clRed); +end; + +function TCLICommandProcessor.ProcessCommand(const Command: TStringArray): Boolean; +var + Cmd: TStringArray; +begin + Result := True; // Continue running + + if Length(Command) = 0 then + Exit; + + // Copy command array so we can modify it + Cmd := Copy(Command); + + // 'ls' command is the same as 'find *' + if LowerCase(Cmd[0]) = 'ls' then + begin + SetLength(Cmd, 2); + Cmd[0] := 'find'; + Cmd[1] := '*'; + end; + + case LowerCase(Cmd[0]) of + 'access': CmdAccess(Cmd); + 'add': CmdAdd(Cmd); + 'cat': CmdCat(Cmd); + 'chdir': if Length(Cmd) > 1 then SetCurrentDir(Cmd[1]); + 'compact', 'defrag': CmdDefrag(Cmd); + 'config': CmdConfig(Cmd); + 'create': CmdCreate(Cmd); + 'delete': CmdDelete(Cmd); + 'dir': CmdDir(Cmd); + 'dirtitle': CmdDirTitle(Cmd); + 'exec', 'load', 'type': CmdExecLoadType(Cmd); + 'exit': if Confirm then Result := False; + 'exittogui': Result := False; + 'extract': CmdExtract(Cmd); + 'filetocsv': CmdFileToCSV(Cmd); + 'filetype': CmdFileType(Cmd); + 'find': CmdFind(Cmd); + 'free': CmdFree(Cmd); + 'help': ShowHelp; + 'insert': CmdInsert(Cmd); + 'interleave': CmdInterleave(Cmd); + 'join': WriteLnColored('This command has not been implemented yet.', clRed); + 'list': CmdList(Cmd); + 'new': CmdNew(Cmd); + 'opt': CmdOpt(Cmd); + 'rename': CmdRename(Cmd); + 'report': CmdReport(Cmd); + 'runscript': CmdRunScript(Cmd); + 'save': CmdSave(Cmd); + 'savecsv': CmdSaveCSV(Cmd); + 'search': CmdSearch(Cmd); + 'split': WriteLnColored('This command has not been implemented yet.', clRed); + 'stamp': CmdStamp(Cmd); + 'status': CmdStatus(Cmd); + 'title': CmdTitle(Cmd); + '': ; // Ignore empty commands + else + WriteLnColored('Unknown command: ' + Cmd[0], clRed); + end; +end; + +function TCLICommandProcessor.ParseInput(const Input: String): TStringArray; +var + Index, J: Integer; +begin + // Split the string at each space, unless enclosed by quotes + Result := Input.Split(' ', '"'); + + // Remove blank entries + if Length(Result) > 0 then + begin + Index := 0; + while Index < Length(Result) do + begin + if (Result[Index] = '') or (Result[Index] = ' ') then + begin + if Index < Length(Result) - 1 then + for J := Index + 1 to Length(Result) - 1 do + Result[J - 1] := Result[J]; + SetLength(Result, Length(Result) - 1); + Dec(Index); + end; + Inc(Index); + end; + end; + + // Remove quotes + if Length(Result) > 0 then + for Index := 0 to Length(Result) - 1 do + Result[Index] := Result[Index].DeQuotedString('"') + else + begin + SetLength(Result, 1); + Result[0] := ''; + end; +end; + +end. 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 <http://www.gnu.org/copyleft/gpl.html>. 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.Position<ScriptFile.Size then B:=ScriptFile.ReadByte; //Read byte by byte - if(B>31)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 Index<Length(Result) do - begin - if(Result[Index]='')or(Result[Index]=' ') then - begin - if Index<Length(Result)-1 then - for j:=Index+1 to Length(Result)-1 do - Result[j-1]:=Result[j]; - SetLength(Result,Length(Result)-1); - dec(Index); - end; - inc(Index); - end; - end; - if Length(Result)>0 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/DiscImage.pas b/LazarusSource/DiscImage.pas index e57f541..fab45a7 100755 --- a/LazarusSource/DiscImage.pas +++ b/LazarusSource/DiscImage.pas @@ -39,8 +39,8 @@ interface maintenance easier. } -uses Classes,Math,crc,ZStream,StrUtils,SysUtils,Zipper,ExtCtrls,DateUtils,md5, - DskImage,FileSystem,HTTPProtocol,fpjson,DOM,XMLWrite; +uses Classes,Math,crc,ZStream,StrUtils,SysUtils,Zipper,DateUtils,md5, + DskImage,FileSystem,fpjson,DOM,XMLWrite,Utils; {$M+} diff --git a/LazarusSource/DiscImageContext.pas b/LazarusSource/DiscImageContext.pas new file mode 100644 index 0000000..ced37af --- /dev/null +++ b/LazarusSource/DiscImageContext.pas @@ -0,0 +1,346 @@ +unit DiscImageContext; + +{ +Disc Image Context - Shared context for disc image operations. +This unit provides a common interface used by both CLI and GUI applications, +allowing the disc image processing library to be used without GUI dependencies. + +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 <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing +to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, +Boston, MA 02110-1335, USA. +} + +{$MODE objFPC}{$H+} + +interface + +uses + Classes, SysUtils, DiscImage; + +type + { TDiscImageContext - Shared context for disc image operations } + TDiscImageContext = class + private + FImage: TDiscImage; + FHasChanged: Boolean; + FCurrentDir: Integer; + FFilename: String; + // Settings + FCreateINF: Boolean; + FAddImpliedAttributes: Boolean; + FHideDEL: Boolean; + FScanSubDirs: Boolean; + FOpenDOS: Boolean; + FCreateDSC: Boolean; + FDFSZeroSecs: Boolean; + FDFSBeyondEdge: Boolean; + FDFSAllowBlank: Boolean; + FSparkIsFS: Boolean; + FADFSInterleave: Byte; + procedure ApplySettings; + public + constructor Create; + destructor Destroy; override; + + // Image operations + function LoadImage(const AFilename: String): Boolean; + function SaveImage(const AFilename: String; Uncompress: Boolean = False): Boolean; + procedure CloseImage; + function CreateNewImage(Major: Word; Minor: Byte; Tracks: Byte = 0): Boolean; + function CreateHDDImage(Major: Word; Size: Cardinal; DirType: Byte = 0; + NewMap: Boolean = False; IDE: Boolean = False): Boolean; + + // Properties + property Image: TDiscImage read FImage; + property HasChanged: Boolean read FHasChanged write FHasChanged; + property CurrentDir: Integer read FCurrentDir write FCurrentDir; + property Filename: String read FFilename; + + // Settings + property CreateINF: Boolean read FCreateINF write FCreateINF; + property AddImpliedAttributes: Boolean read FAddImpliedAttributes write FAddImpliedAttributes; + property HideDEL: Boolean read FHideDEL write FHideDEL; + property ScanSubDirs: Boolean read FScanSubDirs write FScanSubDirs; + property OpenDOS: Boolean read FOpenDOS write FOpenDOS; + property CreateDSC: Boolean read FCreateDSC write FCreateDSC; + property DFSZeroSecs: Boolean read FDFSZeroSecs write FDFSZeroSecs; + property DFSBeyondEdge: Boolean read FDFSBeyondEdge write FDFSBeyondEdge; + property DFSAllowBlank: Boolean read FDFSAllowBlank write FDFSAllowBlank; + property SparkIsFS: Boolean read FSparkIsFS write FSparkIsFS; + property ADFSInterleave: Byte read FADFSInterleave write FADFSInterleave; + end; + + { TRegistrySettings - Cross-platform settings storage } + TRegistrySettings = class + private + FSettings: TStringList; + FFilename: String; + FModified: Boolean; + public + constructor Create(const AAppName: String); + destructor Destroy; override; + + function GetBool(const Key: String; Default: Boolean = False): Boolean; + procedure SetBool(const Key: String; Value: Boolean); + function GetInt(const Key: String; Default: Integer = 0): Integer; + procedure SetInt(const Key: String; Value: Integer); + function GetString(const Key: String; const Default: String = ''): String; + procedure SetString(const Key: String; const Value: String); + function KeyExists(const Key: String): Boolean; + + procedure Save; + procedure Load; + end; + +// Application constants +const + ApplicationTitle = 'Disc Image Manager'; + ApplicationVersion = '1.49.2'; + +// Utility function +function ConvertToKMG(size: Int64): String; + +implementation + +{------------------------------------------------------------------------------- +Convert a size to a human readable format (KB, MB, GB) +-------------------------------------------------------------------------------} +function ConvertToKMG(size: Int64): String; +begin + if size < 1024 then + Result := IntToStr(size) + ' B' + else if size < 1024 * 1024 then + Result := FormatFloat('0.##', size / 1024) + ' KB' + else if size < 1024 * 1024 * 1024 then + Result := FormatFloat('0.##', size / (1024 * 1024)) + ' MB' + else + Result := FormatFloat('0.##', size / (1024 * 1024 * 1024)) + ' GB'; +end; + +{ TDiscImageContext } + +constructor TDiscImageContext.Create; +begin + inherited Create; + FImage := TDiscImage.Create; + FHasChanged := False; + FCurrentDir := 0; + FFilename := ''; + // Default settings + FCreateINF := True; + FAddImpliedAttributes := True; + FHideDEL := True; + FScanSubDirs := True; + FOpenDOS := True; + FCreateDSC := False; + FDFSZeroSecs := False; + FDFSBeyondEdge := True; + FDFSAllowBlank := False; + FSparkIsFS := True; + FADFSInterleave := 0; + ApplySettings; +end; + +destructor TDiscImageContext.Destroy; +begin + FImage.Free; + inherited Destroy; +end; + +procedure TDiscImageContext.ApplySettings; +begin + if Assigned(FImage) then + begin + FImage.AddImpliedAttributes := FAddImpliedAttributes; + FImage.ScanSubDirs := FScanSubDirs; + FImage.OpenDOSPartitions := FOpenDOS; + FImage.CreateDSC := FCreateDSC; + FImage.AllowDFSZeroSectors := FDFSZeroSecs; + FImage.DFSBeyondEdge := FDFSBeyondEdge; + FImage.DFSAllowBlanks := FDFSAllowBlank; + FImage.SparkAsFS := FSparkIsFS; + FImage.InterleaveMethod := FADFSInterleave; + end; +end; + +function TDiscImageContext.LoadImage(const AFilename: String): Boolean; +begin + Result := False; + if FileExists(AFilename) then + begin + ApplySettings; + Result := FImage.LoadFromFile(AFilename); + if Result then + begin + FFilename := AFilename; + FHasChanged := False; + FCurrentDir := 0; + end; + end; +end; + +function TDiscImageContext.SaveImage(const AFilename: String; Uncompress: Boolean): Boolean; +begin + Result := FImage.SaveToFile(AFilename, Uncompress); + if Result then + begin + FFilename := AFilename; + FHasChanged := False; + end; +end; + +procedure TDiscImageContext.CloseImage; +begin + FImage.Close; + FFilename := ''; + FHasChanged := False; + FCurrentDir := 0; +end; + +function TDiscImageContext.CreateNewImage(Major: Word; Minor: Byte; Tracks: Byte): Boolean; +begin + ApplySettings; + Result := FImage.FormatFDD(Major, Minor, Tracks); + if Result then + begin + FFilename := ''; + FHasChanged := True; + FCurrentDir := 0; + end; +end; + +function TDiscImageContext.CreateHDDImage(Major: Word; Size: Cardinal; DirType: Byte; + NewMap: Boolean; IDE: Boolean): Boolean; +begin + ApplySettings; + Result := FImage.FormatHDD(Major, Size, IDE, NewMap, DirType, False); + if Result then + begin + FFilename := ''; + FHasChanged := True; + FCurrentDir := 0; + end; +end; + +{ TRegistrySettings } + +constructor TRegistrySettings.Create(const AAppName: String); +begin + inherited Create; + FSettings := TStringList.Create; + FSettings.Duplicates := dupIgnore; + FSettings.Sorted := True; + FModified := False; + + // Determine settings file location + {$IFDEF UNIX} + FFilename := GetUserDir + '.' + LowerCase(AAppName) + '.conf'; + {$ELSE} + FFilename := GetAppConfigDir(False) + AAppName + '.conf'; + {$ENDIF} + + Load; +end; + +destructor TRegistrySettings.Destroy; +begin + if FModified then + Save; + FSettings.Free; + inherited Destroy; +end; + +function TRegistrySettings.GetBool(const Key: String; Default: Boolean): Boolean; +var + Value: String; +begin + Value := FSettings.Values[Key]; + if Value = '' then + Result := Default + else + Result := (LowerCase(Value) = 'true') or (Value = '1'); +end; + +procedure TRegistrySettings.SetBool(const Key: String; Value: Boolean); +begin + if Value then + FSettings.Values[Key] := 'true' + else + FSettings.Values[Key] := 'false'; + FModified := True; +end; + +function TRegistrySettings.GetInt(const Key: String; Default: Integer): Integer; +var + Value: String; +begin + Value := FSettings.Values[Key]; + if Value = '' then + Result := Default + else + Result := StrToIntDef(Value, Default); +end; + +procedure TRegistrySettings.SetInt(const Key: String; Value: Integer); +begin + FSettings.Values[Key] := IntToStr(Value); + FModified := True; +end; + +function TRegistrySettings.GetString(const Key: String; const Default: String): String; +begin + Result := FSettings.Values[Key]; + if Result = '' then + Result := Default; +end; + +procedure TRegistrySettings.SetString(const Key: String; const Value: String); +begin + FSettings.Values[Key] := Value; + FModified := True; +end; + +function TRegistrySettings.KeyExists(const Key: String): Boolean; +begin + Result := FSettings.IndexOfName(Key) >= 0; +end; + +procedure TRegistrySettings.Save; +var + Dir: String; +begin + try + Dir := ExtractFilePath(FFilename); + if (Dir <> '') and not DirectoryExists(Dir) then + ForceDirectories(Dir); + FSettings.SaveToFile(FFilename); + FModified := False; + except + // Silently ignore save errors + end; +end; + +procedure TRegistrySettings.Load; +begin + try + if FileExists(FFilename) then + FSettings.LoadFromFile(FFilename); + except + // Silently ignore load errors + end; +end; + +end. 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 @@ <PackageName Value="LCL"/> </Item3> </RequiredPackages> - <Units Count="24"> + <Units Count="23"> <Unit0> <Filename Value="DiscImageManager.lpr"/> <IsPartOfProject Value="True"/> @@ -519,20 +519,16 @@ <ResourceBaseClass Value="Form"/> </Unit20> <Unit21> - <Filename Value="ConsoleAppUnit.pas"/> - <IsPartOfProject Value="True"/> - </Unit21> - <Unit22> <Filename Value="RFSDetailUnit.pas"/> <IsPartOfProject Value="True"/> <ComponentName Value="RFSDetailForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - </Unit22> - <Unit23> + </Unit21> + <Unit22> <Filename Value="DiscImageHelper.pas"/> <IsPartOfProject Value="True"/> - </Unit23> + </Unit22> </Units> </ProjectOptions> <CompilerOptions> 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/DiscImageManagerCLI.lpi b/LazarusSource/DiscImageManagerCLI.lpi new file mode 100644 index 0000000..df0d7c1 --- /dev/null +++ b/LazarusSource/DiscImageManagerCLI.lpi @@ -0,0 +1,249 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="12"/> + <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <MainUnitHasScaledStatement Value="False"/> + <CompatibilityMode Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <Title Value="Disc Image Manager CLI"/> + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <VersionInfo> + <UseVersionInfo Value="True"/> + <MajorVersionNr Value="1"/> + <MinorVersionNr Value="50"/> + <Language Value="0809"/> + <StringTable CompanyName="GJH Software" FileDescription="Disc Image Manager CLI - Command Line Interface" ProductName="Disc Image Manager CLI" ProductVersion="1.50"/> + </VersionInfo> + <BuildModes Count="6"> + <Item1 Name="Debug" Default="True"/> + <Item2 Name="Release Linux 64 bit"> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib-cli/Release/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <TargetCPU Value="x86_64"/> + <TargetOS Value="linux"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <RunWithoutDebug Value="True"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <CustomOptions Value="-dNO_GUI"/> + </Other> + </CompilerOptions> + </Item2> + <Item3 Name="Release Linux ARM 64 bit"> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib-cli/Release/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <TargetCPU Value="aarch64"/> + <TargetOS Value="linux"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <RunWithoutDebug Value="True"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <CustomOptions Value="-dNO_GUI"/> + </Other> + </CompilerOptions> + </Item3> + <Item4 Name="Release Windows 64 bit"> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib-cli/Release/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <TargetCPU Value="x86_64"/> + <TargetOS Value="win64"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <RunWithoutDebug Value="True"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <CustomOptions Value="-dNO_GUI"/> + </Other> + </CompilerOptions> + </Item4> + <Item5 Name="Release macOS 64 bit"> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib-cli/Release/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <TargetCPU Value="x86_64"/> + <TargetOS Value="darwin"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <RunWithoutDebug Value="True"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <CustomOptions Value="-dNO_GUI"/> + </Other> + </CompilerOptions> + </Item5> + <Item6 Name="Release macOS ARM"> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib-cli/Release/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <CodeGeneration> + <SmartLinkUnit Value="True"/> + <TargetCPU Value="aarch64"/> + <TargetOS Value="darwin"/> + <Optimizations> + <OptimizationLevel Value="3"/> + </Optimizations> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="False"/> + <RunWithoutDebug Value="True"/> + </Debugging> + <LinkSmart Value="True"/> + </Linking> + <Other> + <CustomOptions Value="-dNO_GUI"/> + </Other> + </CompilerOptions> + </Item6> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <Units Count="7"> + <Unit0> + <Filename Value="DiscImageManagerCLI.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="DiscImage.pas"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="DiscImageContext.pas"/> + <IsPartOfProject Value="True"/> + </Unit2> + <Unit3> + <Filename Value="CLICommands.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + <Unit4> + <Filename Value="DskImage.pas"/> + <IsPartOfProject Value="True"/> + </Unit4> + <Unit5> + <Filename Value="Global.pas"/> + <IsPartOfProject Value="True"/> + </Unit5> + <Unit6> + <Filename Value="filesystem.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="FileSystem"/> + </Unit6> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib-cli/Debug/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <IncludeAssertionCode Value="True"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Checks> + <IOChecks Value="True"/> + <RangeChecks Value="True"/> + <OverflowChecks Value="True"/> + <StackChecks Value="True"/> + </Checks> + <VerifyObjMethodCallValidity Value="True"/> + </CodeGeneration> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + <UseHeaptrc Value="True"/> + <TrashVariables Value="True"/> + <UseExternalDbgSyms Value="True"/> + </Debugging> + </Linking> + <Other> + <CompilerMessages> + <IgnoredMessages idx6018="True" idx5094="True" idx5091="True" idx5060="True" idx5057="True" idx5024="True" idx4081="True" idx4080="True" idx4079="True" idx4035="True"/> + </CompilerMessages> + <CustomOptions Value="-dNO_GUI"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/LazarusSource/DiscImageManagerCLI.lpr b/LazarusSource/DiscImageManagerCLI.lpr new file mode 100644 index 0000000..4caece5 --- /dev/null +++ b/LazarusSource/DiscImageManagerCLI.lpr @@ -0,0 +1,296 @@ +program DiscImageManagerCLI; + +{ +Disc Image Manager - Command Line Interface Version +This version does not require X server or GUI toolkits. + +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 <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing +to the Free Software Foundation, Inc., 51 Franklin Street - Fifth Floor, +Boston, MA 02110-1335, USA. +} + +{$MODE objFPC}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + Classes, SysUtils, CustApp, + DiscImage, DiscImageContext, CLICommands; + +type + { TDiscImageManagerCLI } + TDiscImageManagerCLI = class(TCustomApplication) + private + FProcessor: TCLICommandProcessor; + FScriptFile: TFileStream; + FScriptOpen: Boolean; + procedure OpenScript(const ScriptName: String); + procedure ReadInput(var Input: String); + function DetectColorSupport: Boolean; + function FindPositionalArg: String; + protected + procedure DoRun; override; + public + constructor Create(TheOwner: TComponent); override; + destructor Destroy; override; + procedure WriteHelp; + end; + +{ TDiscImageManagerCLI } + +constructor TDiscImageManagerCLI.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + StopOnException := True; + FProcessor := TCLICommandProcessor.Create; + FScriptFile := nil; + FScriptOpen := False; +end; + +destructor TDiscImageManagerCLI.Destroy; +begin + if FScriptOpen and Assigned(FScriptFile) then + FScriptFile.Free; + FProcessor.Free; + inherited Destroy; +end; + +procedure TDiscImageManagerCLI.OpenScript(const ScriptName: String); +begin + if ScriptName = '' then + Exit; + + if FScriptOpen then + begin + WriteLn('Script already running.'); + Exit; + end; + + if not FileExists(ScriptName) then + begin + WriteLn('Script file ''' + ScriptName + ''' does not exist.'); + Exit; + end; + + WriteLn('Running script ''' + ScriptName + '''.'); + FScriptFile := TFileStream.Create(ScriptName, fmOpenRead or fmShareDenyNone); + FScriptOpen := True; +end; + +procedure TDiscImageManagerCLI.ReadInput(var Input: String); +var + B: Byte; +begin + if not FScriptOpen then + ReadLn(Input) + else + begin + Input := ''; + B := 0; + repeat + if FScriptFile.Position < FScriptFile.Size then + B := FScriptFile.ReadByte; + if (B > 31) and (B < 127) then + Input := Input + Chr(B); + until (B = $0A) or (FScriptFile.Position = FScriptFile.Size); + WriteLn(Input); + end; +end; + +function TDiscImageManagerCLI.DetectColorSupport: Boolean; +var + Term: String; +begin + Result := False; + {$IFDEF UNIX} + Term := GetEnvironmentVariable('TERM'); + Result := (Term <> '') and (Pos('color', LowerCase(Term)) > 0) or + (Pos('xterm', LowerCase(Term)) > 0) or + (Pos('linux', LowerCase(Term)) > 0) or + (Pos('ansi', LowerCase(Term)) > 0); + {$ENDIF} + {$IFDEF WINDOWS} + // Windows 10+ supports ANSI colors + Result := True; + {$ENDIF} +end; + +function TDiscImageManagerCLI.FindPositionalArg: String; +const + // Options that take a value argument + OptionsWithValue = 'es'; +var + I: Integer; + Param: String; +begin + Result := ''; + I := 1; + while I <= ParamCount do + begin + Param := ParamStr(I); + if (Length(Param) > 1) and (Param[1] = '-') then + begin + if (Length(Param) > 2) and (Param[2] = '-') then + // Long option (--script, --execute, etc.): skip it and its value + Inc(I, 2) + else + begin + // Short option (-s, -n, etc.) + if Pos(Param[2], OptionsWithValue) > 0 then + Inc(I, 2) // Option takes a value, skip both + else + Inc(I); // Flag-only option (-n, -h), skip just it + end; + end + else + begin + // Not an option — this is a positional argument + Result := Param; + Exit; + end; + end; +end; + +procedure TDiscImageManagerCLI.DoRun; +var + Input: String; + CmdParams: TStringArray; + Running: Boolean; +begin + // Check for help flag + if HasOption('h', 'help') then + begin + WriteHelp; + Terminate; + Exit; + end; + + // Check for non-interactive mode (single command) + if HasOption('e', 'execute') then + begin + Input := GetOptionValue('e', 'execute'); + CmdParams := FProcessor.ParseInput(Input); + FProcessor.ProcessCommand(CmdParams); + Terminate; + Exit; + end; + + // Detect color support + FProcessor.UseColors := DetectColorSupport and not HasOption('n', 'no-color'); + + // Print header + if FProcessor.UseColors then + Write(clRed + clBold + StringOfChar('*', FProcessor.ConsoleWidth) + clNormal + LineEnding) + else + WriteLn(StringOfChar('*', FProcessor.ConsoleWidth)); + + WriteLn(ApplicationTitle + ' CLI V' + ApplicationVersion); + WriteLn('by Gerald J Holdsworth'); + WriteLn; + {$IFDEF UNIX} + WriteLn('Platform: ' + {$I %FPCTARGETOS%} + ' ' + {$I %FPCTARGETCPU%}); + {$ENDIF} + WriteLn('Type ''help'' for available commands.'); + WriteLn; + + // Check for script file + if HasOption('s', 'script') then + OpenScript(GetOptionValue('s', 'script')); + + // Check for initial image file (positional argument, not an option value) + Input := FindPositionalArg; + if (Input <> '') and FileExists(Input) then + begin + WriteLn('Loading: ' + Input); + if FProcessor.Context.LoadImage(Input) then + WriteLn('Image loaded: ' + FProcessor.Context.Image.FormatString) + else + WriteLn('Failed to load image.'); + end; + + WriteLn('Ready'); + + // Main command loop + Running := True; + while Running do + begin + // Prompt + if FProcessor.Context.Image.FormatNumber <> diInvalidImg then + begin + if FProcessor.Context.HasChanged then + Write('*'); + Write('[' + FProcessor.Context.Image.GetParent(FProcessor.Context.CurrentDir) + ']'); + end; + Write('>'); + + // Read input + ReadInput(Input); + + // Parse and process + CmdParams := FProcessor.ParseInput(Input); + Running := FProcessor.ProcessCommand(CmdParams); + + // Check for end of script + if FScriptOpen then + begin + if FScriptFile.Position = FScriptFile.Size then + begin + FScriptFile.Free; + FScriptFile := nil; + FScriptOpen := False; + end; + end; + end; + + // Footer + if FProcessor.UseColors then + Write(clRed + clBold + StringOfChar('*', FProcessor.ConsoleWidth) + clNormal + LineEnding) + else + WriteLn(StringOfChar('*', FProcessor.ConsoleWidth)); + + Terminate; +end; + +procedure TDiscImageManagerCLI.WriteHelp; +begin + WriteLn('Disc Image Manager CLI - Command-line disc image management tool'); + WriteLn; + WriteLn('Usage: ', ExeName, ' [options] [image-file]'); + WriteLn; + WriteLn('Options:'); + WriteLn(' -h, --help Show this help message'); + WriteLn(' -e, --execute <cmd> Execute a single command and exit'); + WriteLn(' -s, --script <file> Run commands from a script file'); + WriteLn(' -n, --no-color Disable colored output'); + WriteLn; + WriteLn('Examples:'); + WriteLn(' ', ExeName, ' mydisk.ssd Open mydisk.ssd'); + WriteLn(' ', ExeName, ' -e "new ADFSS" Create new ADFS S image'); + WriteLn(' ', ExeName, ' -s commands.txt Run script file'); + WriteLn; + WriteLn('For interactive command help, type ''help'' at the prompt.'); +end; + +var + Application: TDiscImageManagerCLI; + +begin + Application := TDiscImageManagerCLI.Create(nil); + Application.Title := 'Disc Image Manager CLI'; + Application.Run; + Application.Free; +end. 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]) +'</span> '; 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+'<span '+keywordstyle+'>'+tmp+'</span>'; - 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+'<span '+keywordstyle+'>'+tmp+'</span>'; - 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+'<span '+quotestyle+'>' - else - basictxt:=basictxt+cmdRed+cmdItalic; + linetxt:=linetxt+'<span '+quotestyle+'>'; 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+'</span>'; 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('</body></html>'); - //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('</body></html>'); + //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<Length(buffer) do begin @@ -1027,26 +989,21 @@ procedure THexDumpForm.DecodeBasicFile; if((c=$0A)and(cn<>$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; diff --git a/LazarusSource/MainUnit.pas b/LazarusSource/MainUnit.pas index 69412ee..d6b904a 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 {------------------------------------------------------------------------------} @@ -7353,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<Length(OSFiles) do - begin - if OSFiles[ptr].Filename='' then - begin - if ptr<Length(OSFiles)-2 then - for Index:=ptr to Length(OSFiles)-2 do OSFiles[Index]:=OSFiles[Index+1]; - SetLength(OSFiles,Length(OSFiles)-1);//Use Delete method - dec(ptr); - end; - inc(ptr); - end; - //Report the number of entries found - WriteLn(IntToStr(Length(OSFiles))+' entries found.'); - //Now we add/list them - for ptr:=0 to Length(OSFiles)-1 do - begin - //Add directory - if OSFiles[ptr].Directory then - begin - if Command[0]='add' then - begin - Write('Adding directory: '''+OSFiles[ptr].Filename+'''.'); - ok:=AddDirectoryToImage(OSFiles[ptr].Filename); - end //Or list the directory - else WriteLn(cmdBlue+'Directory'+cmdNormal+': ''' - +OSFiles[ptr].Filename+'''.'); - end - else //Add a single file - begin - if Command[0]='add' then - begin - Write('Adding file: '''+OSFiles[ptr].Filename+'''.'); - ok:=AddFileToImage(OSFiles[ptr].Filename)>=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(ptr<dir)then - begin - if Command[0]='compact' then temp:='Compacting' else temp:='Defragging'; - WriteLn(cmdBold+cmdBlue+temp+' drive/partition '+IntToStr(ptr)+cmdNormal); - Defrag(ptr); - end - else WriteLn(cmdRed+'Invalid drive or partition specification'+cmdNormal); - end - else error:=1; - //Set a configuration option, display available options or current settings ++ - 'config','status': - if(Command[0]='config')and(Length(Command)>2)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('<Integer>'); - 'S': Write('<String>'); - 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<Length(Image.Disc) then - if entry<Length(Image.Disc[dir].Entries) then - if Image.Disc[dir].Entries[entry].DirRef>=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 dir<Length(Image.Disc)then - if entry<Length(Image.Disc[dir].Entries)then - DownLoadFile(dir,entry,''); - //If we are outside, then it must be the root - if dir>Length(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(opt<High(Inter))do inc(opt); - //Not found, convert to a number. This will be -1 if an unknown word is given - if LowerCase(Command[1])<>Inter[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(opt<High(Options))do inc(opt); - //Not found, convert to a number. Will be -1 if an unknown word is given - if LowerCase(Command[1])<>Options[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; diff --git a/LazarusSource/Utils.pas b/LazarusSource/Utils.pas index 3977228..99421f3 100644 --- a/LazarusSource/Utils.pas +++ b/LazarusSource/Utils.pas @@ -3,7 +3,7 @@ {$MODE Delphi} { -Copyright (c) 2002-2025 Damien Guard. +Copyright (c) 2002-2025 Damien Guard. Originally from Disk Image Manager https://github.com/damieng/diskimagemanager Relicensed for this project under GNU GPL with permission. @@ -27,14 +27,20 @@ interface uses - Classes, Graphics, LCLIntf, SysUtils; + Classes, SysUtils + {$IFNDEF NO_GUI} + , Graphics, LCLIntf + {$ENDIF} + ; const BytesPerKB: integer = 1024; Power2: array[1..17] of integer = (1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768, 65536); +{$IFNDEF NO_GUI} type TSpinBorderStyle = (bsRaised, bsLowered, bsNone); +{$ENDIF} function StrInt(I: integer): string; function StrHex(I: integer): string; @@ -48,14 +54,21 @@ function CompareBlock(A: array of char; B: string): boolean; function CompareBlockStart(A: array of char; B: string; Start: integer): boolean; function CompareBlockInsensitive(A: array of char; B: string): boolean; +{$IFNDEF NO_GUI} function FontToDescription(ThisFont: TFont): string; function FontFromDescription(Description: string): TFont; function FontHumanReadable(ThisFont: TFont): string; function FontCopy(ThisFont: TFont): TFont; +{$ENDIF} function StrFileSize(Size: integer): string; +function HTTPEncode(const AStr: String): String; +function HTTPDecode(const AStr: String): String; + +{$IFNDEF NO_GUI} procedure DrawBorder(Canvas: TCanvas; var Rect: TRect; BorderStyle: TSpinBorderStyle); +{$ENDIF} implementation @@ -139,6 +152,7 @@ function CompareBlockInsensitive(A: array of char; B: string): boolean; end; end; +{$IFNDEF NO_GUI} // Draw a windows style 3D border procedure DrawBorder(Canvas: TCanvas; var Rect: TRect; BorderStyle: TSpinBorderStyle); var @@ -239,6 +253,7 @@ function FontHumanReadable(ThisFont: TFont): string; begin Result := Trim(StringReplace(FontToDescription(ThisFont), ',', ' ', [rfReplaceAll])); end; +{$ENDIF} function StrYesNo(IsEmpty: boolean): string; begin @@ -299,4 +314,50 @@ function StrFileSize(Size: integer): string; Result := Format('%d MB', [Size div Megabyte]); end; +// HTTP/URL Encode a string (percent encoding) +function HTTPEncode(const AStr: String): String; +const + SafeChars: set of Char = ['A'..'Z', 'a'..'z', '0'..'9', '-', '_', '.', '~']; +var + I: Integer; + Ch: Char; +begin + Result := ''; + for I := 1 to Length(AStr) do + begin + Ch := AStr[I]; + if Ch in SafeChars then + Result := Result + Ch + else + Result := Result + '%' + IntToHex(Ord(Ch), 2); + end; +end; + +// HTTP/URL Decode a string (percent decoding) +function HTTPDecode(const AStr: String): String; +var + I: Integer; + Ch: Char; + HexVal: Integer; +begin + Result := ''; + I := 1; + while I <= Length(AStr) do + begin + Ch := AStr[I]; + if (Ch = '%') and (I + 2 <= Length(AStr)) then + begin + HexVal := StrToIntDef('$' + Copy(AStr, I + 1, 2), -1); + if HexVal >= 0 then + begin + Result := Result + Chr(HexVal); + Inc(I, 3); + Continue; + end; + end; + Result := Result + Ch; + Inc(I); + end; +end; + end.