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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$I ../shared/a_modes.inc}
18 interface
22 var
25 {-------------------------------------------}
26 {--- insert separator beetwin a and b ---}
27 {--- result are correct if (a or b) = '' ---}
28 {--- - - - - - - - - - - - - - - - - - - ---}
31 {--- remove last entry from path ---}
34 {--- not absolute and have no relative dirs ---}
37 {-----------------------------------------------------------------------}
38 {--- try to open/create file in one dir from `dirs` in reverse order ---}
39 {--- e_OpenResourceRW tries to create if not exists ---}
40 {--- create dirs if not exists ---}
41 {--- result <> nil, throws exceptions on errors ---}
42 {--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ---}
47 {--- same as shared/utils ---}
48 function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
51 {--- returns relative wad name; never empty string ---}
54 {--- prepend dirs to 'disk.wad:\file'. if empty disk string then prepend defWad ---}
55 {--- return empty string if error occured or 'path/to/disk.wad:\file' on success ---}
58 {--- same as SysUtils.FinFirst ---}
59 function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
61 {--- try to get a writeable directory from list, throws if no one directory created ---}
62 {--- (unless `required` is `false`: in this case, returns empty string) ---}
63 {--- creates all necessary subdirs, if it can ---}
68 implementation
72 type
75 var
81 begin
88 begin
89 result := (copy(name, 1, 3) = '../') or (pos('/../', name) <> 0) or (copy(name, Length(name) - 2) = '/..') or
90 (copy(name, 1, 3) = '..\') or (pos('\..\', name) <> 0) or (copy(name, Length(name) - 2) = '\..') or
95 begin
100 begin
104 function SpawnStream (dirs: SSArray; name: AnsiString; p: SpawnProc; createNewDir: Boolean): TStream;
106 begin
112 begin
113 try
118 finally
120 end
121 end
125 begin
134 begin
143 begin
152 begin
154 result := b
156 result := a
157 else
161 function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
163 begin
171 begin
186 begin
194 begin
199 end
203 var
207 begin
211 begin
222 begin
230 begin
244 function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
246 begin
253 begin
259 end
262 // k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable).
264 var
269 begin
272 begin
275 begin
277 continue;
280 try
286 begin
291 exit;
296 var
298 begin
302 begin
304 begin
306 begin
307 //writeln('*** KNOWN WRITEABLE DIR: "', result, '"');
308 exit;
313 begin
314 try
316 begin
319 begin
321 begin
324 //writeln('*** NEW WRITEABLE DIR: "', result, '" ("', dirs[f], '"); rq=', required);
325 exit;
332 if required then raise Exception.Create(Format('unable to create directory "%s"', [dirs[High(dirs)]]));