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 {--- remove last entry from path ---}
26 function e_UpperDir (path
: AnsiString
): AnsiString
;
28 {--- not absolute and have no relative dirs ---}
29 function e_IsValidResourceName (name
: AnsiString
): Boolean;
31 {-----------------------------------------------------------------------}
32 {--- try to open/create file in one dir from `dirs` in reverse order ---}
33 {--- e_OpenResourceRW tries to create if not exists ---}
34 {--- create dirs if not exists ---}
35 {--- result <> nil, throws exceptions on errors ---}
36 {--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ---}
37 function e_CreateResource (dirs
: SSArray
; name
: AnsiString
): TStream
;
38 function e_OpenResourceRO (dirs
: SSArray
; name
: AnsiString
): TStream
;
39 function e_OpenResourceRW (dirs
: SSArray
; name
: AnsiString
): TStream
;
41 {--- same as shared/utils ---}
42 function e_FindResource (dirs
: SSArray
; var name
: AnsiString
; nameIsDir
: Boolean = false): Boolean;
43 function e_FindWad (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
45 {--- returns relative wad name; never empty string ---}
46 function e_FindWadRel (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
48 {--- prepend dirs to 'disk.wad:\file'. if empty disk string then prepend defWad ---}
49 {--- return empty string if error occured or 'path/to/disk.wad:\file' on success ---}
50 function e_GetResourcePath (dirs
: SSArray
; path
: AnsiString
; defWad
: AnsiString
): AnsiString
;
52 {--- same as SysUtils.FinFirst ---}
53 function e_FindFirst (dirs
: SSArray
; name
: AnsiString
; attr
: LongInt; out Rslt
: TSearchRec
): LongInt;
55 {--- try to get a writeable directory from list, throws if no one directory created ---}
56 {--- (unless `required` is `false`: in this case, returns empty string) ---}
57 {--- creates all necessary subdirs, if it can ---}
58 function e_GetWriteableDir (dirs
: SSArray
; required
: Boolean=true): AnsiString
;
60 function e_CanCreateFilesAt (dir
: AnsiString
): Boolean;
64 uses WadReader
, e_log
, hashtable
;
67 SpawnProc
= function (pathname
: AnsiString
): Tstream
;
70 writeableDirs
: THashStrCIStr
;
73 function e_UpperDir (path
: AnsiString
): AnsiString
;
76 i
:= High(path
); // consider possible cases: '\a\', '\a', '\abc\'
77 while (i
>= 1) and (path
[i
] <> '/') and (path
[i
] <> '\') do Dec(i
);
78 result
:= Copy(path
, 1, i
-1) // exclude the trailing separator
81 function IsRelativePath (name
: AnsiString
): Boolean;
83 result
:= (copy(name
, 1, 3) = '../') or (pos('/../', name
) <> 0) or (copy(name
, Length(name
) - 2) = '/..') or
84 (copy(name
, 1, 3) = '..\') or (pos('\..\', name
) <> 0) or (copy(name
, Length(name
) - 2) = '\..') or
88 function IsAbsolutePath (name
: AnsiString
): Boolean;
90 result
:= ExpandFileName(name
) = name
;
93 function e_IsValidResourceName (name
: AnsiString
): Boolean;
95 result
:= (IsAbsolutePath(name
) = false) and (IsRelativePath(name
) = false)
98 function SpawnStream (dirs
: SSArray
; name
: AnsiString
; p
: SpawnProc
; createNewDir
: Boolean): TStream
;
103 assert(e_IsValidResourceName(name
));
105 while (i
>= 0) and (result
= nil) do
109 e_LogWritefln(' %s', [dirs
[i
]]);
110 if (createNewDir
= false) or (ForceDirectories(dirs
[i
]) = true) then
111 result
:= p(ConcatPaths([AnsiString(dirs
[i
]), name
]))
118 function e_CreateResource (dirs
: SSArray
; name
: AnsiString
): TStream
;
121 e_LogWritefln('e_CreateResource %s', [name
]);
122 result
:= SpawnStream(dirs
, name
, @createDiskFile
, true);
124 raise Exception
.Create('can''t create resource "' + name
+ '"');
127 function e_OpenResourceRO (dirs
: SSArray
; name
: AnsiString
): TStream
;
130 e_LogWritefln('e_OpenResourceRO %s', [name
]);
131 result
:= SpawnStream(dirs
, name
, @openDiskFileRO
, false);
133 raise EFileNotFoundException
.Create('can''t open resource "' + name
+ '"')
136 function e_OpenResourceRW (dirs
: SSArray
; name
: AnsiString
): TStream
;
139 e_LogWritefln('e_OpenResourceRW %s', [name
]);
140 result
:= SpawnStream(dirs
, name
, @openDiskFileRW
, true);
142 raise Exception
.Create('can''t create resource "' + name
+ '"')
145 function e_FindResource (dirs
: SSArray
; var name
: AnsiString
; nameIsDir
: Boolean = false): Boolean;
146 var i
: Integer; dir
: AnsiString
;
149 e_LogWritefln('e_FindResource %s (%s)', [name
, nameIsDir
]);
152 assert(e_IsValidResourceName(name
));
153 i
:= High(dirs
); dir
:= name
;
154 while (i
>= 0) and (result
= false) do
156 dir
:= ConcatPaths([AnsiString(dirs
[i
]), name
]);
157 result
:= findFileCI(dir
, nameIsDir
);
159 e_LogWritefln(' %s -> %s', [dir
, result
]);
162 if result
= true then
165 e_LogWritefln(' result = %s (%s)', [name
, result
]);
168 function e_FindWad (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
172 e_LogWritefln('e_FindWad "%s"', [name
]);
175 assert(e_IsValidResourceName(name
));
177 while (i
>= 0) and (result
= '') do
179 result
:= findDiskWad(dirs
[i
] + DirectorySeparator
+ name
);
181 e_LogWritefln(' %s -> %s', [dirs
[i
] + DirectorySeparator
+ name
, result
]);
186 function e_FindWadRel (dirs
: SSArray
; name
: AnsiString
): AnsiString
;
189 maxpfx
: AnsiString
= '';
193 if not findFileCI(name
) then exit
;
196 if (length(s
) = 0) then continue
;
197 if (length(name
) <= length(s
)) then continue
;
198 if (length(s
) < length(maxpfx
)) then continue
;
200 if not findFileCI(pfx
, true) then continue
;
201 if (pfx
[length(pfx
)] <> '/') and (pfx
[length(pfx
)] <> '\') then pfx
:= pfx
+'/';
202 if (length(pfx
)+1 > length(name
)) then continue
;
203 if (strEquCI1251(copy(name
, 1, length(pfx
)), pfx
)) then maxpfx
:= pfx
;
205 if (length(maxpfx
) > 0) then
208 Delete(result
, 1, length(maxpfx
));
212 function e_GetResourcePath (dirs
: SSArray
; path
: AnsiString
; defWad
: AnsiString
): AnsiString
;
213 var diskName
, fileName
: AnsiString
;
216 e_LogWritefln('e_GetResourcePath %s (%s)', [path
, defWad
]);
217 assert(length(dirs
) > 0);
219 assert(defWad
<> '');
220 diskName
:= g_ExtractWadName(path
);
221 fileName
:= g_ExtractFilePathName(path
);
222 if diskName
= '' then diskName
:= defWad
else diskName
:= e_FindWad(dirs
, diskName
);
223 if diskName
= '' then result
:= '' else result
:= diskName
+ ':\' + fileName
;
225 e_LogWritefln(' this>>> %s', [result
]);
228 function e_FindFirst (dirs
: SSArray
; name
: AnsiString
; attr
: LongInt; out Rslt
: TSearchRec
): LongInt;
229 var i
: Integer; dir
: AnsiString
;
232 e_LogWritefln('e_FindFirst %s', [name
]);
234 assert(e_IsValidResourceName(name
));
235 i
:= High(dirs
); result
:= -1;
236 while (i
>= 0) and (result
<> 0) do
238 dir
:= dirs
[i
] + DirectorySeparator
+ name
;
239 result
:= FindFirst(dir
, attr
, Rslt
);
241 e_LogWritefln(' %s: %s -- %s', [i
, dir
, result
]);
246 // k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable).
247 function e_CanCreateFilesAt (dir
: AnsiString
): Boolean;
255 for f
:= 0 to $7fffffff do
257 fn
:= Format('%s/$$$temptest$$$_%d.$$$%d$$$', [dir
, f
, f
]);
258 if (FindFirst(fn
, faAnyFile
, sr
) = 0) then
265 st
:= TFileStream
.Create(fn
, fmCreate
);
267 st
:= nil; // just in case
272 try DeleteFile(fn
); except end;
279 function e_GetWriteableDir (dirs
: SSArray
; required
: Boolean=true): AnsiString
;
283 assert(length(dirs
) > 0);
285 if assigned(writeableDirs
) then
287 for f
:= High(dirs
) downto Low(dirs
) do
289 if (writeableDirs
.get(dirs
[f
], result
)) then
291 //writeln('*** KNOWN WRITEABLE DIR: "', result, '"');
296 for f
:= High(dirs
) downto Low(dirs
) do
299 if ForceDirectories(dirs
[f
]) then
302 if (findFileCI(result
, true)) then
304 if e_CanCreateFilesAt(result
) then
306 if not assigned(writeableDirs
) then writeableDirs
:= THashStrCIStr
.Create();
307 writeableDirs
.put(dirs
[f
], result
);
308 //writeln('*** NEW WRITEABLE DIR: "', result, '" ("', dirs[f], '"); rq=', required);
316 if required
then raise Exception
.Create(Format('unable to create directory "%s"', [dirs
[High(dirs
)]]));
321 writeableDirs
.Free();