diff --git a/LazarusSource/DiscImage.pas b/LazarusSource/DiscImage.pas index fa20378..d85801d 100755 --- a/LazarusSource/DiscImage.pas +++ b/LazarusSource/DiscImage.pas @@ -166,6 +166,10 @@ TFileEntry = record diFSMDir = $FD; diFSMSystem = $FE; diFSMUsed = $FF; + //Streamed (read-only) backend - windowed page cache + diStreamPageSize = 65536; //64 KB per cache page + diStreamPageCount = 64; //Number of cache pages (~4 MB resident) + diStreamThreshold = $80000000; //2 GiB - default streamed-load size threshold //TSpark class definition type @@ -368,18 +372,32 @@ TPartition = record //Details about the partition TPartitions = array of TPartition; //Fragment TFragment = record //For retrieving the ADFS E/F fragment information - Offset, + Offset : Int64; //Byte offset into the image (can exceed 4GB) Length, Zone : Cardinal; end; //To collate fragments (ADFS/CDR/Amiga/AFS) TFragmentArray= array of TFragment; + //A single resident page of the streamed (read-only) backend cache + TDIPage = record + Tag : Int64; //Page-aligned file offset, -1 when the slot is empty + LastUse : QWord; //FPageClock value when last accessed (for LRU eviction) + Data : TDIByteArray; //diStreamPageSize bytes of image data + end; //Provides feedback TProgressProc = procedure(Fupdate: String) of Object; private FDisc : TDisc; //Container for the entire catalogue FPartitions : TPartitions; //Container for the entire catalogue (partitioned) Fdata : TDIByteArray; //Container for the image to be loaded into + //Streamed (read-only) backend - used when the image is too large for RAM + FStreamed : Boolean; //True when the image is served from the file on demand + FBackStream : TFileStream; //Backing file, kept open for the image lifetime + FBackSize : Int64; //Authoritative image length when streamed + FBackTemp : String; //Temp file to delete on close ('' if none) + FPageCache : array of TDIPage; //Windowed read-through cache (streamed mode) + FPageClock : QWord; //Monotonic counter driving LRU eviction + FStreamThreshold: Int64; //Size at/above which images are streamed (0=never) FDSD, //Double sided flag (Acorn DFS) FMap, //Old/New Map flag (Acorn ADFS) OFS/FFS (Amiga) FBootBlock, //Is disc an AmigaDOS Kickstart? @@ -450,6 +468,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati root_name, //Root title dosrootname, //DOS Plus root name imagefilename, //Filename of the disc image + FLoadError, //Reason the last load failed (e.g. too large) FFilename : String; //Copy of above, but doesn't get wiped dir_sep : Char; //Directory Separator free_space_map: TSide; //Free Space Map @@ -462,6 +481,8 @@ TFragment = record //For retrieving the ADFS E/F fragment informati SparkFile : TSpark; //For reading in Spark archives FDSKImage : TDSKImage; //For reading in Sinclair/Amstrad DSK files ISOVolDes : array of TISOVolDes;//ISO Volume Descriptors + FBitmapIndex : array of TFragmentArray;//Pre-built ADFS new-map lookup index + FBitmapIndexValid : Boolean; //True once FBitmapIndex is populated //Disc title for new images Fdisctitle, Fafsdisctitle, //AFS has longer titles @@ -489,33 +510,41 @@ TFragment = record //For retrieving the ADFS E/F fragment informati buffer: TDIByteArray); overload; function RISCOSToTimeDate(filedatetime: Int64): TDateTime; function TimeDateToRISCOS(delphitime: TDateTime): Int64; - function Read32b(offset: Cardinal; bigendian: Boolean=False): Cardinal; - function Read32b(offset: Cardinal; var buffer: TDIByteArray; + function Read32b(offset: Int64; bigendian: Boolean=False): Cardinal; + function Read32b(offset: Int64; var buffer: TDIByteArray; bigendian: Boolean=False): Cardinal; overload; - function Read24b(offset: Cardinal; bigendian: Boolean=False): Cardinal; - function Read24b(offset: Cardinal; var buffer: TDIByteArray; + function Read24b(offset: Int64; bigendian: Boolean=False): Cardinal; + function Read24b(offset: Int64; var buffer: TDIByteArray; bigendian: Boolean=False): Cardinal; overload; - function Read16b(offset: Cardinal; bigendian: Boolean=False): Word; - function Read16b(offset: Cardinal; var buffer: TDIByteArray; + function Read16b(offset: Int64; bigendian: Boolean=False): Word; + function Read16b(offset: Int64; var buffer: TDIByteArray; bigendian: Boolean=False): Word; overload; - function ReadByte(offset: Cardinal): Byte; - function ReadByte(offset: Cardinal; var buffer: TDIByteArray): Byte; overload; + function ReadByte(offset: Int64): Byte; + function ReadByte(offset: Int64; var buffer: TDIByteArray): Byte; overload; + function ReadByteBackend(offset: Int64): Byte; + function ShouldStream(filesize: Int64): Boolean; + function OpenStreamed(filename: String): Boolean; + procedure CloseStream; + function FileStartsGZip(filename: String): Boolean; + function SizeOfFile(filename: String): Int64; + function CountGZipMembers(filename: String): Integer; + function InflateGZipToFile(srcfile,destfile: String): Boolean; procedure RemoveDirectory(dirref: Cardinal); - function DiscAddrToIntOffset(disc_addr: Cardinal): Cardinal; - procedure Write32b(value, offset: Cardinal; bigendian: Boolean=False); - procedure Write32b(value, offset: Cardinal; var buffer: TDIByteArray; + function DiscAddrToIntOffset(disc_addr: Int64): Int64; + procedure Write32b(value: Cardinal; offset: Int64; bigendian: Boolean=False); + procedure Write32b(value: Cardinal; offset: Int64; var buffer: TDIByteArray; bigendian: Boolean=False); overload; - procedure Write24b(value, offset: Cardinal; bigendian: Boolean=False); - procedure Write24b(value, offset: Cardinal; var buffer: TDIByteArray; + procedure Write24b(value: Cardinal; offset: Int64; bigendian: Boolean=False); + procedure Write24b(value: Cardinal; offset: Int64; var buffer: TDIByteArray; bigendian: Boolean=False); overload; - procedure Write16b(value: Word; offset: Cardinal; bigendian: Boolean=False); - procedure Write16b(value: Word; offset: Cardinal; var buffer: TDIByteArray; + procedure Write16b(value: Word; offset: Int64; bigendian: Boolean=False); + procedure Write16b(value: Word; offset: Int64; var buffer: TDIByteArray; bigendian: Boolean=False); overload; - procedure WriteByte(value: Byte; offset: Cardinal); - procedure WriteByte(value: Byte; offset: Cardinal; + procedure WriteByte(value: Byte; offset: Int64); + procedure WriteByte(value: Byte; offset: Int64; var buffer: TDIByteArray); overload; - function GetDataLength: Cardinal; - procedure SetDataLength(newlen: Cardinal); + function GetDataLength: Int64; + procedure SetDataLength(newlen: Int64); function ROR13(v: Cardinal): Cardinal; procedure ResetDir(var Entry: TDir); function MapFlagToByte: Byte; @@ -549,6 +578,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati buffer: TDIByteArray): Byte; overload; function NewDiscAddrToOffset(addr: Cardinal; offset: Boolean=True): TFragmentArray; + procedure BuildADFSBitmapIndex; function OffsetToOldDiscAddr(offset: Cardinal): Cardinal; function ByteChecksum(offset,size: Cardinal;newmap: Boolean): Byte; function ByteChecksum(offset,size: Cardinal;newmap: Boolean; @@ -992,7 +1022,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati function MoveFile(filename,directory: String): Integer; function MoveFile(source: Cardinal;dest: Integer): Integer; overload; function ReadDirectory(dirname: String): Integer; - function ReadDiscData(addr,count,side,offset: Cardinal; + function ReadDiscData(addr,count: Int64; side: Cardinal; offset: Int64; var buffer: TDIByteArray): Boolean; procedure ReadImage; function ReadPasswordFile: TUserAccounts; @@ -1016,7 +1046,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati function UpdateVersionString(version: String): Boolean; procedure ValidateAttributes(var attributes: String); function ValidateFilename(parent:String;var filename:String): Boolean; - function WriteDiscData(addr,side: Cardinal;var buffer: TDIByteArray; + function WriteDiscData(addr: Int64; side: Cardinal;var buffer: TDIByteArray; count: Cardinal;start: Cardinal=0): Boolean; function WriteFile(var file_details: TDirEntry; var buffer: TDIByteArray;ShowFSM: Boolean=False): Integer; @@ -1072,6 +1102,7 @@ TFragment = record //For retrieving the ADFS E/F fragment informati property MajorFormatNumber: Word read GetMajorFormatNumber; property MapType: Byte read MapFlagToByte; property MapTypeString: String read MapTypeToString; + property LoadErrorMessage: String read FLoadError; property MaxDirectoryEntries: Cardinal read FMaxDirEnt; property MinorFormatNumber: Byte read GetMinorFormatNumber; property OpenDOSPartitions: Boolean read FOpenDOSPart @@ -1083,6 +1114,9 @@ TFragment = record //For retrieving the ADFS E/F fragment informati property RootName: String read root_name; property ScanSubDirs: Boolean read FScanSubDirs write FScanSubDirs; + property Streamed: Boolean read FStreamed; + property StreamThreshold: Int64 read FStreamThreshold + write FStreamThreshold; property Sectors: Byte read secspertrack; property SparkAsFS: Boolean read FSparkAsFS write FSparkAsFS; diff --git a/LazarusSource/DiscImageContext.pas b/LazarusSource/DiscImageContext.pas index ced37af..cf4f106 100644 --- a/LazarusSource/DiscImageContext.pas +++ b/LazarusSource/DiscImageContext.pas @@ -275,11 +275,14 @@ function TRegistrySettings.GetBool(const Key: String; Default: Boolean): Boolean end; procedure TRegistrySettings.SetBool(const Key: String; Value: Boolean); +var + i: Integer; + s: String; begin - if Value then - FSettings.Values[Key] := 'true' - else - FSettings.Values[Key] := 'false'; + if Value then s := 'true' else s := 'false'; + i := FSettings.IndexOfName(Key); + if i >= 0 then FSettings.Delete(i); + FSettings.Add(Key + '=' + s); FModified := True; end; @@ -295,8 +298,12 @@ function TRegistrySettings.GetInt(const Key: String; Default: Integer): Integer; end; procedure TRegistrySettings.SetInt(const Key: String; Value: Integer); +var + i: Integer; begin - FSettings.Values[Key] := IntToStr(Value); + i := FSettings.IndexOfName(Key); + if i >= 0 then FSettings.Delete(i); + FSettings.Add(Key + '=' + IntToStr(Value)); FModified := True; end; @@ -308,8 +315,12 @@ function TRegistrySettings.GetString(const Key: String; const Default: String): end; procedure TRegistrySettings.SetString(const Key: String; const Value: String); +var + i: Integer; begin - FSettings.Values[Key] := Value; + i := FSettings.IndexOfName(Key); + if i >= 0 then FSettings.Delete(i); + FSettings.Add(Key + '=' + Value); FModified := True; end; diff --git a/LazarusSource/DiscImage_ADFS.pas b/LazarusSource/DiscImage_ADFS.pas index b2d9a1e..b100c2f 100644 --- a/LazarusSource/DiscImage_ADFS.pas +++ b/LazarusSource/DiscImage_ADFS.pas @@ -747,6 +747,62 @@ function TDiscImage.CalculateADFSDirCheck(sector:Cardinal;buffer:TDIByteArray): XOR ((dircheck>> 8)AND$FF); end; +{------------------------------------------------------------------------------- +Build a lookup index of all ADFS new-map fragment entries. +Called once per disc load; thereafter NewDiscAddrToOffset uses O(1) lookup +instead of scanning all nzones zones for every file. +-------------------------------------------------------------------------------} +procedure TDiscImage.BuildADFSBitmapIndex; +const + dr_size = $40; + header = 4; +var + zone : Cardinal; + i,j : Cardinal; + allmap: Cardinal; + start : Cardinal; + id : Cardinal; + off : Int64; //Byte offset into the image (can exceed 4GB on large discs) + len : Cardinal; + n : Integer; +begin + FBitmapIndexValid:=False; + SetLength(FBitmapIndex,0); + if not FMap then exit; + if(idlen=0)or(bpmb=0)or(disc_size[0]=0)then exit; + SetLength(FBitmapIndex,1 shl idlen); + for zone:=0 to nzones-1 do + begin + start :=bootmap+dr_size; + allmap:=(zone+1)*secsize*8-dr_size*8; + i :=zone*secsize*8; + if zone>0 then dec(i,dr_size*8-header*8); + repeat + off:=i; + id :=ReadBits(start,i,idlen); + inc(i,idlen); + j:=i; + while(j0) + and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j); + while(j0 then + begin + off:=((off-(zone_spare*zone))*Int64(bpmb)) mod Int64(disc_size[0]); + n:=Length(FBitmapIndex[id]); + SetLength(FBitmapIndex[id],n+1); + FBitmapIndex[id][n].Offset:=off; + FBitmapIndex[id][n].Length:=len; + FBitmapIndex[id][n].Zone :=zone; + end; + inc(i); + until i>=allmap; + end; + FBitmapIndexValid:=True; +end; + {------------------------------------------------------------------------------- Convert an ADFS New Map address to buffer offset address, with fragment lengths -------------------------------------------------------------------------------} @@ -759,7 +815,7 @@ function TDiscImage.NewDiscAddrToOffset(addr: Cardinal; id : Cardinal=0; allmap : Cardinal=0; len : Cardinal=0; - off : Cardinal=0; + off : Int64=0; //Byte offset into the image (can exceed 4GB) zone : Cardinal=0; start : Cardinal=0; start_zone : Cardinal=0; @@ -795,7 +851,16 @@ function TDiscImage.NewDiscAddrToOffset(addr: Cardinal; sector:=addr mod $100; //Sector needs to have 1 subtracted, if >=1 if sector>=1 then dec(sector); - //Go through the allocation map, looking for the fragment + //Fast path: use pre-built index when available (offset=True only) + if FBitmapIndexValid and offset then + begin + Result:=Copy(FBitmapIndex[fragid]); + if Length(Result)>0 then + for i:=0 to Length(Result)-1 do + inc(Result[i].Offset,sector*secsize); + exit; + end; + //Slow path: scan the allocation map zone by zone //First we need to know how many ids per zone there are (max) id_per_zone:=((secsize*8)-zone_spare)div(idlen+1); //Then work out the start zone @@ -820,11 +885,16 @@ function TDiscImage.NewDiscAddrToOffset(addr: Cardinal; id:=ReadBits(start,i,idlen); //and move the pointer on idlen bits inc(i,idlen); - //Now find the end of the fragment entry - j:=i-1; - repeat - inc(j); - until(IsBitSet(ReadByte(start+(j div 8)),j mod 8))or(j>=allmap); + //Now find the end of the fragment entry. + //Byte-at-a-time scan (up to 8x faster than bit-by-bit for large allocations): + // Phase 1: bit-by-bit until byte-aligned (at most 7 bits) + // Phase 2: skip zero bytes 8 bits at a time + // Phase 3: bit-by-bit within the last non-zero byte (at most 8 bits) + j:=i; + while(j0) + and not IsBitSet(ReadByte(start+(j shr 3)),j and 7)do inc(j); + while(jnil then - if offset=0)and(offset=0)and(offset=0)and(offset=0)and(offset=0)and(offset0 then FBackStream.Read(FPageCache[slot].Data[0],cnt); + except + //Read failure - mark the slot empty and bail out + FPageCache[slot].Tag:=-1; + exit; + end; + //Zero any tail beyond the end of the file so stale data isn't returned + for i:=cnt to diStreamPageSize-1 do FPageCache[slot].Data[i]:=0; + FPageCache[slot].Tag:=page; + end; + //Touch for LRU and return the requested byte + inc(FPageClock); + FPageCache[slot].LastUse:=FPageClock; + Result:=FPageCache[slot].Data[offset-page]; +end; + +{------------------------------------------------------------------------------- +Decide whether an image of the given size should be streamed from disc rather +than loaded entirely into RAM. +-------------------------------------------------------------------------------} +function TDiscImage.ShouldStream(filesize: Int64): Boolean; +begin + //Beyond the 32-bit addressable range it must be streamed + if filesize>=$100000000 then exit(True); + //Otherwise stream when at/above the configured threshold (0 disables this) + Result:=(FStreamThreshold>0)and(filesize>=FStreamThreshold); +end; + +{------------------------------------------------------------------------------- +Open an image for streamed (read-only) access, leaving Fdata empty. +-------------------------------------------------------------------------------} +function TDiscImage.OpenStreamed(filename: String): Boolean; +var + i: Integer; +begin + Result:=False; + try + FBackStream:=TFileStream.Create(filename,fmOpenRead or fmShareDenyNone); + except + FBackStream:=nil; + exit; + end; + FBackSize:=FBackStream.Size; + FStreamed:=True; + //No in-RAM copy is held + SetLength(Fdata,0); + //Initialise the windowed page cache + SetLength(FPageCache,diStreamPageCount); + for i:=0 to diStreamPageCount-1 do + begin + SetLength(FPageCache[i].Data,diStreamPageSize); + FPageCache[i].Tag :=-1; + FPageCache[i].LastUse:=0; + end; + FPageClock:=0; + Result:=True; +end; + +{------------------------------------------------------------------------------- +Release the streamed backing store (if any) and return to in-RAM mode. +-------------------------------------------------------------------------------} +procedure TDiscImage.CloseStream; +begin + if FBackStream<>nil then FreeAndNil(FBackStream); + SetLength(FPageCache,0); + FStreamed:=False; + FBackSize:=0; + //Remove any temporary (decompressed) file we created + if FBackTemp<>'' then + begin + if SysUtils.FileExists(FBackTemp) then SysUtils.DeleteFile(FBackTemp); + FBackTemp:=''; + end; +end; + +{------------------------------------------------------------------------------- +Peek at a file's first bytes to see if it is GZip compressed +-------------------------------------------------------------------------------} +function TDiscImage.FileStartsGZip(filename: String): Boolean; +var + F : TFileStream=nil; + sig : array[0..2] of Byte=(0,0,0); +begin + Result:=False; + try + F:=TFileStream.Create(filename,fmOpenRead or fmShareDenyNone); + if F.Size>=3 then Result:=F.Read(sig[0],3)=3; + except + Result:=False; + end; + if F<>nil then F.Free; + Result:=Result and(sig[0]=$1F)and(sig[1]=$8B)and(sig[2]=$08); +end; + +{------------------------------------------------------------------------------- +Return the size of a file, in bytes (0 if it cannot be opened) +-------------------------------------------------------------------------------} +function TDiscImage.SizeOfFile(filename: String): Int64; +var + F: TFileStream=nil; +begin + Result:=0; + try + F:=TFileStream.Create(filename,fmOpenRead or fmShareDenyNone); + Result:=F.Size; + except + Result:=0; + end; + if F<>nil then F.Free; +end; + +{------------------------------------------------------------------------------- +Count the number of GZip members in a file, by scanning for the signature. +Streamed (bounded memory) so it works on large compressed files. Uses the same +'1F 8B 08' heuristic as Inflate, so routing stays consistent. +-------------------------------------------------------------------------------} +function TDiscImage.CountGZipMembers(filename: String): Integer; +var + F : TFileStream=nil; + buf : array of Byte=nil; + n : Integer=0; + i : Integer=0; + prev1 : Integer=-1; //Previous byte + prev2 : Integer=-1; //Byte before that +const + chunk = 65536; +begin + Result:=0; + try + F:=TFileStream.Create(filename,fmOpenRead or fmShareDenyNone); + SetLength(buf,chunk); + repeat + n:=F.Read(buf[0],chunk); + for i:=0 to n-1 do + begin + if(prev2=$1F)and(prev1=$8B)and(buf[i]=$08)then inc(Result); + prev2:=prev1; + prev1:=buf[i]; + end; + until nnil then F.Free; +end; + +{------------------------------------------------------------------------------- +Decompress a single-member GZip file straight to another file, in chunks, so +no more than a chunk is held in memory at once. Returns False on failure. +-------------------------------------------------------------------------------} +function TDiscImage.InflateGZipToFile(srcfile,destfile: String): Boolean; +var + GZ : TGZFileStream=nil; + FO : TFileStream=nil; + buf : array of Byte=nil; + cnt : Integer=0; +const + chunk = 65536; +begin + Result:=False; + SetLength(buf,chunk); + try + GZ:=TGZFileStream.Create(srcfile,gzOpenRead); + FO:=TFileStream.Create(destfile,fmCreate); + repeat + cnt:=GZ.Read(buf[0],chunk); + if cnt>0 then FO.Write(buf[0],cnt); + until cntnil then GZ.Free; + if FO<>nil then FO.Free; +end; + {------------------------------------------------------------------------------- Rotate Right 13 bits -------------------------------------------------------------------------------} @@ -963,8 +1185,19 @@ function TDiscImage.Inflate(filename: String): TDIByteArray; //Read in the entire file try F:=TFileStream.Create(filename,fmOpenRead or fmShareDenyNone); - SetLength(buffer,F.Size); - F.Read(buffer[0],F.Size); + try + SetLength(buffer,F.Size); + F.Read(buffer[0],F.Size); + except + //Most likely the image is too large to fit into available memory + on EOutOfMemory do + begin + FLoadError:='The image is too large to load into memory (' + +IntToStr(F.Size)+' bytes).'; + F.Free; + exit; + end; + end; except on Exception do begin diff --git a/LazarusSource/DiscImage_Published.pas b/LazarusSource/DiscImage_Published.pas index 10ce8a9..9eb2f76 100644 --- a/LazarusSource/DiscImage_Published.pas +++ b/LazarusSource/DiscImage_Published.pas @@ -12,6 +12,12 @@ constructor TDiscImage.Create; // SetLength(Fpartitions,0); //ADFS Interleaving option FForceInter :=0; + //Stream images at/above this size rather than loading them all into RAM + FStreamThreshold :=diStreamThreshold; + //No streamed backing store yet + FBackStream :=nil; + FStreamed :=False; + FBackTemp :=''; //Deal with Spark archives as a filing system (i.e. in this class) FSparkAsFS :=True; //Allow DFS images which report number of sectors as zero @@ -160,8 +166,15 @@ function TDiscImage.SaveFilter(var FilterIndex: Integer;thisformat: Integer=-1): Load an image from a file, unGZIPping it, if necessary -------------------------------------------------------------------------------} function TDiscImage.LoadFromFile(filename: String;readdisc: Boolean=True): Boolean; +var + Ltemp: String=''; begin Result:=False; + //Clear any previous load error (not reset by ResetVariables so it survives + //the ResetVariables call inside IDImage) + FLoadError:=''; + //Release any backing store left over from a previous load + CloseStream; //Only read the file in if it actually exists (or rather, Windows can find it) if SysUtils.FileExists(filename) then begin @@ -171,8 +184,50 @@ function TDiscImage.LoadFromFile(filename: String;readdisc: Boolean=True): Boole if GetMajorFormatNumber=diSpark then SparkFile.Free; //Blank off the variables ResetVariables; - //Read the file in, uncompressing if need be - FData:=Inflate(filename); + //Large images are streamed from disc on demand rather than loaded entirely + //into RAM (which would exhaust memory and overflow the 32-bit addressing). + if FileStartsGZip(filename)then + begin + //A compressed image can't be streamed by offset. If it is a single member, + //decompress it to a temp file (in bounded memory) and stream that when it + //is large enough; otherwise fall back to the in-RAM Inflate. + if CountGZipMembers(filename)=1 then + begin + Ltemp:=GetTempFileName; + if InflateGZipToFile(filename,Ltemp)then + begin + if ShouldStream(SizeOfFile(Ltemp))then + begin + FBackTemp:=Ltemp; //Streamed from the temp file; deleted on close + if not OpenStreamed(Ltemp)then + FLoadError:='Unable to open the image for streamed access.'; + end + else + begin + //Small enough - the temp file is already the raw image, load it in + FData:=Inflate(Ltemp); + if SysUtils.FileExists(Ltemp)then SysUtils.DeleteFile(Ltemp); + end; + end + else + begin + if SysUtils.FileExists(Ltemp)then SysUtils.DeleteFile(Ltemp); + FData:=Inflate(filename); //Decompression failed - try the original path + end; + end + else + FData:=Inflate(filename); //Multi-member archive - existing in-RAM path + end + else + if ShouldStream(SizeOfFile(filename))then + begin + //Uncompressed and large - stream directly from the image file + if not OpenStreamed(filename)then + FLoadError:='Unable to open the image for streamed access.'; + end + else + //Read the file in + FData:=Inflate(filename); //ID the image if(IDImage)and(readdisc)then ReadImage; //Return a true or false, depending on if FFormat is set. @@ -288,6 +343,12 @@ function TDiscImage.SaveToFile(filename: String;uncompress: Boolean=False): Bool end; begin Result:=False; + //Streamed images are read-only and hold no in-RAM copy to save + if FStreamed then + begin + FLoadError:='Streamed (large) images are read-only and cannot be saved.'; + exit; + end; //Validate the filename ext:=ExtractFileExt(filename); //First extract the extension if ext='' then //If it hasn't been given an extension, then give it the default @@ -369,6 +430,8 @@ function TDiscImage.SaveToFile(filename: String;uncompress: Boolean=False): Bool -------------------------------------------------------------------------------} procedure TDiscImage.Close; begin + //Release any streamed backing store (and temp file) before resetting + CloseStream; ResetVariables; end; @@ -822,10 +885,10 @@ function TDiscImage.FileExists(filename: String;var dir,entry: Cardinal;sfn: Boo {------------------------------------------------------------------------------- Direct access to disc data -------------------------------------------------------------------------------} -function TDiscImage.ReadDiscData(addr,count,side,offset: Cardinal; +function TDiscImage.ReadDiscData(addr,count: Int64; side: Cardinal; offset: Int64; var buffer: TDIByteArray): Boolean; var - i : Cardinal=0; + i : Int64=0; begin Result:=False; if count>0 then //Make sure there is something to read @@ -853,7 +916,7 @@ function TDiscImage.ReadDiscData(addr,count,side,offset: Cardinal; {------------------------------------------------------------------------------- Direct access writing to disc -------------------------------------------------------------------------------} -function TDiscImage.WriteDiscData(addr,side: Cardinal;var buffer: TDIByteArray; +function TDiscImage.WriteDiscData(addr: Int64; side: Cardinal;var buffer: TDIByteArray; count: Cardinal;start: Cardinal=0): Boolean; var i : Cardinal=0; diff --git a/LazarusSource/MainUnit.pas b/LazarusSource/MainUnit.pas index 26a6334..76df45b 100755 --- a/LazarusSource/MainUnit.pas +++ b/LazarusSource/MainUnit.pas @@ -1739,9 +1739,14 @@ procedure TMainForm.OpenImage(filename: String); ShowNewImage(Image.Filename); end else - ReportError('"'+ExtractFilename(filename) - +'" has not been recognised as a valid disc image that ' - +ApplicationTitle+' can open.'); + if Image.LoadErrorMessage<>'' then + //A specific reason was given (e.g. the image is too large for memory) + ReportError('"'+ExtractFilename(filename)+'" could not be opened. ' + +Image.LoadErrorMessage) + else + ReportError('"'+ExtractFilename(filename) + +'" has not been recognised as a valid disc image that ' + +ApplicationTitle+' can open.'); //Close the progress message ProgressForm.Hide; end; diff --git a/LazarusSource/MainUnit_Console.pas b/LazarusSource/MainUnit_Console.pas index 0d389da..5f6bc17 100644 --- a/LazarusSource/MainUnit_Console.pas +++ b/LazarusSource/MainUnit_Console.pas @@ -776,7 +776,10 @@ procedure TMainForm.ParseCommand(var Command: TStringArray); Fcurrdir:=0; ReportFreeSpace; end - else WriteLn(cmdRed+'Image not read.'+cmdNormal); + else + if Image.LoadErrorMessage<>'' then + WriteLn(cmdRed+'Image not read. '+Image.LoadErrorMessage+cmdNormal) + else WriteLn(cmdRed+'Image not read.'+cmdNormal); end else WriteLn(cmdRed+'File not found.'+cmdNormal) else error:=2;