diff --git a/Documentation/Changes.txt b/Documentation/Changes.txt index 02b7801..470cf2a 100755 --- a/Documentation/Changes.txt +++ b/Documentation/Changes.txt @@ -830,15 +830,15 @@ Bug fixes ---------------------- New or improved features * SparkFS images are now fully writable: -* Can now write files to a SparkFS image. -* Can now create a blank directory on a SparkFS image. -* Can now rename files and directories on a SparkFS image. -* Can now move and copy files and directories on a SparkFS image. -* Can now change the timestamp on files and directories on a SparkFS image. -* Can now change the filetype on files on a SparkFS image. -* Can now change the load and execution addresses on files on a SparkFS image. -* Can now change file and directory attibutes on a SparkFS image. -* Can now delete files/directories from a SparkFS image. +* Can write files to a SparkFS image. +* Can create a blank directory on a SparkFS image. +* Can rename files and directories on a SparkFS image. +* Can move and copy files and directories on a SparkFS image. +* Can change the timestamp on files and directories on a SparkFS image. +* Can change the filetype on files on a SparkFS image. +* Can change the load and execution addresses on files on a SparkFS image. +* Can change file and directory attibutes on a SparkFS image. +* Can delete files/directories from a SparkFS image. Bug fixes * SparkFS failed to extract the file data if it was the first file in the archive. @@ -847,17 +847,42 @@ Bug fixes * A bug had crept in, at some earlier version, that crashed the application when the filetype was clicked on. * When editing the date/time stamp, clicking on a field during editing would instead commence editing the selected node on the directory tree for renaming. -1.43 ----------------------- +1.43 - 4th May 2022 +------------------- New or improved features * Reports number of items in a directory in the File Details pane. * Added more sanity checks on ID-ing a DOS or DOS+ image. * Changed the order of ID-ing a format and moved DFS to the end. +* The Image Details dialogue now opens, with Free Space Map display, for AmigaDOS images. +* Attributes are now shown for files on an AmigaDOS image. +* Can now retitle an AmigaDOS image. +* CRC32 is no longer reported for directories. +* Improved the file extraction function for AmigaDOS images, and made it FFS compatible. +* TimeDate stamp is now reported for Amiga files and directories. +* Can create blank Amiga DD and HD floppy images, and blank hard drive images. +* Can create new directories on AmigaDOS images. +* Can write files to an AmigaDOS image. +* Can update the protect attributes on an AmigaDOS file/directory. +* Can date/time stamp an AmigaDOS file/directory. +* Can delete files/directories from an AmigaDOS image. +* Can move files/directories around an AmigaDOS image. +* Can rename files/directories in an AmigaDOS image. +* The file relating to the currently open DOS partition is now marked in green in the directory tree, and cannot be deleted. +* DOS Partitions will now only be searched for on Old Directory ADFS hard drives. +* Added an option to specify whether to automatically open DOS partitions on ADFS hard drives. +* Added an extra command line parameter to create DOS hard drive: DOSHDD| +* Added an extra command line parameter to create Amiga hard drive: AmigaHDD| +* Added extra command line parameters for creating DOS floppies: DOS+640, DOS+800, DOS360, DOS720, DOS1440, and DOS2880. +* Added a command line option to change the configuration options: --config or -cf. Bug fixes * When looking for a DOS partition on an ADFS hard drive, the drive was split as two separate drives. However, the DOS partition is a file held within the ADFS file structure and not a separate partition. * The custom filetype entry box was not positioned correctly in the filetype dialogue. * ADFS Filetypes and timestamps were getting reported for non ADFS formats and ADFS Old Directories. +* Sometimes reading a file off an AmigaDOS image would hang the application. +* During copy/move operations, the directory being hovered over expanded instantly which could cause issues. There is now a 1 sec hover delay before expanding. +* A failed delete, or the user clicking on 'No' to confirm a deletion, would leave the confirmation window open until it was a successful delete, or the user clicked 'Yes'. +* The configuration option to compress UEF images did not get saved to the registry. Platform History diff --git a/Documentation/Disc Image Manager User Guide.docx b/Documentation/Disc Image Manager User Guide.docx index 140545a..041c178 100644 Binary files a/Documentation/Disc Image Manager User Guide.docx 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 7595d26..de8de8b 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 9232d78..cd4b812 100644 --- a/Documentation/ToDo.txt +++ b/Documentation/ToDo.txt @@ -9,6 +9,7 @@ Bugs * Some SS DFS images are IDed as DS images when 'Allow zero sectors' is selected in the preferences. * Access violation has been reported when creating an ADFS HDD image (default options) on Windows. - UNABLE TO REPLICATE * Does not work on Windows 11. - UNABLE TO REPLICATE +* Changing time/date on a file does not update the 'unsaved' icon in the status bar. General * Drag and Drop facilities out of the application...currently looking unlikely for cross platform. This will need to be done using 'code-per-platform' directives. @@ -26,7 +27,7 @@ General DFS ADFS -* Import an existing AFS or DOS image into ADFS as a new partition. +* Import an existing AFS or DOS image into ADFS as a new partition (importing DOS image as parition is as easy as just adding a DOS Image file). AFS * AFS0 images do not get created correctly (in particular the free space allocation maps) - AWAITING MORE INFO ON AFS FORMATS. @@ -34,10 +35,6 @@ AFS * 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. -* Create blank Amiga images. -* Create Free Space Map for Amiga. -* Show file attributes in the File Details panel. Spectrum/Amstrad * Write entire module - REQUIRE MORE INFO ON SPECTRUM FORMAT. diff --git a/LazarusSource/DiscImage.pas b/LazarusSource/DiscImage.pas index 0adbdb5..d44d2d1 100755 --- a/LazarusSource/DiscImage.pas +++ b/LazarusSource/DiscImage.pas @@ -84,6 +84,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati FDFSBeyondEdge, //Check for files going beyond the DFS disc edge FDOSVolInRoot, //Volume name is stored in the root (DOS) FScanSubDirs, //Scan sub directories on opening (ADFS/Amiga/DOS/Spark) + FOpenDOSPart, //Open DOS Partitions on ADFS FDOSUseSFN : Boolean; //Use short filenames, even if there are long filenames (DOS) secsize, //Sector Size bpmb, //Bits Per Map Bit (Acorn ADFS New) @@ -346,15 +347,35 @@ TFragment = record //For retrieving the ADFS E/F fragment informati function AmigaBootChecksum(offset: Cardinal): Cardinal; function AmigaChecksum(offset: Cardinal): Cardinal; function ExtractAmigaFile(filename:String;var buffer:TDIByteArray):Boolean; - function FormatAmiga(minor: Byte): TDisc; + function ExtractAmigaData(sector,filelen: Cardinal; + var buffer: TDIByteArray): Boolean; + function FormatAmigaFDD(minor: Byte): TDisc; + function FormatAmigaHDD(harddrivesize: Cardinal): TDisc; + procedure FormatAmiga(size: Cardinal); function WriteAmigaFile(var file_details: TDirEntry;var buffer: TDIByteArray): Integer; function CreateAmigaDirectory(var dirname,parent,attributes: String): Integer; - function RetitleAmigaDirectory(filename, newtitle: String): Boolean; function RenameAmigaFile(oldfilename: String;var newfilename: String):Integer; function DeleteAmigaFile(filename: String):Boolean; function UpdateAmigaFileAttributes(filename,attributes: String): Boolean; function UpdateAmigaDiscTitle(title: String): Boolean; function MoveAmigaFile(filename,directory: String): Integer; + procedure ReadAmigaFSM; + procedure AmigaFillFreeSpaceMap(address: Cardinal;usage: Byte); + procedure ToAmigaTime(time: TDateTime;var days,mins,ticks: Cardinal); + function FromAmigaTime(days, mins, ticks: Cardinal): TDateTime; + function AmigaIntToStrAttr(attr: Cardinal): String; + function AmigaStrToIntAttr(attr: String): Cardinal; + function AmigaCalculateHashValue(filename: String): Cardinal; + procedure AmigaAllocateFSMBlock(addr:Cardinal;used:Boolean;var fsm:TDIByteArray); + function GetAmigaFSMOffset(addr: Cardinal;var bit: Byte): Cardinal; + function AmigaReadBitmap(var fsm: TDIByteArray): TFragmentArray; + procedure AmigaWriteBitmap(fsmlist: TFragmentArray;var fsm: TDIByteArray); + function AmigaFindFreeSpace(filelen: Cardinal): TFragmentArray; + function UpdateAmigaTimeStamp(filename: String;newtimedate: TDateTime): Boolean; + function GetAmigaChain(sector: Cardinal): TFragmentArray; + procedure AmigaAddToChain(filename: String;paraddr,sector: Cardinal); + function AmigaRemoveFromChain(filename: String;paraddr,sector: Cardinal):Boolean; + procedure ValidateAmigaFile(var filename: String); //Acorn CFS Routines function ID_CFS: Boolean; function ReadUEFFile: TDisc; @@ -443,8 +464,9 @@ TFragment = record //For retrieving the ADFS E/F fragment informati 'DELDeleted' ,'SEQSequence' ,'PRGProgram' , 'USRUser File','RELRelative' ,'CBMCBM' ); //Disc title for new images - disctitle = 'DiscImgMgr'; - afsdisctitle = 'DiscImageManager'; //AFS has longer titles + disctitle = 'DiscImgMgr'; + afsdisctitle = 'DiscImageManager'; //AFS has longer titles + amigadisctitle= 'Disc Image Manager';//Amiga has even longer titles //Root name to use when AFS is partition on ADFS afsrootname = ':AFS$'; {$INCLUDE 'DiscImageRISCOSFileTypes.pas'} @@ -532,6 +554,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati property MapType: Byte read MapFlagToByte; property MapTypeString: String read MapTypeToString; property MaxDirectoryEntries: Cardinal read FMaxDirEnt; + property OpenDOSPartitions: Boolean read FOpenDOSPart write FOpenDOSPart; property ProgressIndicator: TProgressProc write FProgress; property RAWData: TDIByteArray read Fdata; property RootAddress: Cardinal read GetRootAddress; diff --git a/LazarusSource/DiscImageManager.lpi b/LazarusSource/DiscImageManager.lpi index 35cad30..f04507d 100644 --- a/LazarusSource/DiscImageManager.lpi +++ b/LazarusSource/DiscImageManager.lpi @@ -21,10 +21,9 @@ - - + - + diff --git a/LazarusSource/DiscImageManager.lps b/LazarusSource/DiscImageManager.lps index deb266e..197dce8 100644 --- a/LazarusSource/DiscImageManager.lps +++ b/LazarusSource/DiscImageManager.lps @@ -4,7 +4,7 @@ - + @@ -21,8 +21,8 @@ - - + + @@ -31,8 +31,8 @@ - - + + @@ -56,8 +56,8 @@ - - + + @@ -79,7 +79,8 @@ - + + @@ -133,8 +134,8 @@ - - + + @@ -180,8 +181,8 @@ - - + + @@ -206,8 +207,8 @@ - - + + @@ -266,8 +267,8 @@ - - + + @@ -290,8 +291,8 @@ - - + + @@ -311,7 +312,7 @@ - + @@ -325,7 +326,7 @@ - + @@ -340,7 +341,7 @@ - + @@ -348,16 +349,16 @@ - - + + - - + + @@ -369,128 +370,115 @@ + + + + + + + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - - - - - @@ -499,4 +487,20 @@ + + + + + + + + + + + + + + + + diff --git a/LazarusSource/DiscImageManager.res b/LazarusSource/DiscImageManager.res index 59a5b8a..162250b 100644 Binary files a/LazarusSource/DiscImageManager.res and b/LazarusSource/DiscImageManager.res differ diff --git a/LazarusSource/DiscImageUtils.pas b/LazarusSource/DiscImageUtils.pas index 4727258..eb5057a 100644 --- a/LazarusSource/DiscImageUtils.pas +++ b/LazarusSource/DiscImageUtils.pas @@ -53,6 +53,7 @@ TDirEntry = record //Not all fields are used on all formats DirRef : Integer; //Reference to directory, if directory (ADFS/AmigaDOS) TimeStamp : TDateTime; //Timestamp (ADFS D/E/E+/F/F+) EOR : Byte; //Reserved for use by Repton Map Display + isDOSPart : Boolean; //This file is the DOS partition end; type //Define the records for an Acorn File Server password file @@ -134,6 +135,7 @@ procedure ResetDirEntry(var Entry: TDirEntry); DirRef :=$0000; TimeStamp :=0; EOR :=$00; + isDOSPart :=False; end; end; diff --git a/LazarusSource/DiscImage_ADFS.pas b/LazarusSource/DiscImage_ADFS.pas index e11ae68..3c58899 100644 --- a/LazarusSource/DiscImage_ADFS.pas +++ b/LazarusSource/DiscImage_ADFS.pas @@ -238,8 +238,9 @@ function TDiscImage.ID_ADFS: Boolean; end; end; end; - //Check for DOS Plus partition on ADFS Hard drives - if(FFormat=diAcornADFS<<4+$F)and(not FAFSPresent)and(not FDOSPresent)then + //Check for DOS partition on ADFS Hard drives + if(FFormat=diAcornADFS<<4+$F)and(not FAFSPresent)and(not FDOSPresent) + and(FDirType=diADFSOldDir)and(FOpenDOSPart)then begin //Start at the root ctr:=root; @@ -255,6 +256,7 @@ function TDiscImage.ID_ADFS: Boolean; end; //Return a true or false Result:=FFormat>>4=diAcornADFS; + if Result then root_name:='$'; end; end; @@ -538,6 +540,8 @@ function TDiscImage.ReadADFSDir(dirname: String; sector: Cardinal): TDir; ADFSCalcFileDate(Entry); //Not a directory - default. Will be determined later Entry.DirRef:=-1; + //Is this entry the DOS partition? + if doshead=Entry.Sector*secsize then Entry.IsDOSPart:=True; //Add to the result SetLength(Result.Entries,Length(Result.Entries)+1); Result.Entries[Length(Result.Entries)-1]:=Entry; @@ -1247,6 +1251,7 @@ function TDiscImage.FormatADFSFloppy(minor: Byte): TDisc; //Blank everything ResetVariables; SetDataLength(0); + root_name:='$'; //Set the format FFormat:=diAcornADFS<<4+minor; //Interleave option @@ -1567,6 +1572,7 @@ function TDiscImage.FormatADFSHDD(harddrivesize:Cardinal;newmap:Boolean;dirtype: //Blank everything ResetVariables; SetDataLength(0); + root_name:='$'; //Set the format FFormat:=diAcornADFS<<4+$0F; //Set the map and directory @@ -1610,7 +1616,7 @@ function TDiscImage.FormatADFSHDD(harddrivesize:Cardinal;newmap:Boolean;dirtype: FormatNewMapADFS(disctitle); end; //Now write the root - dirid:='$'; + dirid:=root_name; att:='DLR'; CreateADFSDirectory(dirid,dirid,att); //Finalise all the variables by reading the data in again @@ -1830,19 +1836,19 @@ function TDiscImage.WriteADFSFile(var file_details:TDirEntry;var buffer:TDIByteA Result:=-3;//File already exists success:=False; //Validate the proposed filename - if not((file_details.Filename='$')and(FDirType=diADFSBigDir))then + if not((file_details.Filename=root_name)and(FDirType=diADFSBigDir))then file_details.Filename:=ValidateADFSFilename(file_details.Filename); //First make sure it doesn't exist already if(not FileExists(file_details.Parent+dir_sep+file_details.Filename,ref)) - or((file_details.Filename='$')and(FDirType=diADFSBigDir))then + or((file_details.Filename=root_name)and(FDirType=diADFSBigDir))then //Get the directory where we are adding it to, and make sure it exists - if(FileExists(file_details.Parent,ref))OR(file_details.Parent='$')then + if(FileExists(file_details.Parent,ref))OR(file_details.Parent=root_name)then begin - if file_details.filename<>'$' then + if file_details.filename<>root_name then begin file_details.ImageAddress:=0; //Where we are inserting this into - if file_details.Parent='$' then + if file_details.Parent=root_name then dir :=0 else dir :=FDisc[ref div $10000].Entries[ref mod $10000].DirRef; @@ -1910,7 +1916,7 @@ function TDiscImage.WriteADFSFile(var file_details:TDirEntry;var buffer:TDIByteA ADFSAllocateFreeSpace(file_details.Length,fragid,fragments); end; //Now update the directory (local copy) - if file_details.filename<>'$' then + if file_details.filename<>root_name then begin //Get the number of entries in the directory ref:=Length(FDisc[dir].Entries); @@ -2321,7 +2327,7 @@ function TDiscImage.CreateADFSDirectory(var dirname,parent, end; SetLength(buffer,0); Result:=-3;//Directory already exists - if(dirname='$')OR(parent='$')then //Creating the root + if(dirname=root_name)OR(parent=root_name)then //Creating the root parentaddr:=rootfrag else begin @@ -2330,11 +2336,11 @@ function TDiscImage.CreateADFSDirectory(var dirname,parent, //Has it been read in? if not FDisc[FDisc[dir].Entries[entry].DirRef].BeenRead then ReadDirectory(parent); end; - if dirname<>'$' then + if dirname<>root_name then //Validate the name dirname:=ValidateADFSFilename(dirname); //Make sure it does not already exist - if(not FileExists(parent+dir_sep+dirname,ref))OR(dirname='$')then + if(not FileExists(parent+dir_sep+dirname,ref))OR(dirname=root_name)then begin Result:=-5;//Unknown error //Set as 'D' so it gets added as a directory @@ -2437,7 +2443,7 @@ function TDiscImage.CreateADFSDirectory(var dirname,parent, buffer[$1B+Length(dirname)+1]:=$0D; //CR for end of directory name end; //Write the directory - if dirname='$' then //Root - used when formatting an image + if dirname=root_name then //Root - used when formatting an image begin for t:=0 to Length(buffer)-1 do WriteByte(buffer[t],root+t); @@ -2493,10 +2499,10 @@ procedure TDiscImage.UpdateADFSCat(directory: String;newname: String=''); UpdateDOSDirectory(directory); exit; end; - if(FileExists(directory,ref))or(directory='$')then + if(FileExists(directory,ref))or(directory=root_name)then begin //Get the directory reference and sector address - if directory='$' then + if directory=root_name then begin dir :=0; if FMap then diraddr:=rootfrag @@ -2741,14 +2747,14 @@ function TDiscImage.RetitleADFSDirectory(filename,newtitle: String): Boolean; //ADFS Big Directories do not have titles if FDirType=diADFSBigDir then exit; //Check that the file exists, or is the root - if(FileExists(filename,dir,entry))OR(filename='$')then + if(FileExists(filename,dir,entry))OR(filename=root_name)then begin - if filename='$' then + if filename=root_name then begin //Re-title the directory, limiting it to 19 characters FDisc[0].Title:=LeftStr(newtitle,19); //Update the catalogue, which will update the title - UpdateADFSCat('$'); + UpdateADFSCat(root_name); end else begin @@ -2810,7 +2816,7 @@ function TDiscImage.RenameADFSFile(oldfilename: String;var newfilename: String): if FDirType=diADFSBigDir then if not ExtendADFSBigDir(dir,space,False) then begin - Result:=-9; //Cannot extend + Result:=-4; //Cannot extend exit; end; //Are we renaming a directory? @@ -3104,16 +3110,19 @@ function TDiscImage.DeleteADFSFile(filename: String; exit; end; //Check that the file exists - if(FileExists(filename,dir,entry))or((filename='$')and(FDirType=diADFSBigDir))then + if(FileExists(filename,dir,entry))or((filename=root_name)and(FDirType=diADFSBigDir))then begin //If we are deleting the root (usually only when extending/contracting) - if(filename='$')and(FDirType=diADFSBigDir)then + if(filename=root_name)and(FDirType=diADFSBigDir)then begin entry:=$FFFF; dir :=$FFFF; end; success:=True; - if filename<>'$' then + if filename<>root_name then + begin + //Is this file the currently open DOS Partition? + if FDisc[dir].Entries[entry].isDOSPart then exit(False); //Then fail //If directory, delete contents first if(FDisc[dir].Entries[entry].DirRef>0)and(not TreatAsFile)then begin @@ -3130,10 +3139,11 @@ function TDiscImage.DeleteADFSFile(filename: String; +dir_sep +FDisc[FDisc[dir].Entries[entry].DirRef].Entries[0].Filename); end; + end; //Only continue if we are successful if success then begin - if filename<>'$' then + if filename<>root_name then begin //Make a note of the parent - these will become invalid soon fileparent:=GetParent(dir); @@ -3150,7 +3160,7 @@ function TDiscImage.DeleteADFSFile(filename: String; //Remove from the catalogue UpdateADFSCat(fileparent); end; - if filename='$' then + if filename=root_name then addr:=rootfrag;//Read32b(bootmap+$0C+4); //ID of the root //Add to the free space map if not FMap then ADFSDeAllocateFreeSpace(addr,len); //Old map @@ -3458,12 +3468,13 @@ function TDiscImage.MoveADFSFile(filename,directory: String): Integer; direntry:=FDisc[sdir].Entries[sentry]; //Remember the original parent sparent:=GetParent(sdir); - if(FileExists(directory,ddir,dentry))or(directory='$')then + if(FileExists(directory,ddir,dentry))or(directory=root_name)then begin Result:=-10;//Can't move to the same directory //Destination directory reference - ddir:=0;//Root - if directory<>'$' then ddir:=FDisc[ddir].Entries[dentry].DirRef; + if directory=root_name then ddir:=0//Root + else ddir:=FDisc[ddir].Entries[dentry].DirRef; + if ddir>=Length(FDisc) then exit(-12); if ddir<>sdir then //Can't move into the same directory begin //Has it been read in? diff --git a/LazarusSource/DiscImage_Amiga.pas b/LazarusSource/DiscImage_Amiga.pas index 2c745c3..3b13e85 100644 --- a/LazarusSource/DiscImage_Amiga.pas +++ b/LazarusSource/DiscImage_Amiga.pas @@ -9,6 +9,7 @@ function TDiscImage.ID_Amiga: Boolean; Checksum2 : Cardinal; ctr : Integer; temp : String; + look4root : Boolean; const DiscIDs : array[0..3] of String = ('DOS','PFS','KICK','KICKSUP'); begin @@ -27,38 +28,39 @@ function TDiscImage.ID_Amiga: Boolean; until (temp=DiscIDs[ctr]) or (ctr=High(DiscIDs)); if temp=DiscIDs[ctr] then begin - if Read32b($8,True)<>$370 then FBootBlock:=False; //No boot block - //Read the boot block checksum - if FBootBlock then + //Default directory type + FDirType :=$00; + //Get more details from the boot block disc ID + FMap :=IsBitSet(ReadByte($03),0); //AmigaDOS OFS/FFS + FDirType:=(ReadByte($03) AND $4)shr 2; //AmigaDOS DIRC + //Look at the checksum + if not FMap then //OFS should have a checksum begin Checksum1:=Read32b($4,True); - //And calculate what it should be - Checksum2:=AmigaBootChecksum($0); + //And calculate what it should be (only if non-zero) + if Checksum1<>0 then + Checksum2:=AmigaBootChecksum($0) + else + Checksum2:=0; end else begin - //No bootblock, so set both checksums to be the same + //FFS won't, so set both checksums to be the same Checksum1:=0; Checksum2:=0; end; - //And make sure they match if Checksum1=Checksum2 then begin - //Default directory type - FDirType :=$00; - //Get more details from the boot block, if there is one - if FBootBlock then - begin - FMap :=IsBitSet(ReadByte($03),0); //AmigaDOS OFS/FFS - FDirType:=(ReadByte($03) AND $4)shr 2; //AmigaDOS DIRC - end; inc(FDirType,$10); secsize :=$200; //Sector size + //Set up for a hard disc for now FFormat :=diAmiga<<4+$F; //Amiga format (hard disc) density :=0; //Hard disc - //Find the root - root:=$002; //Start search at sector 2 + //Find the root - this will actually be halfway through the disc + root:=(GetDataLength div secsize)div 2; + look4root:=False;//We're not looking at the moment repeat + if look4root then inc(root);//Next sector, if we are looking //Make sure the checksums are not equal Checksum1:=$00; Checksum2:=$FF; @@ -70,22 +72,30 @@ function TDiscImage.ID_Amiga: Boolean; //Rootblock Checksum Checksum1:=Read32b(root*secsize+$14,True); Checksum2:=AmigaChecksum(root*secsize); - end - else - //Check next sector - inc(root); + end; + //If we haven't found the root in the middle + if(Checksum1<>Checksum2)and(not look4root) then + begin + //Start at the beginning and work through + root:=1; + look4root:=True; + end; + //Carry on until we either find the root, or we reach the end of the code until (Checksum1=Checksum2) or (root*secsize+secsize>=GetDataLength); //Update the format. Anything else is a hard drive (already set) - if (Checksum1=Checksum2) and (root=$370) then + if Checksum1=Checksum2 then begin - FFormat :=diAmiga<<4; //Amiga format (DD) - density :=2; //Double Density - end; - if (Checksum1=Checksum2) and (root=$6E0) then - begin - FFormat :=diAmiga<<4+1; //Amiga format (HD) - density :=4; //High Density + if root=$370 then + begin + FFormat :=diAmiga<<4; //Amiga format (DD) + density :=2; //Double Density + end; + if root=$6E0 then + begin + FFormat :=diAmiga<<4+1; //Amiga format (HD) + density :=4; //High Density + end; end; //Set the disc size disc_size[0]:=root*secsize*2; @@ -112,11 +122,7 @@ function TDiscImage.ID_Amiga: Boolean; function TDiscImage.ReadAmigaDisc: TDisc; var d,ptr, - sectors, - maxetry : Integer; - fsm, - fsmptr : Cardinal; - b,c : Byte; + sectors : Integer; begin Result:=nil; //Initialise some variables @@ -129,48 +135,6 @@ function TDiscImage.ReadAmigaDisc: TDisc; disc_size[0]:=Cardinal(sectors)*secsize; //Disc name disc_name[0]:=ReadString(root*secsize+$1B1,-(root*secsize+$1B0)); - //Work out the free space - free_space[0]:=secsize*2; //Allow for the boot block, even if there isn't one - dec(sectors,2); //The first two sectors will still be allocated for one - //Free Space Map pointer - starts at the root block - fsmptr :=root*secsize+$13C; - //Maximum number of entries in the bitmap block - maxetry :=25; - while sectors>0 do - begin - ptr :=0; - repeat - //Get the next bitmap block - fsm:=Read32b(fsmptr+Cardinal(ptr),True)*secsize; - //Iterate through the bitmap block - if fsm>0 then - begin - for d:=4 to secsize do - begin - //Get the next map byte - b:=ReadByte(fsm+Cardinal(d)); - //Go through each bit in this byte - for c:=0 to 7 do - begin - //If a bit is set, that sector is free - if (IsBitSet(b,c)) and (sectors>0) then - inc(free_space[0],secsize); - //Take account of each sector - dec(sectors); - end; - end; - end; - //Next bitmap block pointer - inc(ptr,4); - until (fsm=0) or (ptr>=maxetry*4) or (sectors<=0); - //Get next Free Space Map pointer, if it is extended. - fsmptr:=Read32b(fsmptr+Cardinal(ptr))*secsize; - //Calculate the maximum number of entries - maxetry:=(secsize-4) div 4; - //If free space map pointer is 0, we have run out of bitmap blocks, so zero - //the sector count - if fsmptr=0 then sectors:=0; - end; //Create an entry for the root SetLength(Result,1); //Blank the values @@ -207,6 +171,8 @@ function TDiscImage.ReadAmigaDisc: TDisc; inc(d); //The length of disc will increase as more directories are found until d>=Length(Result); + //Get the free space map + ReadAmigaFSM; end; end; @@ -216,15 +182,9 @@ function TDiscImage.ReadAmigaDisc: TDisc; function TDiscImage.ReadAmigaDir(dirname: String; offset: Cardinal): TDir; var address, - i,att,a, + i, link,ent: Cardinal; Entry : TDirEntry; -const - attributes: array[0..31] of Char = - ('D','E','W','R','A','P','S','H', - 'd','e','w','r','d','e','w','r', - ' ',' ',' ',' ',' ',' ',' ',' ', - ' ',' ',' ',' ',' ',' ',' ',' '); begin //Initialise the return variable (this just stops the compiler from warning) Result.Directory:=''; @@ -238,6 +198,7 @@ function TDiscImage.ReadAmigaDir(dirname: String; offset: Cardinal): TDir; else Result.Directory:=ReadString(offset*secsize+$1B1,-ReadByte(offset*secsize+$1B0)); Result.Sector:=offset; + Result.BeenRead:=True; //Go through the hash table and find the entries. ent:=Read32b(offset*secsize+$0C,True); //Size of hash table if ent=0 then ent:=(secsize div 4)-56; //if 0, then it should be BSIZE/4 - 56 @@ -246,7 +207,6 @@ function TDiscImage.ReadAmigaDir(dirname: String; offset: Cardinal): TDir; //Get the sector of the next entry link:=Read32b(offset*secsize+$18+i*4,True); //Is entry found (0 if no entry) -// if link<>0 then while link<>0 do begin ResetDirEntry(Entry); @@ -256,24 +216,23 @@ function TDiscImage.ReadAmigaDir(dirname: String; offset: Cardinal): TDir; if Read32b(address+$14,True)=AmigaChecksum(address) then begin //Read in the details - Entry.Sector :=Read32b(address+$10,True); //Sector of the first data block + Entry.Sector :=link;//Read32b(address+$10,True); //Sector of the first data block Entry.Filename:=ReadString(address+$1B1,-ReadByte(address+$1B0)); Entry.Length :=Read32b(address+$144,True); Entry.Parent :=dirname; + Entry.TimeStamp:=FromAmigaTime(Read32b(address+$1A4,True), + Read32b(address+$1A8,True), + Read32b(address+$1AC,True)); + //Attributes + Entry.Attributes:=AmigaIntToStrAttr(Read32b(address+$140,True)); if Read32b(address+$1FC,True)=2 then //This is a directory begin //We'll use 'F' for directory, as 'D' is used for something else - Entry.Attributes:='F'; + Entry.Attributes:=Entry.Attributes+'F'; Entry.Filetype :='Directory'; Entry.Length :=secsize; - Entry.Sector :=link; //Sector will therefore point to the header + //Entry.Sector :=link; //Sector will therefore point to the header end; - //Attributes - att :=Read32b(address+$140,True); - for a:=0 to 31 do - if not IsBitSet(att,a) then - Entry.Attributes:=Entry.Attributes+attributes[a]; - RemoveSpaces(Entry.Attributes); //Not a directory - default. Will be determined later Entry.DirRef:=-1; //Add to the result @@ -312,40 +271,53 @@ function TDiscImage.AmigaChecksum(offset: Cardinal): Cardinal; function TDiscImage.ExtractAmigaFile(filename: String; var buffer: TDIByteArray): Boolean; var - source : Integer; - entry,dir, + entry,dir : Cardinal; +begin + Result:=False; + SetLength(buffer,0); + if FileExists(filename,dir,entry) then //Does the file actually exist? + if FDisc[dir].Entries[entry].Length>0 then //Is there anything to extract? + Result:=ExtractAmigaData(FDisc[dir].Entries[entry].Sector, + FDisc[dir].Entries[entry].Length, + buffer); +end; + +{------------------------------------------------------------------------------- +Read data following the hash table links +-------------------------------------------------------------------------------} +function TDiscImage.ExtractAmigaData(sector,filelen: Cardinal; + var buffer: TDIByteArray): Boolean; +var + source, dest, - fragptr,len, - filelen : Cardinal; + fragptr, + len : Cardinal; + links : TFragmentArray; begin + //Default return result Result:=False; - if FileExists(filename,fragptr) then //Does the file actually exist? - //Yes, so load it - there is nothing to stop a directory header being extracted - //if passed in the filename parameter. + //Set the buffer to the required length + SetLength(buffer,filelen); + //Get the links for the file + links:=GetAmigaChain(sector); + //If there are any, then continue + if Length(links)>0 then begin - //FileExists returns a pointer to the file - entry:=fragptr mod $10000; //Bottom 16 bits - entry reference - dir :=fragptr div $10000; //Top 16 bits - directory reference - //Make space to receive the file - filelen:=FDisc[dir].Entries[entry].Length; - SetLength(buffer,filelen); - //Get the starting position - fragptr:=Cardinal(FDisc[dir].Entries[entry].Sector); - dest :=0; //Length pointer/Destination pointer - repeat - //Fragmented filing system, so need to work out source and length - source:=Integer(fragptr*secsize)+$18; //Source of data - len :=Read32b(fragptr*secsize+$C,True);//Amount of data + dest:=0;//Length pointer/Destination pointer + for fragptr:=0 to Length(links)-1 do + begin + len:=links[fragptr].Length; + source:=links[fragptr].Offset*secsize; //Make sure we don't read too much - if dest+len>filelen then - len:=filelen-dest; + if filelen<>0 then if dest+len>filelen then len:=filelen-dest; + //Increase the space required + if dest+len>Length(buffer) then SetLength(buffer,dest+len); + if not FMap then inc(source,$18);//Move to where the data is //Read the data into the buffer - ReadDiscData(source,len,FDisc[dir].Entries[entry].Side,dest,buffer); + ReadDiscData(source,len,0,dest,buffer); //Move the size pointer on, by the amount read inc(dest,len); - //Get the next block pointer - fragptr:=Read32b(fragptr*secsize+$10,True); - until dest>=filelen; //Once we've reached the file length, we're done + end; end; Result:=True; end; @@ -354,58 +326,530 @@ function TDiscImage.ExtractAmigaFile(filename: String; Write a file to Amiga image -------------------------------------------------------------------------------} function TDiscImage.WriteAmigaFile(var file_details: TDirEntry; - var buffer: TDIByteArray): Integer; + var buffer: TDIByteArray): Integer; +var + index, + fragptr, + dir, + entry, + paraddr, + days, + mins, + ticks, + filelen : Cardinal; + header : TDIByteArray; + frag : TFragmentArray; + hdrblks, + datablks: array of Cardinal; +procedure WriteBlockToDisc(address: Cardinal); +var index: Cardinal; begin - Result:=-1; + //Write to the disc + for index:=0 to Length(header)-1 do + WriteByte(header[index],address+index); + //Update the checksum + Write32b(AmigaChecksum(address),address+$14,True); +end; +begin + ValidateAmigaFile(file_details.Filename); + Result:=-6; //Destination directory does not exist + //Ensure that the file does not alredy exist + if not FileExists(file_details.Parent+dir_sep+file_details.Filename,dir,entry) then + begin + Result:=-3; //File already exists + //Ensure that the parent exists + if FileExists(file_details.Parent,dir,entry) then + begin + Result:=-2; //Image full + //Get the parent address + if file_details.Parent=root_name then + begin + paraddr:=root; + dir:=0; + end + else paraddr:=FDisc[dir].Entries[entry].Sector; + //Has it been read in? + if not FDisc[dir].BeenRead then ReadDirectory(file_details.Parent); + //Work out the total number of space, including headers + filelen:=Length(buffer)+secsize; //At least one header + //OFS has 24 byte data headers for each block of data + if not FMap then inc(filelen,Ceil(Length(buffer)/(secsize-24))*24); + //One OFS file header has enough space for 72 pointers * $1E8 = $8940 bytes + if not FMap then inc(filelen,(Length(buffer)div$8940)*secsize); + //One FFS file header has enough space for 72 pointers * $200 = $9000 bytes + if FMap then inc(filelen,(Length(buffer)div$9000)*secsize); + //Ensure it is an exact multiple of sector size + filelen:=Ceil(filelen/secsize)*secsize; + //Find space + frag:=AmigaFindFreeSpace(filelen); + //If any was found, the go ahead and create the file header + if Length(frag)>0 then + begin + //Initialise our block addresses + SetLength(hdrblks,0); + SetLength(datablks,0); + //Split the fragments into header blocks and data blocks + for fragptr:=0 to Length(frag)-1 do + begin + if fragptr mod 73=0 then //File header or extended block + begin + SetLength(hdrblks,Length(hdrblks)+1); + hdrblks[Length(hdrblks)-1]:=frag[fragptr].Offset; + end; + if fragptr mod 73<>0 then //Data block + begin + SetLength(datablks,Length(datablks)+1); + datablks[Length(datablks)-1]:=frag[fragptr].Offset; + end; + end; + //Now go through each and prepare the headers + SetLength(header,secsize);//Prepare the header + //Header blocks + for fragptr:=0 to Length(hdrblks)-1 do + begin + //Clear the buffer area + for index:=0 to Length(header)-1 do header[index]:=0; + //Prepare block for writing + //Common ++++++++++++++++++++++++++++++++ + Write32b(hdrblks[fragptr],4,header,True); //Self pointer + if Length(datablks)<=72*(fragptr+1) then //Number of data block pointers here + Write32b(Length(datablks)-72*fragptr,8,header,True) + else + Write32b(72,8,header,True); + for index:=0 to 71 do //Data pointers + if index+(72*fragptr)0 then + begin + Write32b(16,0,header,True); //Primary Type + Write32b(hdrblks[0],$1F4,header,True); //File header block + end; + //Now write the block to disc + WriteBlockToDisc(hdrblks[fragptr]*secsize); + end; + //Data blocks + for fragptr:=0 to Length(datablks)-1 do + begin + //Clear the buffer area + for index:=0 to Length(header)-1 do header[index]:=0; + //Prepare block for writing + //Data block (OFS) ++++++++++++++++++++++ + if not FMap then + begin + Write32b(8,0,header,True); //Primary Type + Write32b(hdrblks[0],4,header,True); //Pointer to file header + Write32b(fragptr+1,8,header,True); //File data block number + if Length(buffer)-(fragptr*$1E8)<$1E8 then //Data length + Write32b(Length(buffer)-(fragptr*$1E8),$c,header,True) + else + Write32b($1E8,$c,header,True); + if fragptr+10 then + begin + //Prepare the header + SetLength(buffer,secsize); + //Clear it + for index:=0 to Length(buffer)-1 do buffer[index]:=0; + //Write the data + Write32b(2,0,buffer,True); //Primary Type + Write32b(2,$1FC,buffer,True); //Secondary Type + Write32b(frag[0].Offset,4,buffer,True);//Self pointer + Write32b(AmigaStrToIntAttr(attributes),$140,buffer,True);//Attributes + ToAmigaTime(Now,days,mins,ticks); + Write32b(days,$1A4,buffer,True); //Last access date - days + Write32b(mins,$1A8,buffer,True); //Last access time - mins + Write32b(ticks,$1AC,buffer,True); //Last access time - ticks + WriteByte(Length(dirname),$1B0,buffer);//Directory name length + WriteString(dirname,$1B1,30,0,buffer); //Directory name + Write32b(paraddr,$1F4,buffer,True); //Parent address + //Write to the disc + for index:=0 to Length(buffer)-1 do + WriteByte(buffer[index],frag[0].Offset*secsize+index); + //Update the checksum + Write32b(AmigaChecksum(frag[0].Offset*secsize),frag[0].Offset*secsize+$14,True); + //Add to the parent directory + AmigaAddToChain(dirname,paraddr,frag[0].Offset); + //Update our local copy + Result:=Length(FDisc[dir].Entries); + SetLength(FDisc[dir].Entries,Length(FDisc[dir].Entries)+1); + //Update our local FSM + AmigaFillFreeSpaceMap(frag[0].Offset*secsize,$FF); + //Write the fields + FDisc[dir].Entries[Result].Sector:=frag[0].Offset; + FDisc[dir].Entries[Result].Parent:=parent; + FDisc[dir].Entries[Result].Filename:=dirname; + FDisc[dir].Entries[Result].Attributes:='F'+attributes;//'F' is directory + FDisc[dir].Entries[Result].Timestamp:=Now; + FDisc[dir].Entries[Result].Length:=secsize; + FDisc[dir].Entries[Result].Filetype:='Directory'; + FDisc[dir].Entries[Result].DirRef:=Length(FDisc); //Reference to this directory + SetLength(FDisc,Length(FDisc)+1);//Make room + end; + end; + end; end; {------------------------------------------------------------------------------- -Retitle an Amiga directory +Create a new Amiga image - Floppy -------------------------------------------------------------------------------} -function TDiscImage.RetitleAmigaDirectory(filename,newtitle: String): Boolean; +function TDiscImage.FormatAmigaFDD(minor: Byte): TDisc; begin - Result:=False; + //Blank everything + ResetVariables; + SetDataLength(0); + //Set the format + //FFormat:=diAmiga<<4+minor; + //Start with blank result + Result:=nil; + SetLength(Result,0); + //Format the drive + case minor of + 0: FormatAmiga(880*1024); + 1: FormatAmiga(1760*1024); + end; + //Read it back in to set the rest up + if ID_Amiga then Result:=ReadAmigaDisc; + //Set the filename + imagefilename:='Untitled.'+FormatExt; end; {------------------------------------------------------------------------------- -Create a new Amiga image +Create a new Amiga image - Hard Disc -------------------------------------------------------------------------------} -function TDiscImage.FormatAmiga(minor: Byte): TDisc; +function TDiscImage.FormatAmigaHDD(harddrivesize: Cardinal): TDisc; begin + //Blank everything + ResetVariables; + SetDataLength(0); + //Set the format + //FFormat:=diAmiga<<4+$F; + //Start with blank result Result:=nil; SetLength(Result,0); + //Format the drive + FormatAmiga(harddrivesize); + //Read it back in to set the rest up + if ID_Amiga then Result:=ReadAmigaDisc; + //Set the filename + imagefilename:='Untitled.'+FormatExt; +end; + +{------------------------------------------------------------------------------- +Create a new Amiga image - generic +-------------------------------------------------------------------------------} +procedure TDiscImage.FormatAmiga(size: Cardinal); +var + index, + bmpsize, + fsmblock, + days, + mins, + ticks : Cardinal; + fsm : TDIByteArray; + fsmlist, + extlist : TFragmentArray; +begin + ResetVariables; + secsize:=$200; + //Round the size down to the nearest block size + size:=(size div secsize)*secsize; + //Then create it + SetDataLength(size); + //Now blank it + UpdateProgress('Formatting...'); + for index:=0 to size-1 do WriteByte(0,index); + //Set up the data areas + UpdateProgress('Initialising...'); + //Bootblock + WriteString('DOS',0,3,0); + //For sizes > 20MB (i.e. Hard Drives) we'll use FFS + if size>=20*1024*1024 then WriteByte(1,3); + //Rootblock + root:=(size div secsize)div 2; + Write32b($2,root*secsize,True); //Primary Type + Write32b($1,root*secsize+$1FC,True); //Secondar Type + Write32b($48,root*secsize+$C,True); //Hash Table Size + Write32b($FFFFFFFF,root*secsize+$138,True);//Valid bitmap (-1) + ToAmigaTime(Now,days,mins,ticks); + Write32b(days,root*secsize+$1A4,True); //Last access date + Write32b(days,root*secsize+$1D8,True); //Last access date + Write32b(days,root*secsize+$1E4,True); //Creation date + Write32b(mins,root*secsize+$1A8,True); //Last access time + Write32b(mins,root*secsize+$1DC,True); //Last access time + Write32b(mins,root*secsize+$1E8,True); //Creation time + Write32b(ticks,root*secsize+$1AC,True); //Last access time + Write32b(ticks,root*secsize+$1E0,True); //Last access time + Write32b(ticks,root*secsize+$1EC,True); //Creation time + WriteByte(Length(amigadisctitle),root*secsize+$1B0);//Length of disc name + WriteString(amigadisctitle,root*secsize+$1B1,30,0); //Disc name + //Bitmap block + bmpsize:=Ceil(((size-secsize*2)div secsize)/8); + //We'll create it all in a temporary store first + SetLength(fsm,bmpsize); + for index:=0 to bmpsize-1 do fsm[index]:=$FF; + //We have more than required + if bmpsize*8>(size-secsize*2)div secsize then + for index:=((size-secsize*2)div secsize)+1 to bmpsize*8 do + AmigaAllocateFSMBlock(index+2,True,fsm); + //Mark out the used blocks (i.e. Root) + AmigaAllocateFSMBlock(root,True,fsm); + //Write the FSM to disc + SetLength(fsmlist,Ceil(bmpsize/$1FC)); //We'll create our pointer list + if Length(fsmlist)>25 then //And our bitmap extensions list + SetLength(extlist,Ceil((Length(fsmlist)-25)/127)); + if Length(fsmlist)>0 then //Make sure something is there + begin + //First entry is after the root + for index:=1 to Length(fsmlist) do + begin + if index<26 then fsmblock:=root+index //Less than 25 blocks + else fsmblock:=root+index+1+((index-26)div 127)*127;//Make way for the ext blocks + //Allocate the space + AmigaAllocateFSMBlock(fsmblock,True,fsm); + //Write the markers to the root block and ext blocks + if index-1<25 then Write32b(fsmblock,root*secsize+$13C+((index-1)*4),True) + else Write32b(fsmblock,(root+26+((index-26)div 127)*127)*secsize+((index-26)*4),True); + //Make a note + fsmlist[index-1].Offset:=fsmblock; + end; + //Write out the pointers to the bitmap extension blocks + //(last word of each ext block points to the next, or 0 for last) + if Length(extlist)>0 then + begin + //Work out the locations and allocate the free space + for index:=0 to Length(extlist)-1 do + begin + extlist[index].Offset:=root+26+index*127; + AmigaAllocateFSMBlock(extlist[index].Offset,True,fsm); + end; + //Go through again and write the pointers + for index:=0 to Length(extlist)-1 do + //First will be in the rootblock + if index=0 then Write32b(extlist[index].Offset,root*secsize+$1A0,True) + else //Subsequent at the end of each ext block + if index+1-1 then + begin + //Has it been read in? + if not FDisc[FDisc[dir].Entries[entry].DirRef].BeenRead then + ReadDirectory(filename); + success:=True; + //Recusively delete the contents. + while(Length(FDisc[FDisc[dir].Entries[entry].DirRef].Entries)>0)and(success)do + success:=DeleteAmigaFile(filename+dir_sep + +FDisc[FDisc[dir].Entries[entry].DirRef].Entries[0].Filename); + end; + //Remove the entry from the chain + if AmigaRemoveFromChain(Copy(filename,Length(GetParent(dir))+2), + FDisc[dir].Sector, + FDisc[dir].Entries[entry].Sector) then + begin + //Now we can remove this and all related sectors from the FSM + fsmfrags:=AmigaReadBitmap(fsm);//Get the FSM + links:=GetAmigaChain(FDisc[dir].Entries[entry].Sector); //Get the chain + if Length(links)>0 then //Go through the chain and mark each one as free + for hashval:=0 to Length(links)-1 do + begin + AmigaAllocateFSMBlock(links[hashval].Offset,False,fsm); //Mark as free + AmigaFillFreeSpaceMap(links[hashval].Offset*secsize,$00);//Local copy + end; + AmigaWriteBitmap(fsmfrags,fsm);//Put the FSM back + //Update our local copy + if Length(FDisc[dir].Entries)>1 then + if entry=Length(FDisc) then exit(-12); + Result:=-11; //Source does not exist + if FileExists(filename,sdir,sentry) then + begin + if sdir=ddir then exit(-10);//Cannot move to the same directory + //Has it been read in? + if not FDisc[ddir].BeenRead then ReadDirectory(directory); + //Remove from the source + if AmigaRemoveFromChain(Copy(filename,Length(GetParent(sdir))+2), + FDisc[sdir].Sector, + FDisc[sdir].Entries[sentry].Sector) then + begin + //And then add to the destination + AmigaAddToChain(Copy(filename,Length(GetParent(sdir))+2), + FDisc[ddir].Sector, + FDisc[sdir].Entries[sentry].Sector); + //Take a note of this + file_details:=FDisc[sdir].Entries[sentry]; + //Update the local copies + if Length(FDisc[sdir].Entries)>1 then //First remove from the source + if sentry-1 then FDisc[file_details.DirRef].Parent:=ddir; + //Write to the array + FDisc[ddir].Entries[Result]:=file_details; + end; + end; + end; +end; + +{------------------------------------------------------------------------------- +Reads the Free Space Map +-------------------------------------------------------------------------------} +procedure TDiscImage.ReadAmigaFSM; +var + buffer : TDIByteArray; + fsmlist : TFragmentArray; + hashptr, + fragptr, + discaddr, + c,d : Cardinal; + bit : Byte; +begin + UpdateProgress('Reading Free Space Map'); + //Set up the variables + free_space[0]:=0; + secspertrack:=22;//Not used anywhere else + SetLength(free_space_map,1); + SetLength(free_space_map[0],disc_size[0]div(secsize*secspertrack)); + for c:=0 to Length(free_space_map[0])-1 do + begin + //Number of sectors per track + SetLength(free_space_map[0,c],secspertrack); + //Set them all to be used, for now. + for d:=0 to Length(free_space_map[0,c])-1 do free_space_map[0,c,d]:=$FF; + end; + //Set the first two sectors as system + free_space_map[0,0,0]:=$FE; + free_space_map[0,0,1]:=$FE; + AmigaFillFreeSpaceMap(disc_size[0]-1,$00); + //Read in the Free Space Map + fsmlist:=AmigaReadBitmap(buffer); + //Did we get anything? Mark off the systems areas on our copy + if Length(fsmlist)>0 then + for c:=0 to Length(fsmlist) do + AmigaFillFreeSpaceMap(fsmlist[c].Offset*secsize,$FE); + //Mark out the rest of our copy of the FSM + if Length(buffer)>0 then + begin + inc(free_space[0],secsize*2);//Take account of the boot block + //So, start at the beginning + hashptr:=0; + //And get each 32 bit word + while hashptr0 then + s:=(address mod (t*secspertrack*secsize))div secsize + else + s:=address div secsize; + //Make sure we haven't overshot the end of the disc + if t0 then + Result:=Result+1<0 do + begin + //Read in the pointer to the next fragment + fragptr:=Read32b(hashptr,True); + //If it is not zero + if fragptr<>0 then + begin + //Add to the fragment array + SetLength(Result,Length(Result)+1); + Result[Length(Result)-1].Offset:=fragptr; + //Increase our buffer length + SetLength(fsm,Length(fsm)+(secsize-4)); + //Read in the data + ReadDiscData((fragptr*secsize)+4,secsize-4,0,Length(fsm)-(secsize-4),fsm); + //Move onto the next hash pointer + inc(hashptr,4); + //If we reach the end of the root table, move onto the extended block + if hashptr=(root*secsize)+$1A0 then hashptr:=Read32b(hashptr,True)*secsize; + end; + end; + //Adjust the buffer length to match the disc size + if Length(fsm)>Ceil((disc_size[0]div secsize)/32)*4 then + SetLength(fsm,Ceil((disc_size[0]div secsize)/32)*4); +end; + +{------------------------------------------------------------------------------- +Write a supplied FSM to the disc +-------------------------------------------------------------------------------} +procedure TDiscImage.AmigaWriteBitmap(fsmlist: TFragmentArray;var fsm: TDIByteArray); +var + index: Cardinal; +begin + for index:=0 to Length(fsm)-1 do + WriteByte(fsm[index],fsmlist[index div$1FC].Offset*secsize+4+(index mod$1FC)); + //Sort out the checksums + for index:=0 to Length(fsmlist)-1 do + Write32b(AmigaChecksum(fsmlist[index].Offset*secsize),fsmlist[index].Offset*secsize,True); +end; + +{------------------------------------------------------------------------------- +Find and allocate some space for data +-------------------------------------------------------------------------------} +function TDiscImage.AmigaFindFreeSpace(filelen: Cardinal): TFragmentArray; +var + fsm : TDIByteArray; + fsmlist: TFragmentArray; + ptr, + count, + offset, + test : Cardinal; + bit : Byte; + direct : Boolean; +begin + Result:=nil; + //Initialise the return variable + SetLength(Result,0); + //Is there actually enough space? + if free_space[0]>=filelen then + begin + //Get the FSM + fsmlist:=AmigaReadBitmap(fsm); + //Find enough blocks for the data + count:=0; + ptr:=root-1; + direct:=False; //Going down + while count0)and(sector<>0)do //Continue until the termination block + begin + //Confirm the checksum + if Read32b(sector*secsize+$14,True)=AmigaChecksum(sector*secsize) then + begin + //Get the source and length of the next set of data + if FMap then //FFS + begin + source:=Read32b(sector*secsize+hashptr,True)*secsize;//Source of data + len:=secsize;//Amount of data + end + else //OFS + begin//We can do some sanity checks here, to confirm this is the right block + source:=Read32b(sector*secsize+hashptr,True)*secsize; //Read the pointer + if source<>0 then //Not zero, then valid + //Confirm the checksum + if Read32b(source+$14,True)=AmigaChecksum(source) then + begin + len:=Read32b(source+$C,True); //Get the length + inc(source,$18); //Data is here + end else exit; //Checksums don't match, so exit + end; + if len=0 then exit;//If the length returns zero, then quit + if(len>0)and(source<>0)then + begin + //Add a new entry + SetLength(Result,Length(Result)+1); + //And make a note of this link + Result[Length(Result)-1].Offset:=source div secsize; + Result[Length(Result)-1].Length:=len; + //Get the next block pointer + dec(hashptr,4); + if hashptr=$14 then //End of hash table, need to get the next link + begin + //Next extended file pointer table + sector:=Read32b(sector*secsize+$1F8,True); + hashptr:=$134; + end; + end; + end else exit; //Checksum doesn't match, so exit + end; +end; + +{------------------------------------------------------------------------------- +Add an entry to a hash chain +-------------------------------------------------------------------------------} +procedure TDiscImage.AmigaAddToChain(filename: String;paraddr,sector: Cardinal); +var + hashval, + fragptr, + index : Cardinal; +begin + //Blocks now written, add it to the parent + hashval:=AmigaCalculateHashValue(filename);//Calculate the hash value + //Add to the parent directory + fragptr:=$18+hashval*4; + //Read the current value + index:=Read32b(paraddr*secsize+fragptr,True); + //If not zero, follow the chain until it is zero + while index<>0 do + begin + paraddr:=index; + fragptr:=$1F0; + index:=Read32b(paraddr*secsize+fragptr,True); + end; + //Now we have an address at the end of the chain. + Write32b(sector,paraddr*secsize+fragptr,True); + //Update the checksum + Write32b(AmigaChecksum(paraddr*secsize),paraddr*secsize+$14,True); +end; + +{------------------------------------------------------------------------------- +Remove an entry from a hash chain +-------------------------------------------------------------------------------} +function TDiscImage.AmigaRemoveFromChain(filename: String;paraddr,sector: Cardinal):Boolean; +var + hashval, + link : Cardinal; +begin + Result:=False; + //Calulate the hash value + hashval:=AmigaCalculateHashValue(filename)*4+$18; + link:=Read32b(paraddr*secsize+hashval,True);//Start at the parent hash table + while(link<>sector)and(link<>0)do + begin + paraddr:=link; + hashval:=$1F0; + link:=Read32b(paraddr*secsize+hashval,True);//Now we check the chain link + end; + //Have we found our entry? + if link<>0 then + begin + //Copy the chain link from our file to this, thereby bypassing our header + Write32b(Read32b(sector*secsize+$1F0,True),paraddr*secsize+hashval,True); + //Don't forget the checksum + Write32b(AmigaChecksum(paraddr*secsize),paraddr*secsize+$14,True); + Result:=True; + end; +end; + +{------------------------------------------------------------------------------- +Validate an Amiga filename +-------------------------------------------------------------------------------} +procedure TDiscImage.ValidateAmigaFile(var filename: String); +var + index: Integer; +const + illegal = '/:'; begin - Result:=-1; + //Make sure it is no longer than 30 characters long + filename:=LeftStr(filename,30); + if Length(filename)>0 then //Change illegal characters + for index:=1 to Length(filename) do + if Pos(filename[index],illegal)>0 then filename[index]:='_'; + //If nothing was supplied, then supply something + if Length(filename)=0 then filename:='Unnamed'; end; diff --git a/LazarusSource/DiscImage_Published.pas b/LazarusSource/DiscImage_Published.pas index efcb146..e8e9746 100644 --- a/LazarusSource/DiscImage_Published.pas +++ b/LazarusSource/DiscImage_Published.pas @@ -24,6 +24,8 @@ constructor TDiscImage.Create; FScanSubDirs :=True; //Use short filenames in DOS even if long filenames exist FDOSUseSFN :=False; + //Open DOS Partitions on ADFS + FOpenDOSPart :=True; end; constructor TDiscImage.Create(Clone: TDiscImage); var @@ -289,7 +291,7 @@ function TDiscImage.FormatFDD(major:Word;minor:Byte=0;tracks: Byte=0;filename: S end; diAmiga://Create AmigaDOS begin - FDisc:=FormatAmiga(minor); + FDisc:=FormatAmigaFDD(minor); Result:=Length(FDisc)>0; end; diAcornUEF://Create CFS @@ -338,6 +340,11 @@ function TDiscimage.FormatHDD(major:Word;harddrivesize:Cardinal;newmap:Boolean; FDisc:=FormatDOS(harddrivesize,dirtype); Result:=Length(FDisc)>0; end; + diAmiga : //Create Amiga HDD + begin + FDisc:=FormatAmigaHDD(harddrivesize); + Result:=Length(FDisc)>0; + end; end; end; @@ -440,8 +447,7 @@ function TDiscImage.RetitleDirectory(var filename,newtitle: String): Boolean; Result:=RetitleADFSDirectory(filename,newtitle); diCommodore: exit;//Commodore doesn't have directories diSinclair : exit;//Sinclair/Amstrad doesn't have directories - diAmiga : //Retitle AmigaDOS directory - Result:=RetitleAmigaDirectory(filename,newtitle); + diAmiga : exit;//AmigaDOS does not have directory titles diAcornUEF : exit;//CFS doesn't have directories diAcornFS : exit;//Can't retitle AFS directories diDOSPlus : exit;//Can't retitle DOS directories @@ -1087,7 +1093,7 @@ function TDiscImage.TimeStampFile(filename:String;newtimedate:TDateTime):Boolean diAcornADFS: Result:=UpdateADFSTimeStamp(filename,newtimedate);//Update ADFS Timestamp diCommodore: exit;//Update Commodore 64/128 Timestamp diSinclair : exit;//Update Sinclair/Amstrad Timestamp - diAmiga : exit;//Update AmigaDOS Timestamp + diAmiga : Result:=UpdateAmigaTimeStamp(filename,newtimedate);//Update AmigaDOS Timestamp diAcornUEF : exit;//Update CFS Timestamp diAcornFS : Result:=UpdateAFSTimeStamp(filename,newtimedate);//Update AFS Timestamp diSpark : Result:=UpdateSparkTimeStamp(filename,newtimedate);//Update Spark Timestamp diff --git a/LazarusSource/HardDriveUnit.pas b/LazarusSource/HardDriveUnit.pas index 1c8d68a..605bbf8 100644 --- a/LazarusSource/HardDriveUnit.pas +++ b/LazarusSource/HardDriveUnit.pas @@ -61,7 +61,9 @@ THardDriveForm = class(TForm) OldMapLimit=512*1024*1024; //Old map drive limit = 512MB MB =1024*1024; //MegaByte public - ADFSHDD: Boolean; + ADFSHDD, + DOSHDD, + AmigaHDD: Boolean; end; var @@ -139,8 +141,20 @@ procedure THardDriveForm.FormShow(Sender: TObject); rb_OldDir.Enabled:=True; rb_BigDir.Enabled:=False; cb_NewMap.Checked:=False; - end - else + end; + if AmigaHDD then + begin + //Set capacity to 40MB + CapacitySlider.Position:=40; + //Set max to 1024MB + CapacitySlider.Max:=1024;//Maximum 500MB + CapacitySlider.Min:=20; //Minimum 20MB + CapacitySliderChange(Sender); + ADFSControls.Visible:=False; + DOSControls.Visible:=False; + Caption:='Create Amiga Hard Drive'; + end; + if DOSHDD then begin //Set capacity to 40MB CapacitySlider.Position:=40; diff --git a/LazarusSource/MainUnit.lfm b/LazarusSource/MainUnit.lfm index 268d329..f7a10f7 100755 --- a/LazarusSource/MainUnit.lfm +++ b/LazarusSource/MainUnit.lfm @@ -4699,7 +4699,7 @@ object MainForm: TMainForm object C64AttrPanel: TPanel Left = 1 Height = 50 - Top = 480 + Top = 504 Width = 353 Align = alTop BevelOuter = bvNone @@ -5256,7 +5256,7 @@ object MainForm: TMainForm object AFSAttrPanel: TPanel Left = 1 Height = 88 - Top = 392 + Top = 504 Width = 353 Align = alTop BevelOuter = bvNone @@ -5360,7 +5360,7 @@ object MainForm: TMainForm object DOSAttrPanel: TPanel Left = 1 Height = 21 - Top = 371 + Top = 504 Width = 353 Align = alTop BevelOuter = bvNone @@ -5434,6 +5434,279 @@ object MainForm: TMainForm ParentFont = False end end + object AmigaAttrPanel: TPanel + Left = 1 + Height = 150 + Top = 371 + Width = 353 + Align = alTop + BevelOuter = bvNone + ClientHeight = 150 + ClientWidth = 353 + TabOrder = 15 + Visible = False + OnPaint = FileInfoPanelPaint + object cb_Amiga_ownd: TCheckBox + Left = 128 + Height = 20 + Top = 16 + Width = 65 + Caption = 'Delete' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 0 + end + object cb_Amiga_owne: TCheckBox + Left = 190 + Height = 20 + Top = 16 + Width = 74 + Caption = 'Execute' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 1 + end + object cb_Amiga_ownw: TCheckBox + Left = 253 + Height = 20 + Top = 16 + Width = 59 + Caption = 'Write' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 2 + end + object cb_Amiga_ownr: TCheckBox + Left = 324 + Height = 20 + Top = 16 + Width = 56 + Caption = 'Read' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 3 + end + object cb_Amiga_pubd: TCheckBox + Tag = 1 + Left = 190 + Height = 20 + Top = 56 + Width = 65 + Caption = 'Delete' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 4 + end + object cb_Amiga_pube: TCheckBox + Tag = 1 + Left = 128 + Height = 20 + Top = 56 + Width = 74 + Caption = 'Execute' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 5 + end + object cb_Amiga_pubw: TCheckBox + Tag = 1 + Left = 253 + Height = 20 + Top = 56 + Width = 59 + Caption = 'Write' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 6 + end + object OAAttrLabelAmiga: TLabel + Left = 4 + Height = 16 + Top = 2 + Width = 170 + Alignment = taRightJustify + Caption = 'Attributes - Owner Access' + Font.Color = clBlue + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object PubAttrLabelAmiga: TLabel + Left = 6 + Height = 16 + Top = 32 + Width = 166 + Alignment = taRightJustify + Caption = 'Attributes - Public Access' + Font.Color = clBlue + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object cb_Amiga_pubr: TCheckBox + Tag = 2 + Left = 324 + Height = 20 + Top = 56 + Width = 56 + Caption = 'Read' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 7 + end + object OthAttrLabelAmiga: TLabel + Left = 15 + Height = 16 + Top = 78 + Width = 163 + Alignment = taRightJustify + Caption = 'Attributes - Other Access' + Font.Color = clBlue + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + object cb_Amiga_othd: TCheckBox + Left = 48 + Height = 20 + Top = 92 + Width = 65 + Caption = 'Delete' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 8 + end + object cb_Amiga_othe: TCheckBox + Left = 110 + Height = 20 + Top = 92 + Width = 74 + Caption = 'Execute' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 9 + end + object cb_Amiga_othw: TCheckBox + Left = 196 + Height = 20 + Top = 92 + Width = 59 + Caption = 'Write' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 10 + end + object cb_Amiga_othr: TCheckBox + Left = 264 + Height = 20 + Top = 92 + Width = 56 + Caption = 'Read' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 11 + end + object cb_Amiga_hold: TCheckBox + Left = 280 + Height = 20 + Top = 128 + Width = 53 + Caption = 'Hold' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 12 + end + object cb_Amiga_scri: TCheckBox + Left = 213 + Height = 20 + Top = 128 + Width = 61 + Caption = 'Script' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 13 + end + object cb_Amiga_pure: TCheckBox + Left = 126 + Height = 20 + Top = 128 + Width = 53 + Caption = 'Pure' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 14 + end + object cb_Amiga_arch: TCheckBox + Left = 44 + Height = 20 + Top = 128 + Width = 80 + Caption = 'Archived' + Font.Color = clBlack + Font.Name = 'Tahoma' + Font.Style = [fsBold] + OnClick = AttributeChangeClick + ParentFont = False + TabOrder = 15 + end + object MiscAttrLabelAmiga: TLabel + Left = 4 + Height = 16 + Top = 112 + Width = 170 + Alignment = taRightJustify + Caption = 'Attributes - Miscallaenous' + Font.Color = clBlue + Font.Name = 'Tahoma' + Font.Style = [fsBold] + ParentFont = False + end + end end object TextureTiles: TPanel Left = 0 @@ -32203,4 +32476,10 @@ object MainForm: TMainForm ShortCut = 27 end end + object HoverTimer: TTimer + Enabled = False + OnTimer = HoverTimerTimer + Left = 152 + Top = 344 + end end diff --git a/LazarusSource/MainUnit.pas b/LazarusSource/MainUnit.pas index dceea0e..276d82b 100755 --- a/LazarusSource/MainUnit.pas +++ b/LazarusSource/MainUnit.pas @@ -46,13 +46,15 @@ TMyTreeNode = class(TTreeNode) FParentDir : Integer; FIsDir, FBeenRead, - FBroken : Boolean; + FBroken, + FIsDOSPart : 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? + property IsDOSPart: Boolean read FIsDOSPart write FIsDOSPart;//This is the DOS Partition file end; //Form definition @@ -60,7 +62,24 @@ TMyTreeNode = class(TTreeNode) { TMainForm } type TMainForm = class(TForm) + AmigaAttrPanel: TPanel; AFSAttrPanel: TPanel; + cb_Amiga_othd: TCheckBox; + cb_Amiga_arch: TCheckBox; + cb_Amiga_othe: TCheckBox; + cb_Amiga_pure: TCheckBox; + cb_Amiga_hold: TCheckBox; + cb_Amiga_scri: TCheckBox; + cb_Amiga_ownr: TCheckBox; + cb_Amiga_othr: TCheckBox; + cb_Amiga_ownw: TCheckBox; + cb_Amiga_owne: TCheckBox; + cb_Amiga_ownd: TCheckBox; + cb_Amiga_othw: TCheckBox; + cb_Amiga_pubw: TCheckBox; + cb_Amiga_pubr: TCheckBox; + cb_Amiga_pubd: TCheckBox; + cb_Amiga_pube: TCheckBox; DOSAttributeLabel: TLabel; cb_DOS_archive: TCheckBox; DOSAttrPanel: TPanel; @@ -76,6 +95,11 @@ TMainForm = class(TForm) menuFixADFS: TMenuItem; menuDefrag: TMenuItem; menuChangeInterleave: TMenuItem; + OAAttrLabelAmiga: TLabel; + OthAttrLabelAmiga: TLabel; + MiscAttrLabelAmiga: TLabel; + PubAttrLabelAmiga: TLabel; + HoverTimer: TTimer; ToolBarContainer: TCoolBar; FilesToolBar: TToolBar; menuImage: TMenuItem; @@ -315,6 +339,7 @@ TMainForm = class(TForm) procedure CopyToClipboardExecute(Sender: TObject); procedure PasteFromClipboardExecute(Sender: TObject); procedure ToolBarContainerChange(Sender: TObject); + procedure HoverTimerTimer(Sender: TObject); //Misc procedure AddDirectoryToImage(dirname: String); procedure AddDirectoryToTree(CurrDir: TTreeNode; dir: Integer; @@ -324,7 +349,7 @@ TMainForm = class(TForm) function AddFileToImage(filename: String;filedetails: TDirEntry; buffer:TDIByteArray=nil;ignoreerror:Boolean=False):Integer; overload; function AddFileToTree(ParentNode: TTreeNode;importfilename: String; - index:Integer;dir:Boolean;Tree:TTreeView):TTreeNode; + index:Integer;dir:Boolean;Tree:TTreeView;IsDOSPart:Boolean):TTreeNode; procedure AddImageToTree(Tree: TTreeView;ImageToUse: TDiscImage); procedure AddSparkToImage(filename: String); procedure ArrangeFileDetails; @@ -361,6 +386,7 @@ TMainForm = class(TForm) procedure ReadInDirectory(Node: TTreeNode); procedure ReportError(error: String); procedure ResetFileFields; + procedure SaveConfigSettings; procedure SelectNode(filename: String;casesens:Boolean=True); procedure ShowErrorLog; procedure ShowInfo(info: String); @@ -435,6 +461,8 @@ TMainForm = class(TForm) ViewOptions :Cardinal; //Scan sub-directories on opening FScanSubDirs :Boolean; + //Open DOS Partitions on ADFS + FOpenDOS :Boolean; //What are we running on? platform, arch :String; @@ -527,7 +555,7 @@ TMainForm = class(TForm) DesignedDPI = 96; //Application Title ApplicationTitle = 'Disc Image Manager'; - ApplicationVersion = '1.42.1'; + ApplicationVersion = '1.43'; //Current platform and architecture (compile time directive) TargetOS = {$I %FPCTARGETOS%}; TargetCPU = {$I %FPCTARGETCPU%}; @@ -1047,9 +1075,11 @@ function TMainForm.AddFileToImage(filename:String;filedetails: TDirEntry; if(Image.FormatNumber>>4=diAcornADFS) //Need the selected directory for ADFS or(Image.FormatNumber>>4=diSpark) //And Spark or(Image.FormatNumber>>4=diAcornFS) //And Acorn FS + or(Image.FormatNumber>>4=diAmiga) //And Amiga or(Image.FormatNumber>>4=diDOSPlus)then//And DOS Plus if(DirList.Selected.Text='$') or(DirList.Selected.Text='AFS$') + or(DirList.Selected.Text='DF0:') or(DirList.Selected.Text='A:') or(DirList.Selected.Text='C:')then NewFile.Parent:=DirList.Selected.Text else @@ -1088,7 +1118,7 @@ function TMainForm.AddFileToImage(filename:String;filedetails: TDirEntry; if Result>-1 then //File added OK begin if Image.FormatNumber>>4<>diSpark then HasChanged:=True; - AddFileToTree(DirList.Selected,NewFile.Filename,Result,False,DirList); + AddFileToTree(DirList.Selected,NewFile.Filename,Result,False,DirList,False); UpdateImageInfo(side); end else @@ -1137,7 +1167,7 @@ function TMainForm.AddFileErrorToText(error: Integer):String; //Add a file or directory to the TTreeView, under ParentNode {------------------------------------------------------------------------------} function TMainForm.AddFileToTree(ParentNode: TTreeNode;importfilename: String; - index: Integer;dir: Boolean;Tree:TTreeView): TTreeNode; + index: Integer;dir: Boolean;Tree:TTreeView;IsDOSPart:Boolean): TTreeNode; begin Result:=nil; if(ParentNode=nil)or(index<0)then exit; @@ -1160,6 +1190,8 @@ function TMainForm.AddFileToTree(ParentNode: TTreeNode;importfilename: String; TMyTreeNode(Result).IsDir:=dir; //If this is not a directory, it will have no reference if not dir then TMyTreeNode(Result).DirRef:=-1; + //Set the DOS Partition flag + TMyTreeNode(Result).IsDOSPart:=IsDOSPart; Tree.Repaint; end; end; @@ -1545,19 +1577,21 @@ procedure TMainForm.OpenImage(filename: String); Application.ProcessMessages; //Close any open hex dump windows CloseAllHexDumps; - Image.ProgressIndicator:=@UpdateProgress; + Image.ProgressIndicator :=@UpdateProgress; //Update the interleave when loading - Image.InterleaveMethod:=ADFSInterleave; + Image.InterleaveMethod :=ADFSInterleave; //Treat Sparks as a filing system - Image.SparkAsFS:=SparkIsFS; + Image.SparkAsFS :=SparkIsFS; //Allow DFS to have zero number of sectors Image.AllowDFSZeroSectors:=FDFSZeroSecs; //Check for files going over the disc edge on DFS - Image.DFSBeyondEdge:=FDFSBeyondEdge; + Image.DFSBeyondEdge :=FDFSBeyondEdge; //Check for blank filenames in DFS - Image.DFSAllowBlanks:=FDFSAllowBlank; + Image.DFSAllowBlanks :=FDFSAllowBlank; //Scan sub directories - Image.ScanSubDirs:=FScanSubDirs; + Image.ScanSubDirs :=FScanSubDirs; + //Open DOS Partitions + Image.OpenDOSPartitions :=FOpenDOS; //Load the image and create the catalogue if Image.LoadFromFile(filename) then begin @@ -1632,16 +1666,18 @@ 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).BeenRead:=ImageToUse.Disc[dir].BeenRead; - TMyTreeNode(CurrDir).Broken :=ImageToUse.Disc[dir].Broken; + TMyTreeNode(CurrDir).IsDir :=True; + TMyTreeNode(CurrDir).DirRef :=dir; + TMyTreeNode(CurrDir).BeenRead :=ImageToUse.Disc[dir].BeenRead; + TMyTreeNode(CurrDir).Broken :=ImageToUse.Disc[dir].Broken; + TMyTreeNode(CurrDir).IsDOSPart:=False; //Iterate though all the entries for entry:=0 to Length(ImageToUse.Disc[dir].Entries)-1 do begin //Adding new nodes for each one Node:=AddFileToTree(CurrDir,ImageToUse.Disc[dir].Entries[entry].Filename, - entry,false,Tree{,ImageToUse}); + entry,false,Tree, + ImageToUse.Disc[dir].Entries[entry].isDOSPart); //If it is, indeed, a direcotry, the dir ref will point to the sub-dir if ImageToUse.Disc[dir].Entries[entry].DirRef>=0 then //and we'll recursively call ourself to add these entries @@ -1974,6 +2010,64 @@ procedure ArrangeComponent(c,p: TControl;l: TLabel); //And change the panel height to accomodate C64AttrPanel.Height:=cb_C64_l.Top+cb_C64_l.Height; end; + //Commodore Amiga + if Image.FormatNumber>>4=diAmiga then + begin + //Make it visible + AmigaAttrPanel.Visible:=True; + //Position it below the CRC32 section + AmigaAttrPanel.Top:=CRC32Panel.Top+CRC32Panel.Height; + //Position the ticks box inside - Owner Access + OAAttrLabelAmiga.Top:=0; + OAAttrLabelAmiga.Left:=(AmigaAttrPanel.Width-OAAttrLabelAmiga.Width)div 2; + cb_Amiga_ownd.Top:=OAAttrLabelAmiga.Top+OAAttrLabelAmiga.Height; + cb_Amiga_owne.Top:=cb_Amiga_ownd.Top; + cb_Amiga_ownw.Top:=cb_Amiga_ownd.Top; + cb_Amiga_ownr.Top:=cb_Amiga_ownd.Top; + cbpos:=AmigaAttrPanel.Width div 4; //Equally space them + cb_Amiga_ownd.Left:=cbpos*0; + cb_Amiga_owne.Left:=cbpos*1; + cb_Amiga_ownw.Left:=cbpos*2; + cb_Amiga_ownr.Left:=cbpos*3; + //Position the ticks box inside - Public Access + PubAttrLabelAmiga.Top:=cb_Amiga_ownd.Top+cb_Amiga_ownd.Height; + PubAttrLabelAmiga.Left:=(AmigaAttrPanel.Width-PubAttrLabelAmiga.Width)div 2; + cb_Amiga_pubd.Top:=PubAttrLabelAmiga.Top+PubAttrLabelAmiga.Height; + cb_Amiga_pube.Top:=cb_Amiga_pubd.Top; + cb_Amiga_pubw.Top:=cb_Amiga_pubd.Top; + cb_Amiga_pubr.Top:=cb_Amiga_pubd.Top; + cbpos:=AmigaAttrPanel.Width div 4; //Equally space them + cb_Amiga_pubd.Left:=cbpos*0; + cb_Amiga_pube.Left:=cbpos*1; + cb_Amiga_pubw.Left:=cbpos*2; + cb_Amiga_pubr.Left:=cbpos*3; + //Position the ticks box inside - Other access + OthAttrLabelAmiga.Top:=cb_Amiga_pubd.Top+cb_Amiga_pubd.Height; + OthAttrLabelAmiga.Left:=(AmigaAttrPanel.Width-OthAttrLabelAmiga.Width)div 2; + cb_Amiga_othd.Top:=OthAttrLabelAmiga.Top+OthAttrLabelAmiga.Height; + cb_Amiga_othe.Top:=cb_Amiga_othd.Top; + cb_Amiga_othw.Top:=cb_Amiga_othd.Top; + cb_Amiga_othr.Top:=cb_Amiga_othd.Top; + cbpos:=AmigaAttrPanel.Width div 4; //Equally space them + cb_Amiga_othd.Left:=cbpos*0; + cb_Amiga_othe.Left:=cbpos*1; + cb_Amiga_othw.Left:=cbpos*2; + cb_Amiga_othr.Left:=cbpos*3; + //Position the ticks box inside - Misc + MiscAttrLabelAmiga.Top:=cb_Amiga_othd.Top+cb_Amiga_othd.Height; + MiscAttrLabelAmiga.Left:=(AmigaAttrPanel.Width-MiscAttrLabelAmiga.Width)div 2; + cb_Amiga_hold.Top:=MiscAttrLabelAmiga.Top+MiscAttrLabelAmiga.Height; + cb_Amiga_scri.Top:=cb_Amiga_hold.Top; + cb_Amiga_pure.Top:=cb_Amiga_hold.Top; + cb_Amiga_arch.Top:=cb_Amiga_hold.Top; + cbpos:=AmigaAttrPanel.Width div 4; //Equally space them + cb_Amiga_hold.Left:=cbpos*0; + cb_Amiga_scri.Left:=cbpos*1; + cb_Amiga_pure.Left:=cbpos*2; + cb_Amiga_arch.Left:=cbpos*3; + //And change the panel height to accomodate + AmigaAttrPanel.Height:=cb_Amiga_hold.Top+cb_Amiga_hold.Height; + end; end; FileInfoPanel.Repaint; end; @@ -2227,6 +2321,27 @@ procedure TMainForm.DirListChange(Sender: TObject; Node: TTreeNode); cb_C64_l.Checked:=Pos('L',Image.Disc[dir].Entries[entry].Attributes)>0; cb_C64_c.Checked:=Pos('C',Image.Disc[dir].Entries[entry].Attributes)>0; end; + //Amiga + if Image.FormatNumber>>4=diAmiga then + begin + //Tick/untick them + cb_Amiga_ownw.Checked:=Pos('W',Image.Disc[dir].Entries[entry].Attributes)=0; + cb_Amiga_ownr.Checked:=Pos('R',Image.Disc[dir].Entries[entry].Attributes)=0; + cb_Amiga_ownd.Checked:=Pos('D',Image.Disc[dir].Entries[entry].Attributes)=0; + cb_Amiga_owne.Checked:=Pos('E',Image.Disc[dir].Entries[entry].Attributes)=0; + cb_Amiga_pubw.Checked:=Pos('w',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_pubr.Checked:=Pos('r',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_pubd.Checked:=Pos('d',Image.Disc[dir].Entries[entry].Attributes)=0; + cb_Amiga_pube.Checked:=Pos('e',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_othw.Checked:=Pos('i',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_othr.Checked:=Pos('a',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_othd.Checked:=Pos('l',Image.Disc[dir].Entries[entry].Attributes)=0; + cb_Amiga_othe.Checked:=Pos('x',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_arch.Checked:=Pos('A',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_pure.Checked:=Pos('P',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_scri.Checked:=Pos('S',Image.Disc[dir].Entries[entry].Attributes)>0; + cb_Amiga_hold.Checked:=Pos('H',Image.Disc[dir].Entries[entry].Attributes)>0; + end; DoNotUpdate :=False; //Re-enable the event firing //Filetype filetype:=Image.Disc[dir].Entries[entry].Filetype; @@ -2362,17 +2477,19 @@ procedure TMainForm.DirListChange(Sender: TObject; Node: TTreeNode); //Status bar UpdateImageInfo(Image.Disc[dir].Entries[entry].Side); //CRC32 - lb_CRC32.Caption:=Image.GetFileCRC(temp - +Image.GetDirSep(Image.Disc[dir].Partition) - +filename,entry); + if Image.Disc[dir].Entries[entry].DirRef=-1 then + lb_CRC32.Caption:=Image.GetFileCRC(temp + +Image.GetDirSep(Image.Disc[dir].Partition) + +filename,entry); //Parent RemoveTopBit(temp); lb_parent.Caption:=temp; - //Timestamp - ADFS, Spark, FileStore and DOS only + //Timestamp - ADFS, Spark, FileStore, Amiga and DOS only if (Image.Disc[dir].Entries[entry].TimeStamp>0) and((Image.FormatNumber>>4=diAcornADFS) or (Image.FormatNumber>>4=diSpark) or (Image.FormatNumber>>4=diAcornFS) + or (Image.FormatNumber>>4=diAmiga) or (Image.FormatNumber>>4=diDOSPlus))then lb_timestamp.Caption:=FormatDateTime(TimeDateFormat, Image.Disc[dir].Entries[entry].TimeStamp); @@ -2755,11 +2872,11 @@ procedure TMainForm.ParseCommandLine(cmd: String); const DiscFormats = //Accepted format strings 'DFSS DFSS40 DFSD DFSD40 WDFSS WDFSS40 WDFSD WDFSD40 ADFSS ADFSM '+ 'ADFSL ADFSD ADFSE ADFSE+ ADFSF ADFSF+ C1541 C1571 C1581 AMIGADD '+ - 'AMIGAHD CFS '; - const DiscNumber : array[1..22] of Integer = //Accepted format numbers + 'AMIGAHD CFS DOS+640 DOS+800 DOS360 DOS720 DOS1440 DOS2880 '; + const DiscNumber : array[1..28] of Integer = //Accepted format numbers ($001 ,$000 ,$011 ,$010 ,$021 ,$020 ,$031 ,$030 ,$100 ,$110, $120 ,$130 ,$140 ,$150 ,$160 ,$170 ,$200 ,$210 ,$220 ,$400, - $410 ,$500 ); + $410 ,$500 ,$A00 ,$A01 ,$A02 ,$A03 ,$A04 ,$A05); begin SetLength(fields,0); //Collate the parameters @@ -2841,7 +2958,7 @@ procedure TMainForm.ParseCommandLine(cmd: String); end; end; end; - if LeftStr(UpperCase(param),4)='AFSL' then //Create AFS + if LeftStr(UpperCase(param),4)='AFSL' then //Create AFS HDD if StrToIntDef(param2,0)>0 then //Need a second parameter begin //Get the image size @@ -2862,6 +2979,42 @@ procedure TMainForm.ParseCommandLine(cmd: String); ShowNewImage(Image.Filename); end; end; + if UpperCase(param)='DOSHDD' then //Create DOS HDD + begin + //Get the image size + harddrivesize:=StrToIntDef(param2,0); + //Has it been specified in Megabytes? + if UpperCase(RightStr(param2,1))='M' then harddrivesize:=harddrivesize*1024; + //Work the most appropriate FAT + if harddrivesize<33300 then dirtype:=diFAT16 else dirtype:=diFAT32; + //Is the specified image size big enough + if harddrivesize<20*1024 then harddrivesize:=20*1024; + //But not too big + if harddrivesize>1024*1024 then harddrivesize:=512*1024; + //Create it + if Image.FormatHDD(diDOSPlus,harddrivesize*1024,False,dirtype) then + begin + HasChanged:=True; + ShowNewImage(Image.Filename); + end; + end; + if UpperCase(param)='AMIGAHDD' then //Create Amiga HDD + begin + //Get the image size + harddrivesize:=StrToIntDef(param2,0); + //Has it been specified in Megabytes? + if UpperCase(RightStr(param2,1))='M' then harddrivesize:=harddrivesize*1024; + //Is the specified image size big enough + if harddrivesize<20*1024 then harddrivesize:=20*1024; + //But not too big + if harddrivesize>1024*1024 then harddrivesize:=512*1024; + //Create it + if Image.FormatHDD(diAmiga,harddrivesize*1024,False,0) then + begin + HasChanged:=True; + ShowNewImage(Image.Filename); + end; + end; if Pos(UpperCase(param),DiscFormats)>0 then //Create other begin index:=(Pos(UpperCase(param),DiscFormats) DIV 8)+1; @@ -3023,6 +3176,39 @@ procedure TMainForm.ParseCommandLine(cmd: String); HasChanged:=HasChanged OR r; end; end; + //Change configure option +++++++++++++++++++++++++++++++++++++++++++++++++++ + if(option='--config')or(option='-cf')then + begin + //Are there more options in the second parameter? + if Pos('|',param2)>0 then fields:=param2.Split('|'); + if Length(fields)>0 then param2:=fields[0]; + if Length(fields)>1 then + begin + param2:=LowerCase(param2); + fields[1]:=LowerCase(fields[1]); + if param2='trackorder' then //ADFS/AFS track order + begin + if fields[1]='auto' then ADFSInterleave:=0; + if fields[1]='seq' then ADFSInterleave:=1; + if fields[1]='int' then ADFSInterleave:=2; + if fields[1]='mux' then ADFSInterleave:=3; + end; + if(param2='dfs')and(Length(fields)>2)then //DFS Validation + begin + fields[2]:=LowerCase(fields[2]); + if fields[1]='over' then FDFSBeyondEdge:=fields[2]='true'; + if fields[1]='zero' then FDFSZeroSecs :=fields[2]='true'; + if fields[1]='blank' then FDFSAllowBlank:=fields[2]='true'; + end; + //Misc + if param2='inf' then DoCreateINF :=fields[1]='true'; + if param2='debug' then Fdebug :=fields[1]='true'; + if param2='compress' then FUEFCompress:=fields[1]='true'; + if param2='scan' then FScanSubDirs:=fields[1]='true'; + if param2='open' then FOpenDOS :=fields[1]='true'; + SaveConfigSettings; + end; + end; end; end; //Commands that do not require any parameters --------------------------------- @@ -3081,29 +3267,31 @@ procedure TMainForm.FormCreate(Sender: TObject); //Reset the form shift state FormShiftState:=[]; //Texture style - get from the registry - TextureType:=GetRegValI('Texture',1); + TextureType :=GetRegValI('Texture',1); //ADFS L Interleaved type - get from the registry ADFSInterleave:=GetRegValI('ADFS_L_Interleave',0); //Treat Spark as FS? - SparkIsFS:=GetRegValB('Spark_Is_FS',True); + SparkIsFS :=GetRegValB('Spark_Is_FS',True); //Threshold of when to bypass the GUI (during import) - get from registry bypassGUIThres:={GetRegValI('bypass_GUI_Threshold',}100;//); //Create INF Files? - DoCreateINF:=GetRegValB('CreateINF',True); + DoCreateINF :=GetRegValB('CreateINF',True); //Hide Commodore DEL files - DoHideDEL:=GetRegValB('Hide_CDR_DEL',False); + DoHideDEL :=GetRegValB('Hide_CDR_DEL',False); //Allow DFS images with zero sectors - FDFSZeroSecs:=GetRegValB('DFS_Zero_Sectors',False); + FDFSZeroSecs :=GetRegValB('DFS_Zero_Sectors',False); //Check for files going over the DFS disc edge FDFSBeyondEdge:=GetRegValB('DFS_Beyond_Edge',False); //Check for blank filenames in DFS FDFSAllowBlank:=GetRegValB('DFS_Allow_Blanks',False); //Compress UEF Files on save - FUEFCompress:=GetRegValB('UEF_Compress',True); + FUEFCompress :=GetRegValB('UEF_Compress',True); //Scan all sub directories on opening - FScanSubDirs:=GetRegValB('Scan_SubDirs',True); + FScanSubDirs :=GetRegValB('Scan_SubDirs',True); + //Open DOS Partitions on ADFS + FOpenDOS :=GetRegValB('Open_DOS',True); //View menu options - ViewOptions:=GetRegValI('View_Options',$FFFF); + ViewOptions :=GetRegValI('View_Options',$FFFF); //Toolbar order - this doesn't work currently { ToolBarContainer.Bands.Items[0]:=GetRegValS('ToolBar0','ImageToolBar'); ToolBarContainer.Bands.Items[1].Text:=GetRegValS('ToolBar1','FilesToolBar'); @@ -3600,7 +3788,7 @@ procedure TMainForm.ImportFiles(NewImage: TDiscImage;Dialogue: Boolean=True); //Then add it to the tree, if successful if index>=0 then AddFileToTree(DirList.Selected,newentry.Filename,index,False, - DirList) + DirList,False) else //Failed to write the file ReportError('Failed when '+method+' '+newentry.Parent+NewImage.DirSep +newentry.Filename @@ -3800,6 +3988,7 @@ procedure TMainForm.lb_timestampClick(Sender: TObject); if(Image.FormatNumber>>4=diAcornADFS) or(Image.FormatNumber>>4=diAcornFS) or(Image.FormatNumber>>4=diDOSPlus) + or(Image.FormatNumber>>4=diAmiga) or(Image.FormatNumber>>4=diSpark)then begin //Get the references @@ -4325,7 +4514,7 @@ procedure TMainForm.btn_AddPasswordClick(Sender: TObject); if index>=0 then begin HasChanged:=True; - AddFileToTree(DirList.Selected,'Passwords',index,False,DirList); + AddFileToTree(DirList.Selected,'Passwords',index,False,DirList,False); UpdateImageInfo; end else @@ -4551,7 +4740,10 @@ procedure TMainForm.btn_NewDirectoryClick(Sender: TObject); inc(x); dirname:=dirname+IntToStr(x); //Create the directory - CreateDirectory(dirname,'DLR'); + if Image.FormatNumber>>4<>diAmiga then + CreateDirectory(dirname,'DLR') + else + CreateDirectory(dirname,''); //Create with no protection flags for Amiga end; {------------------------------------------------------------------------------} @@ -4597,15 +4789,16 @@ procedure TMainForm.btn_SaveAsCSVClick(Sender: TObject); //And each entry in that directory for entry:=0 to Length(Image.Disc[dir].Entries)-1 do //write out each entry - WriteLine(F,'"'+Image.GetParent(dir)+'","' - +Image.Disc[dir].Entries[entry].Filename+'","' - +IntToHex(Image.Disc[dir].Entries[entry].LoadAddr,hexlen)+'","' - +IntToHex(Image.Disc[dir].Entries[entry].ExecAddr,hexlen)+'","' - +IntToHex(Image.Disc[dir].Entries[entry].Length,hexlen)+'","' - +Image.Disc[dir].Entries[entry].Attributes+'","' - +Image.GetFileCRC(Image.GetParent(dir) - +Image.GetDirSep(Image.Disc[dir].Partition) - +Image.Disc[dir].Entries[entry].Filename)+'"'); + if Image.Disc[dir].Entries[entry].DirRef=-1 then + WriteLine(F,'"'+Image.GetParent(dir)+'","' + +Image.Disc[dir].Entries[entry].Filename+'","' + +IntToHex(Image.Disc[dir].Entries[entry].LoadAddr,hexlen)+'","' + +IntToHex(Image.Disc[dir].Entries[entry].ExecAddr,hexlen)+'","' + +IntToHex(Image.Disc[dir].Entries[entry].Length,hexlen)+'","' + +Image.Disc[dir].Entries[entry].Attributes+'","' + +Image.GetFileCRC(Image.GetParent(dir) + +Image.GetDirSep(Image.Disc[dir].Partition) + +Image.Disc[dir].Entries[entry].Filename)+'"'); //Finally free up the file stream F.Free; //Close the progress window @@ -4636,13 +4829,14 @@ procedure TMainForm.btn_SettingsClick(Sender: TObject); //ADFS Interleaving SettingsForm.InterleaveGroup.ItemIndex:=ADFSInterleave; //Miscellaneous - SettingsForm.CreateINF.Checked:=DoCreateInf; - SettingsForm.WriteDebug.Checked:=Fdebug; - SettingsForm.AllowDFSZeroSecs.Checked:=FDFSZeroSecs; - SettingsForm.DFSBeyondEdge.Checked:=FDFSBeyondEdge; + SettingsForm.CreateINF.Checked :=DoCreateInf; + SettingsForm.WriteDebug.Checked :=Fdebug; + SettingsForm.AllowDFSZeroSecs.Checked :=FDFSZeroSecs; + SettingsForm.DFSBeyondEdge.Checked :=FDFSBeyondEdge; SettingsForm.AllowDFSBlankFilenames.Checked:=FDFSAllowBlank; - SettingsForm.CompressUEF.Checked:=FUEFCompress; - SettingsForm.ScanSubDirs.Checked:=FScanSubDirs; + SettingsForm.CompressUEF.Checked :=FUEFCompress; + SettingsForm.ScanSubDirs.Checked :=FScanSubDirs; + SettingsForm.OpenDOS.Checked :=FOpenDOS; //Show the form, modally SettingsForm.ShowModal; if SettingsForm.ModalResult=mrOK then @@ -4662,15 +4856,9 @@ procedure TMainForm.btn_SettingsClick(Sender: TObject); FDFSAllowBlank:=SettingsForm.AllowDFSBlankFilenames.Checked; FUEFCompress :=SettingsForm.CompressUEF.Checked; FScanSubDirs :=SettingsForm.ScanSubDirs.Checked; + FOpenDOS :=SettingsForm.OpenDOS.Checked; //Save the settings - SetRegValI('Texture',TextureType); - SetRegValI('ADFS_L_Interleave',ADFSInterleave); - SetRegValB('CreateINF',DoCreateINF); - SetRegValB('Debug_Mode',Fdebug); - SetRegValB('DFS_Zero_Sectors',FDFSZeroSecs); - SetRegValB('DFS_Beyond_Edge',FDFSBeyondEdge); - SetRegValB('DFS_Allow_Blanks',FDFSAllowBlank); - SetRegValB('Scan_SubDirs',FScanSubDirs); + SaveConfigSettings; //Change the tile under the filetype if DirList.SelectionCount=1 then DirListChange(Sender,DirList.Selected); //Repaint the main form @@ -4678,6 +4866,23 @@ procedure TMainForm.btn_SettingsClick(Sender: TObject); end; end; +{------------------------------------------------------------------------------} +//Saves the configuration settings to the registry +{------------------------------------------------------------------------------} +procedure TMainForm.SaveConfigSettings; +begin + SetRegValI('Texture', TextureType); + SetRegValI('ADFS_L_Interleave',ADFSInterleave); + SetRegValB('CreateINF', DoCreateINF); + SetRegValB('Debug_Mode', Fdebug); + SetRegValB('DFS_Zero_Sectors', FDFSZeroSecs); + SetRegValB('DFS_Beyond_Edge', FDFSBeyondEdge); + SetRegValB('DFS_Allow_Blanks', FDFSAllowBlank); + SetRegValB('Scan_SubDirs', FScanSubDirs); + SetRegValB('Open_DOS', FOpenDOS); + SetRegValB('UEF_Compress', FUEFCompress); +end; + {------------------------------------------------------------------------------} //The context menu has been requested, so cancel any drag drop operations {------------------------------------------------------------------------------} @@ -4819,6 +5024,7 @@ procedure TMainForm.DirListCustomDrawItem(Sender: TCustomTreeView; TV.Font.Style:=[fsBold,fsItalic]; //Only concerned if it is selected, or a directory not read in, or broken if(cdsSelected in State) + or(TMyTreeNode(Node).IsDOSPart) or(((not TMyTreeNode(Node).BeenRead) or(TMyTreeNode(Node).Broken))and(TMyTreeNode(Node).IsDir))then begin @@ -4866,6 +5072,13 @@ procedure TMainForm.DirListCustomDrawItem(Sender: TCustomTreeView; Brush.Style:=bsClear; Font.Color:=clBlue; end; + //Change the colour - file is the DOS Partition + if TMyTreeNode(Node).isDOSPart then + begin + //Directories not read in + Brush.Style:=bsClear; + Font.Color:=clGreen; + end; //Change the colour - directory broken if(TMyTreeNode(Node).Broken)and(TMyTreeNode(Node).IsDir)then begin @@ -4952,12 +5165,13 @@ function TMainForm.CreateDirectory(dirname, attr: String): TTreeNode; //Mark as changed if Image.FormatNumber>>4<>diSpark then HasChanged:=True; //Create the node as a file - Node:=AddFileToTree(DirList.Selected,dirname,index,True,DirList); + Node:=AddFileToTree(DirList.Selected,dirname,index,True,DirList,False); //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; + TMyTreeNode(Node).Broken:=False; + TMyTreeNode(Node).IsDOSPart:=False; //Update the image UpdateImageInfo; //Select the new node @@ -5117,8 +5331,10 @@ procedure TMainForm.DirListMouseMove(Sender: TObject; Shift: TShiftState; X, begin //Highlight it Dst.Selected:=True; - //Expand the folder tree - Dst.Expand(False); + //Reset the timer + HoverTimer.Enabled:=False; + //And start it off again, so that there is a delay before expanding the node + HoverTimer.Enabled:=True; end; end; //See if we have created an image to move, if not then do so @@ -5212,6 +5428,17 @@ procedure TMainForm.DirListMouseMove(Sender: TObject; Shift: TShiftState; X, end; end; +{------------------------------------------------------------------------------} +//User has hovered over item, so expand +{------------------------------------------------------------------------------} +procedure TMainForm.HoverTimerTimer(Sender: TObject); +begin + if Dst<>nil then + if Dst.Selected then + Dst.Expand(False); + HoverTimer.Enabled:=False; +end; + {------------------------------------------------------------------------------} //Determine whether to copy or move {------------------------------------------------------------------------------} @@ -5372,7 +5599,7 @@ procedure TMainForm.DoCopyMove(copymode: Boolean); end; end; NewNode:=AddFileToTree(Dst,Image.Disc[dir].Entries[entry].Filename, - index,TMyTreeNode(DraggedItem).IsDir,DirList{,Image}); + index,TMyTreeNode(DraggedItem).IsDir,DirList,False); //Did we just copy a directory? if TMyTreeNode(DraggedItem).IsDir then begin @@ -5442,7 +5669,7 @@ procedure TMainForm.btn_NewImageClick(Sender: TObject); major : Word; minor, tracks : Byte; - ok : Boolean; + ok,hdd : Boolean; index : Integer; filename : String; begin @@ -5453,6 +5680,7 @@ procedure TMainForm.btn_NewImageClick(Sender: TObject); //If Create was clicked, then create a new image if NewImageForm.ModalResult=mrOK then begin + CloseAllHexDumps; //From this point, all loaded data will be dumped //Get the main format major:=$FFF; case NewImageForm.MainFormat.ItemIndex of @@ -5503,36 +5731,48 @@ procedure TMainForm.btn_NewImageClick(Sender: TObject); ProgressForm.Show; Application.ProcessMessages; Image.ProgressIndicator:=@UpdateProgress; + hdd:=False; //ADFS Hard Drive if(major=diAcornADFS)and(minor=8)then + begin ok:=Image.FormatHDD(diAcornADFS, NewImageForm.harddrivesize, NewImageForm.newmap, - NewImageForm.dirtype) - else //AFS - if major=diAcornFS then - begin - //Create the format - ok:=Image.FormatHDD(diAcornFS, - NewImageForm.AFSImageSize.Position*10*1024, - False, - 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 //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,filename); + NewImageForm.dirtype); + hdd:=True; + end; + //AFS HardDrive + if major=diAcornFS then + begin + //Create the format + ok:=Image.FormatHDD(diAcornFS, + NewImageForm.AFSImageSize.Position*10*1024, + False,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'); + hdd:=True; + end; + //DOS Hard Drive + if(major=diDOSPlus)and(minor=6)then + begin + ok:=Image.FormatHDD(major,NewImageForm.harddrivesize,False, + NewImageForm.fat); + hdd:=True; + end; + //Amiga Hard Drive + if(major=diAmiga)and(minor=2)then + begin + ok:=Image.FormatHDD(major,NewImageForm.harddrivesize,False,0); + hdd:=True; + end; + //Floppy Drive + if not hdd then + ok:=Image.FormatFDD(major,minor,tracks,filename); + //All OK, so load the new image if ok then begin - CloseAllHexDumps; if major<>diSpark then HasChanged:=True; ShowNewImage(Image.Filename); //This updates the status bar end @@ -5616,7 +5856,29 @@ procedure TMainForm.AttributeChangeClick(Sender: TObject); if cb_DOS_system.Checked then att:=att+'S'; if cb_DOS_archive.Checked then att:=att+'A'; end; - if TMyTreeNode(DirList.Selected).IsDir then att:=att+'D'; + //Attributes - Amiga + if Image.FormatNumber>>4=diAmiga then + begin + if not cb_Amiga_ownd.Checked then att:=att+'D'; + if not cb_Amiga_owne.Checked then att:=att+'E'; + if not cb_Amiga_ownw.Checked then att:=att+'W'; + if not cb_Amiga_ownr.Checked then att:=att+'R'; + if cb_Amiga_arch.Checked then att:=att+'A'; + if cb_Amiga_pure.Checked then att:=att+'P'; + if cb_Amiga_scri.Checked then att:=att+'S'; + if cb_Amiga_hold.Checked then att:=att+'H'; + if not cb_Amiga_pubd.Checked then att:=att+'d'; + if cb_Amiga_pube.Checked then att:=att+'e'; + if cb_Amiga_pubw.Checked then att:=att+'w'; + if cb_Amiga_pubr.Checked then att:=att+'r'; + if not cb_Amiga_othd.Checked then att:=att+'l'; + if cb_Amiga_othe.Checked then att:=att+'x'; + if cb_Amiga_othw.Checked then att:=att+'i'; + if cb_Amiga_othr.Checked then att:=att+'a'; + end; + //Add the directory attribute + if TMyTreeNode(DirList.Selected).IsDir then + if Image.FormatNumber>>4<>diAmiga then att:=att+'D' else att:=att+'F'; //Get the file path filepath:=GetFilePath(DirList.Selected); //Update the attributes for the file @@ -5680,7 +5942,7 @@ procedure TMainForm.DeleteFile(confirm: Boolean); var j, nodes : Integer; - R : Boolean; + R,ok : Boolean; filepath: String; begin if DirList.SelectionCount>0 then @@ -5688,7 +5950,8 @@ procedure TMainForm.DeleteFile(confirm: Boolean); //Take a note of the number of selections nodes:=DirList.SelectionCount; //Go through all the selections (or the only one) - while DirList.SelectionCount>0 do + ok:=True; + while(DirList.SelectionCount>0)and(ok)do begin //Get the full path to the file filepath:=GetFilePath(DirList.Selections[0]); @@ -5698,7 +5961,9 @@ procedure TMainForm.DeleteFile(confirm: Boolean); else R:=True; //If so, then delete if R then - if Image.DeleteFile(filepath) then + begin + ok:=Image.DeleteFile(filepath); + if ok then begin if Image.FormatNumber>>4<>diSpark then HasChanged:=True; //Update the status bar @@ -5724,6 +5989,7 @@ procedure TMainForm.DeleteFile(confirm: Boolean); HexDumpMenu.Items[j].Free; end; end; + end else ok:=False; end; end; end; @@ -6063,6 +6329,7 @@ procedure TMainForm.ResetFileFields; DFSAttrPanel.Visible :=False; C64AttrPanel.Visible :=False; DOSAttrPanel.Visible :=False; + AmigaAttrPanel.Visible:=False; //And untick them cb_ADFS_ownw.Checked:=False; cb_ADFS_ownr.Checked:=False; diff --git a/LazarusSource/NewImageUnit.pas b/LazarusSource/NewImageUnit.pas index 9e53ba1..768804a 100755 --- a/LazarusSource/NewImageUnit.pas +++ b/LazarusSource/NewImageUnit.pas @@ -101,7 +101,8 @@ procedure TNewImageForm.MainFormatClick(Sender: TObject); //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=2) //C64 + OR(MainFormat.ItemIndex=4) //Amiga OR(MainFormat.ItemIndex=5) //CFS OR(MainFormat.ItemIndex=6) //Spark OR(MainFormat.ItemIndex=7) //AFS @@ -150,11 +151,14 @@ procedure TNewImageForm.btn_OKClick(Sender: TObject); begin ok:=True; //Are we creating a hard drive? - if((MainFormat.ItemIndex=1)AND(ADFS.ItemIndex=8)) //ADFS - or((MainFormat.ItemIndex=8)AND(DOS.ItemIndex=6))then //DOS + if((MainFormat.ItemIndex=1)AND(ADFS.ItemIndex=8)) //ADFS + or((MainFormat.ItemIndex=8)AND(DOS.ItemIndex=6)) //DOS + or((MainFormat.ItemIndex=4)AND(Amiga.ItemIndex=2))then//Amiga begin //Then we need to open the additional dialogue to configure this - HardDriveForm.ADFSHDD:=MainFormat.ItemIndex=1; //Set to ADFS or DOS + HardDriveForm.ADFSHDD :=MainFormat.ItemIndex=1; //Set to ADFS + HardDriveForm.DOSHDD :=MainFormat.ItemIndex=8; //Set to DOS + HardDriveForm.AmigaHDD:=MainFormat.ItemIndex=4; //Set to Amiga HardDriveForm.ShowModal; ok:=HardDriveForm.ModalResult=mrOK; if ok then @@ -169,8 +173,14 @@ procedure TNewImageForm.btn_OKClick(Sender: TObject); dirtype:=diADFSOldDir; if HardDriveForm.rb_NewDir.Checked then dirtype:=diADFSNewDir; if HardDriveForm.rb_BigDir.Checked then dirtype:=diADFSBigDir; - end - else //DOS Specific + end; + if MainFormat.ItemIndex=4 then //Amiga Specific + begin + {fat:=diFAT12; + if HardDriveForm.rb_FAT16.Checked then fat:=diFAT16; + if HardDriveForm.rb_FAT32.Checked then fat:=diFAT32;} + end; + if MainFormat.ItemIndex=8 then //DOS Specific begin fat:=diFAT12; if HardDriveForm.rb_FAT16.Checked then fat:=diFAT16; @@ -194,7 +204,6 @@ procedure TNewImageForm.AFSImageSizeChange(Sender: TObject); AFSImageSize.Position:=Round((Ceil((AFSImageSize.Position*10)/1024)*1024)/10); AFSImageSizeLabel.Caption:=IntToStr(Ceil((AFSImageSize.Position*10)/1024))+'MB'; end; - //Label is not updating on Windows end; {------------------------------------------------------------------------------- diff --git a/LazarusSource/SettingsUnit.lfm b/LazarusSource/SettingsUnit.lfm index fc94c41..fb458c9 100644 --- a/LazarusSource/SettingsUnit.lfm +++ b/LazarusSource/SettingsUnit.lfm @@ -1,12 +1,12 @@ object SettingsForm: TSettingsForm Left = 485 - Height = 412 + Height = 429 Top = 137 Width = 448 BorderIcons = [] BorderStyle = bsDialog Caption = 'Preferences' - ClientHeight = 412 + ClientHeight = 429 ClientWidth = 448 Color = 15527148 OnPaint = FormPaint @@ -45,7 +45,7 @@ object SettingsForm: TSettingsForm Width = 81 Caption = 'RISC OS 5' Checked = True - TabOrder = 0 + TabOrder = 3 TabStop = True end object TileRO4: TRadioButton @@ -54,7 +54,7 @@ object SettingsForm: TSettingsForm Top = 120 Width = 81 Caption = 'RISC OS 4' - TabOrder = 1 + TabOrder = 2 end object NoTile: TRadioButton Left = 12 @@ -62,7 +62,7 @@ object SettingsForm: TSettingsForm Top = 8 Width = 52 Caption = 'None' - TabOrder = 2 + TabOrder = 0 end object TilePictureRO3: TImage Left = 8 @@ -78,7 +78,7 @@ object SettingsForm: TSettingsForm Top = 120 Width = 81 Caption = 'RISC OS 3' - TabOrder = 3 + TabOrder = 1 end object TilePictureIyonix: TImage Left = 260 @@ -116,18 +116,18 @@ object SettingsForm: TSettingsForm object CancelButton: TBitBtn Left = 224 Height = 30 - Top = 376 + Top = 392 Width = 100 Cancel = True Caption = 'Cancel' Color = 15527148 ModalResult = 2 - TabOrder = 1 + TabOrder = 5 end object OKBtnBack: TPanel Left = 340 Height = 30 - Top = 376 + Top = 392 Width = 100 BevelColor = clYellow BevelInner = bvLowered @@ -137,7 +137,7 @@ object SettingsForm: TSettingsForm ClientWidth = 100 Color = clYellow ParentColor = False - TabOrder = 2 + TabOrder = 4 object OKButton: TBitBtn Left = 0 Height = 30 @@ -173,17 +173,17 @@ object SettingsForm: TSettingsForm 'Interleaved (0,80,1,81,2,82,...)' 'Multiplexed (0,2,4,...1,3,5,...)' ) - TabOrder = 3 + TabOrder = 1 end object MiscGroup: TGroupBox Left = 0 - Height = 72 + Height = 96 Top = 288 Width = 440 Caption = 'Miscellaneous' - ClientHeight = 53 + ClientHeight = 77 ClientWidth = 430 - TabOrder = 4 + TabOrder = 3 object CreateINF: TCheckBox Left = 4 Height = 18 @@ -200,7 +200,7 @@ object SettingsForm: TSettingsForm Top = 32 Width = 186 Caption = 'Write Debugging Information' - TabOrder = 1 + TabOrder = 2 end object CompressUEF: TCheckBox Left = 228 @@ -210,7 +210,7 @@ object SettingsForm: TSettingsForm Caption = 'Compress UEF Images' Checked = True State = cbChecked - TabOrder = 2 + TabOrder = 1 end object ScanSubDirs: TCheckBox Left = 228 @@ -222,6 +222,16 @@ object SettingsForm: TSettingsForm State = cbChecked TabOrder = 3 end + object OpenDOS: TCheckBox + Left = 4 + Height = 18 + Top = 56 + Width = 191 + Caption = 'Open DOS Partitions on ADFS' + Checked = True + State = cbChecked + TabOrder = 4 + end end object DFSGroup: TGroupBox Left = 224 @@ -231,7 +241,7 @@ object SettingsForm: TSettingsForm Caption = 'DFS Validation' ClientHeight = 85 ClientWidth = 214 - TabOrder = 5 + TabOrder = 2 object DFSBeyondEdge: TCheckBox Left = 4 Height = 18 diff --git a/LazarusSource/SettingsUnit.pas b/LazarusSource/SettingsUnit.pas index 56549c0..d3b5ec2 100644 --- a/LazarusSource/SettingsUnit.pas +++ b/LazarusSource/SettingsUnit.pas @@ -35,6 +35,7 @@ TSettingsForm = class(TForm) AllowDFSZeroSecs: TCheckBox; AllowDFSBlankFilenames: TCheckBox; CancelButton: TBitBtn; + OpenDOS: TCheckBox; ScanSubDirs: TCheckBox; DFSBeyondEdge: TCheckBox; DFSGroup: TGroupBox; diff --git a/README.md b/README.md index b9fdbd7..7013234 100644 --- a/README.md +++ b/README.md @@ -11,7 +11,7 @@ Disc Image Manager is an application used to load a retro disc image, read the c • Commodore 1541 (not 40 track) - Read and Write
• Commodore 1571 - Read and Write
• Commodore 1581 - Read and Write
-• Commodore AmigaDOS floppy and hard discs - Read Only
+• Commodore AmigaDOS floppy and hard discs - OFS and FFS: Read and Write (not fully tested with FFS). No Directory cache or international character support as yet, and no support for rigid disk stuctures.
Currently working on:
• Making Commodore AmigaDOS writable
• Sinclair Spectrum +3 and Amstrad images
@@ -28,6 +28,6 @@ In addition, I've developed a RISC OS sprite to bitmap/PNG converter here (https
Project was written in Lazarus (https://www.lazarus-ide.org). Binaries are available for macOS 32 and 64 bit, Windows 32 and 64 bit, Linux 32 and 64 bit, and Raspbian 32 bit (Linux ARM 32 bit). Full source is available if you wish to compile for other systems.

-You might like to also check out the thread on Stardot (https://stardot.org.uk/forums/viewtopic.php?f=12&t=21252) concerning this project.
+You might like to also check out the thread on Stardot (https://stardot.org.uk/forums/viewtopic.php?f=12&t=21252) concerning this project. I have also put this onto the English Amiga Board (http://eab.abime.net/index.php).

If you want, you can support this project, and others, by buying me a coffee (or a tea/beer/rum/etc.): https://ko-fi.com/geraldholdsworth
diff --git a/binaries/Linux/Disc Image Manager 32 bit.zip b/binaries/Linux/Disc Image Manager 32 bit.zip index bf71396..09480d8 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 92717de..4964ca7 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 4ca5e5b..be506e8 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 a29c22a..638d1af 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 9dbe782..56af77a 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 619d92a..71beccb 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 0ed4b37..6dad103 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 9ea8feb..a4a7f7c 100644 Binary files a/binaries/macOS/Disc Image Manager.dmg and b/binaries/macOS/Disc Image Manager.dmg differ