X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Futils.pas;h=4c4db7b0df59997698bca6e3d5861cb9ba9a01a0;hb=8e694e6ddeb42110a00233d7ff7345c57ee5d90d;hp=577aae0c6c72e1a8dae76997e9b4ac156b1f68fa;hpb=1bddfaf7b6421f1659a6f211dfdb1dfaef5d5173;p=d2df-sdl.git diff --git a/src/shared/utils.pas b/src/shared/utils.pas index 577aae0..4c4db7b 100644 --- a/src/shared/utils.pas +++ b/src/shared/utils.pas @@ -2,8 +2,7 @@ * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,7 +18,7 @@ unit utils; interface uses - SysUtils, Classes; + SysUtils, Classes, md5; // ////////////////////////////////////////////////////////////////////////// // @@ -80,11 +79,15 @@ function isWadPath (const fn: AnsiString): Boolean; // adds ".wad" extension if filename doesn't have one of ".wad", ".pk3", ".zip" function addWadExtension (const fn: AnsiString): AnsiString; +// check wad signature +function isWadData (data: Pointer; len: LongWord): Boolean; + // convert number to strig with nice commas function int64ToStrComma (i: Int64): AnsiString; function upcase1251 (ch: AnsiChar): AnsiChar; inline; function locase1251 (ch: AnsiChar): AnsiChar; inline; +function IsPrintable1251 (ch: AnsiChar): Boolean; function toLowerCase1251 (const s: AnsiString): AnsiString; @@ -102,10 +105,14 @@ function findFileCI (var pathname: AnsiString; lastIsDir: Boolean=false): Boolea // return fixed AnsiString or empty AnsiString function findDiskWad (fname: AnsiString): AnsiString; +// slashes must be normalized! +function isWadNamesEqu (wna, wnb: AnsiString): Boolean; // they throws function openDiskFileRO (pathname: AnsiString): TStream; function createDiskFile (pathname: AnsiString): TStream; +// creates file if necessary +function openDiskFileRW (pathname: AnsiString): TStream; // little endian procedure writeSign (st: TStream; const sign: AnsiString); @@ -165,7 +172,9 @@ function nmin (a, b: Int64): Int64; inline; overload; function nmin (a, b: UInt64): UInt64; inline; overload; function nmin (a, b: Single): Single; inline; overload; function nmin (a, b: Double): Double; inline; overload; +{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} function nmin (a, b: Extended): Extended; inline; overload; +{$ENDIF} function nmax (a, b: Byte): Byte; inline; overload; function nmax (a, b: ShortInt): ShortInt; inline; overload; @@ -177,8 +186,9 @@ function nmax (a, b: Int64): Int64; inline; overload; function nmax (a, b: UInt64): UInt64; inline; overload; function nmax (a, b: Single): Single; inline; overload; function nmax (a, b: Double): Double; inline; overload; +{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} function nmax (a, b: Extended): Extended; inline; overload; - +{$ENDIF} function nclamp (v, a, b: Byte): Byte; inline; overload; function nclamp (v, a, b: ShortInt): ShortInt; inline; overload; function nclamp (v, a, b: Word): Word; inline; overload; @@ -189,8 +199,9 @@ function nclamp (v, a, b: Int64): Int64; inline; overload; function nclamp (v, a, b: UInt64): UInt64; inline; overload; function nclamp (v, a, b: Single): Single; inline; overload; function nclamp (v, a, b: Double): Double; inline; overload; +{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} function nclamp (v, a, b: Extended): Extended; inline; overload; - +{$ENDIF} type TFormatStrFCallback = procedure (constref buf; len: SizeUInt); @@ -267,11 +278,36 @@ 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; +const wadExtensions: array [0..6] of AnsiString = ( + '.dfz', + '.wad', + '.dfwad', + '.pk3', + '.pak', + '.zip', + '.dfzip' +); + // ////////////////////////////////////////////////////////////////////////// // procedure CopyMemory (Dest: Pointer; Src: Pointer; Len: LongWord); inline; @@ -806,10 +842,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'); + 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; @@ -820,6 +859,22 @@ begin end; +function isWadData (data: Pointer; len: LongWord): Boolean; + var p: PChar; +begin + p := PChar(data); + Result := + (* ZIP *) + ((len > 3) and (p[0] = 'P') and (p[1] = 'K') and (p[2] = #03) and (p[3] = #04)) or + ((len > 3) and (p[0] = 'P') and (p[1] = 'K') and (p[2] = #05) and (p[3] = #06)) or + (* PACK *) + ((len > 3) and (p[0] = 'P') and (p[1] = 'A') and (p[2] = 'C') and (p[3] = 'K')) or + ((len > 3) and (p[0] = 'S') and (p[1] = 'P') and (p[2] = 'A') and (p[3] = 'K')) or + (* DFWAD *) + ((len > 5) and (p[0] = 'D') and (p[1] = 'F') and (p[2] = 'W') and (p[3] = 'A') and (p[4] = 'D') and (p[5] = #01)) +end; + + function isWadPath (const fn: AnsiString): Boolean; var pos: Integer; @@ -835,7 +890,7 @@ begin if (pos-4 > 1) and (fn[pos-4] = '.') and ((fn[pos+1] = '\') or (fn[pos+1] = '/')) then begin s := Copy(fn, pos-4, 4); - if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') then + if StrEquCI1251(s, '.wad') or StrEquCI1251(s, '.pk3') or StrEquCI1251(s, '.zip') or StrEquCI1251(s, '.dfz') then begin result := true; exit; @@ -907,6 +962,11 @@ begin result := ch; end; +function IsPrintable1251 (ch: AnsiChar): Boolean; +begin + result := (ch >= #32) and (ch <> #127) +end; + function strEquCI1251 (const s0, s1: AnsiString): Boolean; var @@ -1125,7 +1185,27 @@ begin end; -const fileExtensions: array [0..5] of AnsiString = ('.wad', '.dfzip', '.dfwad', '.pk3', '.pak', '.zip'); +function isWadNamesEqu (wna, wnb: AnsiString): Boolean; +var + ext, newExt: AnsiString; + found: Boolean; +begin + result := StrEquCI1251(wna, wnb); + if result then exit; + // check first ext + ext := getFilenameExt(wna); + found := false; + 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 wadExtensions do if (StrEquCI1251(ext, newExt)) then begin found := true; break; end; + if not found then exit; + wna := forceFilenameExt(wna, ''); + wnb := forceFilenameExt(wnb, ''); + result := StrEquCI1251(wna, wnb); +end; function findDiskWad (fname: AnsiString): AnsiString; var @@ -1138,7 +1218,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 @@ -1155,7 +1235,7 @@ end; function openDiskFileRO (pathname: AnsiString): TStream; begin - if not findFileCI(pathname) then raise Exception.Create('can''t open file "'+pathname+'"'); + if not findFileCI(pathname) then raise EFileNotFoundException.Create('can''t open file "'+pathname+'"'); result := TFileStream.Create(pathname, fmOpenRead or {fmShareDenyWrite}fmShareDenyNone); end; @@ -1172,6 +1252,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 @@ -1352,7 +1456,9 @@ function nmin (a, b: Int64): Int64; inline; overload; begin if (a < b) then resu function nmin (a, b: UInt64): UInt64; inline; overload; begin if (a < b) then result := a else result := b; end; function nmin (a, b: Single): Single; inline; overload; begin if (a < b) then result := a else result := b; end; function nmin (a, b: Double): Double; inline; overload; begin if (a < b) then result := a else result := b; end; +{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} function nmin (a, b: Extended): Extended; inline; overload; begin if (a < b) then result := a else result := b; end; +{$ENDIF} function nmax (a, b: Byte): Byte; inline; overload; begin if (a > b) then result := a else result := b; end; function nmax (a, b: ShortInt): ShortInt; inline; overload; begin if (a > b) then result := a else result := b; end; @@ -1364,7 +1470,9 @@ function nmax (a, b: Int64): Int64; inline; overload; begin if (a > b) then resu function nmax (a, b: UInt64): UInt64; inline; overload; begin if (a > b) then result := a else result := b; end; function nmax (a, b: Single): Single; inline; overload; begin if (a > b) then result := a else result := b; end; function nmax (a, b: Double): Double; inline; overload; begin if (a > b) then result := a else result := b; end; +{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} function nmax (a, b: Extended): Extended; inline; overload; begin if (a > b) then result := a else result := b; end; +{$ENDIF} function nclamp (v, a, b: Byte): Byte; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end; function nclamp (v, a, b: ShortInt): ShortInt; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end; @@ -1376,8 +1484,9 @@ function nclamp (v, a, b: Int64): Int64; inline; overload; begin if (v < a) then function nclamp (v, a, b: UInt64): UInt64; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end; function nclamp (v, a, b: Single): Single; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end; function nclamp (v, a, b: Double): Double; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end; +{$IF DEFINED(CPU386) OR DEFINED(CPUAMD64)} function nclamp (v, a, b: Extended): Extended; inline; overload; begin if (v < a) then result := a else if (v > b) then result := b else result := v; end; - +{$ENDIF} // ////////////////////////////////////////////////////////////////////////// // {$IFDEF WINDOWS} @@ -1909,6 +2018,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;