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).
21 SysUtils
, Classes
, Contnrs
, sfs
;
25 TSFSMemVolumeType
= (sfsmvNone
, sfsmvRAW
, sfsmvSLH
);
27 TSFSMemoryVolume
= class(TSFSVolume
)
29 fType
: TSFSMemVolumeType
;
30 fMemStream
: TMemoryStream
;
35 procedure ReadDirectory (); override;
38 function OpenFileByIndex (const index
: Integer): TStream
; override;
41 TSFSMemoryVolumeFactory
= class (TSFSVolumeFactory
)
43 function IsMyVolumePrefix (const prefix
: TSFSString
): Boolean; override;
44 function Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
; override;
45 procedure Recycle (vol
: TSFSVolume
); override;
56 function SLHCheckMagic (st
: TStream
): Boolean;
58 sign
: packed array [0..3] of Char;
61 st
.ReadBuffer(sign
[0], 4);
62 st
.Seek(-4, soCurrent
);
63 if sign
<> 'slh!' then exit
;
69 procedure TSFSMemoryVolume
.RAWRead ();
73 fMemStream
.CopyFrom(fFileStream
, 0); // voila %-)
74 fi
:= TSFSFileInfo
.Create(self
);
76 fi
.fSize
:= fMemStream
.Size
;
79 procedure TSFSMemoryVolume
.SLHRead ();
80 // unpack LZSS-packed file
83 bufi
, bufo
: packed array of Byte;
84 iused
, oused
, rpos
: Integer;
85 dict
: packed array of Byte;
86 flags
, dpos
, pos
, len
: Word;
89 function ReadCh (): Integer;
94 if fFileStream
.Size
-fFileStream
.Position
> Length(bufi
) then iused
:= Length(bufi
)
95 else iused
:= fFileStream
.Size
-fFileStream
.Position
;
97 if iused
> 0 then fFileStream
.ReadBuffer(bufi
[0], iused
);
100 if iused
= 0 then result
:= -1
101 else begin result
:= bufi
[rpos
]; Inc(rpos
); end;
104 procedure WriteCh (c
: Byte);
106 if oused
>= Length(bufo
) then
108 fMemStream
.WriteBuffer(bufo
[0], oused
);
111 bufo
[oused
] := c
; Inc(oused
);
112 dict
[dpos
] := c
; dpos
:= (dpos
+1) and $FFF;
116 fFileStream
.Seek(4, soCurrent
); // skip signature
117 SetLength(bufi
, 65536); SetLength(bufo
, 65536); SetLength(dict
, 4096);
118 rpos
:= 0; iused
:= 0; oused
:= 0;
119 flags
:= 0; dpos
:= 4096-18;
121 if (flags
and $FF00) = 0 then
123 c
:= ReadCh(); if c
= -1 then break
;
127 if (flags
and $01) <> 0 then
130 c
:= ReadCh(); if c
= -1 then break
;
136 c
:= ReadCh(); if c
= -1 then break
;
138 c
:= ReadCh(); if c
= -1 then break
;
140 pos
:= (pos
and $FF) or ((len
and $F0) shl 4); len
:= (len
and $0F)+3;
143 c
:= dict
[pos
]; pos
:= (pos
+1) and $FFF; Dec(len
);
147 flags
:= flags
shr 1;
149 if oused
> 0 then fMemStream
.WriteBuffer(bufo
[0], oused
);
151 fi
:= TSFSFileInfo
.Create(self
);
152 fi
.fName
:= '<body>';
153 fi
.fSize
:= fMemStream
.Size
;
156 procedure TSFSMemoryVolume
.ReadDirectory ();
158 if fMemStream
= nil then fMemStream
:= TMemoryStream
.Create()
161 fMemStream
.Position
:= 0; fMemStream
.Size
:= 0;
167 else raise ESFSError
.Create('invalid memory SFS');
170 fMemStream
.Position
:= 0;
173 function TSFSMemoryVolume
.OpenFileByIndex (const index
: Integer): TStream
;
177 result
:= nil; fs
:= nil;
178 if fFiles
= nil then exit
;
179 if (index
< 0) or (index
>= fFiles
.Count
) or (fFiles
[index
] = nil) then exit
;
182 fs
:= TSFSMemoryStreamRO
.Create(fMemStream
.Memory
, fMemStream
.Size
);
183 if fFiles
.Count
= 1 then
190 result
:= TSFSPartialStream
.Create(fs
,
191 TSFSFileInfo(fFiles
[index
]).fOfs
,
192 TSFSFileInfo(fFiles
[index
]).fSize
, true);
204 { TSFSMemoryVolumeFactory }
205 function TSFSMemoryVolumeFactory
.IsMyVolumePrefix (const prefix
: TSFSString
): Boolean;
208 (SFSStrComp(prefix
, 'mem') = 0) or
209 (SFSStrComp(prefix
, 'slh!') = 0);
212 procedure TSFSMemoryVolumeFactory
.Recycle (vol
: TSFSVolume
);
217 function TSFSMemoryVolumeFactory
.Produce (const prefix
, fileName
: TSFSString
; st
: TStream
): TSFSVolume
;
219 vt
: TSFSMemVolumeType
;
221 if (prefix
<> 'mem') and SLHCheckMagic(st
) then vt
:= sfsmvSLH
222 else if prefix
<> '' then vt
:= sfsmvRAW
223 else vt
:= sfsmvNone
;
225 result
:= TSFSMemoryVolume
.Create(fileName
, st
);
226 TSFSMemoryVolume(result
).fType
:= vt
;
228 result
.DoDirectoryRead();
237 memf
: TSFSMemoryVolumeFactory
;
239 memf
:= TSFSMemoryVolumeFactory
.Create();
240 SFSRegisterVolumeFactory(memf
);
242 SFSUnregisterVolumeFactory(memf
);