DEADSOFTWARE

Fix error file not open on win32; Added stacktrace logging
[d2df-editor.git] / src / sfs / sfsPlainFS.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 // simple grouping files w/o packing:
17 // Quake I/II .PAK (PACK)
18 // SiN .SIN (SPAK)
19 //
20 {$INCLUDE ../shared/a_modes.inc}
21 {$SCOPEDENUMS OFF}
22 {.$R+}
23 unit sfsPlainFS;
25 interface
27 uses
28 SysUtils, Classes, Contnrs, sfs;
31 type
32 TSFSPlainVolumeType = (sfspvNone, sfspvPAK, sfspvSIN);
34 TSFSPlainVolume = class (TSFSVolume)
35 protected
36 fType: TSFSPlainVolumeType;
38 procedure ReadDirectory (); override;
40 public
41 function OpenFileByIndex (const index: Integer): TStream; override;
42 end;
44 TSFSPlainVolumeFactory = class (TSFSVolumeFactory)
45 public
46 function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override;
47 function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override;
48 procedure Recycle (vol: TSFSVolume); override;
49 end;
52 implementation
54 uses
55 xstreams, utils;
58 { TSFSPlainVolume }
59 procedure TSFSPlainVolume.ReadDirectory ();
60 var
61 dsize, dofs, esz: LongWord;
62 fi: TSFSFileInfo;
63 name: packed array [0..120] of Char;
64 begin
65 if (fType <> sfspvPAK) and (fType <> sfspvSIN) then raise ESFSError.Create('invalid archive');
66 fFileStream.Seek(4, soCurrent); // skip signature
67 dofs := readLongWord(fFileStream);
68 dsize := readLongWord(fFileStream);
69 fFileStream.Position := dofs;
70 if fType = sfspvPAK then esz := 64 else esz := 128;
71 while dsize >= esz do
72 begin
73 fi := TSFSFileInfo.Create(self);
74 FillChar(name[0], length(name), 0);
75 fFileStream.ReadBuffer(name[0], esz-8);
76 fi.fName := PChar(@name[0]);
77 fi.fOfs := readLongWord(fFileStream);
78 fi.fSize := readLongWord(fFileStream);
79 Dec(dsize, esz);
80 end;
81 end;
83 function TSFSPlainVolume.OpenFileByIndex (const index: Integer): TStream;
84 begin
85 result := nil;
86 if fFiles = nil then exit;
87 if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
88 result := TSFSPartialStream.Create(fFileStream, TSFSFileInfo(fFiles[index]).fOfs, TSFSFileInfo(fFiles[index]).fSize, false);
89 end;
92 { TSFSPlainVolumeFactory }
93 function TSFSPlainVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
94 begin
95 result :=
96 StrEquCI1251(prefix, 'pak') or
97 StrEquCI1251(prefix, 'sin');
98 end;
100 procedure TSFSPlainVolumeFactory.Recycle (vol: TSFSVolume);
101 begin
102 vol.Free();
103 end;
105 function TSFSPlainVolumeFactory.Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume;
106 var
107 vt: TSFSPlainVolumeType;
108 sign: packed array [0..3] of Char;
109 dsize, dofs: Integer;
110 begin
111 result := nil;
112 vt := sfspvNone;
114 st.ReadBuffer(sign[0], 4);
115 dofs := readLongWord(st);
116 dsize := readLongWord(st);
117 st.Seek(-12, soCurrent);
118 if sign = 'PACK' then
119 begin
120 if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
121 vt := sfspvPAK;
122 end
123 else if sign = 'SPAK' then
124 begin
125 if (dsize < 0) or (dofs < 0) or (dofs > st.Size) or (dofs+dsize > st.Size) or (dsize mod 64 <> 0) then exit;
126 vt := sfspvSIN;
127 end;
129 result := TSFSPlainVolume.Create(fileName, st);
130 TSFSPlainVolume(result).fType := vt;
131 try
132 result.DoDirectoryRead();
133 except
134 FreeAndNil(result);
135 raise;
136 end;
137 end;
140 var
141 pakf: TSFSPlainVolumeFactory;
142 initialization
143 pakf := TSFSPlainVolumeFactory.Create();
144 SFSRegisterVolumeFactory(pakf);
145 //finalization
146 // SFSUnregisterVolumeFactory(pakf);
147 end.