diff --git a/Documentation/Changes.txt b/Documentation/Changes.txt
index a67140d..0f622cf 100755
--- a/Documentation/Changes.txt
+++ b/Documentation/Changes.txt
@@ -775,6 +775,34 @@ Bug fixes
* When reading the header for an Acorn FS Level 3 image, the incorrect disc size was read. Anything over 16.7MB was read incorrectly.
* Some areas of the file details panel on the main window were not getting repainted correctly with the selected tile.
+1.40 - 28th March 2022
+----------------------
+New or improved features
+* macOS application package now tells the OS that it can accept certain extensions (i.e. become a 'Recommended App').
+* The OS and CPU description has been changed, slightly, in the About dialogue.
+* Added the ability to recognise, and use, a double sided hybrid DFS image (i.e. Acorn/Watford).
+* Added option in the preferences to either scan all sub directories in an image upon loading or not to, for ADFS, Acorn FS, Amiga, and DOS Plus.
+* Added colours to directories that are either not read in or broken (ADFS).
+* Image Contents and File Details header text changed colour to green.
+* Added the ability to create a blank DOS floppy image (360KB/720KB/1.44MB/2.88MB - all FAT12).
+* Added the ability to create a blank 800KB DOS Plus floppy image.
+* Added the ability to create a blank 640KB ADFS/DOS Plus Hybrid image.
+* Enabled the Add DOS Partition to an ADFS image.
+* Added limiter to the Add Partition dialogue box, which changes depending on which format.
+* Temporary limit applied to AFS partition size of 127MB.
+* Added the ability to create a blank DOS Hard Drive image (FAT12/FAT16/FAT32).
+* Improved the separation of the ADFS partition from a hybrid image.
+* Improved the separation of the DOS partition from a hybrid image. This will not result in a viable image when a DOS partition does not exist on the source partition.
+* Begun improving the separation of the AFS partition from a hybrid image. This is still under development and currently does not produce a viable image.
+
+Bug fixes
+* The incorrect OS and CPU where reported in the About dialogue for macOS ARM.
+* The incorrect keyboard shortcuts were used for macOS ARM.
+* A Watford DFS double sided image would get incorrectly IDed as an Acorn DFS double sided image if both sides were different sizes.
+* Sometimes the file info panel would not get fully repainted.
+* When saving an image, some filters where not added.
+* The DOS part of a 640KB ADFS/DOS partition was not getting read correctly.
+
Platform History
----------------
diff --git a/Documentation/Disc Image Manager User Guide.docx b/Documentation/Disc Image Manager User Guide.docx
new file mode 100644
index 0000000..31ea1cc
Binary files /dev/null and b/Documentation/Disc Image Manager User Guide.docx differ
diff --git a/Documentation/Disc Image Manager User Guide.pdf b/Documentation/Disc Image Manager User Guide.pdf
index 87ca22f..a25ba0f 100644
Binary files a/Documentation/Disc Image Manager User Guide.pdf and b/Documentation/Disc Image Manager User Guide.pdf differ
diff --git a/Documentation/ToDo.txt b/Documentation/ToDo.txt
index 7ac1a8f..bc50cab 100644
--- a/Documentation/ToDo.txt
+++ b/Documentation/ToDo.txt
@@ -5,7 +5,6 @@ In no particular order
Bugs
* Scaling - there is a report that icons 'grow' on scaled screens. I have been unable to reproduce this.
+ This appears to happen on Windows (and probably Linux), with single screen only (dual or more it does not do this), resolution of 1400 by anything (or more), and scaled to more than 100%. The icons in the Directory Listing grow as the mouse moves. - TO BE TESTED
- + In addition, the tiling under the graphic for the filetype in the File Details, when it is not big enough, leaves a horrible black edge to the right and bottom. - TO BE TESTED
* 'Bad FS Map' from BeebEm when loading an ADFS/AFS hybrid image after making a change to the ADFS partition. Unable to reproduce.
* Some SS DFS images are IDed as DS images when 'zero length images' is selected in the preferences.
* Access violation has been reported when creating an ADFS HDD image (default options) on Windows. - UNABLE TO REPLICATE
@@ -20,18 +19,20 @@ General
* Export the contents of an open image to another image, or set of images if the selected format is too small or are more directory entries than the format allows.
* Cancel button for progress display?
* Side pane (left hand side) to allow separate images to be opened (REF:3).
-* Use side pane for opening MMFS images and remove the code from TDiscImage (REF:3).
+* Use side panel for opening MMFS images and remove the code from TDiscImage (REF:3).
* For macOS, change the settings being saved to the registry to being saved in a plist file, or within the application directory itself.
+* Import an existing AFS or DOS image into ADFS as a new partition.
+
+DFS
ADFS
* Change the size of the ADFS partition or image.
-
-CFS (UEF)
-* Remember the last block read and compare with the next to get around some tape protection methods.
+* Change the interleave on extracted ADFS 640K images.
AFS
-* AFS0 images do not get created correctly (in particular the free space allocation maps).
-* Add option to new Level 3 images for pre-1988 or post-1988 format.
+* AFS0 images do not get created correctly (in particular the free space allocation maps) - AWAITING MORE INFO ON AFS FORMATS.
+* Add option to new Level 3 images for pre-1988 or post-1988 format - AWAITING MORE INFO ON AFS FORMATS.
+* When extracting the AFS partition, remove the ADFS partition and re-address all the objects, instead of just blanking out the ADFS part - IN PROGRESS.
Amiga
* Write/Delete/Rename files/directories to Amiga images.
@@ -40,7 +41,7 @@ Amiga
* Show file attributes in the File Details panel.
Spectrum/Amstrad
-* Write entire module.
+* Write entire module - REQUIRE MORE INFO ON SPECTRUM FORMAT.
MMFS
* Remove from TDiscImage and incorporate into GUI (REF:3).
@@ -54,6 +55,6 @@ Spark
* Move file.
DOS Plus
-* Create new image
-* Add partition to an ADFS image.
-* Move file - this just changes a file/directory's parent.
\ No newline at end of file
+* There is a bug where if a filename begins with a '.' then this character does not get displayed.
+* On ADFS/DOS hybrids, the directory separator is a '.', not a '\'.
+* Support FAT32
\ No newline at end of file
diff --git a/LazarusSource/AFSPartitionUnit.lfm b/LazarusSource/AFSPartitionUnit.lfm
index a0b590a..338960d 100644
--- a/LazarusSource/AFSPartitionUnit.lfm
+++ b/LazarusSource/AFSPartitionUnit.lfm
@@ -2,12 +2,12 @@ object AFSPartitionForm: TAFSPartitionForm
Left = 436
Height = 156
Top = 272
- Width = 320
+ Width = 355
BorderIcons = [biSystemMenu]
BorderStyle = bsDialog
Caption = 'Partition Size'
ClientHeight = 156
- ClientWidth = 320
+ ClientWidth = 355
Color = 15527148
OnPaint = FormPaint
Position = poMainFormCenter
@@ -16,7 +16,7 @@ object AFSPartitionForm: TAFSPartitionForm
Left = 0
Height = 37
Top = 0
- Width = 320
+ Width = 355
OnChange = PartitionSizeChange
Position = 0
TickMarks = tmBoth
@@ -28,24 +28,23 @@ object AFSPartitionForm: TAFSPartitionForm
Left = 0
Height = 16
Top = 37
- Width = 320
+ Width = 355
Align = alTop
Alignment = taCenter
Caption = 'PartitionSizeLabel'
end
object CancelButton: TBitBtn
- Left = 8
+ Left = 128
Height = 30
Top = 120
Width = 100
- Cancel = True
Caption = 'Cancel'
Color = 15527148
ModalResult = 2
TabOrder = 1
end
object OKBtnBack: TPanel
- Left = 124
+ Left = 244
Height = 30
Top = 120
Width = 100
@@ -73,7 +72,7 @@ object AFSPartitionForm: TAFSPartitionForm
Left = 0
Height = 56
Top = 53
- Width = 320
+ Width = 355
Align = alTop
AutoFill = True
Caption = 'Partition Type'
@@ -84,13 +83,24 @@ object AFSPartitionForm: TAFSPartitionForm
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
- ClientHeight = 39
- ClientWidth = 318
+ ClientHeight = 37
+ ClientWidth = 345
ItemIndex = 0
Items.Strings = (
'Acorn File Server'
'DOS Plus'
)
+ OnClick = rad_typeClick
TabOrder = 3
end
+ object FromFileButton: TBitBtn
+ Left = 8
+ Height = 30
+ Top = 120
+ Width = 100
+ Caption = 'From File...'
+ Color = 15527148
+ Enabled = False
+ TabOrder = 4
+ end
end
diff --git a/LazarusSource/AFSPartitionUnit.pas b/LazarusSource/AFSPartitionUnit.pas
index 7b4ff07..7fe40eb 100644
--- a/LazarusSource/AFSPartitionUnit.pas
+++ b/LazarusSource/AFSPartitionUnit.pas
@@ -14,6 +14,7 @@ interface
TAFSPartitionForm = class(TForm)
CancelButton: TBitBtn;
+ FromFileButton: TBitBtn;
OKBtnBack: TPanel;
OKButton: TBitBtn;
PartitionSizeLabel: TLabel;
@@ -21,10 +22,12 @@ TAFSPartitionForm = class(TForm)
rad_type: TRadioGroup;
procedure FormPaint(Sender: TObject);
procedure PartitionSizeChange(Sender: TObject);
+ procedure rad_typeClick(Sender: TObject);
private
public
-
+ maxAFSSize,
+ maxDOSSize : Cardinal;
end;
var
@@ -46,6 +49,15 @@ procedure TAFSPartitionForm.PartitionSizeChange(Sender: TObject);
PartitionSizeLabel.Caption:=FloatToStr((PartitionSize.Position*$100)/1024)+'KB';
end;
+{------------------------------------------------------------------------------}
+//Ensure we don't create anything bigger than the FS can handle
+{------------------------------------------------------------------------------}
+procedure TAFSPartitionForm.rad_typeClick(Sender: TObject);
+begin
+ if rad_type.ItemIndex=0 then PartitionSize.Max:=maxAFSSize;
+ if rad_type.ItemIndex=1 then PartitionSize.Max:=maxDOSSize;
+end;
+
{------------------------------------------------------------------------------}
//Tile the form
{------------------------------------------------------------------------------}
diff --git a/LazarusSource/DiscImage.pas b/LazarusSource/DiscImage.pas
index d456155..105e89a 100755
--- a/LazarusSource/DiscImage.pas
+++ b/LazarusSource/DiscImage.pas
@@ -1,7 +1,7 @@
unit DiscImage;
{
-TDiscImage class V1.38.5
+TDiscImage class V1.40
Manages retro disc images, presenting a list of files and directories to the
parent application. Will also extract files and write new files. Almost a complete
filing system in itself. Compatible with Acorn DFS, Acorn ADFS, UEF, Commodore
@@ -45,10 +45,11 @@ interface
TDir = record
Directory, //Directory name (ALL)
Title : String; //Directory title (DFS/ADFS)
- Entries : array of TDirEntry;//Entries (above)
+ Entries : array of TDirEntry;//Entries (see DiscImageUtils unit)
ErrorCode : Byte; //Used to indicate error for broken directory (ADFS)
Broken, //Flag if directory is broken (ADFS)
Locked, //Flag if disc is locked (MMFS)
+ BeenRead, //Flag if directory has been reed in
DOSPartition, //Is this in the DOS Plus partition? (ADFS/DOS Plus)
AFSPartition: Boolean; //Is this in the AFS partition? (ADFS/AFS)
Sector, //Where is this directory located (same as TDirEntry)
@@ -79,7 +80,8 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
FSparkAsFS, //Deal with Spark archives as a filing system
FDFSzerosecs, //Allow zero length disc images for DFS?
FDFSAllowBlank, //Allow blank filenames
- FDFSBeyondEdge: Boolean; //Check for files going beyond the DFS disc edge
+ FDFSBeyondEdge, //Check for files going beyond the DFS disc edge
+ FScanSubDirs : Boolean; //Scan sub directories on opening (ADFS/Amiga/DOS/Spark)
secsize, //Sector Size
bpmb, //Bits Per Map Bit (Acorn ADFS New)
dosalloc, //Allocation Unit (DOS Plus)
@@ -287,6 +289,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
function ID_DFS: Boolean;
function ReadDFSDisc(mmbdisc:Integer=-1): TDisc;
procedure DFSFreeSpaceMap(LDisc: TDisc);
+ function IsWatford(s: Integer): Boolean;
function ConvertDFSSector(address,side: Integer): Integer;
function WriteDFSFile(var file_details: TDirEntry;var buffer: TDIByteArray): Integer;
procedure UpdateDFSCat(side: Integer);
@@ -397,15 +400,18 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
function WriteDOSObject(buffer:TDIByteArray;fragments:TFragmentArray):Boolean;
function WriteDOSFile(var file_details: TDirEntry;
var buffer: TDIByteArray):Integer;
+ function InsertDOSEntry(dir: Cardinal;direntry: TDirEntry): Integer;
function CreateDOSDirectory(dirname,parent,attributes: String): Integer;
function DeleteDOSFile(filename: String): Boolean;
+ procedure RemoveDOSEntry(dir, entry: Cardinal);
function UpdateDOSAttributes(filename,attributes: String): Boolean;
function UpdateDOSDiscTitle(title: String): Boolean;
function UpdateDOSTimeStamp(filename:String;newtimedate:TDateTime):Boolean;
function AddDOSPartition(size: Cardinal): Boolean;
- function FormatDOS(shape: Byte): TDisc;
- procedure WriteDOSPartition;
- procedure WriteDOSHeader;
+ function FormatDOS(size: Cardinal;fat: Byte): TDisc;
+ procedure WriteDOSHeader(offset, size: Cardinal;fat: Byte;bootable: Boolean);
+ procedure WriteDOSHeader(offset, size: Cardinal;fat: Byte;bootable: Boolean;
+ buffer:TDIByteArray);overload;
function MoveDOSFile(filename,directory: String): Integer;
//Private constants
const
@@ -433,8 +439,8 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
procedure ReadImage;
procedure SaveToFile(filename: String;uncompress: Boolean=False);
procedure Close;
- function FormatFDD(major,minor,tracks: Byte): Boolean;
- function FormatHDD(major:Byte;harddrivesize:Cardinal;newmap:Boolean;dirtype:Byte):Boolean;
+ function FormatFDD(major:Word;minor,tracks: Byte): Boolean;
+ function FormatHDD(major:Word;harddrivesize:Cardinal;newmap:Boolean;dirtype:Byte):Boolean;
function ExtractFile(filename:String;var buffer:TDIByteArray;entry:Cardinal=0): Boolean;
function WriteFile(var file_details: TDirEntry; var buffer: TDIByteArray): Integer;
function FileExists(filename: String;var Ref: Cardinal): Boolean;
@@ -480,6 +486,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
function AddPartition(filename: String): Boolean; overload;
function ChangeInterleaveMethod(NewMethod: Byte): Boolean;
function GetDirSep(partition: Byte): Char;
+ function ReadDirectory(dirname: String): Integer;
//Published properties
property AFSPresent: Boolean read FAFSPresent;
property AFSRoot: Cardinal read Fafsroot;
@@ -509,6 +516,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati
property ProgressIndicator: TProgressProc write FProgress;
property RAWData: TDIByteArray read Fdata;
property RootAddress: Cardinal read GetRootAddress;
+ property ScanSubDirs: Boolean read FScanSubDirs write FScanSubDirs;
property SparkAsFS: Boolean read FSparkAsFS write FSparkAsFS;
public
destructor Destroy; override;
@@ -518,7 +526,8 @@ implementation
uses
SysUtils,DateUtils;
-
+{This unit is split into sub units. Some code is replicated in the different
+sub units. This is so each filing system can have it's own methods.}
{$INCLUDE 'DiscImage_Private.pas'} //Module for private methods
{$INCLUDE 'DiscImage_Published.pas'}//Module for published methods
{$INCLUDE 'DiscImage_ADFS.pas'} //Module for Acorn ADFS
diff --git a/LazarusSource/DiscImageManager.lpi b/LazarusSource/DiscImageManager.lpi
index 504078d..21be0d8 100644
--- a/LazarusSource/DiscImageManager.lpi
+++ b/LazarusSource/DiscImageManager.lpi
@@ -21,9 +21,9 @@
-
+
-
+
@@ -481,7 +481,7 @@
-
+
diff --git a/LazarusSource/DiscImageManager.lps b/LazarusSource/DiscImageManager.lps
index 6e36ec1..2e7a5df 100644
--- a/LazarusSource/DiscImageManager.lps
+++ b/LazarusSource/DiscImageManager.lps
@@ -4,10 +4,11 @@
-
+
+
@@ -19,8 +20,8 @@
-
-
+
+
@@ -29,8 +30,8 @@
-
-
+
+
@@ -54,8 +55,8 @@
-
-
+
+
@@ -77,7 +78,8 @@
-
+
+
@@ -86,7 +88,7 @@
-
+
@@ -131,7 +133,7 @@
-
+
@@ -178,8 +180,8 @@
-
-
+
+
@@ -204,8 +206,8 @@
-
-
+
+
@@ -243,7 +245,8 @@
-
+
+
@@ -263,13 +266,16 @@
+
+
-
+
+
@@ -282,6 +288,8 @@
+
+
@@ -315,173 +323,164 @@
+
-
-
-
+
-
-
+
+
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
+
+
-
-
+
+
-
+
+
-
-
+
+
-
+
+
+
+
+
+
@@ -490,4 +489,12 @@
+
+
+ -
+
+
+
+
+
diff --git a/LazarusSource/DiscImageManager.res b/LazarusSource/DiscImageManager.res
index 084f14b..1bcf26f 100644
Binary files a/LazarusSource/DiscImageManager.res and b/LazarusSource/DiscImageManager.res differ
diff --git a/LazarusSource/DiscImageUtils.pas b/LazarusSource/DiscImageUtils.pas
index cf04eb6..38d1c62 100644
--- a/LazarusSource/DiscImageUtils.pas
+++ b/LazarusSource/DiscImageUtils.pas
@@ -1,7 +1,7 @@
unit DiscImageUtils;
{
-DiscImageUtils V1.38.4 - part of TDiscImage class
+DiscImageUtils V1.40 - part of TDiscImage class
Copyright (C) 2018-2022 Gerald Holdsworth gerald@hollypops.co.uk
@@ -97,6 +97,7 @@ TUserAccount = record
diADFSNewMap = $01;
diAmigaOFS = $02;
diAmigaFFS = $03;
+ diMaster512 = $01;
diFAT12 = $12;
diFAT16 = $16;
diFAT32 = $32;
diff --git a/LazarusSource/DiscImage_ADFS.pas b/LazarusSource/DiscImage_ADFS.pas
index 543d195..1013d6b 100644
--- a/LazarusSource/DiscImage_ADFS.pas
+++ b/LazarusSource/DiscImage_ADFS.pas
@@ -90,13 +90,15 @@ function TDiscImage.ID_ADFS: Boolean;
if FForceInter=0 then
begin
//If this is not as expected, then change the interleave
- if(ReadByte($1000)<>$FF)or(Read24b($1001)<>$FFFFFF)then
- if FInterleave=2 then FInterleave:=1 else FInterleave:=2;
- //Still not as expected? Change back and clear the flag
- if(ReadByte($1000)<>$FF)or(Read24b($1001)<>$FFFFFF)then
+ if(ReadByte($1000)<>$FF)or(Read16b($1001)<>$FFFF)then
begin
if FInterleave=2 then FInterleave:=1 else FInterleave:=2;
- FDOSPresent:=False;
+ //Still not as expected? Change back and clear the flag
+ if(ReadByte($1000)<>$FF)or(Read16b($1001)<>$FFFF)then
+ begin
+ if FInterleave=2 then FInterleave:=1 else FInterleave:=2;
+ FDOSPresent:=False;
+ end;
end;
end;
//If, at this stage, the flag is set, reset the disc size to 4K.
@@ -555,6 +557,7 @@ function TDiscImage.ReadADFSDir(dirname: String; sector: Cardinal): TDir;
Result.ErrorCode:=Result.ErrorCode OR $08;
end;
end;
+ Result.BeenRead:=True;
end;
end;
if Result.Broken then inc(brokendircount);
@@ -1024,10 +1027,11 @@ function TDiscImage.ReadADFSDisc: TDisc;
//Once found, list their entries
SetLength(Result,Length(Result)+1);
//Read in the contents of the directory
- Result[Length(Result)-1]:=ReadADFSDir(GetParent(d)
- +dir_sep
- +Result[d].Entries[ptr].Filename,
- Result[d].Entries[ptr].Sector);
+ if FScanSubDirs then
+ Result[Length(Result)-1]:=ReadADFSDir(GetParent(d)
+ +dir_sep
+ +Result[d].Entries[ptr].Filename,
+ Result[d].Entries[ptr].Sector);
Result[Length(Result)-1].Parent:=d;
//Remember it
SetLength(visited,Length(visited)+1);
@@ -1837,6 +1841,8 @@ function TDiscImage.WriteADFSFile(var file_details:TDirEntry;var buffer:TDIByteA
dir :=0
else
dir :=FDisc[ref div $10000].Entries[ref mod $10000].DirRef;
+ //Has it been read in?
+ if not FDisc[dir].BeenRead then ReadDirectory(file_details.Parent);
//Big Dir - Verify directory is big enough or if it needs extending and moved.
if(FDirType=diADFSBigDir)and(extend)then //This will extend/contract the directory
if not ExtendADFSBigDir(dir,Length(file_details.Filename),True) then
@@ -2316,6 +2322,8 @@ function TDiscImage.CreateADFSDirectory(var dirname,parent,
begin
FileExists(parent,dir,entry);
parentaddr:=FDisc[dir].Entries[entry].Sector;
+ //Has it been read in?
+ if not FDisc[FDisc[dir].Entries[entry].DirRef].BeenRead then ReadDirectory(parent);
end;
if dirname<>'$' then
//Validate the name
@@ -2493,6 +2501,8 @@ procedure TDiscImage.UpdateADFSCat(directory: String;newname: String='');
begin
dir :=FDisc[ref div $10000].Entries[ref mod $10000].DirRef;
diraddr:=FDisc[ref div $10000].Entries[ref mod $10000].Sector;
+ //Has it been read in?
+ if not FDisc[dir].BeenRead then ReadDirectory(directory);
end;
//Make the sector address a disc address
if not FMap then
@@ -2737,6 +2747,9 @@ function TDiscImage.RetitleADFSDirectory(filename,newtitle: String): Boolean;
end
else
begin
+ //Has it been read in?
+ if not FDisc[FDisc[dir].Entries[entry].DirRef].BeenRead then
+ ReadDirectory(filename);
//Re-title the directory, limiting it to 19 characters
FDisc[FDisc[dir].Entries[entry].DirRef].Title:=LeftStr(newtitle,19);
//Update the catalogue, which will update the title
@@ -3098,6 +3111,10 @@ function TDiscImage.DeleteADFSFile(filename: String;
if filename<>'$' then
//If directory, delete contents first
if(FDisc[dir].Entries[entry].DirRef>0)and(not TreatAsFile)then
+ begin
+ //Has it been read in?
+ if not FDisc[FDisc[dir].Entries[entry].DirRef].BeenRead then
+ ReadDirectory(filename);
//We'll do a bit of recursion to remove each entry one by one. If it
//encounters a directory, that will get it's contents deleted, then itself.
while(Length(FDisc[FDisc[dir].Entries[entry].DirRef].Entries)>0)
@@ -3107,6 +3124,7 @@ function TDiscImage.DeleteADFSFile(filename: String;
filename
+dir_sep
+FDisc[FDisc[dir].Entries[entry].DirRef].Entries[0].Filename);
+ end;
//Only continue if we are successful
if success then
begin
@@ -3443,6 +3461,8 @@ function TDiscImage.MoveADFSFile(filename,directory: String): Integer;
if directory<>'$' then ddir:=FDisc[ddir].Entries[dentry].DirRef;
if ddir<>sdir then //Can't move into the same directory
begin
+ //Has it been read in?
+ if not FDisc[ddir].BeenRead then ReadDirectory(directory);
Result:=-3; //File already exists in destination directory
//Alter for the new parent
direntry.Parent:=directory;
@@ -3772,96 +3792,100 @@ function TDiscImage.FixADFSDirectory(dir,entry: Integer): Boolean;
dirref:=0; //Root
//What is the error?
error:=FDisc[dirref].ErrorCode;
- //Where is the directory, and how big?
- len:=0;
- //We need to resolve the actual disc offset and length
- if(dir>=0)and(entry>=0) then
+ if error>0 then //Only act if there is an error
begin
- if FMap then //New Map
+ //Where is the directory, and how big?
+ len:=0;
+ //We need to resolve the actual disc offset and length
+ if(dir>=0)and(entry>=0) then
begin
- //Get the fragments for the directory (should only be one)
- fragments:=NewDiscAddrToOffset(FDisc[dir].Entries[entry].Sector);
+ if FMap then //New Map
+ begin
+ //Get the fragments for the directory (should only be one)
+ fragments:=NewDiscAddrToOffset(FDisc[dir].Entries[entry].Sector);
+ len:=0;
+ //Work out the total length
+ if Length(fragments)>0 then
+ for i:=0 to Length(fragments)-1 do inc(len,fragments[i].Length);
+ end;
+ if not FMap then //Old Map
+ begin
+ SetLength(fragments,1);
+ fragments[0].Offset:=FDisc[dir].Entries[entry].Sector*$100;
+ len:=FDisc[dir].Entries[entry].Length;
+ fragments[0].Length:=len;
+ end;
+ end
+ else //Root
+ begin
+ //As above
+ fragments:=NewDiscAddrToOffset(rootfrag);
len:=0;
//Work out the total length
if Length(fragments)>0 then
for i:=0 to Length(fragments)-1 do inc(len,fragments[i].Length);
end;
- if not FMap then //Old Map
- begin
- SetLength(fragments,1);
- fragments[0].Offset:=FDisc[dir].Entries[entry].Sector*$100;
- len:=FDisc[dir].Entries[entry].Length;
- fragments[0].Length:=len;
- end;
- end
- else //Root
- begin
- //As above
- fragments:=NewDiscAddrToOffset(rootfrag);
- len:=0;
- //Work out the total length
if Length(fragments)>0 then
- for i:=0 to Length(fragments)-1 do inc(len,fragments[i].Length);
- end;
- if Length(fragments)>0 then
- begin
- //Retrieve the directory into a cache
- if ExtractFragmentedData(fragments,len,dircache) then
begin
- //Tail length
- if FDirType=diADFSOldDir then tail:=$35;
- if FDirType=diADFSNewDir then tail:=$29;
- if FDirType=diADFSBigDir then tail:=$08;
- //First basic check to see if the directory structure is where it should be
- Result:=True; //This can happen for interleaved images
- if(FDirType=diADFSOldDir)and(Length(FDisc[dirref].Entries)=0)
- and(ReadString(1,-4,dircache)<>'Hugo')
- and(ReadString((len-6),-4,dircache)<>'Hugo')then
- Result:=False; //We will assume that if neither are Hugo, then the dir is somewhere else
- if Result then //So we will only fix if we can
+ //Retrieve the directory into a cache
+ if ExtractFragmentedData(fragments,len,dircache) then
begin
- //Start the fixes
- if (error AND $01=$01) then //StartSeq<>EndSeq
+ //Tail length
+ if FDirType=diADFSOldDir then tail:=$35;
+ if FDirType=diADFSNewDir then tail:=$29;
+ if FDirType=diADFSBigDir then tail:=$08;
+ //First basic check to see if the directory structure is where it should be
+ Result:=True; //This can happen for interleaved images
+ if(FDirType=diADFSOldDir)and(Length(FDisc[dirref].Entries)=0)
+ and(ReadString(1,-4,dircache)<>'Hugo')
+ and(ReadString((len-6),-4,dircache)<>'Hugo')
+ and(error AND $02<>$02)then //Only if this is not the reason why it is broken
+ Result:=False; //We will assume that if neither are Hugo, then the dir is somewhere else
+ if Result then //So we will only fix if we can
begin
- //Quite simple - just pick up StartSeq and write it to EndSeq
- if FDirType=diADFSOldDir then WriteByte(ReadByte(0,dircache),(len-tail)+$2F,dircache);
- if FDirType=diADFSNewDir then WriteByte(ReadByte(0,dircache),(len-tail)+$23,dircache);
- if FDirType=diADFSBigDir then WriteByte(ReadByte(0,dircache),(len-tail)+$04,dircache);
- end;
- if (error AND $02=$02) then //StartName<>EndName (Old/New Dirs)
- begin
- //Almost as simple - just re-write what they should be
- if FDirType=diADFSOldDir then StartName:='Hugo';
- if FDirType=diADFSNewDir then StartName:='Nick';
- for i:=1 to 4 do
+ //Start the fixes
+ if (error AND $01=$01) then //StartSeq<>EndSeq
begin
- WriteByte(Ord(StartName[i]),i,dircache); //Header
- WriteByte(Ord(StartName[i]),(len-6)+i,dircache);//Tail
+ //Quite simple - just pick up StartSeq and write it to EndSeq
+ if FDirType=diADFSOldDir then WriteByte(ReadByte(0,dircache),(len-tail)+$2F,dircache);
+ if FDirType=diADFSNewDir then WriteByte(ReadByte(0,dircache),(len-tail)+$23,dircache);
+ if FDirType=diADFSBigDir then WriteByte(ReadByte(0,dircache),(len-tail)+$04,dircache);
end;
- end;
- if (error AND $04=$04) then //StartName<>'SBPr' or EndName<>'oven' (Big)
- begin
- //The same as previously, except start and end do not match
- StartName:='SBPr';
- EndName :='oven';
- for i:=1 to 4 do
+ if (error AND $02=$02) then //StartName<>EndName (Old/New Dirs)
begin
- WriteByte(Ord(StartName[i]),3+i,dircache); //Header
- WriteByte(Ord(EndName[i]) ,(len-tail)+(i-1),dircache);//Tail
+ //Almost as simple - just re-write what they should be
+ if FDirType=diADFSOldDir then StartName:='Hugo';
+ if FDirType=diADFSNewDir then StartName:='Nick';
+ for i:=1 to 4 do
+ begin
+ WriteByte(Ord(StartName[i]),i,dircache); //Header
+ WriteByte(Ord(StartName[i]),(len-6)+i,dircache);//Tail
+ end;
+ end;
+ if (error AND $04=$04) then //StartName<>'SBPr' or EndName<>'oven' (Big)
+ begin
+ //The same as previously, except start and end do not match
+ StartName:='SBPr';
+ EndName :='oven';
+ for i:=1 to 4 do
+ begin
+ WriteByte(Ord(StartName[i]),3+i,dircache); //Header
+ WriteByte(Ord(EndName[i]) ,(len-tail)+(i-1),dircache);//Tail
+ end;
+ end;
+ //Bit 3 indicates invalid checksum - but we'll update anyway
+ //The above changes could alter it
+ if FDirType=diADFSOldDir then //Old - can be zero
+ WriteByte($00,$4FF,dircache)
+ else //New
+ WriteByte(CalculateADFSDirCheck(0,dircache),len-1,dircache);
+ //Write the directory back
+ if WriteFragmentedData(fragments,dircache) then
+ begin
+ //Reset the flags
+ FDisc[dirref].Broken:=False;
+ FDisc[dirref].ErrorCode:=$00;
end;
- end;
- //Bit 3 indicates invalid checksum - but we'll update anyway
- //The above changes could alter it
- if FDirType=diADFSOldDir then //Old - can be zero
- WriteByte($00,$4FF,dircache)
- else //New
- WriteByte(CalculateADFSDirCheck(0,dircache),len-1,dircache);
- //Write the directory back
- if WriteFragmentedData(fragments,dircache) then
- begin
- //Reset the flags
- FDisc[dirref].Broken:=False;
- FDisc[dirref].ErrorCode:=$00;
end;
end;
end;
@@ -4120,18 +4144,28 @@ function TDiscImage.UpdateADFSTimeStamp(filename:String;newtimedate:TDateTime):B
function TDiscImage.ExtractADFSPartition(side: Cardinal): TDIByteArray;
var
index,
- diff : Integer;
- start : Cardinal;
+ diff : Integer;
+ start,
+ new1,
+ new2 : Cardinal;
+ JesMapList : Array of Cardinal;
+ JesMap : String;
+ buffer : TDIByteArray;
begin
Result:=nil;
if(FAFSPresent)or(FDOSPresent)then //Make sure it is a hybrid
begin
- //Copy the original data
- Result:=Fdata;
- //Extracting the ADFS part is simply just blanking the AFS partition, and the
- //ADFS disc title (so that $0F6 and $1F6 do not point to anything).
+ //Side 0 : must be ADFS
if side=0 then
begin
+ //Extracting the ADFS part is simply just blanking the AFS partition, and the
+ //ADFS disc title (so that $0F6 and $1F6 do not point to anything).
+ new1:=GetDataLength;
+ SetLength(Result,new1);
+ //Copy the data across - this will de-interleave it
+ UpdateProgress('Extracting Partition');
+ for index:=0 to new1-1 do Result[index]:=ReadByte(index);
+ UpdateProgress('Extending ADFS Partition');
//Blank off the addresses
if FAFSPresent then //AFS Only
begin
@@ -4151,18 +4185,132 @@ function TDiscImage.ExtractADFSPartition(side: Cardinal): TDIByteArray;
Write24b((Length(Result)>>8)-start,$100+index,Result);
//Pointer
inc(index,3);
- WriteByte(index,$1FE);
+ WriteByte(index,$1FE,Result);
end;
//Expand the image size
Write24b(Length(Result)>>8,$0FC,Result);
+ //Blank off the other partition
+ for index:=disc_size[0] to new1-1 do Result[index]:=$00;
+ //Update the checksums
+ WriteByte(ByteCheckSum($0000,$100,Result),$0FF,Result);
+ WriteByte(ByteCheckSum($0100,$100,Result),$1FF,Result);
+ //Change interleave on 640KB images
+ if new1=$A0000 then
+ begin
+ //Set up the temporary store
+ SetLength(buffer,$A0000);
+ //Copy the data across - direct read from one array to a interleave write in the other
+ for index:=0 to $9FFFF do WriteByte(Result[index],index,buffer);
+ //Write over the result with the new temporary store
+ for index:=0 to $9FFFF do Result[index]:=buffer[index];
+ end;
+ end;
+ //Side 1 : Partition is AFS
+ if(side=1)and(FAFSPresent)then
+ begin
+ //Setup the buffer to accomodate the AFS partition and the ADFS dummy header
+ SetLength(Result,disc_size[1]+$700);//Header + Root = $200+$500
+ //Copy the ADFS dummy header across to the top of the buffer
+ UpdateProgress('Copying the ADFS header');
+ for index:=0 to $6FF do Result[index]:=ReadByte(index);
+ //Copy the AFS partition to just after this
+ UpdateProgress('Extracting the Acorn File Server partition');
+ SetLength(JesMapList,0); //We'll look for objects while we're at it
+ JesMap:='';
+ for index:=0 to disc_size[1]-1 do
+ begin
+ //Copy across, byte by byte
+ Result[$700+index]:=ReadByte(disc_size[0]+index);
+ //Make a note of the character
+ JesMap:=JesMap+chr(Result[index]);
+ //Make sure it is no longer than 6 characters
+ if Length(JesMap)>6 then JesMap:=RightStr(JesMap,6);
+ //Have we found an object?
+ if JesMap='JesMap' then
+ begin
+ //Make a note of the location
+ SetLength(JesMapList,Length(JesMapList)+1);
+ JesMapList[Length(JesMapList)-1]:=index-5;
+ end;
+ end;
+ //Adjust the disc addresses in the ADFS dummy header
+ UpdateProgress('Updating the header');
+ diff:=disc_size[0]-$700; //Difference between the original and the AFS
+ new1:=(afshead-diff)>>8;
+ new2:=(afshead2-diff)>>8;
+ Result[$0F6]:= new1 AND $FF;
+ Result[$0F7]:=(new1 AND $FF00)>>8;
+ Result[$0F8]:=(new1 AND $FF0000)>>16;
+ Result[$1F6]:= new2 AND $FF;
+ Result[$1F7]:=(new2 AND $FF00)>>8;
+ Result[$1F8]:=(new2 AND $FF0000)>>16;
+ //Adjust the root SIN in the AFS header
+ start:=afsroot-(diff>>8);
+ Result[(new1<<8)+$1F]:= start AND $FF;
+ Result[(new1<<8)+$20]:=(start AND $FF00)>>8;
+ Result[(new2<<8)+$1F]:= start AND $FF;
+ Result[(new2<<8)+$20]:=(start AND $FF00)>>8;
+ //Adjust all the allocated sectors in all the objects from positions $0A-$0E to $FA-$FE
+ //We also need to update each directory entry to point to where the object is now.
+ UpdateProgress('Updating object addresses');
+ if Length(JesMapList)>0 then
+ for index:=0 to Length(JesMapList)-1 do
+ begin
+ //First we'll update the chain of pointers
+ new1:=$0A;
+ start:=$FFFFFF;
+ while(start<>0)and(new1<$FF)do //We repeat until the end or we find a zero
+ begin
+ //Grab the current pointer
+ start:=Result[JesMapList[index]+new1 ]
+ +Result[JesMapList[index]+new1+1]<<8
+ +Result[JesMapList[index]+new1+2]<<16;
+ //If it isn't zero
+ if start<>0 then
+ begin
+ //Then adjust
+ start:=start-(diff>>8);
+ //And save it back
+ Result[JesMapList[index]+new1 ]:= start AND $FF;
+ Result[JesMapList[index]+new1+1]:=(start AND $FF00)>>8;
+ Result[JesMapList[index]+new1+2]:=(start AND $FF0000)>>16;
+ end;
+ //Next pointer
+ inc(new1,5);
+ end;
+ //Is this JesMap a directory? Need to adjust all the object pointers
+ end;
+ //Blank out the ADFS Free Space Map
+ for index:=0 to $F5 do
+ begin
+ Result[index]:=$00;
+ Result[index+$100]:=$00;
+ end;
+ Result[$1FE]:=$00;
+ //Update the disc size
+ start:=disc_size[1]>>8;
+ Result[$0FC]:= start AND $FF;
+ Result[$0FD]:=(start AND $FF00)>>8;
+ Result[$0FE]:=(start AND $FF0000)>>16;
//Update the checksums
WriteByte(ByteCheckSum($0000,$100,Result),$0FF,Result);
WriteByte(ByteCheckSum($0100,$100,Result),$1FF,Result);
+ //Blank off the last 32 bytes of the 'root'
+ for index:=0 to 31 do Result[$6E0+index]:=$00;
+ //Write 'Hug' to the last 3 bytes
+ Result[$6FD]:=$48;
+ Result[$6FE]:=$75;
+ Result[$6FF]:=$67;
end;
- //Extracting the AFS part - as ADFS, just blank off the ADFS part, making sure
+{ //Extracting the AFS part - as ADFS, just blank off the ADFS part, making sure
//that the ADFS root is unreadable.
+ //This is the old method - quick and easy.
if(side=1)and(FAFSPresent)then
begin
+ //Copy the data across
+ UpdateProgress('Extracting Partition');
+ SetLength(Result,GetDataLength);
+ for index:=0 to GetDataLength-1 do Result[index]:=ReadByte(index);
//Blank the ADFS section (we'll use the WriteByte method to take account of interleave)
for index:=$200 to (Read24b($FC,Result)<<8)-1 do WriteByte($00,index,Result);
//Blank the ADFS free space map lengths
@@ -4177,21 +4325,21 @@ function TDiscImage.ExtractADFSPartition(side: Cardinal): TDIByteArray;
//Update the checksums
WriteByte(ByteCheckSum($0000,$100,Result),$0FF,Result);
WriteByte(ByteCheckSum($0100,$100,Result),$1FF,Result);
- end;
+ end;}
//Extracting the DOS part - this is literally extracting the DOS Plus part
if(side=1)and(FDOSPresent)then
begin
- //How much are we needing to shift the root up by?
- diff:=$800-(Fdosroot-doshead);
- //Reset the length of the outgoing buffer to the size of the DOS partition
- SetLength(Result,disc_size[side]+diff);
- //Then copy the data from the live array to the outgoing buffer.
- for index:=doshead to Fdosroot-1 do //First the FAT
- Result[index-doshead]:=ReadByte(index);
- for index:=Fdosroot-doshead to $800 do //Blank off the rest of the FAT
- Result[index]:=0;
- for index:=Fdosroot to (doshead+disc_size[side])-1 do //Now the rest of the disc
- Result[(index-doshead)+diff]:=ReadByte(index);
+ //Copy the data across
+ UpdateProgress('Extracting Partition');
+ //Do we have a DOS header? If not, then make room for it
+ if doshead=dosmap then start:=$200 else start:=$0;
+ //Allocate some space
+ SetLength(Result,disc_size[1]+start);
+ //If no header, then install one
+ if doshead=dosmap then //Usually 640KB ADFS hybrid
+ WriteDOSHeader(0,disc_size[1]+start,diMaster512,False,Result);
+ //Write the DOS partition
+ for index:=0 to disc_size[1]-1 do Result[start+index]:=ReadByte(index+doshead);
end;
end;
end;
diff --git a/LazarusSource/DiscImage_AFS.pas b/LazarusSource/DiscImage_AFS.pas
index b77db5e..49f12ba 100644
--- a/LazarusSource/DiscImage_AFS.pas
+++ b/LazarusSource/DiscImage_AFS.pas
@@ -186,10 +186,11 @@ procedure TDiscImage.ReadAFSPartition;
//Making room for it
SetLength(FDisc,Length(FDisc)+1);
//And now read it in
- FDisc[Length(FDisc)-1]:=ReadAFSDirectory(GetParent(d)
- +dir_sep
- +FDisc[d].Entries[e].Filename,
- FDisc[d].Entries[e].Sector*secsize);
+ if FScanSubDirs then
+ FDisc[Length(FDisc)-1]:=ReadAFSDirectory(GetParent(d)
+ +dir_sep
+ +FDisc[d].Entries[e].Filename,
+ FDisc[d].Entries[e].Sector*secsize);
FDisc[Length(FDisc)-1].Parent:=d;
//Remember it
SetLength(visited,Length(visited)+1);
@@ -347,6 +348,7 @@ function TDiscImage.ReadAFSDirectory(dirname:String;addr: Cardinal):TDir;
//Next entry
entry:=Read16b(entry+$00,buffer);
end;
+ Result.BeenRead:=True;
end;
end;
@@ -1050,7 +1052,11 @@ function TDiscImage.FormatAFS(harddrivesize: Cardinal;afslevel: Byte): Boolean;
allocmap1,
allocmap2 : Cardinal;
begin
+ //Default return
Result:=False;
+ //AFS Level 4 is actually ADFS, so here we are using it for Post 1988 format
+ if afslevel=4 then afslevel:=3;//Which currently is not implemented
+ //Only continue if valid level
if(afslevel=2)or(afslevel=3)then
begin
UpdateProgress('Formatting...');
@@ -1764,6 +1770,8 @@ function TDiscImage.WriteAFSFile(var file_details: TDirEntry;
partition:=FDisc[pdir].Partition;
sector:=FDisc[pdir].Entries[entry].Sector*secsize;
end;
+ //Make sure the parent has been read in
+ if not FDisc[pdir].BeenRead then ReadDirectory(file_details.Parent);
//Set the length
file_details.Length:=Length(buffer);
//Will if fit on the disc?
@@ -2127,6 +2135,9 @@ function TDiscImage.DeleteAFSFile(filename: String): Boolean;
//Is this a directory being deleted?
if FDisc[dir].Entries[entry].DirRef>=0 then
begin
+ //Make sure it has been read in
+ if not FDisc[FDisc[dir].Entries[entry].DirRef].BeenRead then
+ ReadDirectory(filename);
//Recursively delete the contents
while(Length(FDisc[FDisc[dir].Entries[entry].DirRef].Entries)>0)
and(success)do
@@ -2265,7 +2276,10 @@ function TDiscImage.MoveAFSFile(filename,directory: String): Integer;
direntry:=FDisc[sdir].Entries[sentry];
//Does the destination directory exist?
if(FileExists(directory,ddir,dentry))or(directory='$')then
- begin
+ begin
+ //Make sure it has been read in
+ if not FDisc[FDisc[ddir].Entries[dentry].DirRef].BeenRead then
+ ReadDirectory(directory);
Result:=-10;//Can't move to the same directory
//Destination directory reference
ddir:=0;//Root
diff --git a/LazarusSource/DiscImage_Amiga.pas b/LazarusSource/DiscImage_Amiga.pas
index f002bbe..2c745c3 100644
--- a/LazarusSource/DiscImage_Amiga.pas
+++ b/LazarusSource/DiscImage_Amiga.pas
@@ -194,9 +194,10 @@ function TDiscImage.ReadAmigaDisc: TDisc;
//Once found, list their entries
SetLength(Result,Length(Result)+1);
//Read in the contents of the directory
- Result[Length(Result)-1]:=ReadAmigaDir(GetParent(d)+dir_sep
- +Result[d].Entries[ptr].Filename,
- Result[d].Entries[ptr].Sector);
+ if FScanSubDirs then
+ Result[Length(Result)-1]:=ReadAmigaDir(GetParent(d)+dir_sep
+ +Result[d].Entries[ptr].Filename,
+ Result[d].Entries[ptr].Sector);
Result[Length(Result)-1].Parent:=d;
//Update the directory reference
Result[d].Entries[ptr].DirRef:=Length(Result)-1;
@@ -285,6 +286,7 @@ function TDiscImage.ReadAmigaDir(dirname: String; offset: Cardinal): TDir;
else link:=0;
end;
end;
+ Result.BeenRead:=True;
end;
end;
diff --git a/LazarusSource/DiscImage_DFS.pas b/LazarusSource/DiscImage_DFS.pas
index ad363bc..f066cdb 100644
--- a/LazarusSource/DiscImage_DFS.pas
+++ b/LazarusSource/DiscImage_DFS.pas
@@ -150,9 +150,12 @@ function TDiscImage.ID_DFS: Boolean;
if not chk then FFormat:=diInvalidImg;
end;
end;
- //Test for Watford DFS - we'll only test one side.
+ //Test for Watford DFS
if chk then
begin
+ t0:=0;//Side 1 - by default Acorn
+ t1:=0;//Side 2 - by default Acorn
+ //First we check side 1
//Offset 0x0200 should have 8 bytes of 0xAA
c:=0;
for i:=0 to 7 do
@@ -160,10 +163,26 @@ function TDiscImage.ID_DFS: Boolean;
//Offset 0x0300 should have 4 bytes of 0x00
for i:=0 to 3 do
if ReadByte($0300+i)=$00 then inc(c);
- //Disc size should match also
- if(c=12)and(Read16b($306)=Read16b($106))then
+ if c=12 then
if FFormat>>4=diAcornDFS then
- inc(FFormat,2);
+ t0:=1;//Set side 1 to Watford
+ //Now we check side 2
+ if dbl then
+ begin
+ //Offset 0x0C00 should have 8 bytes of 0xAA
+ c:=0;
+ for i:=0 to 7 do
+ if ReadByte($0C00+i)=$AA then inc(c);
+ //Offset 0x0D00 should have 4 bytes of 0x00
+ for i:=0 to 3 do
+ if ReadByte($0D00+i)=$00 then inc(c);
+ if c=12 then
+ if FFormat>>4=diAcornDFS then
+ t1:=1;//Set side 1 to Watford
+ end;
+ if(t0=1)and(t1=1)then inc(FFormat,2);
+ if(t0=0)and(t1=1)then inc(FFormat,4);
+ if(t0=1)and(t1=0)then inc(FFormat,6);
end;
end;
end;
@@ -336,7 +355,7 @@ procedure TDiscImage.DFSFreeSpaceMap(LDisc: TDisc);
begin
//Directory size
free_space[s]:=$200;
- if FFormat mod $10>1 then inc(free_space[s],$200); //Watford DFS
+ if IsWatford(s) then inc(free_space[s],$200); //Watford DFS
//Free Space Map
SetLength(free_space_map[s],disc_size[s]DIV$A00); //Number of tracks
for f:=0 to Length(free_space_map[s])-1 do
@@ -348,7 +367,7 @@ procedure TDiscImage.DFSFreeSpaceMap(LDisc: TDisc);
//First two sectors are used
free_space_map[s,0,0]:=$FE;
free_space_map[s,0,1]:=$FE;
- if FFormat mod $10>1 then //Watford DFS
+ if IsWatford(s) then //Watford DFS
begin
free_space_map[s,0,2]:=$FE;
free_space_map[s,0,3]:=$FE;
@@ -372,12 +391,24 @@ procedure TDiscImage.DFSFreeSpaceMap(LDisc: TDisc);
end;
end;
+{-------------------------------------------------------------------------------
+Is it a Watford side?
+-------------------------------------------------------------------------------}
+function TDiscImage.IsWatford(s: Integer): Boolean;
+begin
+ Result:=False;
+ //This side a Watford DFS?
+ if (FFormat mod$10=2)
+ or (FFormat mod$10=3)
+ or((FFormat mod$10=5)and(s=1))
+ or((FFormat mod$10=7)and(s=0))then Result:=True;
+end;
+
{-------------------------------------------------------------------------------
Write Acorn DFS File
-------------------------------------------------------------------------------}
function TDiscImage.WriteDFSFile(var file_details: TDirEntry;var buffer: TDIByteArray): Integer;
var
- f : Byte;
i,l,
pos,
count,
@@ -390,7 +421,6 @@ function TDiscImage.WriteDFSFile(var file_details: TDirEntry;var buffer: TDIByte
begin
Result:=-3; //File already exists
count:=file_details.Length;
- f:=FFormat MOD $10; //Minor format (sub format)
//Ensure that Side is not beyond the array
file_details.Side:=file_details.Side MOD 2;
if file_details.Side>Length(FDisc)-1 then file_details.Side:=0;
@@ -404,8 +434,8 @@ function TDiscImage.WriteDFSFile(var file_details: TDirEntry;var buffer: TDIByte
Result:=-4;//Catalogue full
//Can the catalogue be extended?
l:=Length(FDisc[file_details.Side].Entries);
- if ((l<31) and (f<2)) // Max 31 entries for Acorn DFS
- or ((l<62) and (f>1)) then // and 62 entries for Watford DFS
+ if((l<31)and(not IsWatford(file_details.Side))) // Max 31 entries for Acorn DFS
+ or((l<62)and(IsWatford(file_details.Side)))then // and 62 entries for Watford DFS
begin
//Extend the catalogue by 1
SetLength(FDisc[file_details.Side].Entries,l+1);
@@ -435,8 +465,8 @@ function TDiscImage.WriteDFSFile(var file_details: TDirEntry;var buffer: TDIByte
end
else
begin //First sector for the data, if first entry
- if f<2 then pos:=2; //Acorn DFS is sector 2
- if f>1 then pos:=4; //Watford DFS is sector 4
+ if not IsWatford(file_details.Side) then pos:=2; //Acorn DFS is sector 2
+ if IsWatford(file_details.Side) then pos:=4; //Watford DFS is sector 4
end;
//Add the entry at the insert point
FDisc[file_details.Side].Entries[filen]:=file_details;
@@ -511,14 +541,13 @@ procedure TDiscImage.UpdateDFSCat(side: Integer);
var
i,s,c : Integer;
fn,dn : String;
- t,f : Byte;
+ t : Byte;
begin
- f:=FFormat mod $10;//Subformat
//Update the number of catalogue entries
c:=Length(FDisc[side].Entries);
if c<32 then
WriteByte(c*8,ConvertDFSSector($105,side));
- if f>1 then //Extra files on Watford DFS
+ if IsWatford(side) then //Extra files on Watford DFS
if c>31 then
begin
WriteByte( 31*8, ConvertDFSSector($105,side));
@@ -530,7 +559,7 @@ procedure TDiscImage.UpdateDFSCat(side: Integer);
//Catalogue sector
s:=$000; //Acorn DFS
c:=i;
- if (f>1) and (i>30) then s:=$200; //Watford DFS
+ if(IsWatford(side))and(i>30)then s:=$200; //Watford DFS
if s=$200 then c:=i-31;
//Filename
fn:=FDisc[side].Entries[i].Filename;
diff --git a/LazarusSource/DiscImage_DOSPlus.pas b/LazarusSource/DiscImage_DOSPlus.pas
index 10e5dc4..920e04c 100755
--- a/LazarusSource/DiscImage_DOSPlus.pas
+++ b/LazarusSource/DiscImage_DOSPlus.pas
@@ -162,11 +162,12 @@ procedure TDiscImage.ReadDOSPartition;
//Making room for it
SetLength(FDisc,Length(FDisc)+1);
//And now read it in
- FDisc[Length(FDisc)-1]:=ReadDOSDirectory(GetParent(d)
- +GetDirSep(part)
- +FDisc[d].Entries[e].Filename,
- FDisc[d].Entries[e].Sector,
- lenctr);
+ if FScanSubDirs then
+ FDisc[Length(FDisc)-1]:=ReadDOSDirectory(GetParent(d)
+ +GetDirSep(part)
+ +FDisc[d].Entries[e].Filename,
+ FDisc[d].Entries[e].Sector,
+ lenctr);
FDisc[Length(FDisc)-1].Parent:=d;
//Set the length of the directory
FDisc[d].Entries[e].Length:=lenctr;
@@ -193,8 +194,9 @@ procedure TDiscImage.ReadDOSHeader;
if DOSBlocks=0 then
DOSBlocks:=Read32b(doshead+$20); //Disc Size (if >65535 blocks)
FATType:=diFAT12;
- if(DOSBlocks>4086)and(DOSBlocks<65526)then FATType:=diFAT16;
- if DOSBlocks>65525 then FATType:=diFAT32;
+ if(DOSBlocks div dosalloc>4086)
+ and(DOSBlocks div dosalloc<65526)then FATType:=diFAT16;
+ if DOSBlocks div dosalloc>65525 then FATType:=diFAT32;
//Where the FAT(s) is(are)
dosmap:=doshead+cluster_size;
if NumFATs>1 then dosmap2:=dosmap+DOSFATSize*cluster_size else dosmap2:=dosmap;
@@ -267,8 +269,9 @@ function TDiscImage.ReadDOSDirectory(dirname: String;addr: Cardinal;
//Read in the details
Result.Entries[entry].Filename:=ReadString($00+index*32,-8,buffer); //Filename
//Replace 0x05 with 0xE5
- if Ord(Result.Entries[entry].Filename[1])=$05 then
- Result.Entries[entry].Filename[5]:=Chr($E5);
+ if Result.Entries[entry].Filename<>'' then
+ if Ord(Result.Entries[entry].Filename[1])=$05 then
+ Result.Entries[entry].Filename[1]:=Chr($E5);
//Remove the trailing spaces
RemoveSpaces(Result.Entries[entry].Filename);
ext:=ReadString($08+index*32,-3,buffer); //Extension
@@ -294,6 +297,7 @@ function TDiscImage.ReadDOSDirectory(dirname: String;addr: Cardinal;
inc(index);
status:=ReadByte(index*32,buffer);
end;
+ Result.BeenRead:=True;
end;
{-------------------------------------------------------------------------------
@@ -573,6 +577,7 @@ function TDiscImage.ExtractDOSFile(filename: String;
entry : Cardinal;
begin
Result:=False;
+ //if filename[Length(dosrootname)+1]='.' then filename[Length(dosrootname)+1]:='\';
if FileExists(filename,dir,entry) then //Does the file actually exist?
begin
//Reset the buffer
@@ -1197,11 +1202,7 @@ function TDiscImage.WriteDOSFile(var file_details: TDirEntry;
if WriteDOSObject(buffer,fragments) then
begin
//Insert it into the directory
- Result:=Length(FDisc[dir].Entries);
- SetLength(FDisc[dir].Entries,Result+1);
- FDisc[dir].Entries[Result]:=file_details;
- //Update the parent
- UpdateDOSDirectory(file_details.Parent);
+ Result:=InsertDOSEntry(dir,file_details);
//And refresh the free space map
ReadDOSFSM;
end;
@@ -1211,6 +1212,18 @@ function TDiscImage.WriteDOSFile(var file_details: TDirEntry;
end;
end;
+{-------------------------------------------------------------------------------
+Insert a file into a directory
+-------------------------------------------------------------------------------}
+function TDiscImage.InsertDOSEntry(dir: Cardinal;direntry: TDirEntry): Integer;
+begin
+ Result:=Length(FDisc[dir].Entries);
+ SetLength(FDisc[dir].Entries,Result+1);
+ FDisc[dir].Entries[Result]:=direntry;
+ //Update the parent
+ UpdateDOSDirectory(direntry.Parent);
+end;
+
{-------------------------------------------------------------------------------
Create a DOS directory
-------------------------------------------------------------------------------}
@@ -1304,6 +1317,8 @@ function TDiscImage.DeleteDOSFile(filename: String): Boolean;
if FDisc[dir].Entries[entry].DirRef>=0 then
begin
index:=FDisc[dir].Entries[entry].DirRef;
+ //Make sure it has been read in
+ if not FDisc[index].BeenRead then ReadDirectory(filename);
//Recursively delete the contents
while(Length(FDisc[index].Entries)>0)and(success)do
success:=DeleteDOSFile(filename+GetDirSep(side)+FDisc[index].Entries[0].Filename);
@@ -1314,19 +1329,30 @@ function TDiscImage.DeleteDOSFile(filename: String): Boolean;
//Update the FSM
clusters:=GetClusterChain(FDisc[dir].Entries[entry].Sector);
DeAllocateDOSClusters(0,clusters);
- //Remove the entry from the local copy
- if entry>4=diAcornADFS)and(not FMap)and(FDirType=diADFSOldDir)then
begin
fsed:=GetADFSMaxLength(False);
//Is there enough free space?
- if fsed>=size div secsize then
+ if fsed>=size then
begin
//Work out the start
fsst:=GetDataLength-size;
//Adjust the ADFS free space map
fsptr:=GetADFSMaxLength(True);
Write24b(Read24b($100+fsptr)-(size div secsize),$100+fsptr); //Just adjust the length
- //Adjust the ADFS disc size
- if GetDataLength=640*1024 then Write24b($000AA0,$FC);
//Update our disc sizes
disc_size[0]:=fsst;
SetLength(disc_size,2);
disc_size[1]:=size;
SetLength(free_space,2);
- if FFormat AND $F<>$F then //Not for hard disc partitions
- begin
- doshead :=disc_size[0];
- //Set the DOS root parameters
- dosmap:=doshead;
- dosmap2:=doshead;
- dosroot_size:=$70*$20;
- //And cluster size
- cluster_size:=$100;
- dosalloc:=8;
- //FAT Size and type
- DOSFATSize:=1; //This is one less than the actual size
- NumFATs:=1; //Number of FATs present
- FATType:=diFAT12;//FAT type
- DOSBlocks:=disc_size[1]div cluster_size; //Number of blocks on disc
- Fdosroot:=doshead+((NumFATs*DOSFATSize)+1)*cluster_size; //Where the root is
- end;
+ doshead :=disc_size[0];
+ //Set the DOS root parameters
+ dosmap:=doshead;
+ dosmap2:=doshead;
+ dosroot_size:=$70*$20;
+ //And cluster size
+ cluster_size:=$100;
+ dosalloc:=8;
+ //FAT Size and type
+ DOSFATSize:=1; //This is one less than the actual size
+ NumFATs:=1; //Number of FATs present
+ FATType:=diFAT12;//FAT type
+ DOSBlocks:=disc_size[1]div cluster_size; //Number of blocks on disc
+ Fdosroot:=doshead+((NumFATs*DOSFATSize)+1)*cluster_size; //Where the root is
//Clear the partition of any left over data
for index:=doshead to GetDataLength-1 do WriteByte(0,index);
//Create the partition
- WriteDOSPartition;
+ WriteDOSHeader(doshead,size,diMaster512,False);
//Update the checksums
WriteByte(ByteCheckSum($0000,$100),$0FF);//Checksum sector 0
WriteByte(ByteCheckSum($0100,$100),$1FF);//Checksum sector 1
@@ -1459,46 +1479,259 @@ function TDiscImage.AddDOSPartition(size: Cardinal): Boolean;
{-------------------------------------------------------------------------------
Create a new DOS Plus or DOS image
-------------------------------------------------------------------------------}
-function TDiscImage.FormatDOS(shape: Byte): TDisc;
+function TDiscImage.FormatDOS(size: Cardinal;fat: Byte): TDisc;
+var
+ index: Cardinal;
begin
//Default return value
Result:=nil;
- //Reset everything
- ResetVariables;
- SetDataLength(0);
- //Set the format
- FFormat:=diDOSPlus<<4;
- //Set the data size
- case shape of
- 0: SetDataLength( 800*1024);// 800KB DOS Plus
- 1: SetDataLength( 360*1024);// 360KB DOS
- 2: SetDataLength( 720*1024);// 720KB DOS
- 3: SetDataLength(1440*1024);//1.44MB DOS
- 4: SetDataLength(2880*1024);//2.88MB DOS
+ if fat=diFAT32 then exit; //Not supported yet, so just exit
+ if size>=180*1024 then
+ begin
+ //Reset everything
+ ResetVariables;
+ SetDataLength(0);
+ //Reset the format (it'll get set later when we ID and Read the new image)
+ FFormat:=diInvalidImg;
+ disc_size[0]:=size;
+ SetDataLength(size);
+ //Empty the area
+ for index:=0 to size-1 do WriteByte(0,index);
+ //Master 512 DOS Plus or Standard DOS?
+ if(size<>800*1024)and(size<>640*1024)then //Standard DOS
+ WriteDOSHeader(0,size,fat,True)
+ else
+ begin //Master 512
+ //BBC Master DOS Plus images do not have a DOS header, which makes them easier.
+ if size=640*1024 then //Master 512 hybrid image
+ begin
+ //Create the ADFS image (ADFS 'L')
+ Result:=FormatADFSFloppy(2);
+ //Create the 636K DOS partition
+ for index:=0 to $1FA do WriteByte(0,index);//Most of the ADFS header needs blanked
+ Write24b($000AA0,$FC); //Signature for 640K DOS Plus
+ Write24b($FFFFFF,$1000);//FAT signature
+ WriteByte(0,$1FE);//Blank off the free space count
+ //Update the checksums
+ WriteByte(ByteCheckSum($0000,$100),$0FF);//Checksum sector 0
+ WriteByte(ByteCheckSum($0100,$100),$1FF);//Checksum sector 1
+ end;
+ if size=800*1024 then //Master 512 800K image
+ begin
+ //Very simplistic this format.
+ WriteByte($FD,0); //Media descriptor byte
+ WriteByte($FF,1); //Start of FAT
+ WriteByte($FF,2);
+ WriteByte($8,$80B); //Indicates volume name in the root
+ end;
+ end;
+ //ID the image to set up all the variables
+ if IDImage then
+ begin
+ //And read it in
+ ReadImage;
+ //Returning a result
+ Result:=FDisc;
+ //Set the filename
+ imagefilename:='Untitled.'+FormatExt;
+ end;
end;
- disc_size[0]:=GetDataLength;
end;
{-------------------------------------------------------------------------------
-Write a DOS Partition
+Write a DOS Header
-------------------------------------------------------------------------------}
-procedure TDiscImage.WriteDOSPartition;
+procedure TDiscImage.WriteDOSHeader(offset, size: Cardinal;fat: Byte;bootable: Boolean);
+var
+ buffer: TDIByteArray;
begin
- //
+ SetLength(buffer,0);
+ WriteDOSHeader(offset,size,fat,bootable,buffer);
end;
-
-{-------------------------------------------------------------------------------
-Write a DOS Header
--------------------------------------------------------------------------------}
-procedure TDiscImage.WriteDOSHeader;
+procedure TDiscImage.WriteDOSHeader(offset, size: Cardinal;fat: Byte;
+ bootable: Boolean;buffer: TDIByteArray);
+var
+ maxCluster,
+ totBlocks,
+ FATloc,
+ FATsize,
+ Lrootsize : Cardinal;
+ sectorSize : Word;
+ LnumFATs,
+ allocSize,
+ mdb : Byte;
+ index : Integer;
+ master512 : Boolean;
+const
+ //Boot code - this is actual code which'll get run on boot
+ bootCode : array[0..40] of Byte = ($FA,$31,$C0,$8E,$D0,$BC,$00,$7C,$FB,$8E,
+ $D8,$E8,$00,$00,$5E,$83,$C6,$19,$BB,$07,
+ $00,$FC,$AC,$84,$C0,$74,$06,$B4,$0E,$CD,
+ $10,$EB,$F5,$30,$E4,$CD,$16,$CD,$19,$0D,
+ $0A);
begin
- //
+ //Clear the area
+ for index:=0 to $1FF do WriteByte(0,offset+index,buffer);
+ //BBC Master 512 image?
+ master512:=False;
+ sectorSize:=$200; //Sector size. $200 is most DOS. M512 is $400
+ LnumFATs:=2; //Number of FATs. Most DOS is 2. M512 is 1
+ mdb:=$F0; //Media descriptor byte
+ Lrootsize:=$200; //Root size
+ maxCluster:=1;
+ //Maximum number of clusters
+ if fat=diFAT12 then maxCluster:=$FF6; //FAT12
+ if fat=diFAT16 then maxCluster:=$FFF6; //FAT16
+ if fat=diFAT32 then maxCluster:=$10000000; //FAT32
+ if fat=diMaster512 then //BBC Master 512 DOS Plus (FAT12)
+ begin //These have different values to standard DOS
+ maxCluster:=$FF6;
+ sectorSize:=$200;
+ Lrootsize :=$70;
+ LnumFATs :=1;
+ mdb :=$FF;
+ bootable :=False;
+ master512 :=True;
+ end;
+ //Not a valid FAT type, so exit
+ if maxCluster=1 then exit; //Error
+ //Total Blocks
+ totBlocks:=size div sectorSize;
+ //JMP Instruction for Boot sector
+ WriteByte($EB,offset+$00,buffer);
+ if master512 then
+ begin
+ WriteByte($FE,offset+$01,buffer);
+ WriteByte($91,offset+$02,buffer);
+ end
+ else
+ begin
+ WriteByte($3C,offset+$01,buffer);
+ WriteByte($90,offset+$02,buffer);
+ end;
+ //OEM Name
+ WriteString('DIM',offset+$03,8,32,buffer);
+ //Block Size
+ Write16b(sectorSize,offset+$0B,buffer);
+ //Cluster size
+ if not master512 then
+ allocSize:=(totBlocks div maxCluster)+1
+ else
+ allocSize:=4;
+ WriteByte(allocSize,offset+$0D,buffer);
+ //Reserved sectors
+ Write16b($0001,offset+$0E,buffer);
+ //Number of FATs
+ WriteByte(LnumFATs,offset+$10,buffer);
+ //Size of root : maximum number of entries
+ Write16b(Lrootsize,offset+$11,buffer);
+ //Total number of blocks
+ if totBlocks<=$FFFF then
+ begin
+ //If it'll fit in the original BIOS block
+ Write16b(totBlocks,offset+$13,buffer);
+ Write32b(0,offset+$20,buffer);
+ end
+ else
+ begin
+ //Otherwise it'll need to go in the extended block - only for FAT16 & FAT32
+ Write16b($0000,offset+$13,buffer);
+ Write32b(totBlocks,offset+$20,buffer);
+ end;
+ //Media descriptor byte
+ WriteByte(mdb,offset+$15,buffer);
+ //FAT Size
+ if not master512 then
+ FATsize:=((((totBlocks DIV allocSize)*12)DIV 8)+sectorSize)DIV sectorSize
+ else
+ FATsize:=1;
+ Write16b(FATsize,offset+$16,buffer);
+ //Extended BIOS block
+ if not master512 then //The rest of this is not applicable to Master 512 images
+ begin
+ //Sectors per track
+ Write16b($0020,offset+$18,buffer);
+ //Number of heads
+ Write16b($0010,offset+$1C,buffer);
+ //Extended Boot Signature
+ WriteByte($29,offset+$26,buffer);
+ //Volume Serial Number
+ Write32b($D68D00EC,offset+$27,buffer);
+ //Volume Label
+ WriteString('NO NAME',offset+$2B,11,32,buffer);
+ //File System Type
+ if fat=diFAT12 then WriteString('FAT12',offset+$36,8,32,buffer);
+ if fat=diFAT16 then WriteString('FAT16',offset+$36,8,32,buffer);
+ if fat=diFAT32 then WriteString('FAT32',offset+$36,8,32,buffer);
+ //Boot code
+ if bootable then
+ begin
+ //Write the boot code
+ for index:=0 to Length(bootCode)-1 do
+ WriteByte(bootCode[index],offset+$3E+index,buffer);
+ //And the text
+ WriteString('Non-system disk'#$0D#$0A'Press any key to reboot'#$0D#$0A,
+ offset+$67,0,0,buffer);
+ //Boot block signature - indicates it is bootable
+ WriteByte($55,offset+$1FE,buffer);
+ WriteByte($AA,offset+$1FF,buffer);
+ end;
+ end;
+ //Write the FAT(s)
+ for index:=0 to LnumFATs-1 do
+ begin
+ //Calculate this FAT's location
+ FATloc:=sectorSize+FATsize*sectorSize*index;
+ //Media descriptor byte, repeated on each FAT
+ WriteByte(mdb,offset+FATloc,buffer);
+ //Then the 0xFFFF which follows
+ Write16b($FFFF,offset+FATloc+1,buffer);
+ end;
end;
{-------------------------------------------------------------------------------
Move a file/directory
-------------------------------------------------------------------------------}
function TDiscImage.MoveDOSFile(filename,directory: String): Integer;
+var
+ direntry : TDirEntry;
+ sdir,
+ sentry,
+ ddir,
+ dentry,
+ ptr : Cardinal;
begin
- Result:=-12;
+ Result:=-11;//Source file not found
+ //Does the file exist?
+ if FileExists(filename,sdir,sentry) then
+ begin
+ Result:=-6;//Destination directory not found
+ //Take a copy
+ direntry:=FDisc[sdir].Entries[sentry];
+ //Does the destination directory exist?
+ if(FileExists(directory,ddir,dentry))or(directory=dosrootname)then
+ begin
+ //Make sure it has been read in
+ if not FDisc[FDisc[ddir].Entries[dentry].DirRef].BeenRead then
+ ReadDirectory(directory);
+ Result:=-10;//Can't move to the same directory
+ //Destination directory reference
+ ddir:=0;//Root
+ if directory<>dosrootname then ddir:=FDisc[ddir].Entries[dentry].DirRef;
+ if ddir<>sdir then //Can't move into the same directory
+ begin
+ Result:=-3; //File already exists in destination directory
+ //Alter for the new parent
+ direntry.Parent:=directory;
+ //Does the filename already exist in the new location?
+ if not FileExists(directory+Dir_Sep+direntry.Filename,ptr) then
+ begin
+ //Insert into the new directory
+ Result:=InsertDOSEntry(ddir,direntry);
+ //Now remove from the original directory
+ RemoveDOSEntry(sdir,sentry);
+ end;
+ end;
+ end;
+ end;
end;
diff --git a/LazarusSource/DiscImage_Private.pas b/LazarusSource/DiscImage_Private.pas
index a6f31a0..636cd8a 100644
--- a/LazarusSource/DiscImage_Private.pas
+++ b/LazarusSource/DiscImage_Private.pas
@@ -137,7 +137,7 @@ function TDiscImage.FormatToString: String;
'SJ Research MDFS',
'DOS Plus');
SUB : array[0..$A] of array[0..15] of String =
- (('Acorn SSD','Acorn DSD','Watford SSD','Watford DSD','','','','','','','','','','','',''),
+ (('Acorn SSD','Acorn DSD','Watford SSD','Watford DSD','','Acorn/Watford DSD','','Watford/Acorn DSD','','','','','','','',''),
('S','M','L','D','E','E+','F','F+','','','','','','','Hybrid','Hard Disc'),
('1541','1571','1581','1541 40 Track','1571 80 Track','','','','','','','','','','',''),
('','Extended','','','','','','','','','','','','','',''),
@@ -172,7 +172,7 @@ function TDiscImage.FormatToString: String;
function TDiscImage.FormatToExt: String;
const
EXT : array[0..$A] of array[0..15] of String =
- (('ssd','dsd','ssd','dsd','','','','','','','','','','','',''),//DFS
+ (('ssd','dsd','ssd','dsd','','dsd','','dsd','','','','','','','',''),//DFS
('ads','adm','adl','adf','adf','adf','adf','adf','','','','','','','dat','hdf'),//ADFS
('d64','d71','d81','d64','d71','','','','','','','','','','',''),//Commodore 64
('','dsk','','','','','','','','','','','','','','hdf'),//Sinclair Spectrum
@@ -636,6 +636,7 @@ procedure TDiscImage.ResetDir(var Entry: TDir);
Partition :=0;
Sector :=0;
Parent :=-1;
+ BeenRead :=False;
end;
end;
diff --git a/LazarusSource/DiscImage_Published.pas b/LazarusSource/DiscImage_Published.pas
index bdf922f..c85a2e2 100644
--- a/LazarusSource/DiscImage_Published.pas
+++ b/LazarusSource/DiscImage_Published.pas
@@ -20,6 +20,8 @@ constructor TDiscImage.Create;
FDFSBeyondEdge:=False;
//Allow blank filenames in DFS
FDFSAllowBlank:=False;
+ //Scan sub directories in ADFS, Amiga, DOS, Spark
+ FScanSubDirs:=True;
end;
constructor TDiscImage.Create(Clone: TDiscImage);
var
@@ -90,7 +92,7 @@ function TDiscImage.SaveFilter(var FilterIndex: Integer;thisformat: Integer=-1):
//Save the current format
currentformat:=FFormat;
index:=0;
- for queryformat:=$00 to $8F do
+ for queryformat:=$00 to $AF do
begin
//Set the format
FFormat:=queryformat;
@@ -254,13 +256,14 @@ procedure TDiscImage.Close;
{-------------------------------------------------------------------------------
Create and format a new disc image
-------------------------------------------------------------------------------}
-function TDiscImage.FormatFDD(major,minor,tracks: Byte): Boolean;
+function TDiscImage.FormatFDD(major:Word;minor,tracks: Byte): Boolean;
begin
Result:=False;
//Make sure the numbers are within bounds
- major :=major MOD $10;
- minor :=minor MOD $10;
- tracks:=tracks MOD 2;
+ major :=major AND $FFF;
+ minor :=minor AND $F;
+ if major<>diDOSPlus then
+ tracks:=tracks MOD 2;
case major of
diAcornDFS://Create DFS
begin
@@ -294,7 +297,14 @@ function TDiscImage.FormatFDD(major,minor,tracks: Byte): Boolean;
end;
diDOSPlus://Create DOS or DOS Plus
begin
- FDisc:=FormatDOS(minor);
+ case minor of
+ 0: FDisc:=FormatDOS( 640*1024,diFAT12);// 640KB ADFS/DOS Plus
+ 1: FDisc:=FormatDOS( 800*1024,diFAT12);// 800KB DOS Plus
+ 2: FDisc:=FormatDOS( 360*1024,diFAT12);// 360KB DOS
+ 3: FDisc:=FormatDOS( 720*1024,diFAT12);// 720KB DOS
+ 4: FDisc:=FormatDOS(1440*1024,diFAT12);//1.44MB DOS
+ 5: FDisc:=FormatDOS(2880*1024,diFAT12);//2.88MB DOS
+ end;
Result:=Length(FDisc)>0;
end;
end;
@@ -303,10 +313,12 @@ function TDiscImage.FormatFDD(major,minor,tracks: Byte): Boolean;
{-------------------------------------------------------------------------------
Create and format a new hard disc image
-------------------------------------------------------------------------------}
-function TDiscimage.FormatHDD(major:Byte;harddrivesize:Cardinal;newmap:Boolean;
+function TDiscimage.FormatHDD(major:Word;harddrivesize:Cardinal;newmap:Boolean;
dirtype:Byte):Boolean;
begin
Result:=False;
+ //Make sure the numbers are within bounds
+ major :=major AND $FFF;
case major of
diAcornADFS: //Create ADFS
begin
@@ -314,6 +326,11 @@ function TDiscimage.FormatHDD(major:Byte;harddrivesize:Cardinal;newmap:Boolean;
Result:=Length(FDisc)>0;
end;
diAcornFS: Result:=FormatAFS(harddrivesize,dirtype);//Create Acorn FS
+ diDOSPlus: //Create DOS HDD
+ begin
+ FDisc:=FormatDOS(harddrivesize,dirtype);
+ Result:=Length(FDisc)>0;
+ end;
end;
end;
@@ -471,7 +488,17 @@ function TDiscImage.FileExists(filename: String;var dir,entry: Cardinal): Boolea
SetLength(Path,0);
//Explode the pathname into an array, without the '.'
if(FFormat>>4<>diAcornDFS)and(FFormat>>4<>diCommodore)then //Not DFS or Commodore
+ begin
Path:=filename.Split(dir_sep);
+ //Is this on a DOS Partition of an ADFS?
+ if(FFormat>>4=diAcornADFS)and(FDOSPresent)
+ and(LeftStr(filename,Length(dosrootname))=dosrootname)then
+ begin
+ //Then we'll need to combine the filename and extension
+ Path[Length(Path)-2]:=Path[Length(Path)-2]+'.'+Path[Length(Path)-1];
+ SetLength(Path,Length(Path)-1);
+ end;
+ end;
if FFormat>>4=diAcornDFS then //With DFS, we need the initial root name, including the '.'
begin
//So should only be 2 entries
@@ -1399,3 +1426,60 @@ function TDiscImage.GetDirSep(partition: Byte): Char;
if FDOSPresent then Result:='\';
end;
end;
+
+{-------------------------------------------------------------------------------
+Read a directory, given the directory name
+-------------------------------------------------------------------------------}
+function TDiscImage.ReadDirectory(dirname: String): Integer;
+var
+ dir,
+ entry,
+ sector,
+ len,f : Cardinal;
+ NewDir : TDir;
+begin
+ RemoveControl(dirname);
+ //This is only here to stop the hints that variables aren't intialised
+ Result:=-1;
+ NewDir.Directory:=dirname;
+ dir:=0;
+ entry:=0;
+ sector:=0;
+ len:=0;
+ //Reset the Result TDir to default values
+ ResetDir(NewDir);
+ //Is it a valid directory?
+ if FileExists(dirname,dir,entry) then //Does it exist? (and grab the references)
+ if FDisc[dir].Entries[entry].DirRef>-1 then //Valid directory
+ if not FDisc[FDisc[dir].Entries[entry].DirRef].BeenRead then //Hasn't already been read?
+ begin
+ sector:=FDisc[dir].Entries[entry].Sector;
+ //Divert to the appropriate function
+ case FFormat>>4 of
+ diAcornADFS: NewDir:=ReadADFSDir(dirname,sector);
+ diAcornFS : NewDir:=ReadAFSDirectory(dirname,sector);
+ diAmiga : NewDir:=ReadAmigaDir(dirname,sector);
+ diDOSPlus : NewDir:=ReadDOSDirectory(dirname,sector,len);
+ end;
+ //Did it return something?
+ if NewDir.Directory<>'' then
+ begin
+ //Return an index (the previously saved directory reference
+ Result:=FDisc[dir].Entries[entry].DirRef;
+ //Then add it to the list
+ FDisc[Result]:=NewDir;
+ FDisc[Result].Parent:=dir;
+ FDisc[Result].BeenRead:=True;
+ //Now go through the entries and see if there are any sub dirs
+ if Length(FDisc[Result].Entries)>0 then //Make sure we have some entries
+ for f:=0 to Length(FDisc[Result].Entries)-1 do
+ if(Pos('D',FDisc[Result].Entries[f].Attributes)>0) //Found a directory
+ or(Pos('F',FDisc[Result].Entries[f].Attributes)>0)then
+ //D is for ADFS, AFS and DOS Plus, F is for Amiga
+ begin
+ SetLength(FDisc,Length(FDisc)+1); //Make space for it
+ FDisc[Result].Entries[f].DirRef:=Length(FDisc)-1; //And set the directory reference
+ end;
+ end;
+ end;
+end;
diff --git a/LazarusSource/DiscImage_Spark.pas b/LazarusSource/DiscImage_Spark.pas
index ecca41e..41f8f6b 100644
--- a/LazarusSource/DiscImage_Spark.pas
+++ b/LazarusSource/DiscImage_Spark.pas
@@ -8,7 +8,7 @@ function TDiscImage.ID_Spark: Boolean;
Result:=False;
if(FFormat=diInvalidImg)or(FSparkAsFS)then
begin
- if GetDataLength>0 then //Any data?
+ if(GetDataLength>0)and(FFilename<>'')then //Any data?
begin
//Open the file in TSpark
SparkFile:=TSpark.Create(FFilename);
diff --git a/LazarusSource/Global.pas b/LazarusSource/Global.pas
index 7b7f1c4..740167e 100644
--- a/LazarusSource/Global.pas
+++ b/LazarusSource/Global.pas
@@ -25,9 +25,9 @@ interface
uses
Classes,SysUtils,Registry
- {$IFDEF Darwin}
+{ {$IFDEF Darwin}
,MacOSAll
- {$ENDIF}
+ {$ENDIF}}
;
function ReadLine(var Stream: TFileStream;var Line: string): boolean;
diff --git a/LazarusSource/HardDriveUnit.lfm b/LazarusSource/HardDriveUnit.lfm
index f7250f1..78d7d69 100644
--- a/LazarusSource/HardDriveUnit.lfm
+++ b/LazarusSource/HardDriveUnit.lfm
@@ -136,56 +136,105 @@ object HardDriveForm: THardDriveForm
Left = 96
Height = 16
Top = 8
- Width = 114
+ Width = 120
Caption = 'Hard Disc Capacity:'
end
object CapacityLabel: TLabel
Left = 416
Height = 16
Top = 28
- Width = 37
+ Width = 34
Caption = '10MB'
end
- object cb_NewMap: TCheckBox
- Left = 88
- Height = 23
+ object ADFSControls: TPanel
+ Left = 80
+ Height = 20
Top = 56
- Width = 83
- Caption = 'New Map'
- OnChange = cb_NewMapChange
+ Width = 402
+ BevelOuter = bvNone
+ ClientHeight = 20
+ ClientWidth = 402
TabOrder = 3
+ OnPaint = FormPaint
+ object cb_NewMap: TCheckBox
+ Left = 16
+ Height = 18
+ Top = 0
+ Width = 79
+ Caption = 'New Map'
+ OnChange = cb_NewMapChange
+ TabOrder = 0
+ end
+ object DirectoryLabel: TLabel
+ Left = 144
+ Height = 16
+ Top = 0
+ Width = 60
+ Caption = 'Directory:'
+ end
+ object rb_OldDir: TRadioButton
+ Left = 224
+ Height = 18
+ Top = 0
+ Width = 44
+ Caption = 'Old'
+ Checked = True
+ TabOrder = 1
+ TabStop = True
+ end
+ object rb_NewDir: TRadioButton
+ Left = 277
+ Height = 18
+ Top = 0
+ Width = 49
+ Caption = 'New'
+ TabOrder = 2
+ end
+ object rb_BigDir: TRadioButton
+ Left = 333
+ Height = 18
+ Top = 0
+ Width = 42
+ Caption = 'Big'
+ TabOrder = 3
+ end
end
- object rb_OldDir: TRadioButton
- Left = 296
- Height = 23
+ object DOSControls: TPanel
+ Left = 80
+ Height = 20
Top = 56
- Width = 48
- Caption = 'Old'
- Checked = True
+ Width = 402
+ BevelOuter = bvNone
+ ClientHeight = 20
+ ClientWidth = 402
TabOrder = 4
- TabStop = True
- end
- object rb_NewDir: TRadioButton
- Left = 349
- Height = 23
- Top = 56
- Width = 53
- Caption = 'New'
- TabOrder = 5
- end
- object rb_BigDir: TRadioButton
- Left = 405
- Height = 23
- Top = 56
- Width = 46
- Caption = 'Big'
- TabOrder = 6
- end
- object DirectoryLabel: TLabel
- Left = 216
- Height = 16
- Top = 56
- Width = 59
- Caption = 'Directory:'
+ OnPaint = FormPaint
+ object rb_FAT12: TRadioButton
+ Left = 27
+ Height = 18
+ Top = 0
+ Width = 56
+ Caption = 'FAT12'
+ OnChange = rb_FAT12Change
+ TabOrder = 0
+ end
+ object rb_FAT16: TRadioButton
+ Left = 136
+ Height = 18
+ Top = 0
+ Width = 57
+ Caption = 'FAT16'
+ OnChange = rb_FAT16Change
+ TabOrder = 1
+ end
+ object rb_FAT32: TRadioButton
+ Left = 256
+ Height = 18
+ Top = 0
+ Width = 58
+ Caption = 'FAT32'
+ OnChange = rb_FAT32Change
+ TabOrder = 2
+ end
end
end
diff --git a/LazarusSource/HardDriveUnit.pas b/LazarusSource/HardDriveUnit.pas
index 7b0ae98..52c3b45 100644
--- a/LazarusSource/HardDriveUnit.pas
+++ b/LazarusSource/HardDriveUnit.pas
@@ -41,20 +41,28 @@ THardDriveForm = class(TForm)
OKButton: TBitBtn;
CancelButton: TBitBtn;
CapacitySlider: TTrackBar;
+ ADFSControls: TPanel;
+ DOSControls: TPanel;
+ rb_FAT12: TRadioButton;
rb_BigDir: TRadioButton;
+ rb_FAT16: TRadioButton;
+ rb_FAT32: TRadioButton;
rb_NewDir: TRadioButton;
rb_OldDir: TRadioButton;
procedure cb_NewMapChange(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure CapacitySliderChange(Sender: TObject);
procedure FormShow(Sender: TObject);
+ procedure rb_FAT12Change(Sender: TObject);
+ procedure rb_FAT16Change(Sender: TObject);
+ procedure rb_FAT32Change(Sender: TObject);
private
const
OldMapLimit=512*1024*1024; //Old map drive limit = 512MB
Multiplier =63*16*512; //Capacity multiplier = sectors*heads*secsize
MB =1024*1024; //MegaByte
public
-
+ ADFSHDD: Boolean;
end;
var
@@ -102,12 +110,21 @@ procedure THardDriveForm.cb_NewMapChange(Sender: TObject);
-------------------------------------------------------------------------------}
procedure THardDriveForm.CapacitySliderChange(Sender: TObject);
begin
- //Update the label
- CapacityLabel.Caption:=
- IntToStr(Ceil((CapacitySlider.Position*10*Multiplier)/MB))+'MB';
- //If it goes over 512MB, ensure it is a New map
- if CapacitySlider.Position*10*Multiplier>OldMapLimit then
- cb_NewMap.Checked:=True;
+ if ADFSHDD then
+ begin
+ //Update the label
+ CapacityLabel.Caption:=
+ IntToStr(Ceil((CapacitySlider.Position*10*Multiplier)/MB))+'MB';
+ //If it goes over 512MB, ensure it is a New map
+ if CapacitySlider.Position*10*Multiplier>OldMapLimit then
+ cb_NewMap.Checked:=True;
+ end
+ else
+ begin
+ //Update the label
+ CapacityLabel.Caption:=
+ IntToStr(Ceil((CapacitySlider.Position*10)/MB))+'MB';
+ end;
end;
{-------------------------------------------------------------------------------
@@ -115,17 +132,73 @@ procedure THardDriveForm.CapacitySliderChange(Sender: TObject);
-------------------------------------------------------------------------------}
procedure THardDriveForm.FormShow(Sender: TObject);
begin
- //Set capacity to 40MB
- CapacitySlider.Position:=8;
+ if ADFSHDD then
+ begin
+ //Set capacity to 40MB
+ CapacitySlider.Position:=8;
+ CapacitySlider.Min:=4;
+ CapacitySliderChange(Sender);
+ ADFSControls.Visible:=True;
+ DOSControls.Visible:=False;
+ Caption:='Create ADFS Hard Drive';
+ //Set directory type to 'Old'
+ rb_OldDir.Checked:=True;
+ rb_NewDir.Checked:=False;
+ rb_BigDir.Checked:=False;
+ //Enable/Disable the appropriate radio boxes
+ rb_OldDir.Enabled:=True;
+ rb_BigDir.Enabled:=False;
+ cb_NewMap.Checked:=False;
+ end
+ else
+ begin
+ //Set capacity to 40MB
+ CapacitySlider.Position:=(40*1024*1024)div 10;
+ //Set max to 500MB for FAT12
+ CapacitySlider.Max:=(500*1024*1024)div 10;
+ CapacitySlider.Min:=(20*1024*1024)div 10;
+ CapacitySliderChange(Sender);
+ ADFSControls.Visible:=False;
+ DOSControls.Visible:=True;
+ Caption:='Create DOS Hard Drive';
+ rb_FAT12.Checked:=True;
+ rb_FAT16.Checked:=False;
+ rb_FAT32.Checked:=False;
+
+ end;
+end;
+
+{-------------------------------------------------------------------------------
+FAT12 has been selected
+-------------------------------------------------------------------------------}
+procedure THardDriveForm.rb_FAT12Change(Sender: TObject);
+begin
+ //Set max to 500MB for FAT12
+ CapacitySlider.Max:=(500*1024*1024)div 10;
+ CapacitySlider.Min:=(20*1024*1024)div 10;
+ CapacitySliderChange(Sender);
+end;
+
+{-------------------------------------------------------------------------------
+FAT16 has been selected
+-------------------------------------------------------------------------------}
+procedure THardDriveForm.rb_FAT16Change(Sender: TObject);
+begin
+ //Set max to 1000MB for FAT16
+ CapacitySlider.Max:=(1000*1024*1024)div 10;
+ CapacitySlider.Min:=(20*1024*1024)div 10;
+ CapacitySliderChange(Sender);
+end;
+
+{-------------------------------------------------------------------------------
+FAT32 has been selected
+-------------------------------------------------------------------------------}
+procedure THardDriveForm.rb_FAT32Change(Sender: TObject);
+begin
+ //Set max to 1024MB for FAT32
+ CapacitySlider.Max:=(1024*1024*1024)div 10;
+ CapacitySlider.Min:=(20*1024*1024)div 10;
CapacitySliderChange(Sender);
- //Set directory type to 'Old'
- rb_OldDir.Checked:=True;
- rb_NewDir.Checked:=False;
- rb_BigDir.Checked:=False;
- //Enable/Disable the appropriate radio boxes
- rb_OldDir.Enabled:=True;
- rb_BigDir.Enabled:=False;
- cb_NewMap.Checked:=False;
end;
end.
diff --git a/LazarusSource/MainUnit.lfm b/LazarusSource/MainUnit.lfm
index 0c978fc..9fee144 100755
--- a/LazarusSource/MainUnit.lfm
+++ b/LazarusSource/MainUnit.lfm
@@ -4313,7 +4313,7 @@ object MainForm: TMainForm
Align = alTop
Alignment = taCenter
Caption = 'Image Contents'
- Font.Color = clRed
+ Font.Color = clGreen
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
@@ -4507,7 +4507,7 @@ object MainForm: TMainForm
Align = alTop
Alignment = taCenter
Caption = 'File Details'
- Font.Color = clRed
+ Font.Color = clGreen
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
diff --git a/LazarusSource/MainUnit.pas b/LazarusSource/MainUnit.pas
index 23a9ce4..be23c5a 100755
--- a/LazarusSource/MainUnit.pas
+++ b/LazarusSource/MainUnit.pas
@@ -44,11 +44,15 @@ TMyTreeNode = class(TTreeNode)
private
FDirRef,
FParentDir : Integer;
- FIsDir : Boolean;
+ FIsDir,
+ FBeenRead,
+ FBroken : Boolean;
public
property ParentDir: Integer read FParentDir write FParentDir;//Parent directory reference
property IsDir : Boolean read FIsDir write FIsDir; //Is it a directory
property DirRef : Integer read FDirRef write FDirRef; //Reference into TDiscImage.Disc
+ property BeenRead : Boolean read FBeenRead write FBeenRead; //Has the directory been read in
+ property Broken : Boolean read FBroken write FBroken; //Is the ADFS directory broken?
end;
//Form definition
@@ -337,13 +341,15 @@ TMainForm = class(TForm)
procedure DownLoadDirectory(dir,entry: Integer; path: String);
procedure DownLoadFile(dir,entry: Integer; path: String;filename: String='');
procedure ExtractFiles(ShowDialogue: Boolean);
+ function FindNode(filename: String;casesens:Boolean=True): TTreeNode;
function FindPartitionRoot(filepath: String): Integer;
function GetCopyMode(Shift: TShiftState): Boolean;
function GetFilePath(Node: TTreeNode): String;
function GetFileTypeGraphic(filetype: String;offset: Integer;
const filetypes: array of String): Integer;
function GetImageFilename(dir,entry: Integer): String;
- procedure GetImageIndex(Node: TTreeNode;ImageToUse: TDiscImage);
+ function GetImageIndex(Node: TTreeNode;ImageToUse: TDiscImage): Integer;
+ procedure SetImageIndex(Node: TTreeNode;ImageToUse: TDiscImage);
function GetNodeAt(Y: Integer): TTreeNode;
function GetTextureTile(Ltile:Integer=-1): TBitmap;
function GetWindowsFilename(dir,entry: Integer): String;
@@ -352,6 +358,7 @@ TMainForm = class(TForm)
procedure OpenImage(filename: String);
procedure ParseCommandLine(cmd: String);
function QueryUnsaved: Boolean;
+ procedure ReadInDirectory(Node: TTreeNode);
procedure ReportError(error: String);
procedure ResetFileFields;
procedure SelectNode(filename: String;casesens:Boolean=True);
@@ -426,6 +433,11 @@ TMainForm = class(TForm)
FUEFCompress :Boolean;
//View options (what is visible)
ViewOptions :Cardinal;
+ //Scan sub-directories on opening
+ FScanSubDirs :Boolean;
+ //What are we running on?
+ platform,
+ arch :String;
const
//These point to certain icons used when no filetype is found, or non-ADFS
//The numbers are indexes into the TImageList component 'FileImages'.
@@ -514,39 +526,10 @@ TMainForm = class(TForm)
DesignedDPI = 96;
//Application Title
ApplicationTitle = 'Disc Image Manager';
- ApplicationVersion = '1.38.5';
+ ApplicationVersion = '1.40';
//Current platform and architecture (compile time directive)
- {$IFDEF Darwin}
- platform = 'macOS'; //Apple Mac OS X
- {$ENDIF}
- {$IFDEF Windows}
- platform = 'Windows'; //Microsoft Windows
- {$ENDIF}
- {$IFDEF Linux}
- platform = 'Linux'; //Linux
- {$ENDIF}
- {$IFNDEF Darwin}{$IFNDEF Windows}{$IFNDEF Linux}
- platform = 'OS?'; //Unknown OS
- {$ENDIF}{$ENDIF}{$ENDIF}
- {$IFNDEF CPUARM}
- {$IFDEF CPU32}
- arch = '32 bit'; //32 bit CPU
- {$ENDIF}
- {$IFDEF CPU64}
- arch = '64 bit'; //64 bit CPU
- {$ENDIF}
- {$ENDIF}
- {$IFDEF CPUARM}
- {$IFDEF CPU32}
- arch = '32 bit ARM'; //32 bit ARM CPU
- {$ENDIF}
- {$IFDEF CPU64}
- arch = '64 bit ARM'; //64 bit ARM CPU
- {$ENDIF}
- {$ENDIF}
- {$IFNDEF CPU32}{$IFNDEF CPU64}
- arch = 'CPU?'; //Unknown CPU
- {$ENDIF}{$ENDIF}
+ TargetOS = {$I %FPCTARGETOS%};
+ TargetCPU = {$I %FPCTARGETCPU%};
procedure AfterConstruction; override;
end;
@@ -931,6 +914,9 @@ function TMainForm.AddFileToImage(filename:String;filedetails: TDirEntry;
//And it is a directory
if TMyTreeNode(DirList.Selected).IsDir then
begin
+ //Make sure the directory has been read in
+ if not TMyTreeNode(DirList.Selected).BeenRead then
+ ReadInDirectory(DirList.Selected);
//Find out which side of a DFS disc it is
if (Image.DoubleSided)//FormatNumber mod 2=1)
and(Image.FormatNumber>>4=diAcornDFS)then //Only for DFS double sided
@@ -1492,30 +1478,39 @@ procedure TMainForm.DownLoadDirectory(dir,entry: Integer;path: String);
windowsfilename: String;
ref : Cardinal;
c,s : Integer;
+ Node : TTreeNode;
begin
ref:=0;
// Ensure path ends in a directory separator
if path[Length(path)]<>PathDelim then path:=path+PathDelim;
//Get the full path and filename
imagefilename:=GetImageFilename(dir,entry);
- //Convert to Windows filename
- windowsfilename:=GetWindowsFilename(dir,entry);
- if Image.FileExists(imagefilename,ref) then
+ //Find the correct node
+ Node:=FindNode(imagefilename);
+ if Node<>nil then
begin
- //Create the directory
- if not DirectoryExists(path+windowsfilename) then
+ //Need to ensure that the directory has been read in
+ if not TMyTreeNode(Node).BeenRead then
+ ReadInDirectory(Node);
+ //Convert to Windows filename
+ windowsfilename:=GetWindowsFilename(dir,entry);
+ if Image.FileExists(imagefilename,ref) then
begin
- CreateDir(path+windowsfilename);
- CreateINFFile(dir,entry,path);
- end;
- //Navigate into the directory
- s:=Image.Disc[dir].Entries[entry].DirRef;
- //Iterate through the entries
- for c:=0 to Length(Image.Disc[s].Entries)-1 do
- DownLoadFile(s,c,path+windowsfilename);
- end
- //Happens if the file could not be located
- else ReportError('Could not locate directory "'+imagefilename+'"');
+ //Create the directory
+ if not DirectoryExists(path+windowsfilename) then
+ begin
+ CreateDir(path+windowsfilename);
+ CreateINFFile(dir,entry,path);
+ end;
+ //Navigate into the directory
+ s:=Image.Disc[dir].Entries[entry].DirRef;
+ //Iterate through the entries
+ for c:=0 to Length(Image.Disc[s].Entries)-1 do
+ DownLoadFile(s,c,path+windowsfilename);
+ end
+ //Happens if the file could not be located
+ else ReportError('Could not locate directory "'+imagefilename+'"');
+ end;
end;
{------------------------------------------------------------------------------}
@@ -1555,6 +1550,8 @@ procedure TMainForm.OpenImage(filename: String);
Image.DFSBeyondEdge:=FDFSBeyondEdge;
//Check for blank filenames in DFS
Image.DFSAllowBlanks:=FDFSAllowBlank;
+ //Scan sub directories
+ Image.ScanSubDirs:=FScanSubDirs;
//Load the image and create the catalogue
if Image.LoadFromFile(filename) then
begin
@@ -1629,8 +1626,10 @@ procedure TMainForm.AddDirectoryToTree(CurrDir:TTreeNode;dir:Integer;
//Make a note of the dir ref, it is the highest
if dir>highdir then highdir:=dir;
//Set the 'IsDir' flag to true, as this is a directory
- TMyTreeNode(CurrDir).IsDir:=True;
- TMyTreeNode(CurrDir).DirRef:=dir;
+ TMyTreeNode(CurrDir).IsDir :=True;
+ TMyTreeNode(CurrDir).DirRef :=dir;
+ TMyTreeNode(CurrDir).BeenRead:=ImageToUse.Disc[dir].BeenRead;
+ TMyTreeNode(CurrDir).Broken :=ImageToUse.Disc[dir].Broken;
//Iterate though all the entries
for entry:=0 to Length(ImageToUse.Disc[dir].Entries)-1 do
begin
@@ -1970,6 +1969,7 @@ procedure ArrangeComponent(c,p: TControl;l: TLabel);
C64AttrPanel.Height:=cb_C64_l.Top+cb_C64_l.Height;
end;
end;
+ FileInfoPanel.Repaint;
end;
{------------------------------------------------------------------------------}
@@ -2442,13 +2442,13 @@ procedure TMainForm.DirListChange(Sender: TObject; Node: TTreeNode);
{------------------------------------------------------------------------------}
procedure TMainForm.DirListGetImageIndex(Sender: TObject; Node: TTreeNode);
begin
- GetImageIndex(Node,Image);
+ SetImageIndex(Node,Image);
end;
{------------------------------------------------------------------------------}
//Called when the TreeView is updated, and it wants to know which icon to use
{------------------------------------------------------------------------------}
-procedure TMainForm.GetImageIndex(Node: TTreeNode;ImageToUse: TDiscImage);
+function TMainForm.GetImageIndex(Node: TTreeNode;ImageToUse: TDiscImage): Integer;
var
ft,i,
dir,
@@ -2551,7 +2551,18 @@ procedure TMainForm.GetImageIndex(Node: TTreeNode;ImageToUse: TDiscImage);
if RightStr(Node.Text,5)='empty' then ft:=mmbdiscempt;
end;
end;
+ Result:=ft;
+end;
+
+{------------------------------------------------------------------------------}
+//Called when the TreeView is updated, and it wants to know which icon to use
+{------------------------------------------------------------------------------}
+procedure TMainForm.SetImageIndex(Node: TTreeNode;ImageToUse: TDiscImage);
+var
+ ft: Integer;
+begin
//Tell the system what the ImageList reference is
+ ft:=GetImageIndex(Node,ImageToUse);
Node.ImageIndex:=ft;
//And ensure it stays selected
Node.SelectedIndex:=Node.ImageIndex;
@@ -2641,12 +2652,15 @@ procedure TMainForm.FormShow(Sender: TObject);
//Create the dialogue boxes
CreateFileTypeDialogue;
//Create the copy and paste shortcuts
- CopyToClipboard.ShortCut :=$4000 OR ord('C'); //Ctrl+C (WindowsLinux)
- PasteFromClipboard.ShortCut:=$4000 OR ord('V'); //Ctrl+V (Windows/Linux)
- {$IFDEF Darwin}
- CopyToClipboard.ShortCut :=$1000 OR ord('C'); //Meta+C (Mac)
- PasteFromClipboard.ShortCut:=$1000 OR ord('V'); //Meta+V (Mac)
- {$ENDIF}
+ if TargetOS='Darwin' then
+ begin
+ CopyToClipboard.ShortCut :=$1000 OR ord('C'); //Meta+C (Mac)
+ PasteFromClipboard.ShortCut:=$1000 OR ord('V'); //Meta+V (Mac)
+ end else
+ begin
+ CopyToClipboard.ShortCut :=$4000 OR ord('C'); //Ctrl+C (WindowsLinux)
+ PasteFromClipboard.ShortCut:=$4000 OR ord('V'); //Ctrl+V (Windows/Linux)
+ end;
//Meta/Cmd = $1000, Shift = $2000, Ctrl = $4000, Alt = $8000
end;
@@ -3023,6 +3037,18 @@ procedure TMainForm.ParseCommandLine(cmd: String);
{------------------------------------------------------------------------------}
procedure TMainForm.FormCreate(Sender: TObject);
begin
+ platform:='OS?';
+ arch:='CPU?';
+ //Platform details - OS
+ if TargetOS='Darwin' then platform:= 'macOS'; //Apple Mac OS X
+ if(TargetOS='Win64')
+ or(TargetOS='Win32') then platform:= 'Windows'; //Microsoft Windows
+ if TargetOS='Linux' then platform:= 'Linux'; //Linux
+ //Platform details - CPU
+ if TargetCPU='aarch64' then arch := 'ARM 64 bit';
+ if TargetCPU='arm' then arch := 'ARM 32 bit';
+ if TargetCPU='i386' then arch := 'Intel 32 bit';
+ if TargetCPU='x86_64' then arch := 'Intel 64 bit';
//Just updates the title bar
Caption:=ApplicationTitle;
//Create the image instance
@@ -3053,6 +3079,8 @@ procedure TMainForm.FormCreate(Sender: TObject);
FDFSAllowBlank:=GetRegValB('DFS_Allow_Blanks',False);
//Compress UEF Files on save
FUEFCompress:=GetRegValB('UEF_Compress',True);
+ //Scan all sub directories on opening
+ FScanSubDirs:=GetRegValB('Scan_SubDirs',True);
//View menu options
ViewOptions:=GetRegValI('View_Options',$FFFF);
//Toolbar order - this doesn't work currently
@@ -3075,6 +3103,23 @@ procedure TMainForm.FormCreate(Sender: TObject);
//Select a node
{------------------------------------------------------------------------------}
procedure TMainForm.SelectNode(filename: String;casesens:Boolean=True);
+var
+ Node : TTreeNode;
+begin
+ //Unselect everything
+ DirList.ClearSelection;
+ //Find the node
+ Node:=FindNode(filename,casesens);
+ //Did it find anything, then select it
+ if Node<>nil then Node.Selected:=True;
+ //We'll need to give the tree focus, so it shows up
+ DirList.SetFocus;
+end;
+
+{------------------------------------------------------------------------------}
+//Find a node
+{------------------------------------------------------------------------------}
+function TMainForm.FindNode(filename: String;casesens:Boolean=True): TTreeNode;
var
i,
found : Integer;
@@ -3082,8 +3127,6 @@ procedure TMainForm.SelectNode(filename: String;casesens:Boolean=True);
Node : TTreeNode;
Ldirsep: Char;
begin
- //Unselect everything
- DirList.ClearSelection;
//Marker for our found item
found:=-1;
//Go through each one
@@ -3109,9 +3152,9 @@ procedure TMainForm.SelectNode(filename: String;casesens:Boolean=True);
inc(i);
end;
if found>=0 then //and select it
- DirList.Items[found].Selected:=True;
- //We'll need to give the tree focus, so it shows up
- DirList.SetFocus;
+ Result:=DirList.Items[found]
+ else
+ Result:=nil;
end;
{------------------------------------------------------------------------------}
@@ -3204,6 +3247,7 @@ procedure TMainForm.FormDropFiles(Sender: TObject;
NewImage.AllowDFSZeroSectors:=FDFSZeroSecs;
NewImage.DFSBeyondEdge:=FDFSBeyondEdge;
NewImage.DFSAllowBlanks:=FDFSAllowBlank;
+ NewImage.ScanSubDirs:=True;
for FileName in FileNames do
begin
//If it is not a directory
@@ -3511,6 +3555,9 @@ procedure TMainForm.ImportFiles(NewImage: TDiscImage;Dialogue: Boolean=True);
+'" when adding "'+newentry.Filename+'"')
else
begin
+ //Make sure it has been read in
+ if not TMyTreeNode(DirList.Selected).BeenRead then
+ ReadInDirectory(DirList.Selected);
//Is it a directory we're adding? ADFS and Amiga only
if(newentry.DirRef>=0)and((curformat=diAcornADFS)or(curformat=diAmiga))then
if newentry.Filename<>'$' then //Create the directory
@@ -4201,9 +4248,9 @@ procedure TMainForm.btn_SavePartitionClick(Sender: TObject);
if(Image.FormatNumber>>4=diAcornADFS)
and(Image.DOSPresent)
and(side<>0)then targetformat:=diDOSPlus<<4;
- //ADFS/AFS Hybrid, with ADFS partition selected, so target will be ADFS 'L'
+ //ADFS/AFS Hybrid, with ADFS partition selected, so target will be ADFS Hard Disc
if(Image.FormatNumber>>4=diAcornADFS)
- and(side=0)then targetformat:=diAcornADFS<<4+2;
+ and(side=0)then targetformat:=diAcornADFS<<4+$F;
//Populate the filter part of the dialogue
index:=0;
SaveImage.Filter:=Image.SaveFilter(index,targetformat);
@@ -4215,7 +4262,17 @@ procedure TMainForm.btn_SavePartitionClick(Sender: TObject);
SaveImage.DefaultExt:='.'+Copy(exts[(index*2)-1],3);
//Show the dialogue
if SaveImage.Execute then
+ begin
+ //Show a progress message
+ ProgressForm.Show;
+ //Process the messages to close the file dialogue box
+ Application.ProcessMessages;
+ Image.ProgressIndicator:=@UpdateProgress;
+ //Separate the partitions
Image.SeparatePartition(side,SaveImage.FileName);
+ //Close the progress message
+ ProgressForm.Hide;
+ end;
end else ReportError('Invalid partition selected');
end;
@@ -4348,8 +4405,14 @@ procedure TMainForm.btn_AddPartitionClick(Sender: TObject);
begin
//Set up the form
AFSPartitionForm.PartitionSize.Min:=9; //Minimum partition size
- AFSPartitionForm.PartitionSize.Max:=Image.GetMaxLength div $100; //Max partition size
- AFSPartitionForm.PartitionSize.Position:=AFSPartitionForm.PartitionSize.Max; //Current size
+ AFSPartitionForm.maxAFSSize:=Image.GetMaxLength div $100;
+ if AFSPartitionForm.maxAFSSize>$7F000 then // <----- TO BE REMOVED
+ AFSPartitionForm.maxAFSSize:=$7F000; //Max AFS is, currently, 127MB
+ AFSPartitionForm.maxDOSSize:=Image.GetMaxLength div $100;
+ if AFSPartitionForm.maxDOSSize>$1F4000 then
+ AFSPartitionForm.maxDOSSize:=$1F4000; //Max DOS FAT12 is 500MB
+ AFSPartitionForm.PartitionSize.Max :=AFSPartitionForm.maxAFSSize; //Max partition size
+ AFSPartitionForm.PartitionSize.Position:=AFSPartitionForm.maxAFSSize; //Current size
AFSPartitionForm.PartitionSizeChange(Sender); //Update the label
AFSPartitionForm.rad_type.ItemIndex:=0; //Set to Acorn FS by default
//Display the form
@@ -4541,6 +4604,7 @@ procedure TMainForm.btn_SettingsClick(Sender: TObject);
SettingsForm.DFSBeyondEdge.Checked:=FDFSBeyondEdge;
SettingsForm.AllowDFSBlankFilenames.Checked:=FDFSAllowBlank;
SettingsForm.CompressUEF.Checked:=FUEFCompress;
+ SettingsForm.ScanSubDirs.Checked:=FScanSubDirs;
//Show the form, modally
SettingsForm.ShowModal;
if SettingsForm.ModalResult=mrOK then
@@ -4559,6 +4623,7 @@ procedure TMainForm.btn_SettingsClick(Sender: TObject);
FDFSBeyondEdge:=SettingsForm.DFSBeyondEdge.Checked;
FDFSAllowBlank:=SettingsForm.AllowDFSBlankFilenames.Checked;
FUEFCompress :=SettingsForm.CompressUEF.Checked;
+ FScanSubDirs :=SettingsForm.ScanSubDirs.Checked;
//Save the settings
SetRegValI('Texture',TextureType);
SetRegValI('ADFS_L_Interleave',ADFSInterleave);
@@ -4567,6 +4632,7 @@ procedure TMainForm.btn_SettingsClick(Sender: TObject);
SetRegValB('DFS_Zero_Sectors',FDFSZeroSecs);
SetRegValB('DFS_Beyond_Edge',FDFSBeyondEdge);
SetRegValB('DFS_Allow_Blanks',FDFSAllowBlank);
+ SetRegValB('Scan_SubDirs',FScanSubDirs);
//Change the tile under the filetype
if DirList.SelectionCount=1 then DirListChange(Sender,DirList.Selected);
//Repaint the main form
@@ -4701,14 +4767,23 @@ procedure TMainForm.DirListCustomDrawItem(Sender: TCustomTreeView;
NodeRect : TRect;
indent,
arrowin,
- arrowsize: Integer;
+ arrowsize,
+ imgidx : Integer;
TV : TTreeView;
begin
if Sender is TTreeView then
begin
TV:=TTreeView(Sender);
- //Only concerned if it is selected
- if cdsSelected in State then
+ //Default font style
+ TV.Font.Style:=[fsBold];
+ //If it is a directory that hasn't been read in yet
+ if(TMyTreeNode(Node).IsDir)and(not TMyTreeNode(Node).BeenRead)then
+ TV.Font.Style:=[fsBold,fsItalic];
+ //Only concerned if it is selected, or a directory not read in, or broken
+ if(cdsSelected in State)
+ or(((not TMyTreeNode(Node).BeenRead)
+ or(TMyTreeNode(Node).Broken))and(TMyTreeNode(Node).IsDir))then
+ begin
with TV.Canvas do
begin
indent:=(Node.Level*TV.Indent)+TV.Indent+1;
@@ -4719,13 +4794,11 @@ procedure TMainForm.DirListCustomDrawItem(Sender: TCustomTreeView;
NodeRect:=Node.DisplayRect(False);
//Draw the button
arrowsize:=DirList.ExpandSignSize;
- {$IFDEF Darwin}
- dec(arrowsize); //For some reason macOS size is 1px smaller
- {$ENDIF}
+ if TargetOS='Darwin' then dec(arrowsize); //For some reason macOS size is 1px smaller
//Centralise it
arrowin:=(NodeRect.Height-arrowsize)div 2;
//Adjust the lefthand position to accomodate the arrow
- NodeRect.Left:=NodeRect.Left+indent+arrowin-NodeRect.Height-1;
+ NodeRect.Left:=NodeRect.Left+indent+arrowin-NodeRect.Height;
//And the top
NodeRect.Top:=NodeRect.Top+arrowin;
//Set the size
@@ -4737,18 +4810,42 @@ procedure TMainForm.DirListCustomDrawItem(Sender: TCustomTreeView;
//Draw the Image
NodeRect:=Node.DisplayRect(False);
NodeRect.Left:=NodeRect.Left+indent;
- NodeRect.Top:=NodeRect.Top+1;
+ NodeRect.Top:=NodeRect.Top+2;
NodeRect.Width:=TV.ImagesWidth;
NodeRect.Height:=NodeRect.Width;
- TImageList(TV.Images).StretchDraw(TV.Canvas,Node.ImageIndex,NodeRect);
+ //Get the correct image
+ imgidx:=Node.ImageIndex;
+ if imgidx=-1 then imgidx:=GetImageIndex(Node,Image);
+ TImageList(TV.Images).StretchDraw(TV.Canvas,imgidx,NodeRect);
//Write out the text
NodeRect:=Node.DisplayRect(False);
- NodeRect.Left:=NodeRect.Left+indent+TV.ImagesWidth+7;
+ NodeRect.Left:=NodeRect.Left+indent+TV.ImagesWidth+4;
NodeRect.Top:=NodeRect.Top+2;
- Brush.Color:=TV.SelectionColor; //Background
- Font.Color:=TV.SelectionFontColor; //Foreground
+ //Change the colour - directory not been read in
+ if(not TMyTreeNode(Node).BeenRead)and(TMyTreeNode(Node).IsDir)then
+ begin
+ //Directories not read in
+ Brush.Style:=bsClear;
+ Font.Color:=clBlue;
+ end;
+ //Change the colour - directory broken
+ if(TMyTreeNode(Node).Broken)and(TMyTreeNode(Node).IsDir)then
+ begin
+ //Directories not read in
+ Brush.Style:=bsClear;
+ Font.Color:=clRed;
+ end;
+ //Change the colour - selected item
+ if cdsSelected in State then
+ begin
+ //Selected items
+ Brush.Style:=bsSolid; //Solid background
+ Brush.Color:=TV.SelectionColor; //Background
+ Font.Color:=TV.SelectionFontColor; //Foreground
+ end;
TextOut(NodeRect.Left,NodeRect.Top,Node.Text);
end;
+ end;
end;
end;
@@ -4806,6 +4903,9 @@ function TMainForm.CreateDirectory(dirname, attr: String): TTreeNode;
DirList.Selections[0].Index)
else
parentdir:=GetImageFilename(TMyTreeNode(DirList.Selections[0]).DirRef,-1);
+ //Ensure that the directory has been read in
+ if not TMyTreeNode(DirList.Selections[0]).BeenRead then
+ ReadInDirectory(DirList.Selections[0]);
//Add it
index:=Image.CreateDirectory(dirname,parentdir,attr);
//Function returns pointer to next item (or parent if no children)
@@ -4818,6 +4918,8 @@ function TMainForm.CreateDirectory(dirname, attr: String): TTreeNode;
//Update the directory reference and the directory flag
TMyTreeNode(Node).DirRef:=Length(Image.Disc)-1;
TMyTreeNode(Node).IsDir:=True;
+ TMyTreeNode(Node).BeenRead:=True; //It'll be empty anyway
+ TMyTreeNode(NOde).Broken:=False;
//Update the image
UpdateImageInfo;
//Select the new node
@@ -5080,13 +5182,15 @@ function TMainForm.GetCopyMode(Shift: TShiftState): Boolean;
//Default result
Result:=True;
//Look at the key modifiers
- {$IFDEF Darwin} //For the Mac
- if ssMeta in Shift then Result:=False; //Move
- if ssAlt in Shift then Result:=True; //Copy
- {$ELSE} //For Windows or Linux
- if ssShift in Shift then Result:=False; //Move
- if ssCtrl in Shift then Result:=True; //Copy
- {$ENDIF}
+ if TargetOS='Darwin' then //For the Mac
+ begin
+ if ssMeta in Shift then Result:=False; //Move
+ if ssAlt in Shift then Result:=True; //Copy
+ end else
+ begin //For Windows or Linux
+ if ssShift in Shift then Result:=False; //Move
+ if ssCtrl in Shift then Result:=True; //Copy
+ end;
//If the destination is the same as the source, copy only (not UEF)
if(DraggedItem<>nil)and(Dst<>nil)then
if(DraggedItem.Parent=Dst)and(Image.FormatNumber>>4<>diAcornUEF)then
@@ -5161,6 +5265,9 @@ procedure TMainForm.DoCopyMove(copymode: Boolean);
//Only allow moving/copying if it is not within itself
if(DraggedItem<>Dst)or(Image.FormatNumber>>4=diAcornUEF)then
begin
+ //Read in the destination, if necessary
+ if(TMyTreeNode(Dst).IsDir)and(not TMyTreeNode(Dst).BeenRead)then
+ ReadInDirectory(Dst);
//Take a copy of the filename
newfn:=DraggedItem.Text;
//Do the copy/move
@@ -5291,10 +5398,10 @@ procedure TMainForm.CancelDragDropExecute(Sender: TObject);
{------------------------------------------------------------------------------}
procedure TMainForm.btn_NewImageClick(Sender: TObject);
var
- major : Word;
+ major : Word;
minor,
- tracks: Byte;
- ok : Boolean;
+ tracks : Byte;
+ ok : Boolean;
begin
if QueryUnsaved then
begin
@@ -5328,8 +5435,8 @@ procedure TMainForm.btn_NewImageClick(Sender: TObject);
7: minor:=NewImageForm.AFS.ItemIndex;
8: minor:=NewImageForm.DOS.ItemIndex;
end;
- //Number of tracks (DFS only)
tracks:=0; //Default
+ //Number of tracks (DFS only)
if major=diAcornDFS then
tracks:=NewImageForm.DFSTracks.ItemIndex;
//Now create the image
@@ -5343,17 +5450,24 @@ procedure TMainForm.btn_NewImageClick(Sender: TObject);
else //AFS
if major=diAcornFS then
begin
+ //Create the format
ok:=Image.FormatHDD(diAcornFS,
NewImageForm.AFSImageSize.Position*10*1024,
False,
- NewImageForm.AFS.ItemIndex+2);
+ minor+2);
if(ok)and(NewImageForm.cb_AFScreatepword.Checked)then
//Create blank password file for AFS
if Image.CreatePasswordFile(nil)<0 then //If fails, report an error
ReportError('Failed to create a password file');
end
- else //Floppy Drive
- ok:=Image.FormatFDD(major,minor,tracks);
+ else //DOS Hard Drive
+ if(major=diDOSPlus)and(minor=6)then
+ ok:=Image.FormatHDD(major,
+ NewImageForm.harddrivesize,
+ False,
+ NewImageForm.fat)
+ else //Floppy Drive
+ ok:=Image.FormatFDD(major,minor,tracks);
if ok then
begin
CloseAllHexDumps;
@@ -5636,7 +5750,48 @@ procedure TMainForm.DirListDblClick(Sender: TObject);
HexDump[index].DisplaySpriteFile;
end;
end;
+ end
+ else //User double clicked on a directory
+ begin
+ ReadInDirectory(Node);
+ //Need to open the directory
+ Node.Expand(False);
+ end;
+end;
+
+{------------------------------------------------------------------------------}
+//Read a directory onto the tree
+{------------------------------------------------------------------------------}
+procedure TMainForm.ReadInDirectory(Node: TTreeNode);
+var
+ dir,
+ entry,
+ index : Integer;
+ filename: String;
+begin
+ if not TMyTreeNode(Node).BeenRead then //If it hasn't been read
+ begin
+ entry:=Node.Index;
+ dir:=-1;
+ //dir variable, as above
+ if Node.Parent<>nil then //We will only act on this if not the root
+ begin
+ dir:=TMyTreeNode(Node).ParentDir;
+ //Get the full filename with path
+ filename:=Image.GetParent(dir)+Image.DirSep+
+ Image.Disc[dir].Entries[entry].Filename;
+ //And read in the directory
+ index:=Image.ReadDirectory(filename);
+ if index<>-1 then
+ begin
+ //Add the entire directory contents
+ AddDirectoryToTree(Node,index,Image,index);
+ //Mark this directory as having been read
+ TMyTreeNode(Node).BeenRead:=True;
+ TMyTreeNode(Node).Broken:=Image.Disc[Image.Disc[dir].Entries[entry].DirRef].Broken;
+ end;
end;
+ end;
end;
{------------------------------------------------------------------------------}
diff --git a/LazarusSource/NewImageUnit.lfm b/LazarusSource/NewImageUnit.lfm
index 8b1a202..5aeb12a 100755
--- a/LazarusSource/NewImageUnit.lfm
+++ b/LazarusSource/NewImageUnit.lfm
@@ -233,31 +233,6 @@ object NewImageForm: TNewImageForm
ModalResult = 2
TabOrder = 8
end
- object AFS: TRadioGroup
- Left = 268
- Height = 55
- Top = 0
- Width = 260
- AutoFill = True
- Caption = 'Acorn File Server'
- ChildSizing.LeftRightSpacing = 6
- ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
- ChildSizing.EnlargeVertical = crsHomogenousChildResize
- ChildSizing.ShrinkHorizontal = crsScaleChilds
- ChildSizing.ShrinkVertical = crsScaleChilds
- ChildSizing.Layout = cclLeftToRightThenTopToBottom
- ChildSizing.ControlsPerLine = 1
- ClientHeight = 36
- ClientWidth = 250
- ItemIndex = 0
- Items.Strings = (
- 'Level 2'
- 'Level 3'
- )
- OnClick = AFSClick
- TabOrder = 9
- Visible = False
- end
object AFSSize: TGroupBox
Left = 268
Height = 104
@@ -300,7 +275,7 @@ object NewImageForm: TNewImageForm
end
object DOS: TRadioGroup
Left = 268
- Height = 109
+ Height = 144
Top = 0
Width = 260
AutoFill = True
@@ -312,17 +287,47 @@ object NewImageForm: TNewImageForm
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
- ClientHeight = 90
+ ClientHeight = 125
ClientWidth = 250
ItemIndex = 0
Items.Strings = (
- '800K DOS Plus'
- '360K DOS'
- '720K DOS'
- '1.44M DOS'
- '2.88M DOS'
+ '640KB ADFS/DOS Plus'
+ '800KB DOS Plus'
+ '360KB'
+ '720KB'
+ '1.44MB'
+ '2.88MB'
+ 'DOS Hard Drive'
)
TabOrder = 11
Visible = False
end
+ object AFS: TRadioGroup
+ Left = 268
+ Height = 55
+ Top = 0
+ Width = 260
+ AutoFill = True
+ Caption = 'Acorn File Server'
+ ChildSizing.LeftRightSpacing = 6
+ ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+ ChildSizing.EnlargeVertical = crsHomogenousChildResize
+ ChildSizing.ShrinkHorizontal = crsScaleChilds
+ ChildSizing.ShrinkVertical = crsScaleChilds
+ ChildSizing.Layout = cclTopToBottomThenLeftToRight
+ ChildSizing.ControlsPerLine = 2
+ ClientHeight = 36
+ ClientWidth = 250
+ ColumnLayout = clVerticalThenHorizontal
+ Columns = 2
+ ItemIndex = 0
+ Items.Strings = (
+ 'Level 2'
+ 'Level 3 (<1988)'
+ 'Level 3 (>1988)'
+ )
+ OnClick = AFSClick
+ TabOrder = 9
+ Visible = False
+ end
end
diff --git a/LazarusSource/NewImageUnit.pas b/LazarusSource/NewImageUnit.pas
index 2a36367..0737b27 100755
--- a/LazarusSource/NewImageUnit.pas
+++ b/LazarusSource/NewImageUnit.pas
@@ -58,7 +58,8 @@ TNewImageForm = class(TForm)
public
harddrivesize : Cardinal;
newmap : Boolean;
- dirtype : Byte;
+ dirtype,
+ fat : Byte;
end;
var
@@ -95,14 +96,15 @@ procedure TNewImageForm.MainFormatClick(Sender: TObject);
7: AFS.Visible :=True;
8: DOS.Visible :=True;
end;
- DFSTracks.Visible:=DFS.Visible;
- AFSSize.Visible :=AFS.Visible;
+ DFSTracks.Visible :=DFS.Visible;
+ AFSSize.Visible :=AFS.Visible;
//Currently, only certain types of format can be created
btn_OK.Enabled:=(MainFormat.ItemIndex=0) //DFS
OR(MainFormat.ItemIndex=1) //ADFS
OR(MainFormat.ItemIndex=2) //C64
OR(MainFormat.ItemIndex=5) //CFS
- OR(MainFormat.ItemIndex=7);//AFS
+ OR(MainFormat.ItemIndex=7) //AFS
+ OR(MainFormat.ItemIndex=8);//DOS
end;
{-------------------------------------------------------------------------------
@@ -146,10 +148,11 @@ procedure TNewImageForm.btn_OKClick(Sender: TObject);
ok: Boolean;
begin
ok:=True;
- //Are we creating a hard drive?
+ //Are we creating an ADFS hard drive?
if(MainFormat.ItemIndex=1)AND(ADFS.ItemIndex=8)then
begin
//Then we need to open the additional dialogue to configure this
+ HardDriveForm.ADFSHDD:=True;
HardDriveForm.ShowModal;
ok:=HardDriveForm.ModalResult=mrOK;
if ok then
@@ -164,6 +167,22 @@ procedure TNewImageForm.btn_OKClick(Sender: TObject);
if HardDriveForm.rb_BigDir.Checked then dirtype:=diADFSBigDir;
end;
end;
+ //Are we creating a DOS hard drive?
+ if(MainFormat.ItemIndex=8)AND(DOS.ItemIndex=6)then
+ begin
+ //Then we need to open the additional dialogue to configure this
+ HardDriveForm.ADFSHDD:=False;
+ HardDriveForm.ShowModal;
+ ok:=HardDriveForm.ModalResult=mrOK;
+ if ok then
+ begin
+ //Selected hard drive size in MB
+ harddrivesize:=HardDriveForm.CapacitySlider.Position*10;
+ if HardDriveForm.rb_FAT12.Checked then fat:=diFAT12;
+ if HardDriveForm.rb_FAT16.Checked then fat:=diFAT16;
+ if HardDriveForm.rb_FAT32.Checked then fat:=diFAT32;
+ end;
+ end;
//Return to the calling form
if ok then ModalResult:=mrOK;
end;
@@ -193,7 +212,7 @@ procedure TNewImageForm.AFSClick(Sender: TObject);
AFSImageSize.Min:=40; //Level 2 minimum size 400K
AFSImageSize.Max:=102; //Level 2 maximum size is 1023K (1MB)
end;
- if AFS.ItemIndex=1 then
+ if(AFS.ItemIndex=1)or(AFS.ItemIndex=2)then
begin
AFSImageSize.Min:=64; //Level 3 minimum size 640K
AFSImageSize.Max:=13107; //Level 3 temporary max is ~128MB
diff --git a/LazarusSource/SettingsUnit.lfm b/LazarusSource/SettingsUnit.lfm
index 11b7a62..fc94c41 100644
--- a/LazarusSource/SettingsUnit.lfm
+++ b/LazarusSource/SettingsUnit.lfm
@@ -1,12 +1,12 @@
object SettingsForm: TSettingsForm
Left = 485
- Height = 399
+ Height = 412
Top = 137
Width = 448
BorderIcons = []
BorderStyle = bsDialog
Caption = 'Preferences'
- ClientHeight = 399
+ ClientHeight = 412
ClientWidth = 448
Color = 15527148
OnPaint = FormPaint
@@ -116,7 +116,7 @@ object SettingsForm: TSettingsForm
object CancelButton: TBitBtn
Left = 224
Height = 30
- Top = 362
+ Top = 376
Width = 100
Cancel = True
Caption = 'Cancel'
@@ -127,7 +127,7 @@ object SettingsForm: TSettingsForm
object OKBtnBack: TPanel
Left = 340
Height = 30
- Top = 362
+ Top = 376
Width = 100
BevelColor = clYellow
BevelInner = bvLowered
@@ -177,12 +177,12 @@ object SettingsForm: TSettingsForm
end
object MiscGroup: TGroupBox
Left = 0
- Height = 104
+ Height = 72
Top = 288
- Width = 224
+ Width = 440
Caption = 'Miscellaneous'
- ClientHeight = 85
- ClientWidth = 214
+ ClientHeight = 53
+ ClientWidth = 430
TabOrder = 4
object CreateINF: TCheckBox
Left = 4
@@ -203,15 +203,25 @@ object SettingsForm: TSettingsForm
TabOrder = 1
end
object CompressUEF: TCheckBox
- Left = 4
+ Left = 228
Height = 18
- Top = 56
+ Top = 8
Width = 150
Caption = 'Compress UEF Images'
Checked = True
State = cbChecked
TabOrder = 2
end
+ object ScanSubDirs: TCheckBox
+ Left = 228
+ Height = 18
+ Top = 32
+ Width = 190
+ Caption = 'Scan sub-directories on open'
+ Checked = True
+ State = cbChecked
+ TabOrder = 3
+ end
end
object DFSGroup: TGroupBox
Left = 224
diff --git a/LazarusSource/SettingsUnit.pas b/LazarusSource/SettingsUnit.pas
index be5e37a..56549c0 100644
--- a/LazarusSource/SettingsUnit.pas
+++ b/LazarusSource/SettingsUnit.pas
@@ -35,6 +35,7 @@ TSettingsForm = class(TForm)
AllowDFSZeroSecs: TCheckBox;
AllowDFSBlankFilenames: TCheckBox;
CancelButton: TBitBtn;
+ ScanSubDirs: TCheckBox;
DFSBeyondEdge: TCheckBox;
DFSGroup: TGroupBox;
WriteDebug: TCheckBox;
diff --git a/binaries/Linux/Disc Image Manager 32 bit.zip b/binaries/Linux/Disc Image Manager 32 bit.zip
index 06e687c..a847480 100644
Binary files a/binaries/Linux/Disc Image Manager 32 bit.zip and b/binaries/Linux/Disc Image Manager 32 bit.zip differ
diff --git a/binaries/Linux/Disc Image Manager ARM 32 bit.zip b/binaries/Linux/Disc Image Manager ARM 32 bit.zip
index 69be4c4..b658387 100644
Binary files a/binaries/Linux/Disc Image Manager ARM 32 bit.zip and b/binaries/Linux/Disc Image Manager ARM 32 bit.zip differ
diff --git a/binaries/Linux/Disc Image Manager.zip b/binaries/Linux/Disc Image Manager.zip
index f14e4c0..a9a6271 100644
Binary files a/binaries/Linux/Disc Image Manager.zip and b/binaries/Linux/Disc Image Manager.zip differ
diff --git a/binaries/Windows/Disc Image Manager 32 bit.zip b/binaries/Windows/Disc Image Manager 32 bit.zip
index f7be7e0..2e7714f 100644
Binary files a/binaries/Windows/Disc Image Manager 32 bit.zip and b/binaries/Windows/Disc Image Manager 32 bit.zip differ
diff --git a/binaries/Windows/Disc Image Manager.zip b/binaries/Windows/Disc Image Manager.zip
index 41294ca..6c00001 100644
Binary files a/binaries/Windows/Disc Image Manager.zip and b/binaries/Windows/Disc Image Manager.zip differ
diff --git a/binaries/macOS/Disc Image Manager 32 bit.dmg b/binaries/macOS/Disc Image Manager 32 bit.dmg
index d2e7147..6547020 100644
Binary files a/binaries/macOS/Disc Image Manager 32 bit.dmg and b/binaries/macOS/Disc Image Manager 32 bit.dmg differ
diff --git a/binaries/macOS/Disc Image Manager ARM.dmg b/binaries/macOS/Disc Image Manager ARM.dmg
index 62f9843..52f5b94 100644
Binary files a/binaries/macOS/Disc Image Manager ARM.dmg and b/binaries/macOS/Disc Image Manager ARM.dmg differ
diff --git a/binaries/macOS/Disc Image Manager.dmg b/binaries/macOS/Disc Image Manager.dmg
index 25046fa..0209254 100644
Binary files a/binaries/macOS/Disc Image Manager.dmg and b/binaries/macOS/Disc Image Manager.dmg differ