X-Git-Url: https://deadsoftware.ru/gitweb?p=d2df-sdl.git;a=blobdiff_plain;f=src%2Fshared%2Futils.pas;h=a3a650070a1ff1ef05791ee85676edd231259dd1;hp=a854ca45bc922f155465ed98a32daad0710ced8c;hb=20b94bcdd97ce8f4e0c02dd7e1461f6701785cbe;hpb=75125c8752adeb3dc9e2ea3841b3b64dc23268ce diff --git a/src/shared/utils.pas b/src/shared/utils.pas index a854ca4..a3a6500 100644 --- a/src/shared/utils.pas +++ b/src/shared/utils.pas @@ -18,7 +18,7 @@ unit utils; interface uses - SysUtils, Classes; + SysUtils, Classes, md5; // ////////////////////////////////////////////////////////////////////////// // @@ -26,6 +26,17 @@ type SSArray = array of ShortString; +const wadExtensions: array [0..6] of AnsiString = ( + '.dfz', + '.wad', + '.dfwad', + '.pk3', + '.pak', + '.zip', + '.dfzip' +); + + // ////////////////////////////////////////////////////////////////////////// // type TUtf8DecoderFast = packed record @@ -87,6 +98,8 @@ function int64ToStrComma (i: Int64): AnsiString; function upcase1251 (ch: AnsiChar): AnsiChar; inline; function locase1251 (ch: AnsiChar): AnsiChar; inline; +function IsValid1251 (ch: Word): Boolean; +function IsPrintable1251 (ch: AnsiChar): Boolean; function toLowerCase1251 (const s: AnsiString): AnsiString; @@ -97,12 +110,18 @@ function utf8Valid (const s: AnsiString): Boolean; function utf8to1251 (s: AnsiString): AnsiString; -// `pathname` will be modified if path is valid -// `lastIsDir` should be `true` if we are searching for directory -// nobody cares about shitdoze, so i'll use the same code path for it +// findFileCI takes case-insensitive path, traverses it, and rewrites it to +// a case-sensetive one (using real on-disk names). return value means 'success'. +// if some dir or file wasn't found, pathname is undefined (destroyed, but not +// necessarily cleared). +// last name assumed to be a file, not directory (unless `lastIsDir` flag is set). function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean; -// return fixed AnsiString or empty AnsiString +// findDiskWad tries to find the wad file using common wad extensions +// (see `wadExtensions` array). +// returns real on-disk filename, or empty string. +// original wad extension is used as a hint for the first try. +// also, this automatically performs `findFileCI()`. function findDiskWad (fname: AnsiString): AnsiString; // slashes must be normalized! function isWadNamesEqu (wna, wnb: AnsiString): Boolean; @@ -110,6 +129,8 @@ function isWadNamesEqu (wna, wnb: AnsiString): Boolean; // they throws function openDiskFileRO (pathname: AnsiString): TStream; function createDiskFile (pathname: AnsiString): TStream; +// create file if necessary, but don't truncate the existing one +function openDiskFileRW (pathname: AnsiString): TStream; // little endian procedure writeSign (st: TStream; const sign: AnsiString); @@ -275,12 +296,26 @@ procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline; procedure ZeroMemory (Dest: Pointer; Len: LongWord); inline; +type + TDiskFileInfo = record + diskName: AnsiString; + size: LongInt; + age: LongInt; + // not changed by info getter; used in other parts of the code + userName: AnsiString; + tag: Integer; + hash: TMD5Digest; + udata: Pointer; + end; + +function GetDiskFileInfo (fname: AnsiString; var info: TDiskFileInfo): Boolean; + + implementation uses xstreams; - // ////////////////////////////////////////////////////////////////////////// // procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline; begin @@ -814,10 +849,13 @@ end; function hasWadExtension (const fn: AnsiString): Boolean; var - ext: AnsiString; + ext, newExt: AnsiString; begin ext := getFilenameExt(fn); - result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz'); + result := true; + for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then exit; + result := false; + //result := StrEquCI1251(ext, '.wad') or StrEquCI1251(ext, '.pk3') or StrEquCI1251(ext, '.zip') or StrEquCI1251(ext, '.dfz'); end; @@ -827,6 +865,7 @@ begin if not hasWadExtension(result) then result := result+'.wad'; end; + function isWadData (data: Pointer; len: LongWord): Boolean; var p: PChar; begin @@ -930,6 +969,16 @@ begin result := ch; end; +function IsValid1251 (ch: Word): Boolean; +begin + result := (ch = Ord('?')) or (wc2shitmap[ch] <> '?') +end; + +function IsPrintable1251 (ch: AnsiChar): Boolean; +begin + result := (ch >= #32) and (ch <> #127) +end; + function strEquCI1251 (const s0, s1: AnsiString): Boolean; var @@ -1080,9 +1129,9 @@ end; // ////////////////////////////////////////////////////////////////////////// // -// `pathname` will be modified if path is valid -// `lastIsDir` should be `true` if we are searching for directory -// nobody cares about shitdoze, so i'll use the same code path for it +// findFileCI eats case-insensitive path, traverses it and rewrites it to a +// case-sensetive. result value means success. +// if file/dir not founded than pathname is in undefined state! function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolean; var sr: TSearchRec; @@ -1148,8 +1197,6 @@ begin end; -const fileExtensions: array [0..6] of AnsiString = ('.dfz', '.wad', '.dfwad', '.pk3', '.pak', '.zip', '.dfzip'); - function isWadNamesEqu (wna, wnb: AnsiString): Boolean; var ext, newExt: AnsiString; @@ -1160,12 +1207,12 @@ begin // check first ext ext := getFilenameExt(wna); found := false; - for newExt in fileExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end; + for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end; if not found then exit; // check second ext ext := getFilenameExt(wnb); found := false; - for newExt in fileExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end; + for newExt in wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end; if not found then exit; wna := forceFilenameExt(wna, ''); wnb := forceFilenameExt(wnb, ''); @@ -1183,7 +1230,7 @@ begin origExt := getFilenameExt(fname); fname := forceFilenameExt(fname, ''); //writeln(' findDiskWad01: fname=<', fname, '>; origExt=<', origExt, '>'); - for newExt in fileExtensions do + for newExt in wadExtensions do begin //writeln(' findDiskWad02: fname=<', fname, '>; origExt=<', origExt, '>; newExt=<', newExt, '>'); if (StrEquCI1251(newExt, origExt)) then @@ -1217,6 +1264,30 @@ begin end; +function openDiskFileRW (pathname: AnsiString): TStream; +var + path: AnsiString; + oldname: AnsiString; +begin + //writeln('*** TRYING R/W FILE "', pathname, '"'); + path := ExtractFilePath(pathname); + if length(path) > 0 then + begin + if not findFileCI(path, true) then raise Exception.Create('can''t create file "'+pathname+'"'); + end; + oldname := pathname; + if findFileCI(oldname) then + begin + //writeln('*** found old file "', oldname, '"'); + result := TFileStream.Create(oldname, fmOpenReadWrite or fmShareDenyWrite); + end + else + begin + result := TFileStream.Create(path+ExtractFileName(pathname), fmCreate); + end; +end; + + procedure writeIntegerLE (st: TStream; vp: Pointer; size: Integer); {$IFDEF ENDIAN_LITTLE} begin @@ -1959,6 +2030,32 @@ begin end; +function GetDiskFileInfo (fname: AnsiString; var info: TDiskFileInfo): Boolean; +var + age: LongInt; + size: LongInt; + handle: THandle; +begin + result := false; + if (length(fname) = 0) then exit; + if not findFileCI(fname) then exit; + // get age + age := FileAge(fname); + if (age = -1) then exit; + // get size + handle := FileOpen(fname, fmOpenRead or fmShareDenyNone); + if (handle = THandle(-1)) then exit; + size := FileSeek(handle, 0, fsFromEnd); + FileClose(handle); + if (size = -1) then exit; + // fill info + info.diskName := fname; + info.size := size; + info.age := age; + result := true; +end; + + (* var ss: ShortString;