From 2fdb1deb5facdcfadb85ab28050bc02451cf7ba8 Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Thu, 7 Apr 2016 22:10:08 +0300 Subject: [PATCH] added my old SFS (vfs ;-) system --- src/game/Doom2DF.dpr | 5 + src/sfs/sfs.pas | 1186 ++++++++++++++++++++++++++++++++++++++++ src/sfs/sfsMemFS.pas | 241 ++++++++ src/sfs/sfsPlainFS.pas | 726 ++++++++++++++++++++++++ src/sfs/sfsZipFS.pas | 529 ++++++++++++++++++ src/sfs/xstreams.pas | 297 ++++++++++ 6 files changed, 2984 insertions(+) create mode 100644 src/sfs/sfs.pas create mode 100644 src/sfs/sfsMemFS.pas create mode 100644 src/sfs/sfsPlainFS.pas create mode 100644 src/sfs/sfsZipFS.pas create mode 100644 src/sfs/xstreams.pas diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 8b2ec19..e72de94 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -40,6 +40,11 @@ uses e_sound in '../engine/e_sound.pas', e_textures in '../engine/e_textures.pas', e_fixedbuffer in '../engine/e_fixedbuffer.pas', + sfs in '../sfs/sfs.pas', + sfsPlainFS in '../sfs/sfsPlainFS.pas', + sfsZipFS in '../sfs/sfsZipFS.pas', + sfsMemFS in '../sfs/sfsMemFS.pas', + xstreams in '../sfs/xstreams.pas', WADEDITOR in '../shared/WADEDITOR.pas', WADSTRUCT in '../shared/WADSTRUCT.pas', MAPSTRUCT in '../shared/MAPSTRUCT.pas', diff --git a/src/sfs/sfs.pas b/src/sfs/sfs.pas new file mode 100644 index 0000000..3fa92fa --- /dev/null +++ b/src/sfs/sfs.pas @@ -0,0 +1,1186 @@ +// streaming file system (virtual) +{$MODE DELPHI} +{.$R-} +unit sfs; + +interface + +uses + SysUtils, Classes, Contnrs; + + +type + ESFSError = class(Exception); + + TSFSChar = AnsiChar; + TSFSString = AnsiString; + + TSFSVolume = class; + + TSFSFileInfo = class + public + fOwner: TSFSVolume; // òàê, íà âñÿêèé ñëó÷àé + fPath: TSFSString; // ðàçäåëèòåëè êàòàëîãîâ -- "/"; êîðåíü íèêàê íå îáîçíà÷åí, åñëè íå ïóñòîå, îáÿçàíî çàâåðøàåòñÿ "/" + fName: TSFSString; // òîëüêî èìÿ + fSize: Int64; // unpacked + fOfs: Int64; // in VFS (many of 'em need this %-) + + constructor Create (pOwner: TSFSVolume); + destructor Destroy (); override; + + property path: TSFSString read fPath; + property name: TSFSString read fName; + property size: Int64 read fSize; + end; + + // âèðòóàëüíàÿ ôàéëîâàÿ ñèñòåìà. ÒÎËÜÊÎ ÄËß ×ÒÅÍÈß! + // òîì ÍÅ ÄÎËÆÅÍ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè ôàáðèêè! + TSFSVolume = class + protected + fFileName: TSFSString;// îáû÷íî èìÿ îðèãèíàëüíîãî ôàéëà + fFileStream: TStream; // îáû÷íî ïîòîê äëÿ ÷òåíèÿ îðèãèíàëüíîãî ôàéëà + fFiles: TObjectList; // TSFSFileInfo èëè íàñëåäíèêè + + // ïðèøèáèòü âñå ñòðóêòóðû. + // íå äîëæíà ïàäàòü, åñëè å¸ âûçûâàþò íåñêîëüêî ðàç. + procedure Clear (); virtual; + + // âûçûâàåòñÿ èç DoDirectoryRead() äëÿ çàïîëíåíèÿ ñïèñêà ôàéëîâ. + // ñ÷èòàåòñÿ, ÷òî âñå ìàãèêè óæå ïðîâåðåíû è ôàéë òî÷íî íàø. + // fFileName, fFileStream óæå óñòàíîâëåíû, fFiles ñîçäàí, + // â í¸ì, ñêîðåå âñåãî, íèêîãî íåò. + // ïîçèöèÿ ïîòîêà -- òà, ÷òî îñòàâèëà ôàáðèêà. + // ïðè îøèáêàõ êèäàòü èñêëþ÷åíèå, òîãäà òîì áóäåò ïðèáèò ôàáðèêîé. + // ðàçäåëèòåëè ïóòåé äîëæíû áûòü òîëüêî "/", êîðíåâîé "/" äîëæåí + // áûòü îïóùåí, ïóòè (åñëè íå ïóñòûå) äîëæíû çàâåðøàòüñÿ "/"! + // fName äîëæíî ñîäåðæàòü òîëüêî èìÿ, fPath -- òîëüêî ïóòü. + // â ïðèíöèïå, îá ýòîì ïîçàáîòèòñÿ DoDirectoryRead(), íî çà÷åì + // äàâàòü åìó ëèøíþþ ðàáîòó? + procedure ReadDirectory (); virtual; abstract; + + // íàéòè ôàéë, âåðíóòü åãî èíäåêñ â fFiles. + // ýòà ïðîöåäóðà ìîæåò ìåíÿòü fFiles! + // fPath -- â ïðàâèëüíîé ôîðìå, ñ "/", êîðíåâîé "/" óáèò, ôèíàëüíûé äîáàâëåí. + // åñëè ôàéë íå íàéäåí, âåðíóòü -1. + function FindFile (const fPath, fName: TSFSString): Integer; virtual; + + // ïðè îøèáêàõ êèäàòüñÿ èñêëþ÷åíèÿìè. + function OpenFileByIndex (const index: Integer): TStream; virtual; abstract; + + // âîçâðàùàåò êîëè÷åñòâî ôàéëîâ â fFiles + function GetFileCount (): Integer; virtual; + + // âîçâðàùàåò ôàéë ñ èíäåêñîì index. + // ìîæåò âîçâðàùàòü NIL. + // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû! + function GetFiles (index: Integer): TSFSFileInfo; virtual; + + public + // pSt íå îáÿçàòåëüíî çàïîìèíàòü, åñëè îí íå íóæåí. + constructor Create (const pFileName: TSFSString; pSt: TStream); virtual; + // fFileStream óíè÷òîæàòü íåëüçÿ, åñëè îí ðàâåí ïàðàìåòðó pSt êîíñòðóêòîðà. + destructor Destroy (); override; + + // âûçûâàåò ReadDirectory(). + // ýòà ïðîöåäóðà ñàìà ðàçáåð¸òñÿ ñ äóáëèêàòàìè èì¸í: ïîäîáàâëÿåò â + // êîíåö èì¸í-äóáëèêàòîâ ïîä÷¸ðêèâàíèå è äåñÿòè÷íûé íîìåð. + // òàêæå îíà íîðìàëèçóåò âèä èì¸í. + procedure DoDirectoryRead (); + + // åñëè íå ñìîãëî îòêóïîðèòü ôàéëî (èëè åù¸ ãäå îøèáëîñü), çàøâûðí¸ò èñêëþ÷åíèå. + function OpenFileEx (const fName: TSFSString): TStream; virtual; + + property FileCount: Integer read GetFileCount; // ìîæåò âåðíóòü íîëü + // ìîæåò âîçâðàùàòü NIL. + // íèêàêèõ ïàäåíèé íà íåïðàâèëüíûå èíäåêñû! + property Files [index: Integer]: TSFSFileInfo read GetFiles; + end; + + // ôàáðèêà òîìîâ. âñå SFS ïðè ñòàðòå äîáàâëÿþò ñâîè ôàáðèêè. + // áëàãîäàðÿ ýòîìó ìîæíî ñîçäàâàòü ðàçíûå âñÿêèå SFS ñòàíäàðòíûì + // âûçîâîì ñòàíäàðòíîé ïðîöåäóðû. + // ôàáðèêà ÍÅ ÄÎËÆÍÀ óáèâàòüñÿ íèêàê èíà÷å, ÷åì ïðè ïîìîùè âûçîâà + // SFSUnregisterVolumeFactory()! ýòî ãàðàíòèðóåò, ÷òî äâèæîê + // ïåðåä ðàññòðåëîì îòäàñò åé âñå å¸ òîìà. + TSFSVolumeFactory = class + public + // åñëè äîáàâëÿåì ôàéë äàííûõ ôàéë ñ èìåíåì òèïà "zip:....", òî + // SFS èçâëå÷¸ò ýòî "zip" è ïåðåäàñò â ñèþ ôóíêöèþ. + // åæåëè ôóíêöèÿ âåðí¸ò ïðàâäó, òî SFS âûçîâåò Produce äëÿ äàííîãî + // ôàéëà. åñëè íè îäíà ôàáðèêà ïðåôèêñ íå ïðèçíàåò, òî ôàéë íå îòêðîþò. + // èñïîëüçóåòñÿ äëÿ ñêèïàíèÿ àâòîäåòåêòà. + // SFS ÍÅ Ñ×ÈÒÀÅÒ ÏÐÅÔÈÊÑÎÌ ÑÒÐÎÊÓ ÊÎÐÎ×Å ÒÐ¨Õ ÑÈÌÂÎËÎÂ! + function IsMyVolumePrefix (const prefix: TSFSString): Boolean; virtual; abstract; + // ïðîâåðÿåò, ìîæåò ëè ôàáðèêà ñäåëàòü òîì äëÿ äàííîãî ôàéëà. + // st -- îòêðûòûé äëÿ ÷òåíèÿ ôàéëîâé ïîòîê. óêàçàòåëü ÷òåíèÿ ñòîèò â íà÷àëå. + // ýòîò ïîòîê íåëüçÿ çàêðûâàòü! + // prefix: òî, ÷òî áûëî ïåðåäàíî â IsMyVolumePrefix() èëè ''. + // èñêëþ÷åíèå ñ÷èòàåòñÿ îøèáêîé, âîçâðàò NIL ñ÷èòàåòñÿ îøèáêîé. + function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; virtual; abstract; + // êîãäà òîì áîëüøå íå íóæåí, îí áóäåò îòäàí ôàáðèêå íà ïåðåðàáîòêó. + // äàëåå äâèæîê íå áóäåò þçàòü ñåé òîì. + procedure Recycle (vol: TSFSVolume); virtual; abstract; + end; + + // "èòåðàòîð", âîçâðàùàåìûé SFSFileList() + TSFSFileList = class + protected + fVolume: TSFSVolume; + + function GetCount (): Integer; + function GetFiles (index: Integer): TSFSFileInfo; + + public + constructor Create (const pVolume: TSFSVolume); + destructor Destroy (); override; + + property Count: Integer read GetCount; + // ïðè íåïðàâèëüíîì èíäåêñå ìîë÷à âåðí¸ò NIL. + // ïðè ïðàâèëüíîì òîæå ìîæåò âåðíóòü NIL! + // î÷åíü íå ñîâåòóþ ìåíÿòü ñîäåðæèìîå ïîëó÷åííîãî êëàññà. + // êîíå÷íî, ÿ ìîã áû âîçâðàùàòü íîâóþ ñòðóêòóðó èëè íå÷òî ïîõîæåå, + // íî áëèí, åñëè òû èäèîò è íå óìååøü äàæå êîììåíòû ÷èòàòü, òî + // êàêîãî òû âîîáùå â ïðîãðàììèíã ïîëåç? + property Files [index: Integer]: TSFSFileInfo read GetFiles; default; + end; + + +procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory); +// ýòà ôóíêöèÿ àâòîìàòè÷åñêè ïðèáü¸ò factory. +procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory); + +// äîáàâèòü ñáîðíèê â ïîñòîÿííûé ñïèñîê. +// åñëè ñáîðíèê ñ òàêèì èìåíåì óæå îòêðûò, òî íå îòêðûâàåò åãî ïîâòîðíî. +// íèêîãäà íå êèäàåò èñêëþ÷åíèé. +// top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà. +// âåðí¸ò ëîæü ïðè îøèáêå. +// ñïîñîáíî îòêðûâàòü ñáîðíèêè â ñáîðíèêàõ ïðè ïîìîùè êðóòûõ èì¸í a-la: +// "zip:pack0::pack:pack1::wad2:pack2". +// â äàëüíåéøåì ñëåäóåò îáðàùàòüñÿ ê ñáîðíèêó êàê "pack2::xxx". +// èëè ìîæíî íàïèñàòü: +// "zip:pack0::pack:pack1::wad2:pack2|datafile". +// è îáðàùàòüñÿ êàê "datafile::xxx". +// "||" ïðåîáðàçóþòñÿ â ïðîñòîé "|" è ðàçäåëèòåëåì íå ñ÷èòàþòñÿ. +// ïðèíèìàåòñÿ âî âíèìàíèå òîëüêî ïîñëåäíÿÿ òðóáà. +function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean=false): Boolean; + +// äîáàâèòü â ïîñòîÿííûé ñïèñîê ñáîðíèê èç ïîòîêà ds. +// åñëè âîçâðàùàåò èñòèíó, òî SFS ñòàíîâèòñÿ âëÿäåëüöåì ïîòîêà ds è ñàìà +// óãðîáèò ñåé ïîòîê ïî íåîáõîäèìîñòè. +// virtualName ñòàíîâèòñÿ èìåíåì ñáîðíèêà äëÿ îïåðàöèè îòêðûòèÿ ôàéëà òèïà +// "packfile:file.ext". +// åñëè êàêîé-íèáóäü ñáîðíèê ñ èìåíåì virtualName óæå îòêðûò, âåðí¸ò false. +// íèêîãäà íå êèäàåò èñêëþ÷åíèé. +// top: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà. +// âåðí¸ò ëîæü ïðè îøèáêå. +// îòêðûâàåò ñáîðíèê èç ïîòîêà. dataFileName -- ÂÈÐÒÓÀËÜÍÎÅ èìÿ. +// ò.å. íà ñàìîì äåëå òàêîãî ôàéëà ìîæåò è íå áûòü íà äèñêå. +function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; top: Boolean=false): Boolean; + +// øâûðÿåòñÿ èñêëþ÷åíèÿìè. +// åñëè fName íå èìååò óêàçàíèÿ íà ôàéë äàííûõ (ýòî òî, ÷òî îòäåëåíî îò +// îñòàëüíîãî èìåíè äâîåòî÷èåì), òî èùåì ñíà÷àëà ïî âñåì çàðåãèñòðèðîâàííûì +// ôàéëàì äàííûõ, ïîòîì â òåêóùåì êàòàëîãå, ïîòîì â êàòàëîãå, îòêóäà ñòàðòîâàëè. +// åñëè íè÷åãî íå íàøëè, êèäàåì èñêëþ÷åíèå. +function SFSFileOpenEx (const fName: TSFSString): TStream; + +// ïðè îøèáêå -- NIL, è íèêàêèõ èñêëþ÷åíèé. +function SFSFileOpen (const fName: TSFSString): TStream; + +// âîçâðàùàåò NIL ïðè îøèáêå. +// ïîñëå èñïîëüçîâàíèÿ, íàòóðàëüíî, èòåðàòîð íàäî ãðîõíóòü %-) +function SFSFileList (const dataFileName: TSFSString): TSFSFileList; + +function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString; +// èãíîðèðóåò ðåãèñòð ñèìâîëîâ +// <0: s0 < s1 +// =0: s0 = s1 +// >0: s0 > s1 +function SFSStrComp (const s0, s1: TSFSString): Integer; + +// ðàçîáðàòü òîëñòîå èìÿ ôàéëà, âåðíóòü âèðòóàëüíîå èìÿ ïîñëåäíåãî ñïèñêà +// èëè ïóñòóþ ñòîðîêó, åñëè ñïèñêîâ íå áûëî. +function SFSGetLastVirtualName (const fn: TSFSString): string; + +// ïðåîáðàçîâàòü ÷èñëî â ñòðîêó, êðàñèâî ðàçáàâëÿÿ çàïÿòûìè +function Int64ToStrComma (i: Int64): string; + +// Wildcard matching +// this code is meant to allow wildcard pattern matches. tt is VERY useful +// for matching filename wildcard patterns. tt allows unix grep-like pattern +// comparisons, for instance: +// +// ? Matches any single characer +// + Matches any single characer or nothing +// * Matches any number of contiguous characters +// [abc] Matches a or b or c at that position +// [!abc] Matches anything but a or b or c at that position +// [a-e] Matches a through e at that position +// +// 'ma?ch.*' -Would match match.exe, mavch.dat, march.on, etc +// 'this [e-n]s a [!zy]est' -Would match 'this is a test', but would +// not match 'this as a yest' +// +function WildMatch (pattern, text: TSFSString): Boolean; +function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer; +function HasWildcards (const pattern: TSFSString): Boolean; + + +var + // ïðàâäà: ðàçðåøåíî èñêàòü ôàéëî íå òîëüêî â ôàéëàõ äàííûõ, íî è íà äèñêå. + sfsDiskEnabled: Boolean = true; + // ïðàâäà: åñëè ôàéë íå ïðåôèêñîâàí, òî ñíà÷àëà èùåì ôàéëî íà äèñêå, + // ïîòîì â ôàéëàõ äàííûõ. + sfsDiskFirst: Boolean = true; + // ïðàâäà: äàæå äëÿ ïðåôèêñîâàíûõ ôàéëîâ ñíà÷àëà ïðîñìîòðèì äèñê + // (åñëè óñòàíîâëåí ôëàæîê sfsDiskFirst è sfsDiskEnabled). + sfsForceDiskForPrefixed: Boolean = false; + // ñïèñîê äèñêîâûõ êàòàëîãîâ äëÿ ïîèñêà ôàéëà. åñëè ïóñò -- èùåì òîëüêî â + // òåêóùåì. êàòàëîãè ðàçäåëÿþòñÿ òðóáîé ("|"). + // çàìåíÿåòñÿ íà òåêóùèé êàòàëîã (ñ çàâåðøàþùèì "/"), + // çàìåíÿåòñÿ íà êàòàëîã, ãäå ñèäèò .EXE (ñ çàâåðøàþùèì "/"). + sfsDiskDirs: TSFSString = '|'; + + +implementation + +uses + xstreams; + + +function Int64ToStrComma (i: Int64): string; +var + f: Integer; +begin + Str(i, result); + f := Length(result)+1; + while f > 4 do + begin + Dec(f, 3); Insert(',', result, f); + end; +end; + + +const + // character defines + WILD_CHAR_ESCAPE = '\'; + WILD_CHAR_SINGLE = '?'; + WILD_CHAR_SINGLE_OR_NONE = '+'; + WILD_CHAR_MULTI = '*'; + WILD_CHAR_RANGE_OPEN = '['; + WILD_CHAR_RANGE = '-'; + WILD_CHAR_RANGE_CLOSE = ']'; + WILD_CHAR_RANGE_NOT = '!'; + + +function HasWildcards (const pattern: TSFSString): Boolean; +begin + result := + (Pos(WILD_CHAR_ESCAPE, pattern) <> 0) or + (Pos(WILD_CHAR_SINGLE, pattern) <> 0) or + (Pos(WILD_CHAR_SINGLE_OR_NONE, pattern) <> 0) or + (Pos(WILD_CHAR_MULTI, pattern) <> 0) or + (Pos(WILD_CHAR_RANGE_OPEN, pattern) <> 0); +end; + +function MatchMask (const pattern: TSFSString; p, pend: Integer; const text: TSFSString; t, tend: Integer): Boolean; +var + rangeStart, rangeEnd: AnsiChar; + rangeNot, rangeMatched: Boolean; + ch: AnsiChar; +begin + // sanity checks + if (pend < 0) or (pend > Length(pattern)) then pend := Length(pattern); + if (tend < 0) or (tend > Length(text)) then tend := Length(text); + if t < 1 then t := 1; + if p < 1 then p := 1; + while p <= pend do + begin + if t > tend then + begin + // no more text. check if there's no more chars in pattern (except "*" & "+") + while (p <= pend) and + ((pattern[p] = WILD_CHAR_MULTI) or + (pattern[p] = WILD_CHAR_SINGLE_OR_NONE)) do Inc(p); + result := (p > pend); + exit; + end; + case pattern[p] of + WILD_CHAR_SINGLE: ; + WILD_CHAR_ESCAPE: + begin + Inc(p); + if p > pend then result := false else result := (pattern[p] = text[t]); + if not result then exit; + end; + WILD_CHAR_RANGE_OPEN: + begin + result := false; + Inc(p); if p > pend then exit; // sanity check + rangeNot := (pattern[p] = WILD_CHAR_RANGE_NOT); + if rangeNot then begin Inc(p); if p > pend then exit; {sanity check} end; + if pattern[p] = WILD_CHAR_RANGE_CLOSE then exit; // sanity check + ch := text[t]; // speed reasons + rangeMatched := false; + repeat + if p > pend then exit; // sanity check + rangeStart := pattern[p]; + if rangeStart = WILD_CHAR_RANGE_CLOSE then break; + Inc(p); if p > pend then exit; // sanity check + if pattern[p] = WILD_CHAR_RANGE then + begin + Inc(p); if p > pend then exit; // sanity check + rangeEnd := pattern[p]; Inc(p); + if rangeStart < rangeEnd then + begin + rangeMatched := (ch >= rangeStart) and (ch <= rangeEnd); + end + else rangeMatched := (ch >= rangeEnd) and (ch <= rangeStart); + end + else rangeMatched := (ch = rangeStart); + until rangeMatched; + if rangeNot = rangeMatched then exit; + + // skip the rest or the range + while (p <= pend) and (pattern[p] <> WILD_CHAR_RANGE_CLOSE) do Inc(p); + if p > pend then exit; // sanity check + end; + WILD_CHAR_SINGLE_OR_NONE: + begin + Inc(p); + result := MatchMask(pattern, p, pend, text, t, tend); + if not result then result := MatchMask(pattern, p, pend, text, t+1, tend); + exit; + end; + WILD_CHAR_MULTI: + begin + while (p <= pend) and (pattern[p] = WILD_CHAR_MULTI) do Inc(p); + result := (p > pend); if result then exit; + while not result and (t <= tend) do + begin + result := MatchMask(pattern, p, pend, text, t, tend); + Inc(t); + end; + exit; + end; + else result := (pattern[p] = text[t]); if not result then exit; + end; + Inc(p); Inc(t); + end; + result := (t > tend); +end; + + +function WildMatch (pattern, text: TSFSString): Boolean; +begin + if pattern <> '' then pattern := AnsiLowerCase(pattern); + if text <> '' then text := AnsiLowerCase(text); + result := MatchMask(pattern, 1, -1, text, 1, -1); +end; + +function WildListMatch (wildList, text: TSFSString; delimChar: AnsiChar=':'): Integer; +var + s, e: Integer; +begin + if wildList <> '' then wildList := AnsiLowerCase(wildList); + if text <> '' then text := AnsiLowerCase(text); + result := 0; + s := 1; + while s <= Length(wildList) do + begin + e := s; while e <= Length(wildList) do + begin + if wildList[e] = WILD_CHAR_RANGE_OPEN then + begin + while (e <= Length(wildList)) and (wildList[e] <> WILD_CHAR_RANGE_CLOSE) do Inc(e); + end; + if wildList[e] = delimChar then break; + Inc(e); + end; + if s < e then + begin + if MatchMask(wildList, s, e-1, text, 1, -1) then exit; + end; + Inc(result); + s := e+1; + end; + result := -1; +end; + + +type + TVolumeInfo = class + fFactory: TSFSVolumeFactory; + fVolume: TSFSVolume; + fPackName: TSFSString; // äëÿ îäíîãî è òîãî æå ôàéëà áóäåò òîëüêî îäèí òîì! + fStream: TStream; // ôàéëîâûé ïîòîê äëÿ ñáîðíèêà + fPermanent: Boolean; // èñòèíà -- íå áóäåò óãðîáëåíà, åñëè íå îñòàíåòñÿ íè îäíîãî îòêðûòîãî òîìà + // èñòèíà -- ýòîò òîì áûë ñîçäàí èç ïîòîêà è íå èìååò äèñêîâîãî ôàéëà, ïîòîìó ôàáðèêå áóäåò ïåðåäàíî íå èìÿ ñáîðíèêà, à ïóñòàÿ ñòðîêà + fNoDiskFile: Boolean; + fOpenedFilesCount: Integer; + + destructor Destroy (); override; + end; + + TOwnedPartialStream = class (TSFSPartialStream) + protected + fOwner: TVolumeInfo; + + public + constructor Create (pOwner: TVolumeInfo; pSrc: TStream; pPos, pSize: Int64; pKillSrc: Boolean); + destructor Destroy (); override; + end; + + +var + factories: TObjectList; // TSFSVolumeFactory + volumes: TObjectList; // TVolumeInfo + + +// ðàçáèòü èìÿ ôàéëà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ, +// ñîáñòâåííî èìÿ ôàéëà +// èìÿ âûãëÿäèò êàê: +// (("sfspfx:")?"datafile::")*"filename" +procedure SplitFName (const fn: string; out dataFile, fileName: string); +var + f: Integer; +begin + f := Length(fn)-1; + while f >= 1 do + begin + if (fn[f] = ':') and (fn[f+1] = ':') then break; + Dec(f); + end; + if f < 1 then begin dataFile := ''; fileName := fn; end + else + begin + dataFile := Copy(fn, 1, f-1); + fileName := Copy(fn, f+2, maxInt-10000); + end; +end; + +// ñàéäýôôåêò: âûðåçàåò âèðòóàëüíîå èìÿ èç dataFile. +function ExtractVirtName (var dataFile: string): string; +var + f: Integer; +begin + f := Length(dataFile); result := dataFile; + while f > 1 do + begin + if dataFile[f] = ':' then break; + if dataFile[f] = '|' then + begin + if dataFile[f-1] = '|' then begin Dec(f); Delete(dataFile, f, 1); end + else + begin + result := Copy(dataFile, f+1, Length(dataFile)); + Delete(dataFile, f, Length(dataFile)); + break; + end; + end; + Dec(f); + end; +end; + +// ðàçáèòü èìÿ ñáîðíèêà íà ÷àñòè: ïðåôèêñ ôàéëîâîé ñèñòåìû, èìÿ ôàéëà äàííûõ, +// âèðòóàëüíîå èìÿ. åñëè âèðòóàëüíîãî èìåíè íå äàíî, îíî áóäåò ðàâíî dataFile. +// èìÿ âûãëÿäèò êàê: +// [sfspfx:]datafile[|virtname] +// åñëè ïåðåä äâîåòî÷èåì ìåíüøå òð¸õ áóêâ, òî ýòî ñ÷èòàåòñÿ íå ïðåôèêñîì, +// à èìåíåì äèñêà. +procedure SplitDataName (const fn: string; out pfx, dataFile, virtName: string); +var + f: Integer; +begin + f := Pos(':', fn); + if f <= 3 then begin pfx := ''; dataFile := fn; end + else + begin + pfx := Copy(fn, 1, f-1); + dataFile := Copy(fn, f+1, maxInt-10000); + end; + virtName := ExtractVirtName(dataFile); +end; + +// íàéòè ïðîèçâîäèòåëÿ äëÿ ýòîãî ôàéëà (åñëè ôàéë óæå îòêðûò). +// onlyPerm: òîëüêî "ïîñòîÿííûå" ïðîèçâîäèòåëè. +function FindVolumeInfo (const dataFileName: TSFSString; onlyPerm: Boolean=false): Integer; +var + f: Integer; + vi: TVolumeInfo; +begin + f := 0; + while f < volumes.Count do + begin + if volumes[f] <> nil then + begin + vi := TVolumeInfo(volumes[f]); + if not onlyPerm or vi.fPermanent then + begin + if SFSStrComp(vi.fPackName, dataFileName) = 0 then + begin + result := f; + exit; + end; + end; + end; + Inc(f); + end; + result := -1; +end; + +// íàéòè èíôó äëÿ ýòîãî òîìà. +// õîðîøåå èìÿ, ïðàâäà? %-) +function FindVolumeInfoByVolumeInstance (vol: TSFSVolume): Integer; +begin + result := volumes.Count-1; + while result >= 0 do + begin + if volumes[result] <> nil then + begin + if TVolumeInfo(volumes[result]).fVolume = vol then exit; + end; + Dec(result); + end; +end; + +// <0: s0 < s1 +// =0: s0 = s1 +// >0: s0 > s1 +function SFSStrComp (const s0, s1: TSFSString): Integer; +begin + result := AnsiCompareText(s0, s1); +end; + +function SFSReplacePathDelims (const s: TSFSString; newDelim: TSFSChar): TSFSString; +var + f: Integer; +begin + result := s; + for f := 1 to Length(result) do + begin + if (result[f] = '/') or (result[f] = '\') then + begin + // avoid unnecessary string changes + if result[f] <> newDelim then result[f] := newDelim; + end; + end; +end; + +function SFSGetLastVirtualName (const fn: TSFSString): string; +var + rest, tmp: string; + f: Integer; +begin + rest := fn; + repeat + f := Pos('::', rest); if f = 0 then f := Length(rest)+1; + tmp := Copy(rest, 1, f-1); Delete(rest, 1, f+1); + result := ExtractVirtName(tmp); + until rest = ''; +end; + + +{ TVolumeInfo } +destructor TVolumeInfo.Destroy (); +var + f, me: Integer; + used: Boolean; // ôëàæîê çàþçàíîñòè ïîòîêà êåì-òî åù¸ +begin + if fFactory <> nil then fFactory.Recycle(fVolume); + fVolume := nil; fFactory := nil; fPackName := ''; + + // òèïà ìóñîðîñáîðíèê: åñëè íàø ïîòîê áîëåå íèêåì íå þçàåòñÿ, + // òî óãðîáèòü åãî íàôèã. + me := volumes.IndexOf(self); + used := false; + f := volumes.Count-1; + while not used and (f >= 0) do + begin + if (f <> me) and (volumes[f] <> nil) then + begin + used := (TVolumeInfo(volumes[f]).fStream = fStream); + if not used then + used := (TVolumeInfo(volumes[f]).fVolume.fFileStream = fStream); + end; + Dec(f); + end; + if not used then FreeAndNil(fStream); // åñëè áîëüøå íèêåì íå þçàíî, ïðèøèá¸ì + inherited Destroy(); +end; + + +{ TOwnedPartialStream } +constructor TOwnedPartialStream.Create (pOwner: TVolumeInfo; pSrc: TStream; + pPos, pSize: Int64; pKillSrc: Boolean); +begin + inherited Create(pSrc, pPos, pSize, pKillSrc); + fOwner := pOwner; + if pOwner <> nil then Inc(pOwner.fOpenedFilesCount); +end; + +destructor TOwnedPartialStream.Destroy (); +var + f: Integer; +begin + inherited Destroy(); + if fOwner <> nil then + begin + Dec(fOwner.fOpenedFilesCount); + if not fOwner.fPermanent and (fOwner.fOpenedFilesCount < 1) then + begin + f := volumes.IndexOf(fOwner); + if f <> -1 then volumes[f] := nil; // this will destroy the volume + end; + end; +end; + + +{ TSFSFileInfo } +constructor TSFSFileInfo.Create (pOwner: TSFSVolume); +begin + inherited Create(); + fOwner := pOwner; + fPath := ''; fName := ''; + fSize := 0; fOfs := 0; + if pOwner <> nil then pOwner.fFiles.Add(self); +end; + +destructor TSFSFileInfo.Destroy (); +begin + if fOwner <> nil then fOwner.fFiles.Extract(self); + inherited Destroy(); +end; + + +{ TSFSVolume } +constructor TSFSVolume.Create (const pFileName: TSFSString; pSt: TStream); +begin + inherited Create(); + fFileStream := pSt; + fFileName := pFileName; + fFiles := TObjectList.Create(true); +end; + +procedure TSFSVolume.DoDirectoryRead (); +var + fl: TStringList; //!!!FIXME! change to list of wide TSFSStrings or so! + f, c, n: Integer; + sfi: TSFSFileInfo; + tmp, fn, ext: TSFSString; +begin + fl := nil; + fFileName := ExpandFileName(SFSReplacePathDelims(fFileName, '/')); + try + ReadDirectory(); + fFiles.Pack(); + + // check for duplicate file names + fl := TStringList.Create(); fl.Sorted := true; + for f := 0 to fFiles.Count-1 do + begin + sfi := TSFSFileInfo(fFiles[f]); + + // normalize name & path + sfi.fPath := SFSReplacePathDelims(sfi.fPath, '/'); + if (sfi.fPath <> '') and (sfi.fPath[1] = '/') then Delete(sfi.fPath, 1, 1); + if (sfi.fPath <> '') and (sfi.fPath[Length(sfi.fPath)] <> '/') then sfi.fPath := sfi.fPath+'/'; + tmp := SFSReplacePathDelims(sfi.fName, '/'); + c := Length(tmp); while (c > 0) and (tmp[c] <> '/') do Dec(c); + if c > 0 then + begin + // split path and name + Delete(sfi.fName, 1, c); // cut name + tmp := Copy(tmp, 1, c); // get path + if tmp = '/' then tmp := ''; // just delimiter; ignore it + sfi.fPath := sfi.fPath+tmp; + end; + + // check for duplicates + if fl.Find(sfi.fPath+sfi.fName, c) then + begin + n := 0; tmp := sfi.fName; + c := Length(tmp); while (c > 0) and (tmp[c] <> '.') do Dec(c); + if c < 1 then c := Length(tmp)+1; + fn := Copy(tmp, 1, c-1); ext := Copy(tmp, c, Length(tmp)); + repeat + tmp := fn+'_'+IntToStr(n)+ext; + if not fl.Find(sfi.fPath+tmp, c) then break; + Inc(n); + until false; + sfi.fName := tmp; + end; + fl.Add(sfi.fName); + end; + fl.Free(); + except + fl.Free(); + raise; + end; +end; + +destructor TSFSVolume.Destroy (); +begin + Clear(); + FreeAndNil(fFiles); + inherited Destroy(); +end; + +procedure TSFSVolume.Clear (); +begin + fFiles.Clear(); +end; + +function TSFSVolume.FindFile (const fPath, fName: TSFSString): Integer; +begin + if fFiles = nil then result := -1 + else + begin + result := fFiles.Count; + while result > 0 do + begin + Dec(result); + if fFiles[result] <> nil then + begin + if (SFSStrComp(fPath, TSFSFileInfo(fFiles[result]).fPath) = 0) and + (SFSStrComp(fName, TSFSFileInfo(fFiles[result]).fName) = 0) then exit; + end; + end; + result := -1; + end; +end; + +function TSFSVolume.GetFileCount (): Integer; +begin + if fFiles = nil then result := 0 else result := fFiles.Count; +end; + +function TSFSVolume.GetFiles (index: Integer): TSFSFileInfo; +begin + if fFiles = nil then result := nil + else + begin + if (index < 0) or (index >= fFiles.Count) then result := nil + else result := TSFSFileInfo(fFiles[index]); + end; +end; + +function TSFSVolume.OpenFileEx (const fName: TSFSString): TStream; +var + fp, fn: TSFSString; + f, ls: Integer; +begin + fp := fName; + // normalize name, find split position + if (fp <> '') and ((fp[1] = '/') or (fp[1] = '\')) then Delete(fp, 1, 1); + ls := 0; + for f := 1 to Length(fp) do + begin + if fp[f] = '\' then fp[f] := '/'; + if fp[f] = '/' then ls := f; + end; + fn := Copy(fp, ls+1, Length(fp)); + fp := Copy(fp, 1, ls); + f := FindFile(fp, fn); + if f = -1 then raise ESFSError.Create('file not found: "'+fName+'"'); + result := OpenFileByIndex(f); + if result = nil then raise ESFSError.Create('file not found: "'+fName+'"'); +end; + + +{ TSFSFileList } +constructor TSFSFileList.Create (const pVolume: TSFSVolume); +var + f: Integer; +begin + inherited Create(); + ASSERT(pVolume <> nil); + f := FindVolumeInfoByVolumeInstance(pVolume); + ASSERT(f <> -1); + fVolume := pVolume; + Inc(TVolumeInfo(volumes[f]).fOpenedFilesCount); // íå ïîçâîëèì óáèòü çàïèñü! +end; + +destructor TSFSFileList.Destroy (); +var + f: Integer; +begin + f := FindVolumeInfoByVolumeInstance(fVolume); + ASSERT(f <> -1); + Dec(TVolumeInfo(volumes[f]).fOpenedFilesCount); + // óáü¸ì çàïèñü, åñëè îíà âðåìåííàÿ, è â íåé íåò áîëüøå íè÷åãî îòêðûòîãî + if not TVolumeInfo(volumes[f]).fPermanent and + (TVolumeInfo(volumes[f]).fOpenedFilesCount < 1) then volumes[f] := nil; + inherited Destroy(); +end; + +function TSFSFileList.GetCount (): Integer; +begin + result := fVolume.fFiles.Count; +end; + +function TSFSFileList.GetFiles (index: Integer): TSFSFileInfo; +begin + if (index < 0) or (index >= fVolume.fFiles.Count) then result := nil + else result := TSFSFileInfo(fVolume.fFiles[index]); +end; + + +procedure SFSRegisterVolumeFactory (factory: TSFSVolumeFactory); +var + f: Integer; +begin + if factory = nil then exit; + if factories.IndexOf(factory) <> -1 then + raise ESFSError.Create('duplicate factories are not allowed'); + f := factories.IndexOf(nil); + if f = -1 then factories.Add(factory) else factories[f] := factory; +end; + +procedure SFSUnregisterVolumeFactory (factory: TSFSVolumeFactory); +var + f: Integer; + c: Integer; +begin + if factory = nil then exit; + f := factories.IndexOf(factory); + if f = -1 then raise ESFSError.Create('can''t unregister nonexisting factory'); + c := 0; while c < volumes.Count do + begin + if (volumes[c] <> nil) and (TVolumeInfo(volumes[c]).fFactory = factory) then volumes[c] := nil; + Inc(c); + end; + factories[f] := nil; +end; + + +function SFSAddDataFileEx (dataFileName: TSFSString; ds: TStream; + top, permanent: Integer): Integer; +// dataFileName ìîæåò èìåòü ïðåôèêñ òèïà "zip:" (ñì. âûøå: IsMyPrefix). +// ìîæåò âûêèíóòü èñêëþ÷åíèå! +// top: +// <0: äîáàâèòü â íà÷àëî ñïèñêà ïîèñêà. +// =0: íå ìåíÿòü. +// >0: äîáàâèòü â êîíåö ñïèñêà ïîèñêà. +// permanent: +// <0: ñîçäàòü "âðåìåííûé" òîì. +// =0: íå ìåíÿòü ôëàæîê ïîñòîÿíñòâà. +// >0: ñîçäàòü "ïîñòîÿííûé" òîì. +// åñëè ds <> nil, òî ñîçäà¸ò ñáîðíèê èç ïîòîêà. åñëè ñáîðíèê ñ èìåíåì +// dataFileName óæå çàðåãèñòðèðîâàí, òî ïàäàåò íàôèã. +// âîçâðàùàåò èíäåêñ â volumes. +// óìååò äåëàòü ðåêóðñèþ. +var + fac: TSFSVolumeFactory; + vol: TSFSVolume; + vi: TVolumeInfo; + f: Integer; + st, st1: TStream; + pfx: TSFSString; + fn, vfn, tmp: TSFSString; +begin + f := Pos('::', dataFileName); + if f <> 0 then + begin + // ðåêóðñèâíîå îòêðûòèå. + // ðàçîáü¸ì dataFileName íà èìÿ ñáîðíèêà è îñòàòîê. + // pfx áóäåò èìåíåì ñáîðíèêà, dataFileName -- îñòàòêîì. + pfx := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f+1); + // ñíà÷àëà îòêðîåì ïåðâûé ñïèñîê... + result := SFSAddDataFileEx(pfx, ds, 0, 0); + // ...òåïåðü ïðîäîëæèì ñ îñòàòêîì. + // óçíàåì, êàêîå ôàéëî îòêðûâàòü. + // âûêîâûðÿåì ïåðâûé "::" ïðåôèêñ (ýòî áóäåò èìÿ ôàéëà). + f := Pos('::', dataFileName); if f = 0 then f := Length(dataFileName)+1; + fn := Copy(dataFileName, 1, f-1); Delete(dataFileName, 1, f-1); + // dataFileName õðàíèò îñòàòîê. + // èçâëå÷¸ì èìÿ ôàéëà: + SplitDataName(fn, pfx, tmp, vfn); + // îòêðîåì ýòîò ôàéë + vi := TVolumeInfo(volumes[result]); st := nil; + try + st := vi.fVolume.OpenFileEx(tmp); + st1 := TOwnedPartialStream.Create(vi, st, 0, st.Size, true); + except + FreeAndNil(st); + // óäàëèì íåèñïîëüçóåìûé âðåìåííûé òîì. + if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[result] := nil; + raise; + end; + // óðà. îòêðûëè ôàéë. êèäàåì â âîçäóõ ÷åï÷èêè, ïðîäîëæàåì ðàçâëå÷åíèå. + fn := fn+dataFileName; + try + st1.Position := 0; + result := SFSAddDataFileEx(fn, st1, top, permanent); + except + st1.Free(); // à âîò íå çàëàäèëîñü. çàêðûëè îòêðûòîå ôàéëî, âûëåòåëè. + raise; + end; + exit; + end; + + // îáûêíîâåííîå íåðåêóðñèâíîå îòêðûòèå. + SplitDataName(dataFileName, pfx, fn, vfn); + + f := FindVolumeInfo(vfn); + if f <> -1 then + begin + if ds <> nil then raise ESFSError.Create('subdata name conflict'); + if permanent <> 0 then TVolumeInfo(volumes[f]).fPermanent := (permanent > 0); + if top = 0 then result := f + else if top < 0 then result := 0 + else result := volumes.Count-1; + if result <> f then volumes.Move(f, result); + exit; + end; + + if ds <> nil then st := ds + else st := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite); + st.Position := 0; + + volumes.Pack(); + + fac := nil; vol := nil; + try + for f := 0 to factories.Count-1 do + begin + fac := TSFSVolumeFactory(factories[f]); + if fac = nil then continue; + if (pfx <> '') and not fac.IsMyVolumePrefix(pfx) then continue; + st.Position := 0; + try + if ds <> nil then vol := fac.Produce(pfx, '', st) + else vol := fac.Produce(pfx, fn, st); + except + vol := nil; + end; + if vol <> nil then break; + end; + if vol = nil then raise ESFSError.Create('no factory for "'+dataFileName+'"'); + except + if st <> ds then st.Free(); + raise; + end; + + vi := TVolumeInfo.Create(); + try + if top < 0 then + begin + result := 0; + volumes.Insert(0, vi); + end + else result := volumes.Add(vi); + except + vol.Free(); + if st <> ds then st.Free(); + vi.Free(); + raise; + end; + + vi.fFactory := fac; + vi.fVolume := vol; + vi.fPackName := vfn; + vi.fStream := st; + vi.fPermanent := (permanent > 0); + vi.fNoDiskFile := (ds <> nil); + vi.fOpenedFilesCount := 0; +end; + +function SFSAddSubDataFile (const virtualName: TSFSString; ds: TStream; + top: Boolean = false): Boolean; +var + tv: Integer; +begin + ASSERT(ds <> nil); + try + if top then tv := -1 else tv := 1; + SFSAddDataFileEx(virtualName, ds, tv, 0); + result := true; + except + result := false; + end; +end; + +function SFSAddDataFile (const dataFileName: TSFSString; top: Boolean = false): Boolean; +var + tv: Integer; +begin + try + if top then tv := -1 else tv := 1; + SFSAddDataFileEx(dataFileName, nil, tv, 1); + result := true; + except + result := false; + end; +end; + + +function SFSExpandDirName (const s: TSFSString): TSFSString; +var + f, e: Integer; + es: TSFSString; +begin + f := 1; result := s; + while f < Length(result) do + begin + while (f < Length(result)) and (result[f] <> '<') do Inc(f); + if f >= Length(result) then exit; + e := f; while (e < Length(result)) and (result[e] <> '>') do Inc(e); + es := Copy(result, f, e+1-f); + + if es = '' then es := GetCurrentDir + else if es = '' then es := ExtractFilePath(ParamStr(0)) + else es := ''; + + if es <> '' then + begin + if (es[Length(es)] <> '/') and (es[Length(es)] <> '\') then es := es+'/'; + Delete(result, f, e+1-f); + Insert(es, result, f); + Inc(f, Length(es)); + end + else f := e+1; + end; +end; + +function SFSFileOpenEx (const fName: TSFSString): TStream; +var + dataFileName, fn: TSFSString; + f: Integer; + vi: TVolumeInfo; + diskChecked: Boolean; + ps: TStream; + + function CheckDisk (): TStream; + // ïðîâåðèì, åñòü ëè ôàëî fn ãäå-òî íà äèñêàõ. + var + dfn, dirs, cdir: TSFSString; + f: Integer; + begin + result := nil; + if diskChecked or not sfsDiskEnabled then exit; + diskChecked := true; + dfn := SFSReplacePathDelims(fn, '/'); + dirs := sfsDiskDirs; if dirs = '' then dirs := ''; + while dirs <> '' do + begin + f := 1; while (f <= Length(dirs)) and (dirs[f] <> '|') do Inc(f); + cdir := Copy(dirs, 1, f-1); Delete(dirs, 1, f); + if cdir = '' then continue; + cdir := SFSReplacePathDelims(SFSExpandDirName(cdir), '/'); + if cdir[Length(cdir)] <> '/' then cdir := cdir+'/'; + try + result := TFileStream.Create(cdir+dfn, fmOpenRead or fmShareDenyWrite); + exit; + except + end; + end; + end; + +begin + SplitFName(fName, dataFileName, fn); + if fn = '' then raise ESFSError.Create('invalid file name: "'+fName+'"'); + + diskChecked := false; + + if dataFileName <> '' then + begin + // ïðåôèêñîâàíûé ôàéë + if sfsForceDiskForPrefixed then + begin + result := CheckDisk(); + if result <> nil then exit; + end; + + f := SFSAddDataFileEx(dataFileName, nil, 0, 0); + vi := TVolumeInfo(volumes[f]); + + try + result := vi.fVolume.OpenFileEx(fn); + ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true); + except + result.Free(); + if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil; + result := CheckDisk(); // îáëîì ñ datafile, ïðîâåðèì äèñê + if result = nil then raise ESFSError.Create('file not found: "'+fName+'"'); + exit; + end; + //Inc(vi.fOpenedFilesCount); + result := ps; + exit; + end; + + // íåïðåôèêñîâàíûé ôàéë + if sfsDiskFirst then + begin + result := CheckDisk(); + if result <> nil then exit; + end; + // èùåì ïî âñåì ïåðìàíåíòíûì ïðåôèêñàì + f := 0; + while f < volumes.Count do + begin + vi := TVolumeInfo(volumes[f]); + if (vi <> nil) and vi.fPermanent then + begin + if vi.fVolume <> nil then + begin + result := vi.fVolume.OpenFileEx(fn); + if result <> nil then + begin + try + ps := TOwnedPartialStream.Create(vi, result, 0, result.Size, true); + result := ps; + //Inc(vi.fOpenedFilesCount); + except + FreeAndNil(result); + end; + end; + if result <> nil then exit; + end; + end; + Inc(f); + end; + result := CheckDisk(); + if result = nil then raise ESFSError.Create('file not found: "'+fName+'"'); +end; + +function SFSFileOpen (const fName: TSFSString): TStream; +begin + try + result := SFSFileOpenEx(fName); + except + result := nil; + end; +end; + +function SFSFileList (const dataFileName: TSFSString): TSFSFileList; +var + f: Integer; + vi: TVolumeInfo; +begin + result := nil; + if dataFileName = '' then exit; + + try + f := SFSAddDataFileEx(dataFileName, nil, 0, 0); + except + exit; + end; + vi := TVolumeInfo(volumes[f]); + + try + result := TSFSFileList.Create(vi.fVolume); + except + if not vi.fPermanent and (vi.fOpenedFilesCount < 1) then volumes[f] := nil; + end; +end; + + +initialization + factories := TObjectList.Create(true); + volumes := TObjectList.Create(true); +finalization + //volumes.Free(); // it fails for some reason... Runtime 217 (^C hit). wtf?! + //factories.Free(); // not need to be done actually... +end. diff --git a/src/sfs/sfsMemFS.pas b/src/sfs/sfsMemFS.pas new file mode 100644 index 0000000..f3fcf0b --- /dev/null +++ b/src/sfs/sfsMemFS.pas @@ -0,0 +1,241 @@ +// Streaming R/O Virtual File System v0.2.0 +// Copyright (C) XL A.S. Ketmar. All rights reserved +// See the file aplicense.txt for conditions of use. +// +// "memory group". reads the whole pack in memory (and decompress it if +// necessary). memory image has only one file named "". +// +// now understands: +// slh!: DOS Allegro "slh!" +// mem : raw file (no processing, just read) +// as a side effect this gives us an opportunity to read enclosed packs +// from the packs which aren't supporting backseeking (such as zips). +// +{$MODE DELPHI} +{.$R-} +unit sfsMemFS; + +interface + +uses + SysUtils, Classes, Contnrs, sfs; + + +type + TSFSMemVolumeType = (sfsmvNone, sfsmvRAW, sfsmvSLH); + + TSFSMemoryVolume = class(TSFSVolume) + protected + fType: TSFSMemVolumeType; + fMemStream: TMemoryStream; + + procedure RAWRead (); + procedure SLHRead (); + + procedure ReadDirectory (); override; + function OpenFileByIndex (const index: Integer): TStream; override; + end; + + TSFSMemoryVolumeFactory = class (TSFSVolumeFactory) + public + function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override; + function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override; + procedure Recycle (vol: TSFSVolume); override; + end; + + + +implementation + +uses + xstreams; + + +function SLHCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; +begin + result := false; + st.ReadBuffer(sign[0], 4); + st.Seek(-4, soCurrent); + if sign <> 'slh!' then exit; + result := true; +end; + + +{ TSFSMemoryVolume } +procedure TSFSMemoryVolume.RAWRead (); +var + fi: TSFSFileInfo; +begin + fMemStream.CopyFrom(fFileStream, 0); // voila %-) + fi := TSFSFileInfo.Create(self); + fi.fName := ''; + fi.fSize := fMemStream.Size; +end; + +procedure TSFSMemoryVolume.SLHRead (); +// unpack LZSS-packed file +var + fi: TSFSFileInfo; + bufi, bufo: packed array of Byte; + iused, oused, rpos: Integer; + dict: packed array of Byte; + flags, dpos, pos, len: Word; + c: Integer; + + function ReadCh (): Integer; + begin + if rpos >= iused then + begin + // int64! + if fFileStream.Size-fFileStream.Position > Length(bufi) then iused := Length(bufi) + else iused := fFileStream.Size-fFileStream.Position; + rpos := 0; + if iused > 0 then fFileStream.ReadBuffer(bufi[0], iused); + end; + + if iused = 0 then result := -1 + else begin result := bufi[rpos]; Inc(rpos); end; + end; + + procedure WriteCh (c: Byte); + begin + if oused >= Length(bufo) then + begin + fMemStream.WriteBuffer(bufo[0], oused); + oused := 0; + end; + bufo[oused] := c; Inc(oused); + dict[dpos] := c; dpos := (dpos+1) and $FFF; + end; + +begin + fFileStream.Seek(4, soCurrent); // skip signature + SetLength(bufi, 65536); SetLength(bufo, 65536); SetLength(dict, 4096); + rpos := 0; iused := 0; oused := 0; + flags := 0; dpos := 4096-18; + repeat + if (flags and $FF00) = 0 then + begin + c := ReadCh(); if c = -1 then break; + flags := c or $FF00; + end; + + if (flags and $01) <> 0 then + begin + // literal + c := ReadCh(); if c = -1 then break; + WriteCh(c); + end + else + begin + // "copy" + c := ReadCh(); if c = -1 then break; + pos := c; + c := ReadCh(); if c = -1 then break; + len := c; + pos := (pos and $FF) or ((len and $F0) shl 4); len := (len and $0F)+3; + while len > 0 do + begin + c := dict[pos]; pos := (pos+1) and $FFF; Dec(len); + WriteCh(c); + end; + end; + flags := flags shr 1; + until false; + if oused > 0 then fMemStream.WriteBuffer(bufo[0], oused); + + fi := TSFSFileInfo.Create(self); + fi.fName := ''; + fi.fSize := fMemStream.Size; +end; + +procedure TSFSMemoryVolume.ReadDirectory (); +begin + if fMemStream = nil then fMemStream := TMemoryStream.Create() + else + begin + fMemStream.Position := 0; fMemStream.Size := 0; + end; + + case fType of + sfsmvSLH: SLHRead(); + sfsmvRAW: RAWRead(); + else raise ESFSError.Create('invalid memory SFS'); + end; + + fMemStream.Position := 0; +end; + +function TSFSMemoryVolume.OpenFileByIndex (const index: Integer): TStream; +var + fs: TStream; +begin + result := nil; fs := nil; + if fFiles = nil then exit; + if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit; + + try + fs := TSFSMemoryStreamRO.Create(fMemStream.Memory, fMemStream.Size); + if fFiles.Count = 1 then + begin + result := fs; + end + else + begin + try + result := TSFSPartialStream.Create(fs, + TSFSFileInfo(fFiles[index]).fOfs, + TSFSFileInfo(fFiles[index]).fSize, true); + except + FreeAndNil(fs); + raise; + end; + end; + except + result := nil; + end; +end; + + +{ TSFSMemoryVolumeFactory } +function TSFSMemoryVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean; +begin + result := + (SFSStrComp(prefix, 'mem') = 0) or + (SFSStrComp(prefix, 'slh!') = 0); +end; + +procedure TSFSMemoryVolumeFactory.Recycle (vol: TSFSVolume); +begin + vol.Free(); +end; + +function TSFSMemoryVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; +var + vt: TSFSMemVolumeType; +begin + if (prefix <> 'mem') and SLHCheckMagic(st) then vt := sfsmvSLH + else if prefix <> '' then vt := sfsmvRAW + else vt := sfsmvNone; + + result := TSFSMemoryVolume.Create(fileName, st); + TSFSMemoryVolume(result).fType := vt; + try + result.DoDirectoryRead(); + except + FreeAndNil(result); + raise; + end; +end; + + +var + memf: TSFSMemoryVolumeFactory; +initialization + memf := TSFSMemoryVolumeFactory.Create(); + SFSRegisterVolumeFactory(memf); +finalization + SFSUnregisterVolumeFactory(memf); +end. diff --git a/src/sfs/sfsPlainFS.pas b/src/sfs/sfsPlainFS.pas new file mode 100644 index 0000000..54438f0 --- /dev/null +++ b/src/sfs/sfsPlainFS.pas @@ -0,0 +1,726 @@ +// Streaming R/O Virtual File System v0.2.0 +// Copyright (C) XL A.S. Ketmar. All rights reserved +// See the file aplicense.txt for conditions of use. +// +// simple grouping files w/o packing: +// wad, doom : DooM .WAD (IWAD, PWAD) +// pak, quake : Quake I/II .PAK (PACK) +// grp, duke3d : Duke3D .GRP (KenSilverman) +// spe, spec, abuse: Abuse .SPE (SPEC1.0) +// wad2 : Quake .WAD (WAD2) +// allegro : DOS Allegro (slh.ALL.; ALL.) +// dune2 pak : alas, no signature %-( +// M.A.X. res : RES0 +// sin : SiN .SIN (SPAK) +// +{.$DEFINE SFS_PLAIN_FS_ALTERNATIVE_SPEC} + // define this and the first byte of each file in .SPE will contain + // file type. + // undefine this and file type will be directory name. +{.$DEFINE SFS_PLAIN_FS_DEBUG_ALLEGRO} +{$MODE DELPHI} +{.$R-} +unit sfsPlainFS; + +interface + +uses + SysUtils, Classes, Contnrs, sfs; + + + +type + TSFSPlainVolumeType = + (sfspvNone, sfspvWAD, sfspvPAK, sfspvGRP, sfspvSPE, sfspvWAD2, sfspvALL, + sfspvDune2, sfspvMAX, sfspvSIN); + + TSFSPlainVolume = class (TSFSVolume) + protected + fType: TSFSPlainVolumeType; + + procedure PAKReadDirectory (); + procedure WADReadDirectory (); + procedure GRPReadDirectory (); + procedure SPEReadDirectory (); + procedure WAD2ReadDirectory (); + procedure ALLReadDirectory (); + procedure Dune2ReadDirectory (); + procedure MAXReadDirectory (); + procedure SINReadDirectory (); + + procedure ReadDirectory (); override; + function OpenFileByIndex (const index: Integer): TStream; override; + end; + + TSFSPlainVolumeFactory = class (TSFSVolumeFactory) + public + function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override; + function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override; + procedure Recycle (vol: TSFSVolume); override; + end; + + + +implementation + +uses + xstreams; + + +type + TSFSExtFileInfo = class (TSFSFileInfo) + public + fVBuf: packed array of Byte; + fLink: TSFSString; + end; + + TAllegroProperty = class + name: TSFSString; + ofs: Int64; + size: Integer; + end; + + +function ReadMD (st: TStream): Integer; +// read dword in big-endian format. portable. +var + buf: packed array [0..3] of Byte; +begin + st.ReadBuffer(buf[0], 4); + result := (buf[0] shl 24) or (buf[1] shl 16) or (buf[2] shl 8) or buf[3]; +end; + +function WADCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; + fcnt, dofs: Integer; +begin + result := false; + st.ReadBuffer(sign[0], 4); + st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4); + st.Seek(-12, soCurrent); + if (sign <> 'IWAD') and (sign <> 'PWAD') then exit; + if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or + (dofs+fcnt*16 > st.Size) then exit; + result := true; +end; + +function PAKCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; + dsize, dofs: Integer; +begin + result := false; + st.ReadBuffer(sign[0], 4); + st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4); + st.Seek(-12, soCurrent); + if sign <> 'PACK' then exit; + if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or + (dsize mod 64 <> 0) then exit; + result := true; +end; + +function SINCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; + dsize, dofs: Integer; +begin + result := false; + st.ReadBuffer(sign[0], 4); + st.ReadBuffer(dofs, 4); st.ReadBuffer(dsize, 4); + st.Seek(-12, soCurrent); + if sign <> 'SPAK' then exit; + if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or + (dsize mod 64 <> 0) then exit; + result := true; +end; + +function GRPCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..11] of Char; + fcnt: Integer; +begin + result := false; + st.ReadBuffer(sign[0], 12); + st.ReadBuffer(fcnt, 4); + st.Seek(-16, soCurrent); + if sign <> 'KenSilverman' then exit; + if (fcnt < 0) or (fcnt*16 > st.Size-16) then exit; + result := true; +end; + +function SPECheckMagic (st: TStream): Boolean; +var + sign: packed array [0..6] of Char; + b: Byte; + fcnt: Integer; +begin + result := false; + st.ReadBuffer(sign[0], 7); st.ReadBuffer(b, 1); + st.ReadBuffer(fcnt, 4); + st.Seek(-12, soCurrent); + if (sign <> 'SPEC1.0') or (b <> 0) or (fcnt < 0) then exit; + result := true; +end; + +function WAD2CheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; + fcnt, dofs: Integer; +begin + result := false; + st.ReadBuffer(sign[0], 4); + st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4); + st.Seek(-12, soCurrent); + if sign <> 'WAD2' then exit; + if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or + (dofs+fcnt*32 > st.Size) then exit; + result := true; +end; + +function ALLCheckMagic (st: TStream): Boolean; +var + sign0, sign1: packed array [0..3] of Char; +begin + result := false; + st.ReadBuffer(sign0[0], 4); + st.ReadBuffer(sign1[0], 4); + st.Seek(-8, soCurrent); + if sign0 = 'slh.' then + begin + if sign1 <> 'ALL.' then exit; + end else if sign0 <> 'ALL.' then exit; + result := true; +end; + +function Dune2CheckMagic (st: TStream): Boolean; +var + cpos, np, f: Integer; +begin + cpos := st.Position; + st.ReadBuffer(np, 4); + st.Position := np-4; + st.ReadBuffer(f, 4); + st.Position := cpos; + result := (f = 0); +end; + +function MAXCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; + fcnt, dofs: Integer; +begin + result := false; + st.ReadBuffer(sign[0], 4); + st.ReadBuffer(dofs, 4); st.ReadBuffer(fcnt, 4); + st.Seek(-12, soCurrent); + if sign <> 'RES0' then exit; + if (dofs < 0) or (dofs > st.Size) or (fcnt < 0) or + (dofs+fcnt > st.Size) then exit; + result := true; +end; + + +{ TSFSPlainVolume } +procedure TSFSPlainVolume.WADReadDirectory (); +var + fcnt: LongWord; + dofs: LongWord; + fi: TSFSFileInfo; + name: packed array [0..9] of Char; +begin + fFileStream.Seek(4, soCurrent); // skip signature + fFileStream.ReadBuffer(fcnt, 4); + fFileStream.ReadBuffer(dofs, 4); + fFileStream.Position := dofs; + while fcnt <> 0 do + begin + fi := TSFSFileInfo.Create(self); + fFileStream.ReadBuffer(fi.fOfs, 4); + fFileStream.ReadBuffer(fi.fSize, 4); + FillChar(name[0], Length(name), 0); + fFileStream.ReadBuffer(name[0], 8); + fi.fName := PChar(@name[0]); + Dec(fcnt); + end; +end; + +procedure TSFSPlainVolume.PAKReadDirectory (); +var + dsize, dofs: LongWord; + fi: TSFSFileInfo; + name: packed array [0..56] of Char; +begin + fFileStream.Seek(4, soCurrent); // skip signature + fFileStream.ReadBuffer(dofs, 4); + fFileStream.ReadBuffer(dsize, 4); + fFileStream.Position := dofs; + while dsize >= 64 do + begin + fi := TSFSFileInfo.Create(self); + FillChar(name[0], Length(name), 0); + fFileStream.ReadBuffer(name[0], 56); + fi.fName := PChar(@name[0]); + fFileStream.ReadBuffer(fi.fOfs, 4); + fFileStream.ReadBuffer(fi.fSize, 4); + Dec(dsize, 64); + end; +end; + +procedure TSFSPlainVolume.SINReadDirectory (); +var + dsize, dofs: LongWord; + fi: TSFSFileInfo; + name: packed array [0..120] of Char; +begin + fFileStream.Seek(4, soCurrent); // skip signature + fFileStream.ReadBuffer(dofs, 4); + fFileStream.ReadBuffer(dsize, 4); + fFileStream.Position := dofs; + while dsize >= 128 do + begin + fi := TSFSFileInfo.Create(self); + FillChar(name[0], Length(name), 0); + fFileStream.ReadBuffer(name[0], 120); + fi.fName := PChar(@name[0]); + fFileStream.ReadBuffer(fi.fOfs, 4); + fFileStream.ReadBuffer(fi.fSize, 4); + Dec(dsize, 128); + end; +end; + +procedure TSFSPlainVolume.GRPReadDirectory (); +var + fcnt: LongWord; + fi: TSFSFileInfo; + name: packed array [0..12] of Char; + ofs: Int64; +begin + fFileStream.Seek(12, soCurrent); // skip signature + fFileStream.ReadBuffer(fcnt, 4); + ofs := fFileStream.Position+fcnt*16; + while fcnt <> 0 do + begin + fi := TSFSFileInfo.Create(self); + fi.fOfs := ofs; + FillChar(name[0], Length(name), 0); + fFileStream.ReadBuffer(name[0], 12); + fi.fName := PChar(@name[0]); + fFileStream.ReadBuffer(fi.fSize, 4); + Inc(ofs, fi.fSize); + Dec(fcnt); + end; +end; + +procedure TSFSPlainVolume.SPEReadDirectory (); +var + fcnt: Word; + fi: TSFSExtFileInfo; + {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC} + pp: TSFSString; + {$ENDIF} + name: ShortString; + f, c: Integer; + b: Byte; + wasUnfixedLink: Boolean; +begin + fFileStream.Seek(8, soCurrent); // skip signature + fFileStream.ReadBuffer(fcnt, 2); + while fcnt <> 0 do + begin + fi := TSFSExtFileInfo.Create(self); + {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC} + SetLength(fi.fVBuf, 1); fFileStream.ReadBuffer(fi.fVBuf[0], 1); + {$ELSE} + SetLength(fi.fVBuf, 0); + fFileStream.ReadBuffer(b, 1); + pp := IntToHex(b, 2)+'/'; + {$ENDIF} + fFileStream.ReadBuffer(name[0], 1); + if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name)); + f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1); + fi.fName := SFSReplacePathDelims(name, '/'); + if fi.fName = '' then fi.fName := 'untitled_file'; + if fi.fName[1] = '/' then Delete(fi.fName, 1, 1); + {$IFNDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC} + fi.fName := pp+fi.fName; + {$ENDIF} + fFileStream.ReadBuffer(b, 1); + if (b and $01) <> 0 then + begin + // link + fFileStream.ReadBuffer(name[0], 1); + if name[0] <> #0 then fFileStream.ReadBuffer(name[1], Length(name)); + f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1); + if name[0] = #0 then name := #0; + fi.fLink := name; + end + else + begin + fi.fLink := ''; + fFileStream.ReadBuffer(fi.fSize, 4); + {$IFDEF SFS_PLAIN_FS_ALTERNATIVE_SPEC} + Inc(fi.fSize); // plus type byte + {$ENDIF} + fFileStream.ReadBuffer(fi.fOfs, 4); + end; + Dec(fcnt); + end; + + // now fixup links + // nobody uses this shit, but it was documented by JC. %-) + // i even allow links to links! %-) + wasUnfixedLink := true; + while wasUnfixedLink do + begin + f := 0; wasUnfixedLink := false; + while f < fFiles.Count do + begin + fi := TSFSExtFileInfo(fFiles[f]); Inc(f); + if (fi = nil) or (fi.fLink = '') then continue; + c := 0; + while c < fFiles.Count do + begin + if c <> f then + begin + // link can't be linked to itself + if SFSStrComp(TSFSExtFileInfo(fFiles[c]).fName, fi.fLink) = 0 then break; + end; + Inc(c); + end; + if c < fFiles.Count then + begin + if TSFSExtFileInfo(fFiles[c]).fLink <> '' then wasUnfixedLink := true + else + begin + TSFSExtFileInfo(fFiles[c]).fOfs := fi.fOfs; + TSFSExtFileInfo(fFiles[c]).fSize := fi.fSize; + TSFSExtFileInfo(fFiles[c]).fLink := ''; + end; + end + else begin Dec(f); fFiles.Delete(f); end; // invalid link + end; + end; +end; + +procedure TSFSPlainVolume.WAD2ReadDirectory (); +var + fcnt, dofs: LongWord; + fi: TSFSFileInfo; + name: packed array [0..16] of Char; + f, c: Integer; +begin + fFileStream.Seek(4, soCurrent); // skip signature + fFileStream.ReadBuffer(fcnt, 4); + fFileStream.ReadBuffer(dofs, 4); + fFileStream.Position := dofs; + while fcnt <> 0 do + begin + fi := TSFSFileInfo.Create(self); + fFileStream.ReadBuffer(fi.fOfs, 4); + fFileStream.ReadBuffer(fi.fSize, 4); + fFileStream.ReadBuffer(f, 4); + fFileStream.ReadBuffer(c, 4); + FillChar(name[0], Length(name), 0); + fFileStream.ReadBuffer(name[0], 16); + fi.fName := PChar(@name[0]); + Dec(fcnt); + end; +end; + +procedure TSFSPlainVolume.ALLReadDirectory (); +var + fcnt: Integer; + fi: TSFSFileInfo; + sign: packed array [0..3] of Char; + nameList: TStringList; + propList: TObjectList; + name: ShortString; + f, c: Integer; + prp: TAllegroProperty; +begin + nameList := TStringList.Create(); propList := nil; + try + propList := TObjectList.Create(true); + fFileStream.ReadBuffer(sign[0], 4); + if sign[0] = 's' then fFileStream.ReadBuffer(sign[0], 4); + // signature skipped + fcnt := ReadMD(fFileStream); + while fcnt > 0 do + begin + // collect properties + nameList.Clear(); propList.Clear(); + repeat + fFileStream.ReadBuffer(sign[0], 4); + if sign <> 'prop' then break; + fFileStream.ReadBuffer(sign[0], 4); + f := ReadMD(fFileStream); // size + if f < 0 then + begin + {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO} + WriteLn(ErrOutput, 'ALLEGRO: invalid property length at $', IntToHex(fFileStream.Position-8, 8)); + {$ENDIF} + raise ESFSError.Create('invalid ALLEGRO file'); + end; + if sign = 'NAME' then + begin + if f > 255 then c := 255 else c := f; + FillChar(name, SizeOf(name), 0); + fFileStream.ReadBuffer(name[1], c); name[0] := chr(c); + Dec(f, c); + c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1); + nameList.Add(name); + end + else + begin + prp := TAllegroProperty.Create(); + Move(sign[0], name[1], 4); name[0] := #4; + c := 1; while (c <= ord(name[0])) and (name[c] <> #0) do Inc(c); name[0] := chr(c-1); + prp.name := sign; + prp.ofs := fFileStream.Position; + prp.size := f; + propList.Add(prp); + end; + fFileStream.Seek(f, soCurrent); + until false; + if nameList.Count = 0 then nameList.Add('untitled_file'); + + Move(sign[0], name[1], 4); name[5] := #0; + f := 1; while (f <= 4) and (name[f] <> #0) do Inc(f); + while (f > 0) and (name[f] <= ' ') do Dec(f); + name[0] := chr(f); + + // read size + f := ReadMD(fFileStream); + c := ReadMD(fFileStream); + if f <> c then + begin + {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO} + WriteLn(ErrOutput, 'ALLEGRO: probably a packed data at $', IntToHex(fFileStream.Position-8, 8)); + {$ENDIF} + raise ESFSError.Create('invalid ALLEGRO file'); + end; + + // add files + while nameList.Count > 0 do + begin + fi := TSFSFileInfo.Create(self); + fi.fName := nameList[0]; + fi.fPath := name; + fi.fSize := c; + fi.fOfs := fFileStream.Position; + // add properties + for f := 0 to propList.Count-1 do + begin + prp := TAllegroProperty(propList[f]); + fi := TSFSFileInfo.Create(self); + fi.fName := prp.name; + fi.fPath := name+'.props/'+nameList[0]; + fi.fSize := prp.size; + fi.fOfs := prp.ofs; + end; + nameList.Delete(0); + end; + fFileStream.Seek(c, soCurrent); + Dec(fcnt); + end; + {$IFDEF SFS_PLAIN_FS_DEBUG_ALLEGRO} + WriteLn(ErrOutput, 'ALLEGRO: ok'); + {$ENDIF} + finally + propList.Free(); + nameList.Free(); + end; +end; + +procedure TSFSPlainVolume.Dune2ReadDirectory (); +var + ofs: LongWord; + fi: TSFSFileInfo; + name: string[255]; + ch: Char; +begin + repeat + fFileStream.ReadBuffer(ofs, 4); + if ofs = 0 then break; + name[0] := #0; + fFileStream.ReadBuffer(ch, 1); + while ch <> #0 do + begin + if name[0] <> #255 then + begin + Inc(name[0]); name[ord(name[0])] := ch; + end; + fFileStream.ReadBuffer(ch, 1); + end; + if fFiles.Count > 0 then + begin + fi := TSFSFileInfo(fFiles[fFiles.Count-1]); + fi.fSize := ofs-fi.fOfs; + end; + fi := TSFSFileInfo.Create(self); + fi.fOfs := ofs; + fi.fSize := 0; + fi.fName := name; + until false; + if fFiles.Count > 0 then + begin + fi := TSFSFileInfo(fFiles[fFiles.Count-1]); + fi.fSize := fFileStream.Size-fi.fOfs; + end; +end; + +procedure TSFSPlainVolume.MAXReadDirectory (); +var + fcnt: LongInt; + dofs: LongWord; + fi: TSFSFileInfo; + name: packed array [0..9] of Char; +begin + fFileStream.Seek(4, soCurrent); // skip signature + fFileStream.ReadBuffer(dofs, 4); + fFileStream.ReadBuffer(fcnt, 4); + fFileStream.Position := dofs; + while fcnt >= 16 do + begin + fi := TSFSFileInfo.Create(self); + FillChar(name[0], Length(name), 0); + fFileStream.ReadBuffer(name[0], 8); + fFileStream.ReadBuffer(fi.fOfs, 4); + fFileStream.ReadBuffer(fi.fSize, 4); + fi.fName := PChar(@name[0]); + Dec(fcnt, 16); + end; +end; + + +procedure TSFSPlainVolume.ReadDirectory (); +begin + case fType of + sfspvWAD: WADReadDirectory(); + sfspvPAK: PAKReadDirectory(); + sfspvGRP: GRPReadDirectory(); + sfspvSPE: SPEReadDirectory(); + sfspvWAD2: WAD2ReadDirectory(); + sfspvALL: ALLReadDirectory(); + sfspvDune2: Dune2ReadDirectory(); + sfspvMAX: MAXReadDirectory(); + sfspvSIN: SINReadDirectory(); + else raise ESFSError.Create('invalid plain SFS'); + end; +end; + +function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream; +var + fs: TStream; + kill: Boolean; +begin + result := nil; fs := nil; + if fFiles = nil then exit; + if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit; + if not (fFiles[index] is TSFSExtFileInfo) or + (Length(TSFSExtFileInfo(fFiles[index]).fVBuf) < 1) then + begin + kill := false; + try + try + fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite); + kill := true; + except + fs := fFileStream; + end; + result := TSFSPartialStream.Create(fs, + TSFSFileInfo(fFiles[index]).fOfs, + TSFSFileInfo(fFiles[index]).fSize, kill); + except + if kill then FreeAndNil(fs); + result := nil; + end; + end + else + begin + kill := false; + try + try + fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite); + kill := true; + except + fs := fFileStream; + end; + result := TSFSPartialStream.Create(fs, + TSFSExtFileInfo(fFiles[index]).fOfs, + TSFSExtFileInfo(fFiles[index]).fSize-Length(TSFSExtFileInfo(fFiles[index]).fVBuf), + kill, + @(TSFSExtFileInfo(fFiles[index]).fVBuf[0]), + Length(TSFSExtFileInfo(fFiles[index]).fVBuf)); + except + if kill then FreeAndNil(fs); + result := nil; + end; + end; +end; + + +{ TSFSPlainVolumeFactory } +function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean; +begin + result := + (SFSStrComp(prefix, 'pak') = 0) or + //(SFSStrComp(prefix, 'wad') = 0) or // sorry + (SFSStrComp(prefix, 'wad2') = 0) or + (SFSStrComp(prefix, 'grp') = 0) or + (SFSStrComp(prefix, 'spe') = 0) or + (SFSStrComp(prefix, 'spec') = 0) or + (SFSStrComp(prefix, 'quake') = 0) or + (SFSStrComp(prefix, 'doom') = 0) or + (SFSStrComp(prefix, 'duke3d') = 0) or + (SFSStrComp(prefix, 'abuse') = 0) or + (SFSStrComp(prefix, 'allegro') = 0) or + (SFSStrComp(prefix, 'dune2') = 0) or + (SFSStrComp(prefix, 'max') = 0) or + (SFSStrComp(prefix, 'sin') = 0); +end; + +procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume); +begin + vol.Free(); +end; + +function TSFSPlainVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; +var + vt: TSFSPlainVolumeType; +begin + vt := sfspvNone; + if WADCheckMagic(st) then vt := sfspvWAD + else if PAKCheckMagic(st) then vt := sfspvPAK + else if GRPCheckMagic(st) then vt := sfspvGRP + else if SPECheckMagic(st) then vt := sfspvSPE + else if WAD2CheckMagic(st) then vt := sfspvWAD2 + //else if ALLCheckMagic(st) then vt := sfspvALL + else if MAXCheckMagic(st) then vt := sfspvMAX + else if SINCheckMagic(st) then vt := sfspvSIN; + //else if Dune2CheckMagic(st) then vt := sfspvDune2; // this must be the last! + + if vt <> sfspvNone then + begin + result := TSFSPlainVolume.Create(fileName, st); + TSFSPlainVolume(result).fType := vt; + try + result.DoDirectoryRead(); + except + FreeAndNil(result); + raise; + end; + end + else result := nil; +end; + + +var + pakf: TSFSPlainVolumeFactory; +initialization + pakf := TSFSPlainVolumeFactory.Create(); + SFSRegisterVolumeFactory(pakf); +finalization + SFSUnregisterVolumeFactory(pakf); +end. diff --git a/src/sfs/sfsZipFS.pas b/src/sfs/sfsZipFS.pas new file mode 100644 index 0000000..e76aa9a --- /dev/null +++ b/src/sfs/sfsZipFS.pas @@ -0,0 +1,529 @@ +// Streaming R/O Virtual File System v0.2.0 +// Copyright (C) XL A.S. Ketmar. All rights reserved +// See the file aplicense.txt for conditions of use. +// +// grouping files with packing: +// zip, jar: PKZIP-compatible archives (store, deflate) +// fout2 : Fallout II .DAT +// vtdb : Asphyre's VTDb +// dfwad : D2D:F wad archives +// +{.$DEFINE SFS_DEBUG_ZIPFS} +{$MODE DELPHI} +{.$R-} +unit sfsZipFS; + +interface + +uses + SysUtils, Classes, Contnrs, sfs; + + + +type + TSFSZipVolumeType = (sfszvNone, sfszvZIP, sfszvF2DAT, sfszvVTDB, sfszvDFWAD); + + TSFSZipVolume = class(TSFSVolume) + protected + fType: TSFSZipVolumeType; + + procedure ZIPReadDirectory (); + procedure F2DATReadDirectory (); + procedure VTDBReadDirectory (); + procedure DFWADReadDirectory (); + + procedure ReadDirectory (); override; + function OpenFileByIndex (const index: Integer): TStream; override; + end; + + TSFSZipVolumeFactory = class (TSFSVolumeFactory) + public + function IsMyVolumePrefix (const prefix: TSFSString): Boolean; override; + function Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; override; + procedure Recycle (vol: TSFSVolume); override; + end; + + + +implementation + +uses + zstream, xstreams; + + +type + TZDecompressionStream = TDecompressionStream; + +type + TSFSZipFileInfo = class (TSFSFileInfo) + public + fMethod: Byte; // 0: store; 8: deflate; 255: other + fPackSz: Int64; + end; + + TZLocalFileHeader = packed record + version: Byte; + hostOS: Byte; + flags: Word; + method: Word; + time: LongWord; + crc: LongWord; + packSz: LongWord; + unpackSz: LongWord; + fnameSz: Word; + localExtraSz: Word; + end; + + +function ZIPCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; +begin + result := false; + st.ReadBuffer(sign[0], 4); + st.Seek(-4, soCurrent); + if (sign <> 'PK'#3#4) and (sign <> 'PK'#5#6) then exit; + result := true; +end; + +function F2DATCheckMagic (st: TStream): Boolean; +var + dsize, fiSz: Integer; +begin + result := false; + st.Position := st.Size-8; + st.ReadBuffer(dsize, 4); st.ReadBuffer(fiSz, 4); + st.Position := 0; + if (fiSz <> st.Size) or (dsize < 5+13) or (dsize > fiSz-4) then exit; + result := true; +end; + +function VTDBCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..3] of Char; + fcnt, dofs: Integer; +begin + result := false; + if st.Size < 32 then exit; + st.ReadBuffer(sign[0], 4); + st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4); + st.Seek(-12, soCurrent); + if sign <> 'vtdm' then exit; + if (fcnt < 0) or (dofs < 32) or (dofs+fcnt*8 > st.Size) then exit; + result := true; +end; + +function DFWADCheckMagic (st: TStream): Boolean; +var + sign: packed array [0..5] of Char; + fcnt: Word; +begin + result := false; + if st.Size < 10 then exit; + st.ReadBuffer(sign[0], 6); + st.ReadBuffer(fcnt, 2); + st.Seek(-8, soCurrent); + //writeln('trying DFWAD... [', sign, ']'); + if (sign[0] <> 'D') and (sign[1] <> 'F') and (sign[2] <> 'W') and + (sign[3] <> 'A') and (sign[4] <> 'D') and (sign[5] <> #$01) then exit; + //writeln('DFWAD FOUND, with ', fcnt, ' files'); + //if (fcnt < 0) then exit; + result := true; +end; + + +{ TSFSZipVolume } +procedure TSFSZipVolume.ZIPReadDirectory (); +var + fi: TSFSZipFileInfo; + name: ShortString; + sign, dSign: packed array [0..3] of Char; + lhdr: TZLocalFileHeader; + ignoreFile, skipped: Boolean; + crc, psz, usz: LongWord; + buf: packed array of Byte; + bufPos, bufUsed: Integer; +begin + SetLength(buf, 0); + // read local directory + repeat + fFileStream.ReadBuffer(sign[0], Length(sign)); + + if sign <> 'PK'#3#4 then break; + + ignoreFile := false; skipped := false; + fi := TSFSZipFileInfo.Create(self); + fi.fPackSz := 0; + fi.fMethod := 0; + + fFileStream.ReadBuffer(lhdr, SizeOf(lhdr)); + if lhdr.fnameSz > 255 then name[0] := #255 else name[0] := chr(lhdr.fnameSz); + fFileStream.ReadBuffer(name[1], Length(name)); + fFileStream.Seek(lhdr.fnameSz-Length(name), soCurrent); // rest of the name (if any) + fi.fName := name; + fFileStream.Seek(lhdr.localExtraSz, soCurrent); + + if (lhdr.flags and 1) <> 0 then + begin + // encrypted file: skip it + ignoreFile := true; + end; + + if (lhdr.method <> 0) and (lhdr.method <> 8) then + begin + // not stored. not deflated. skip. + ignoreFile := true; + end; + + fi.fOfs := fFileStream.Position; + fi.fSize := lhdr.unpackSz; + fi.fPackSz := lhdr.packSz; + fi.fMethod := lhdr.method; + + if (lhdr.flags and (1 shl 3)) <> 0 then + begin + // it has a descriptor. stupid thing at all... + {$IFDEF SFS_DEBUG_ZIPFS} + WriteLn(ErrOutput, 'descr: $', IntToHex(fFileStream.Position, 8)); + WriteLn(ErrOutput, 'size: ', lhdr.unpackSz); + WriteLn(ErrOutput, 'psize: ', lhdr.packSz); + {$ENDIF} + skipped := true; + + if lhdr.packSz <> 0 then + begin + // some kind of idiot already did our work (maybe paritally) + // trust him (her? %-) + fFileStream.Seek(lhdr.packSz, soCurrent); + end; + + // scan for descriptor + if Length(buf) = 0 then SetLength(buf, 65536); + bufPos := 0; bufUsed := 0; + fFileStream.ReadBuffer(dSign[0], 4); + repeat + if dSign <> 'PK'#7#8 then + begin + // skip one byte + Move(dSign[1], dSign[0], 3); + if bufPos >= bufUsed then + begin + bufPos := 0; + // int64! + if fFileStream.Size-fFileStream.Position > Length(buf) then + bufUsed := Length(buf) + else bufUsed := fFileStream.Size-fFileStream.Position; + if bufUsed = 0 then raise ESFSError.Create('invalid ZIP file'); + fFileStream.ReadBuffer(buf[0], bufUsed); + end; + dSign[3] := chr(buf[bufPos]); Inc(bufPos); + Inc(lhdr.packSz); + continue; + end; + // signature found: check if it is a real one + // ???: make stronger check (for the correct following signature)? + // sign, crc, packsize, unpacksize + fFileStream.Seek(-bufUsed+bufPos, soCurrent); bufPos := 0; bufUsed := 0; + fFileStream.ReadBuffer(crc, 4); // crc + fFileStream.ReadBuffer(psz, 4); // packed size + // is size correct? + if psz = lhdr.packSz then + begin + // this is a real description. fuck it off + fFileStream.ReadBuffer(usz, 4); // unpacked size + break; + end; + // this is just a sequence of bytes + fFileStream.Seek(-8, soCurrent); + fFileStream.ReadBuffer(dSign[0], 4); + Inc(lhdr.packSz, 4); + until false; + // store correct values + fi.fSize := usz; + fi.fPackSz := psz; + end; + + // skip packed data + if not skipped then fFileStream.Seek(lhdr.packSz, soCurrent); + if ignoreFile then fi.Free(); + until false; + + if (sign <> 'PK'#1#2) and (sign <> 'PK'#5#6) then + begin + {$IFDEF SFS_DEBUG_ZIPFS} + WriteLn(ErrOutput, 'end: $', IntToHex(fFileStream.Position, 8)); + WriteLn(ErrOutput, 'sign: $', sign[0], sign[1], '#', ord(sign[2]), '#', ord(sign[3])); + {$ENDIF} + raise ESFSError.Create('invalid .ZIP archive (no central dir)'); + end; +end; + +procedure TSFSZipVolume.F2DATReadDirectory (); +var + dsize: Integer; + fi: TSFSZipFileInfo; + name: ShortString; + f: Integer; + b: Byte; +begin + fFileStream.Position := fFileStream.Size-8; + fFileStream.ReadBuffer(dsize, 4); + fFileStream.Seek(-dsize, soCurrent); Dec(dsize, 4); + while dsize > 0 do + begin + fi := TSFSZipFileInfo.Create(self); + fFileStream.ReadBuffer(f, 4); + if (f < 1) or (f > 255) then raise ESFSError.Create('invalid Fallout II .DAT file'); + Dec(dsize, 4+f+13); + if dsize < 0 then raise ESFSError.Create('invalid Fallout II .DAT file'); + name[0] := chr(f); if f > 0 then fFileStream.ReadBuffer(name[1], f); + f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1); + fi.fName := name; + fFileStream.ReadBuffer(b, 1); // packed? + if b = 0 then fi.fMethod := 0 else fi.fMethod := 255; + fFileStream.ReadBuffer(fi.fSize, 4); + fFileStream.ReadBuffer(fi.fPackSz, 4); + fFileStream.ReadBuffer(fi.fOfs, 4); + end; +end; + +procedure TSFSZipVolume.VTDBReadDirectory (); +// idiotic format +var + fcnt, dofs: Integer; + keys: array of record name: string; ofs: Integer; end; + fi: TSFSZipFileInfo; + f, c: Integer; + rtype: Word; +begin + fFileStream.Seek(4, soCurrent); // skip signature + fFileStream.ReadBuffer(fcnt, 4); + fFileStream.ReadBuffer(dofs, 4); + fFileStream.Seek(dofs, soBeginning); + + // read keys + SetLength(keys, fcnt); + for f := 0 to fcnt-1 do + begin + fFileStream.ReadBuffer(c, 4); + if (c < 0) or (c > 1023) then raise ESFSError.Create('invalid VTDB file'); + SetLength(keys[f].name, c); + if c > 0 then + begin + fFileStream.ReadBuffer(keys[f].name[1], c); + keys[f].name := SFSReplacePathDelims(keys[f].name, '/'); + if keys[f].name[1] = '/' then Delete(keys[f].name, 1, 1); + end; + fFileStream.ReadBuffer(keys[f].ofs, 4); + end; + + // read records (record type will be converted to directory name) + for f := 0 to fcnt-1 do + begin + fFileStream.Position := keys[f].ofs; + fi := TSFSZipFileInfo.Create(self); + fFileStream.ReadBuffer(rtype, 2); + fFileStream.ReadBuffer(fi.fSize, 4); + fFileStream.ReadBuffer(fi.fPackSz, 4); + fi.fOfs := fFileStream.Position+12; + fi.fName := keys[f].name; + fi.fPath := IntToHex(rtype, 4)+'/'; + fi.fMethod := 255; + end; +end; + +procedure TSFSZipVolume.DFWADReadDirectory (); +// idiotic format +var + fcnt: Word; + fi: TSFSZipFileInfo; + f, c, fofs, fpksize: Integer; + curpath, fname: string; + name: packed array [0..15] of Char; +begin + curpath := ''; + fFileStream.Seek(6, soCurrent); // skip signature + fFileStream.ReadBuffer(fcnt, 2); + if fcnt = 0 then exit; + // read files + for f := 0 to fcnt-1 do + begin + fFileStream.ReadBuffer(name[0], 16); + fFileStream.ReadBuffer(fofs, 4); + fFileStream.ReadBuffer(fpksize, 4); + c := 0; + fname := ''; + while (c < 16) and (name[c] <> #0) do + begin + if name[c] = '\' then name[c] := '/' + else if name[c] = '/' then name[c] := '_'; + fname := fname+name[c]; + Inc(c); + end; + // new directory? + if (fofs = 0) and (fpksize = 0) then + begin + if length(fname) <> 0 then fname := fname+'/'; + curpath := fname; + continue; + end; + if length(fname) = 0 then continue; // just in case + //writeln('DFWAD: [', curpath, '] [', fname, '] at ', fofs, ', size ', fpksize); + // create file record + fi := TSFSZipFileInfo.Create(self); + fi.fOfs := fofs; + fi.fSize := -1; + fi.fPackSz := fpksize; + fi.fName := fname; + fi.fPath := curpath; + fi.fMethod := 255; + end; +end; + +procedure TSFSZipVolume.ReadDirectory (); +begin + case fType of + sfszvZIP: ZIPReadDirectory(); + sfszvF2DAT: F2DATReadDirectory(); + sfszvVTDB: VTDBReadDirectory(); + sfszvDFWAD: DFWADReadDirectory(); + else raise ESFSError.Create('invalid zipped SFS'); + end; +end; + +function TSFSZipVolume.OpenFileByIndex (const index: Integer): TStream; +var + zs: TZDecompressionStream; + fs: TStream; + gs: TSFSGuardStream; + kill: Boolean; + buf: packed array [0..1023] of Char; + rd: LongInt; +begin + result := nil; + zs := nil; + fs := nil; + gs := nil; + if fFiles = nil then exit; + if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit; + kill := false; + try + try + fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite); + kill := true; + except + fs := fFileStream; + end; + if TSFSZipFileInfo(fFiles[index]).fMethod = 0 then + begin + result := TSFSPartialStream.Create(fs, + TSFSZipFileInfo(fFiles[index]).fOfs, + TSFSZipFileInfo(fFiles[index]).fSize, kill); + end + else + begin + fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning); + if TSFSZipFileInfo(fFiles[index]).fMethod = 255 then + begin + zs := TZDecompressionStream.Create(fs) + end + else + begin + zs := TZDecompressionStream.Create(fs, true {-15}{MAX_WBITS}); + end; + // sorry, pals, DFWAD is completely broken, so users of it should SUFFER + if TSFSZipFileInfo(fFiles[index]).fSize = -1 then + begin + TSFSZipFileInfo(fFiles[index]).fSize := 0; + //writeln('trying to determine file size...'); + try + while true do + begin + rd := zs.read(buf, 1024); + //writeln(' got ', rd, ' bytes'); + if rd > 0 then Inc(TSFSZipFileInfo(fFiles[index]).fSize, rd); + if rd < 1024 then break; + end; + //writeln(' resulting size: ', TSFSZipFileInfo(fFiles[index]).fSize, ' bytes'); + // recreate stream + FreeAndNil(zs); + fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning); + zs := TZDecompressionStream.Create(fs) + except + FreeAndNil(zs); + if kill then FreeAndNil(fs); + result := nil; + exit; + end; + end; + gs := TSFSGuardStream.Create(zs, fs, true, kill, false); + zs := nil; + fs := nil; + result := TSFSPartialStream.Create(gs, 0, TSFSZipFileInfo(fFiles[index]).fSize, true); + end; + except + FreeAndNil(gs); + FreeAndNil(zs); + if kill then FreeAndNil(fs); + result := nil; + exit; + end; +end; + + +{ TSFSZipVolumeFactory } +function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: TSFSString): Boolean; +begin + result := + (SFSStrComp(prefix, 'zip') = 0) or + (SFSStrComp(prefix, 'jar') = 0) or + (SFSStrComp(prefix, 'fout2') = 0) or + (SFSStrComp(prefix, 'vtdb') = 0) or + (SFSStrComp(prefix, 'wad') = 0) or + (SFSStrComp(prefix, 'dfwad') = 0); +end; + +procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume); +begin + vol.Free(); +end; + +function TSFSZipVolumeFactory.Produce (const prefix, fileName: TSFSString; st: TStream): TSFSVolume; +var + vt: TSFSZipVolumeType; +begin + vt := sfszvNone; + if ZIPCheckMagic(st) then vt := sfszvZIP + else if DFWADCheckMagic(st) then vt := sfszvDFWAD + else if F2DATCheckMagic(st) then vt := sfszvF2DAT + else if VTDBCheckMagic(st) then vt := sfszvVTDB; + + if vt <> sfszvNone then + begin + result := TSFSZipVolume.Create(fileName, st); + TSFSZipVolume(result).fType := vt; + try + result.DoDirectoryRead(); + except {$IFDEF SFS_DEBUG_ZIPFS} on e: Exception do begin + WriteLn(errOutput, 'ZIP ERROR: [', e.ClassName, ']: ', e.Message); + {$ENDIF} + FreeAndNil(result); + raise; + {$IFDEF SFS_DEBUG_ZIPFS}end;{$ENDIF} + end; + end + else + begin + result := nil; + end; +end; + + +var + zipf: TSFSZipVolumeFactory; +initialization + zipf := TSFSZipVolumeFactory.Create(); + SFSRegisterVolumeFactory(zipf); +finalization + SFSUnregisterVolumeFactory(zipf); +end. diff --git a/src/sfs/xstreams.pas b/src/sfs/xstreams.pas new file mode 100644 index 0000000..a9026cf --- /dev/null +++ b/src/sfs/xstreams.pas @@ -0,0 +1,297 @@ +// special stream classes +{$MODE DELPHI} +{.$R-} +unit xstreams; + +interface + +uses + SysUtils, Classes, SDL2; + + +type + // ïîòîê-îá¸ðòêà äëÿ SDL_RWops + TSFSSDLStream = class(TStream) + protected + fRW: PSDL_RWops; // SDL-íàÿ ïðîêëàäêà + fFreeSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè? + + public + constructor Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true); + destructor Destroy (); override; + + function Read (var buffer; count: LongInt): LongInt; override; + function Write (const buffer; count: LongInt): LongInt; override; + function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override; + end; + + // read-only ïîòîê äëÿ èçâëå÷åíèÿ èç èñõîäíîãî òîëüêî êóñî÷êà + TSFSPartialStream = class(TStream) + protected + fSource: TStream; // èñõîäíûé ïîòîê + fKillSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè? + fLastReadPos: Int64; // ïîñëåäíèé Read() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos) + fCurrentPos: Int64; // ïîñëåäíèé Seek() îñòàíîâèëñÿ çäåñü (îòíîñ. fStartPos) + fStartPos: Int64; // íà÷àëî êóñî÷êà + fSize: Int64; // äëèíà êóñî÷êà + fPreBuf: packed array of Byte; // ýòîò áóôåð áóäåò ïåðåä ôàéëîì + + procedure CheckPos (); + + public + // aSrc: ïîòîê-èñõîäíèê. + // aPos: íà÷àëüíàÿ ïîçèöèÿ â ïîòîêå. -1 -- ñ òåêóùåé. + // åñëè aPos < òåêóùåé ïîçèöèè, òî èñõîäíûé ïîòîê äîëæåí + // íîðìàëüíî ïîääåðæèâàòü Seek()! + // aSize: êîëè÷åñòâî áàéòèêîâ, êîòîðîå ìîæíî ïðî÷åñòü èç ïîòîêà. + // åñëè ìåíüøå íóëÿ -- òî äî êîíöà. + // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì? + // òàêæå ìîæåò ïðèøïàíäîðèòü ê íà÷àëó ôàéëà áóôåð. bufSz áóäåò äîáàâëåíî ê + // äëèíå ôàéëà. + constructor Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0); + destructor Destroy (); override; + + // íîðìàëèçóåò count è ÷èòàåò. + function Read (var buffer; count: LongInt): LongInt; override; + // Write() ïðîñòî ãðîìêî ïàäàåò. + function Write (const buffer; count: LongInt): LongInt; override; + // Seek() ðåàëèçîâàíî, ÷òîáû ìîãëà ðàáîòàòü ïðîïåðòÿ Size. + // âîîáùå-òî ìîæíî ïåðåêðûòü ìåòîä GetSize(), íî âäðóã êàêîé + // áîëüíîé íà ãîëîâó êîäåð áóäåò ïîëó÷àòü ðàçìåð ïðè ïîìîùè + // Seek()'à? + function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override; + end; + + TSFSGuardStream = class(TStream) + protected + fSource: TStream; // èñõîäíûé ïîòîê + fGuardedStream: TStream; // ïîòîê, êîòîðûé çàâàëèì ïðè ïîìèðàíèè + fKillSource: Boolean; // óáèâàòü èñõîäíèê ïðè ïîìèðàíèè? + fKillGuarded: Boolean; // óáèâàòü îõðàíÿåìûé ïðè ïîìèðàíèè? + fGuardedFirst: Boolean; // ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî? + + public + // aSrc: ïîòîê-èñõîäíèê (íà êîòîðûé çàìàïåíû îïåðàöèè ÷òåíèÿ/çàïèñè). + // aKillSrc: óáèâàòü ëè èñõîäíûé ïîòîê, êîãäà ñàìè óìèðàåì? + // aKillGuarded: óáèâàòü ëè îõðàíÿåìûé ïîòîê, êîãäà ñàìè óìèðàåì? + // aGuardedFirst: true: ïðè ñìåðòè ïåðâûì ïðèøèáàåì îõðàíÿåìîãî. + constructor Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true); + destructor Destroy (); override; + + // íèæåñëåäóþùåå çàìàïëåíî íà fSource + function Read (var buffer; count: LongInt): LongInt; override; + function Write (const buffer; count: LongInt): LongInt; override; + function Seek (const offset: Int64; origin: TSeekOrigin): Int64; override; + end; + + TSFSMemoryStreamRO = class(TCustomMemoryStream) + public + constructor Create (pMem: Pointer; pSize: Integer); + + function Write (const buffer; count: LongInt): LongInt; override; + end; + + +implementation + +uses + sfs; // for ESFSError + +{ TSFSSDLStream } +constructor TSFSSDLStream.Create (aSrc: PSDL_RWops; aFreeSource: Boolean=true); +begin + inherited Create(); + //ASSERT(aSrc <> nil); + fRW := aSrc; + fFreeSource := aFreeSource; +end; + +destructor TSFSSDLStream.Destroy (); +begin + if fFreeSource and (fRW <> nil) then SDL_FreeRW(fRW); + inherited Destroy(); +end; + +function TSFSSDLStream.Read (var buffer; count: LongInt): LongInt; +begin + if (fRW = nil) or (count <= 0) then begin result := 0; exit; end; + result := SDL_RWread(fRW, @buffer, 1, count); +end; + +function TSFSSDLStream.Write (const buffer; count: LongInt): LongInt; +begin + if (fRW = nil) or (count <= 0) then begin result := 0; exit; end; + result := SDL_RWwrite(fRW, @buffer, 1, count); +end; + +function TSFSSDLStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64; +var + ss: Integer; +begin + if fRW = nil then begin result := 0; exit; end; + case origin of + soBeginning: ss := RW_SEEK_SET; + soCurrent: ss := RW_SEEK_CUR; + soEnd: ss := RW_SEEK_END; + else raise ESFSError.Create('invalid Seek() call'); + // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð. + end; + result := SDL_RWseek(fRW, offset, ss); + if result = -1 then raise ESFSError.Create('Seek() error'); +end; + + +{ TSFSPartialStream } +constructor TSFSPartialStream.Create (aSrc: TStream; aPos, aSize: Int64; aKillSrc: Boolean; preBuf: Pointer=nil; bufSz: Integer=0); +begin + inherited Create(); + ASSERT(aSrc <> nil); + if aPos < 0 then aPos := aSrc.Position; + if aSize < 0 then aSize := 0; + fSource := aSrc; + fKillSource := aKillSrc; + fLastReadPos := 0; + fCurrentPos := 0; + fStartPos := aPos; + fSize := aSize; + if bufSz > 0 then + begin + SetLength(fPreBuf, bufSz); + Move(preBuf^, fPreBuf[0], bufSz); + Inc(fSize, bufSz); + end + else + begin + fPreBuf := nil; + end; +end; + +destructor TSFSPartialStream.Destroy (); +begin + if fKillSource then FreeAndNil(fSource); + inherited Destroy(); +end; + +procedure TSFSPartialStream.CheckPos (); +begin + if fSource.Position <> fStartPos+fCurrentPos-Length(fPreBuf) then + begin + fSource.Position := fStartPos+fCurrentPos-Length(fPreBuf); + end; + fLastReadPos := fCurrentPos; +end; + +function TSFSPartialStream.Write (const buffer; count: LongInt): LongInt; +begin + result := 0; + raise ESFSError.Create('can''t write to read-only stream'); + // à íå õîäè, íåõîðîøèé, â íàø ñàäèê ãóëÿòü! +end; + +function TSFSPartialStream.Read (var buffer; count: LongInt): LongInt; +var + left: Int64; + pc: Pointer; + rd: LongInt; +begin + if count < 0 then raise ESFSError.Create('invalid Read() call'); // ñêàçî÷íûé äîëáî¸á... + if count = 0 then begin result := 0; exit; end; + pc := @buffer; + result := 0; + if (Length(fPreBuf) > 0) and (fCurrentPos < Length(fPreBuf)) then + begin + fLastReadPos := fCurrentPos; + left := Length(fPreBuf)-fCurrentPos; + if left > count then left := count; + if left > 0 then + begin + Move(fPreBuf[fCurrentPos], pc^, left); + Inc(PChar(pc), left); + Inc(fCurrentPos, left); + fLastReadPos := fCurrentPos; + Dec(count, left); + result := left; + if count = 0 then exit; + end; + end; + CheckPos(); + left := fSize-fCurrentPos; + if left < count then count := left; // è òàê ñëó÷àåòñÿ... + if count > 0 then + begin + rd := fSource.Read(pc^, count); + Inc(result, rd); + Inc(fCurrentPos, rd); + fLastReadPos := fCurrentPos; + end + else + begin + result := 0; + end; +end; + +function TSFSPartialStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64; +begin + case origin of + soBeginning: result := offset; + soCurrent: result := offset+fCurrentPos; + soEnd: result := fSize+offset; + else raise ESFSError.Create('invalid Seek() call'); + // äðóãèõ íå áûâàåò. à ó êîãî áûâàåò, òîìó ÿ íå äîêòîð. + end; + if result < 0 then result := 0 + else if result > fSize then result := fSize; + fCurrentPos := result; +end; + + +{ TSFSGuardStream } +constructor TSFSGuardStream.Create (aSrc, aGuarded: TStream; aKillSrc, aKillGuarded: Boolean; aGuardedFirst: Boolean=true); +begin + inherited Create(); + fSource := aSrc; fGuardedStream := aGuarded; + fKillSource := aKillSrc; fKillGuarded := aKillGuarded; + fGuardedFirst := aGuardedFirst; +end; + +destructor TSFSGuardStream.Destroy (); +begin + if fKillGuarded and fGuardedFirst then FreeAndNil(fGuardedStream); + if fKillSource then FreeAndNil(fSource); + if fKillGuarded and not fGuardedFirst then FreeAndNil(fGuardedStream); + inherited Destroy(); +end; + +function TSFSGuardStream.Read (var buffer; count: LongInt): LongInt; +begin + result := fSource.Read(buffer, count); +end; + +function TSFSGuardStream.Write (const buffer; count: LongInt): LongInt; +begin + result := fSource.Write(buffer, count); +end; + +function TSFSGuardStream.Seek (const offset: Int64; origin: TSeekOrigin): Int64; +begin + result := fSource.Seek(offset, origin); +end; + + +{ TSFSMemoryStreamRO } +constructor TSFSMemoryStreamRO.Create (pMem: Pointer; pSize: Integer); +begin + inherited Create(); + SetPointer(pMem, pSize); + Position := 0; +end; + +function TSFSMemoryStreamRO.Write (const buffer; count: LongInt): LongInt; +begin + result := 0; + raise ESFSError.Create('can''t write to read-only stream'); + // ñîâñåì ñáðåíäèë... +end; + + +end. -- 2.29.2