1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {$I ../shared/a_modes.inc}
20 uses SysUtils
, Utils
, Classes
;
25 {-------------------------------------------}
26 {--- insert separator beetwin a and b ---}
27 {--- result are correct if (a or b) = '' ---}
28 {--- - - - - - - - - - - - - - - - - - - ---}
29 function e_CatPath (a
, b
: AnsiString
): AnsiString
;
31 {--- remove last entry from path ---}
32 function e_UpperDir (path
: AnsiString
): AnsiString
;
34 {--- not absolute and have no relative dirs ---}
35 function e_IsValidResourceName (name
: AnsiString
): Boolean;
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 {--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ---}
43 function e_CreateResource (dirs
: SSArray
; name
: AnsiString
): TStream
;
44 function e_OpenResourceRO (dirs
: SSArray
; name
: AnsiString
): TStream
;
45 function e_OpenResourceRW (dirs
: SSArray
; name
: AnsiString
): TStream
;
47 {--- same as shared/utils ---}
48 function e_FindResource (dirs
: SSArray
; var name
: AnsiString
; nameIsDir
: Boolean = false): Boolean;
49 function e_FindWad (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
51 {--- returns relative wad name; never empty string ---}
52 function e_FindWadRel (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
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 ---}
56 function e_GetResourcePath (dirs
: SSArray
; path
: AnsiString
; defWad
: AnsiString
): AnsiString
;
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 ---}
64 function e_GetWriteableDir (dirs
: SSArray
; required
: Boolean=true): AnsiString
;
66 function e_CanCreateFilesAt (dir
: AnsiString
): Boolean;
70 uses WadReader
, e_log
, hashtable
;
73 SpawnProc
= function (pathname
: AnsiString
): Tstream
;
76 writeableDirs
: THashStrCIStr
= nil;
79 function e_UpperDir (path
: AnsiString
): AnsiString
;
82 i
:= High(path
); // consider possible cases: '\a\', '\a', '\abc\'
83 while (i
>= 1) and (path
[i
] <> '/') and (path
[i
] <> '\') do Dec(i
);
84 result
:= Copy(path
, 1, i
-1) // exclude the trailing separator
87 function IsRelativePath (name
: AnsiString
): Boolean;
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
94 function IsAbsolutePath (name
: AnsiString
): Boolean;
96 result
:= ExpandFileName(name
) = name
;
99 function e_IsValidResourceName (name
: AnsiString
): Boolean;
101 result
:= (IsAbsolutePath(name
) = false) and (IsRelativePath(name
) = false)
104 function SpawnStream (dirs
: SSArray
; name
: AnsiString
; p
: SpawnProc
; createNewDir
: Boolean): TStream
;
109 assert(e_IsValidResourceName(name
));
111 while (i
>= 0) and (result
= nil) do
115 e_LogWritefln(' %s', [dirs
[i
]]);
116 if (createNewDir
= false) or (ForceDirectories(dirs
[i
]) = true) then
117 result
:= p(e_CatPath(dirs
[i
], name
))
124 function e_CreateResource (dirs
: SSArray
; name
: AnsiString
): TStream
;
127 e_LogWritefln('e_CreateResource %s', [name
]);
128 result
:= SpawnStream(dirs
, name
, @createDiskFile
, true);
130 raise Exception
.Create('can''t create resource "' + name
+ '"');
133 function e_OpenResourceRO (dirs
: SSArray
; name
: AnsiString
): TStream
;
136 e_LogWritefln('e_OpenResourceRO %s', [name
]);
137 result
:= SpawnStream(dirs
, name
, @openDiskFileRO
, false);
139 raise EFileNotFoundException
.Create('can''t open resource "' + name
+ '"')
142 function e_OpenResourceRW (dirs
: SSArray
; name
: AnsiString
): TStream
;
145 e_LogWritefln('e_OpenResourceRW %s', [name
]);
146 result
:= SpawnStream(dirs
, name
, @openDiskFileRW
, true);
148 raise Exception
.Create('can''t create resource "' + name
+ '"')
151 function e_CatPath (a
, b
: AnsiString
): AnsiString
;
158 result
:= a
+ '/' + b
161 function e_FindResource (dirs
: SSArray
; var name
: AnsiString
; nameIsDir
: Boolean = false): Boolean;
162 var i
: Integer; dir
: AnsiString
;
165 e_LogWritefln('e_FindResource %s (%s)', [name
, nameIsDir
]);
168 assert(e_IsValidResourceName(name
));
169 i
:= High(dirs
); dir
:= name
;
170 while (i
>= 0) and (result
= false) do
172 dir
:= e_CatPath(dirs
[i
], name
);
173 result
:= findFileCI(dir
, nameIsDir
);
175 e_LogWritefln(' %s -> %s', [dir
, result
]);
178 if result
= true then
181 e_LogWritefln(' result = %s (%s)', [name
, result
]);
184 function e_FindWad (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
188 e_LogWritefln('e_FindWad "%s"', [name
]);
191 assert(e_IsValidResourceName(name
));
193 while (i
>= 0) and (result
= '') do
195 result
:= findDiskWad(dirs
[i
] + DirectorySeparator
+ name
);
197 e_LogWritefln(' %s -> %s', [dirs
[i
] + DirectorySeparator
+ name
, result
]);
202 function e_FindWadRel (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
205 maxpfx
: AnsiString
= '';
209 if not findFileCI(name
) then exit
;
212 if (length(s
) = 0) then continue
;
213 if (length(name
) <= length(s
)) then continue
;
214 if (length(s
) < length(maxpfx
)) then continue
;
216 if not findFileCI(pfx
, true) then continue
;
217 if (pfx
[length(pfx
)] <> '/') and (pfx
[length(pfx
)] <> '\') then pfx
:= pfx
+'/';
218 if (length(pfx
)+1 > length(name
)) then continue
;
219 if (strEquCI1251(copy(name
, 1, length(pfx
)), pfx
)) then maxpfx
:= pfx
;
221 if (length(maxpfx
) > 0) then
224 Delete(result
, 1, length(maxpfx
));
228 function e_GetResourcePath (dirs
: SSArray
; path
: AnsiString
; defWad
: AnsiString
): AnsiString
;
229 var diskName
, fileName
: AnsiString
;
232 e_LogWritefln('e_GetResourcePath %s (%s)', [path
, defWad
]);
233 assert(length(dirs
) > 0);
235 assert(defWad
<> '');
236 diskName
:= g_ExtractWadName(path
);
237 fileName
:= g_ExtractFilePathName(path
);
238 if diskName
= '' then diskName
:= defWad
else diskName
:= e_FindWad(dirs
, diskName
);
239 if diskName
= '' then result
:= '' else result
:= diskName
+ ':\' + fileName
;
241 e_LogWritefln(' this>>> %s', [result
]);
244 function e_FindFirst (dirs
: SSArray
; name
: AnsiString
; attr
: LongInt; out Rslt
: TSearchRec
): LongInt;
245 var i
: Integer; dir
: AnsiString
;
248 e_LogWritefln('e_FindFirst %s', [name
]);
250 assert(e_IsValidResourceName(name
));
251 i
:= High(dirs
); result
:= -1;
252 while (i
>= 0) and (result
<> 0) do
254 dir
:= dirs
[i
] + DirectorySeparator
+ name
;
255 result
:= FindFirst(dir
, attr
, Rslt
);
257 e_LogWritefln(' %s: %s -- %s', [i
, dir
, result
]);
262 // k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable).
263 function e_CanCreateFilesAt (dir
: AnsiString
): Boolean;
271 for f
:= 0 to $7fffffff do
273 fn
:= Format('%s/$$$temptest$$$_%d.$$$%d$$$', [dir
, f
, f
]);
274 if (FindFirst(fn
, faAnyFile
, sr
) = 0) then
281 st
:= TFileStream
.Create(fn
, fmCreate
);
283 st
:= nil; // just in case
288 try DeleteFile(fn
); except end;
295 function e_GetWriteableDir (dirs
: SSArray
; required
: Boolean=true): AnsiString
;
299 assert(length(dirs
) > 0);
301 if assigned(writeableDirs
) then
303 for f
:= High(dirs
) downto Low(dirs
) do
305 if (writeableDirs
.get(dirs
[f
], result
)) then
307 //writeln('*** KNOWN WRITEABLE DIR: "', result, '"');
312 for f
:= High(dirs
) downto Low(dirs
) do
315 if ForceDirectories(dirs
[f
]) then
318 if (findFileCI(result
, true)) then
320 if e_CanCreateFilesAt(result
) then
322 if not assigned(writeableDirs
) then writeableDirs
:= THashStrCIStr
.Create();
323 writeableDirs
.put(dirs
[f
], result
);
324 //writeln('*** NEW WRITEABLE DIR: "', result, '" ("', dirs[f], '"); rq=', required);
332 if required
then raise Exception
.Create(Format('unable to create directory "%s"', [dirs
[High(dirs
)]]));