1 // Streaming R/O Virtual File System v0.2.0
2 // Copyright (C) XL A.S. Ketmar. All rights reserved
3 // See the file aplicense.txt for conditions of use.
5 // "memory group". reads the whole pack in memory (and decompress it if
6 // necessary). memory image has only one file named "<body>".
9 // slh!: DOS Allegro "slh!"
10 // mem : raw file (no processing, just read)
11 // as a side effect this gives us an opportunity to read enclosed packs
12 // from the packs which aren't supporting backseeking (such as zips).
23 SysUtils
, Classes
, Contnrs
, sfs
;
27 TSFSMemVolumeType
= (sfsmvNone
, sfsmvRAW
, sfsmvSLH
);
29 TSFSMemoryVolume
= class(TSFSVolume
)
31 fType
: TSFSMemVolumeType
;
32 fMemStream
: TMemoryStream
;
37 procedure ReadDirectory (); override;
40 function OpenFileByIndex (const index
: Integer): TStream
; override;
43 TSFSMemoryVolumeFactory
= class (TSFSVolumeFactory
)
45 function IsMyVolumePrefix (const prefix
: TSFSString
): Boolean; override;
46 function Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
; override;
47 procedure Recycle (vol
: TSFSVolume
); override;
59 function SLHCheckMagic (st
: TStream
): Boolean;
61 sign
: packed array [0..3] of Char;
64 st
.ReadBuffer(sign
[0], 4);
65 st
.Seek(-4, soCurrent
);
66 if sign
<> 'slh!' then exit
;
72 procedure TSFSMemoryVolume
.RAWRead ();
76 fMemStream
.CopyFrom(fFileStream
, 0); // voila %-)
77 fi
:= TSFSFileInfo
.Create(self
);
79 fi
.fSize
:= fMemStream
.Size
;
82 procedure TSFSMemoryVolume
.SLHRead ();
83 // unpack LZSS-packed file
86 bufi
, bufo
: packed array of Byte;
87 iused
, oused
, rpos
: Integer;
88 dict
: packed array of Byte;
89 flags
, dpos
, pos
, len
: Word;
92 function ReadCh (): Integer;
97 if fFileStream
.Size
-fFileStream
.Position
> Length(bufi
) then iused
:= Length(bufi
)
98 else iused
:= fFileStream
.Size
-fFileStream
.Position
;
100 if iused
> 0 then fFileStream
.ReadBuffer(bufi
[0], iused
);
103 if iused
= 0 then result
:= -1
104 else begin result
:= bufi
[rpos
]; Inc(rpos
); end;
107 procedure WriteCh (c
: Byte);
109 if oused
>= Length(bufo
) then
111 fMemStream
.WriteBuffer(bufo
[0], oused
);
114 bufo
[oused
] := c
; Inc(oused
);
115 dict
[dpos
] := c
; dpos
:= (dpos
+1) and $FFF;
119 fFileStream
.Seek(4, soCurrent
); // skip signature
120 SetLength(bufi
, 65536); SetLength(bufo
, 65536); SetLength(dict
, 4096);
121 rpos
:= 0; iused
:= 0; oused
:= 0;
122 flags
:= 0; dpos
:= 4096-18;
124 if (flags
and $FF00) = 0 then
126 c
:= ReadCh(); if c
= -1 then break
;
130 if (flags
and $01) <> 0 then
133 c
:= ReadCh(); if c
= -1 then break
;
139 c
:= ReadCh(); if c
= -1 then break
;
141 c
:= ReadCh(); if c
= -1 then break
;
143 pos
:= (pos
and $FF) or ((len
and $F0) shl 4); len
:= (len
and $0F)+3;
146 c
:= dict
[pos
]; pos
:= (pos
+1) and $FFF; Dec(len
);
150 flags
:= flags
shr 1;
152 if oused
> 0 then fMemStream
.WriteBuffer(bufo
[0], oused
);
154 fi
:= TSFSFileInfo
.Create(self
);
155 fi
.fName
:= '<body>';
156 fi
.fSize
:= fMemStream
.Size
;
159 procedure TSFSMemoryVolume
.ReadDirectory ();
161 if fMemStream
= nil then fMemStream
:= TMemoryStream
.Create()
164 fMemStream
.Position
:= 0; fMemStream
.Size
:= 0;
170 else raise ESFSError
.Create('invalid memory SFS');
173 fMemStream
.Position
:= 0;
176 function TSFSMemoryVolume
.OpenFileByIndex (const index
: Integer): TStream
;
180 result
:= nil; fs
:= nil;
181 if fFiles
= nil then exit
;
182 if (index
< 0) or (index
>= fFiles
.Count
) or (fFiles
[index
] = nil) then exit
;
185 fs
:= TSFSMemoryStreamRO
.Create(fMemStream
.Memory
, fMemStream
.Size
);
186 if fFiles
.Count
= 1 then
193 result
:= TSFSPartialStream
.Create(fs
,
194 TSFSFileInfo(fFiles
[index
]).fOfs
,
195 TSFSFileInfo(fFiles
[index
]).fSize
, true);
207 { TSFSMemoryVolumeFactory }
208 function TSFSMemoryVolumeFactory
.IsMyVolumePrefix (const prefix
: TSFSString
): Boolean;
211 SFSStrEqu(prefix
, 'mem') or
212 SFSStrEqu(prefix
, 'slh!');
215 procedure TSFSMemoryVolumeFactory
.Recycle (vol
: TSFSVolume
);
220 function TSFSMemoryVolumeFactory
.Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
;
222 vt
: TSFSMemVolumeType
;
224 if (prefix
<> 'mem') and SLHCheckMagic(st
) then vt
:= sfsmvSLH
225 else if prefix
<> '' then vt
:= sfsmvRAW
226 else vt
:= sfsmvNone
;
228 result
:= TSFSMemoryVolume
.Create(fileName
, st
);
229 TSFSMemoryVolume(result
).fType
:= vt
;
231 result
.DoDirectoryRead();
240 memf
: TSFSMemoryVolumeFactory
;
242 memf
:= TSFSMemoryVolumeFactory
.Create();
243 SFSRegisterVolumeFactory(memf
);
245 SFSUnregisterVolumeFactory(memf
);