Subversion Repositories autosfx

Rev

Blame | Last modification | View Log | RSS feed

  1. unit ZMUtils19;
  2.  
  3. (*
  4.   ZMUtils19.pas - Some utility functions
  5.     Copyright (C) 2009, 2010  by Russell J. Peters, Roger Aelbrecht,
  6.       Eric W. Engler and Chris Vleghert.
  7.  
  8.         This file is part of TZipMaster Version 1.9.
  9.  
  10.     TZipMaster is free software: you can redistribute it and/or modify
  11.     it under the terms of the GNU Lesser General Public License as published by
  12.     the Free Software Foundation, either version 3 of the License, or
  13.     (at your option) any later version.
  14.  
  15.     TZipMaster is distributed in the hope that it will be useful,
  16.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  17.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18.     GNU Lesser General Public License for more details.
  19.  
  20.     You should have received a copy of the GNU Lesser General Public License
  21.     along with TZipMaster.  If not, see <http://www.gnu.org/licenses/>.
  22.  
  23.     contact: problems@delphizip.org (include ZipMaster in the subject).
  24.     updates: http://www.delphizip.org
  25.     DelphiZip maillist subscribe at http://www.freelists.org/list/delphizip
  26.  
  27.   modified 2010-06-26
  28. ---------------------------------------------------------------------------*)
  29.  
  30. {$INCLUDE '.\ZipVers19.inc'}
  31.  
  32. {$IFDEF VERD6up}
  33. {$WARN UNIT_PLATFORM OFF}
  34. {$WARN SYMBOL_PLATFORM OFF}
  35. {$ENDIF}
  36.  
  37. interface
  38.  
  39. uses
  40.   SysUtils, Windows, Classes;
  41.  
  42. type
  43.   TPathSlashDirection = (psdExternal, psdInternal);
  44. //  DeleteOpts = (htdFinal, htdAllowUndo);
  45.  
  46. type
  47. {$IFDEF UNICODE}
  48.   TZMRawBytes = RawByteString;
  49. {$ELSE}
  50.   TZMRawBytes =  AnsiString;
  51. {$ENDIF}
  52.  
  53.  
  54. const                      // QueryZip return bit values and errors
  55.   zqbStartEXE     = 1;     // is EXE file may be SFX
  56.   zqbStartLocal   = 2;     // normal zip file start
  57.   zqbStartSpan    = 4;     // first part of span
  58.   zqbStartCentral = 8;     // continuing Central Header
  59.   zqbHasComment   = 16;
  60.   //  zqbGoodComment = 16;  // comment length good (no junk at end)
  61.   zqbHasLocal     = 32;    // first Central entry points to local header
  62.   zqbHasCentral   = 64;    // Central entry where it should be
  63.   zqbHasEOC       = 128;   // End of Central entry
  64.   zqbHasLoc64     = 256;   // EOC64 locator entry
  65.   zqbHasEOC64     = 512;   // Zip64 EOC
  66.   zqbJunkAtEnd    = 1024;  // junk at end of zip
  67.   zqbIsDiskZero   = 2048;  // is disk 0
  68.  
  69.   zqFieldError   = -5;     // bad field value
  70.   zqFileError    = -7;     // file handling error
  71.   zqGeneralError = -9;     // unspecified failure
  72.  
  73.  
  74. function AbsErr(err: Integer): Integer;
  75. function DelimitPath(const Path: String; Sep: Boolean): String;
  76.  
  77. function DirExists(const FName: String): Boolean;
  78.  
  79. function DiskAvailable(const path: String): Boolean;
  80.  
  81. function EraseFile(const FName: String; permanent: Boolean): Integer;
  82. function ExtractNameOfFile(const FileName: String): String;
  83.  
  84. function ExeVersion(const FName: String; var MS, LS: DWORD): Boolean;
  85. function ExeVers(const FName: String): Integer;
  86. function VersStr(vers: Integer; Comma: Boolean = False): String;
  87.  
  88. function FileSeek64(Handle: Integer; const Offset: Int64; Origin: Integer): Int64;
  89.  
  90. // stable replacement for depreciated FileAge()
  91. function File_Age(const FName: String): Cardinal;
  92.  
  93. procedure File_Close(var fh: Integer);
  94.  
  95. procedure File_Delete(const FName: String);
  96.  
  97. function File_Size(const FSpec: TFilename): Int64;
  98.  
  99. function ForceDirectory(const DirName: String): Boolean;
  100.  
  101. function GetVolumeLabel(const drive: String): String;
  102.  
  103. function Hi64(i: Int64): Cardinal;
  104.  
  105. function IsSameFile(const FName1, FName2: String): Boolean;
  106.  
  107. function IsWild(const FSpec: String): Boolean;
  108. //  returns position of first wild character or 0
  109. function HasWild(const FSpec: String): Integer;
  110. function HasWildW(const FSpec: WideString): Integer;
  111.  
  112. //  true we're running under XP or later.
  113. function IsWinXP: Boolean;
  114. function WinVersion: Integer;
  115.  
  116. function Lo64(i: Int64): Cardinal;
  117.  
  118. function PathConcat(const path, extra: String): String;
  119.  
  120. function QueryZip(const FName: String): Integer;
  121.  
  122. function SetSlash(const path: String; dir: TPathSlashDirection): String;
  123. function SetSlashW(const path: WideString; dir: TPathSlashDirection): WideString;
  124.  
  125. function StrToOEM(const astr: String): String;
  126. function OEMToStr(const astr: Ansistring): String;
  127. //1 return True if contains chars (<#31 ?) >#126
  128. function StrHasExt(const astr: String): Boolean; overload;
  129. {$IFDEF UNICODE}
  130. function StrHasExt(const astr: AnsiString): Boolean; overload;
  131. function StrHasExt(const astr: TZMRawBytes): Boolean; overload;
  132. {$ENDIF}
  133. function LastPos(const s: String; ch: Char; before: Integer = MAXINT): Integer;
  134. function LastPosW(const s: WideString; wch: Widechar; before: Integer = MAXINT): Integer;
  135.  
  136. function CalcCRC32(const mem; len: Integer; init: DWORD): DWORD;
  137.  
  138. function OpenResStream(const ResName: String; const rtype: PChar): TResourceStream;
  139.  
  140. function IsFolder(const Name: String): Boolean;
  141. {$IFDEF UNICODE}
  142. overload;
  143. function IsFolder(const name: TZMRawBytes): boolean; overload;
  144. {$ENDIF}
  145.  
  146. function CanHash(const FSpec: String): Boolean;
  147.  
  148. // return true if filename is obviously invalid
  149. function NameIsBad(const astr: String): Boolean;
  150.  
  151.  // return exe size (if < 4G)
  152.  //    0 _ not exe
  153. function ExeSize(const Name: String): Cardinal; overload;
  154. function ExeSize(fileHandle: Integer): Cardinal; overload;
  155.  
  156.  
  157.  // check for SFX header or detached header
  158.  // return <0 error
  159. const
  160.   cstNone = 0;        // not found
  161.   cstExe  = 1;        // might be stub of unknown type
  162.   cstSFX17 = 17;      // found 1.7 SFX headers
  163.   cstSFX19 = 19;      // found 1.9 SFX headers
  164.   cstDetached = 2048; // is detached - if name specified ZipName will modified for it
  165.  
  166. function CheckSFXType(const fileHandle: Integer; var ZipName: String;
  167.   var size: Integer): Integer; overload;
  168. function CheckSFXType(const Name: String; var ZipName: String;
  169.   var size: Integer): Integer; overload;
  170.  
  171. function FileDateToLocalDateTime(stamp: Integer): TDateTime;
  172.  
  173. // -------------------------- ------------ -------------------------
  174. implementation
  175.  
  176. uses ZMStructs19, ShellApi, Forms, ZMUTF819, ZMSFXInt19;
  177.  
  178. type
  179.   TInt64Rec = packed record
  180.     case Integer of
  181.       0: (I: Int64);
  182.       1: (Lo, Hi: Cardinal);
  183.   end;
  184.  
  185. const
  186.   CRC32Table: array[0..255] of DWORD = (
  187.     $00000000, $77073096, $EE0E612C, $990951BA,
  188.     $076DC419, $706AF48F, $E963A535, $9E6495A3,
  189.     $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
  190.     $09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
  191.     $1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
  192.     $1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
  193.     $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
  194.     $14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
  195.     $3B6E20C8, $4C69105E, $D56041E4, $A2677172,
  196.     $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
  197.     $35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
  198.     $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
  199.     $26D930AC, $51DE003A, $C8D75180, $BFD06116,
  200.     $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
  201.     $2802B89E, $5F058808, $C60CD9B2, $B10BE924,
  202.     $2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
  203.  
  204.     $76DC4190, $01DB7106, $98D220BC, $EFD5102A,
  205.     $71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
  206.     $7807C9A2, $0F00F934, $9609A88E, $E10E9818,
  207.     $7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
  208.     $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
  209.     $6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
  210.     $65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
  211.     $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
  212.     $4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
  213.     $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
  214.     $4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
  215.     $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
  216.     $5005713C, $270241AA, $BE0B1010, $C90C2086,
  217.     $5768B525, $206F85B3, $B966D409, $CE61E49F,
  218.     $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
  219.     $59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
  220.  
  221.     $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
  222.     $EAD54739, $9DD277AF, $04DB2615, $73DC1683,
  223.     $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
  224.     $E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
  225.     $F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
  226.     $F762575D, $806567CB, $196C3671, $6E6B06E7,
  227.     $FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
  228.     $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
  229.     $D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
  230.     $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
  231.     $D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
  232.     $DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
  233.     $CB61B38C, $BC66831A, $256FD2A0, $5268E236,
  234.     $CC0C7795, $BB0B4703, $220216B9, $5505262F,
  235.     $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
  236.     $C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
  237.  
  238.     $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
  239.     $9C0906A9, $EB0E363F, $72076785, $05005713,
  240.     $95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
  241.     $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
  242.     $86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
  243.     $81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
  244.     $88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
  245.     $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
  246.     $A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
  247.     $A7672661, $D06016F7, $4969474D, $3E6E77DB,
  248.     $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
  249.     $A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
  250.     $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
  251.     $BAD03605, $CDD70693, $54DE5729, $23D967BF,
  252.     $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
  253.     $B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
  254.  
  255. //--------------------------------------------------------
  256. function Lo64(i: Int64): Cardinal;
  257. var
  258.   r: TInt64Rec;
  259. begin
  260.   r.I := i;
  261.   Result := r.Lo;
  262. end;
  263.  
  264. function Hi64(i: Int64): Cardinal;
  265. var
  266.   r: TInt64Rec;
  267. begin
  268.   r.I := i;
  269.   Result := r.Hi;
  270. end;
  271.  
  272. //--------------------------------------------------------
  273. function AbsErr(err: Integer): Integer;
  274. begin
  275.   if err < 0 then
  276.     Result := -err
  277.   else
  278.     Result := err;
  279. end;
  280.  
  281. function DelimitPath(const Path: String; Sep: Boolean): String;
  282. begin
  283.   Result := Path;
  284.   if Length(Path) = 0 then
  285.   begin
  286.     if Sep then
  287.       Result := PathDelim{'\'};
  288.     exit;
  289.   end;
  290.   if (AnsiLastChar(Path)^ = PathDelim) <> Sep then
  291.   begin
  292.     if Sep then
  293.       Result := Path + PathDelim
  294.     else
  295.       Result := Copy(Path, 1, pred(Length(Path)));
  296.   end;
  297. end;
  298.  
  299. (*? DirExists
  300. 1.73 12 July 2003 return true empty string (current directory)
  301. *)
  302. function DirExists(const FName: String): Boolean;
  303. var
  304.   Code: DWORD;
  305.   dir: String;
  306. begin
  307.   Result := True;                           // current directory exists
  308.   dir := DelimitPath(FName, False);
  309.   if FName <> '' then
  310.   begin
  311.     Code := GetFileAttributes(PChar(dir{FName}));
  312.     Result := (Code <> MAX_UNSIGNED) and ((FILE_ATTRIBUTE_DIRECTORY and Code) <> 0);
  313.   end;
  314. end;
  315.  
  316. function DiskAvailable(const path: String): Boolean;
  317. var
  318.   drv: Integer;
  319.   em:  Cardinal;
  320.   pth: String;
  321. begin
  322.   Result := False;
  323.   pth := ExpandUNCFileName(path);
  324.   if (length(pth) > 1) and (pth[2] = DriveDelim) then
  325.     //  if (length(pth) >1) and (pth[2] = ':') then
  326.   begin
  327.     drv := Ord(Uppercase(pth)[1]) - $40;
  328.     em  := SetErrorMode(SEM_FAILCRITICALERRORS);
  329.     Result := DiskSize(drv) <> -1;
  330.     SetErrorMode(em);
  331.   end;
  332. end;
  333.  
  334. (*? EraseFile
  335. 1.77 moved from ZMaster
  336.  Delete a file and put it in the recyclebin on demand.
  337. *)
  338. function EraseFile(const FName: String; permanent: Boolean): Integer;
  339. var
  340.   DelFileName: String;
  341.   SHF: TSHFileOpStruct;
  342. begin
  343.   // If we do not have a full path then FOF_ALLOWUNDO does not work!?
  344.   DelFileName := FName;
  345.   if ExtractFilePath(FName) = '' then
  346.     DelFileName := GetCurrentDir() + PathDelim{'\'} + FName;
  347.  
  348.   Result := -1;
  349.   // We need to be able to 'Delete' without getting an error
  350.   // if the file does not exists as in ReadSpan() can occur.
  351.   if not FileExists(DelFileName) then
  352.     Exit;
  353.   //  with SHF do
  354.   //  begin
  355.   SHF.Wnd := Application.Handle;
  356.   SHF.wFunc := FO_DELETE;
  357.   SHF.pFrom := PChar(DelFileName + #0);
  358.   SHF.pTo := nil;
  359.   SHF.fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
  360.   if not permanent then
  361.     SHF.fFlags := SHF.fFlags or FOF_ALLOWUNDO;
  362.   //  end;
  363.   Result := SHFileOperation(SHF);
  364. end;
  365.  
  366. function ExeVersion(const FName: String; var MS, LS: DWORD): Boolean;
  367. var
  368.   Dummy: DWORD;
  369.   VerInfo: Pointer;
  370.   VerInfoSize: DWORD;
  371.   VerValue: PVSFixedFileInfo;
  372.   VerValueSize: DWORD;
  373. begin
  374.   Result := False;
  375.   if FileExists(FName) then
  376.   begin
  377.     VerInfoSize := GetFileVersionInfoSize(PChar(FName), Dummy);
  378.     GetMem(VerInfo, VerInfoSize);
  379.     try
  380.       if GetFileVersionInfo(PChar(FName), 0, VerInfoSize, VerInfo) then
  381.       begin
  382.         VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  383.         MS := VerValue^.dwFileVersionMS;
  384.         LS := VerValue^.dwFileVersionLS;
  385.         Result := True;
  386.       end;
  387.     finally
  388.       FreeMem(VerInfo, VerInfoSize);
  389.     end;
  390.   end;
  391. end;
  392.  
  393.  // format M.N.RR.BBB
  394.  // return Version as used by DelphiZip
  395. function ExeVers(const FName: String): Integer;
  396. var
  397.   LS: DWORD;
  398.   MS: DWORD;
  399. begin
  400.   Result := -1;
  401.   if ExeVersion(FName, MS, LS) then
  402.   begin
  403.     Result := (Integer(MS) shr 16) * 1000000;
  404.     Result := Result + (Integer(MS and $FFFF) * 100000);
  405.     Result := Result + ((Integer(LS) shr 16) * 10000);
  406.     Result := Result + Integer(LS and $FFFF) mod 1000;
  407.   end;
  408. end;
  409.  
  410. function ExtractNameOfFile(const FileName: String): String;
  411. var
  412.   I: Integer;
  413.   J: Integer;
  414. begin
  415.   I := LastDelimiter(PathDelim + DriveDelim, FileName);
  416.   J := LastDelimiter('.', FileName);
  417.   if (J <= I) then
  418.   begin
  419.     J := MaxInt;
  420.   end;    // no ext
  421.   Result := Copy(FileName, I + 1, J - (I + 1));
  422. end;
  423.  
  424. function VersStr(vers: Integer; Comma: Boolean = False): String;
  425. const
  426.   fmt: array [Boolean] of String =
  427.     ('%d.%d.%d.%4.4d', '%d,%d,%d,%d');
  428. begin
  429.   Result := Format(fmt[Comma], [vers div 1000000, (vers mod 1000000) div
  430.     100000, (vers mod 100000) div 10000, vers mod 1000]);
  431. end;
  432.  
  433. function OpenResStream(const ResName: String; const rtype: PChar): TResourceStream;
  434. var
  435.   hFindRes: Cardinal;
  436.   idNo: Integer;
  437.   inst: Integer;
  438.   rsn:  PChar;
  439. begin
  440.   Result := nil;
  441.   try
  442.     rsn  := PChar(ResName);
  443.     //    idno := 0;
  444.     inst := HInstance;
  445.     if (Length(ResName) > 1) and (ResName[1] = '#') then
  446.     begin
  447.       idNo := StrToInt(copy(ResName, 2, 25));
  448.       rsn  := PChar(idNo);
  449.     end;
  450.     hFindRes := FindResource(inst, rsn, rtype);
  451.     if (hFindRes = 0) and ModuleIsLib then
  452.     begin
  453.       inst := MainInstance;
  454.       hFindRes := FindResource(inst, rsn, rtype);
  455.     end;
  456.     if hFindRes <> 0 then
  457.       Result := TResourceStream.Create(inst, ResName, rtype);
  458.   except
  459.     Result := nil;
  460.   end;
  461. end;
  462.  
  463. function File_Age(const FName: String): Cardinal;
  464. var
  465.   FindData: TWin32FindData;
  466.   Handle: THandle;
  467.   LocalFileTime: TFileTime;
  468. begin
  469.   Handle := FindFirstFile(PChar(FName), FindData);
  470.   if Handle <> INVALID_HANDLE_VALUE then
  471.   begin
  472.     FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
  473.     Windows.FindClose(Handle);
  474.     if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
  475.         LongRec(Result).Lo) then
  476.       Exit;
  477.   end;
  478.   Result := Cardinal(-1);
  479. end;
  480.  
  481. procedure File_Close(var fh: Integer);
  482. var
  483.   h: Integer;
  484. begin
  485.   if fh <> Invalid_Handle then
  486.   begin
  487.     h  := fh;
  488.     fh := Invalid_Handle;
  489.     FileClose(h);
  490.   end;
  491. end;
  492.  
  493. procedure File_Delete(const FName: String);
  494. begin
  495.   if FileExists(FName) then
  496.     SysUtils.DeleteFile(FName);
  497. end;
  498.  
  499. function FileSeek64(Handle: Integer; const Offset: Int64; Origin: Integer): Int64;
  500. {$IFDEF VERD6up}
  501. begin
  502.   Result := FileSeek(Handle, Offset, Origin);
  503. end;
  504. {$ELSE}
  505.   //function FileSeek64(Handle: Integer; const Offset: Int64;  Origin: Integer): Int64;
  506. var
  507.   r: TInt64Rec;
  508. begin
  509.   r.I  := Offset;
  510.   r.Lo := SetFilePointer(Handle, Integer(r.Lo), @r.Hi, Origin);
  511.   if (r.Lo = Cardinal(-1)) and (GetLastError <> 0) then
  512.     r.I := -1;
  513.   Result := r.i;
  514. end;
  515.  
  516. {$ENDIF}
  517.  
  518. function File_Size(const FSpec: TFilename): Int64;
  519. var
  520.   sr: TSearchRec;
  521. begin
  522.   Result := 0;
  523.   if SysUtils.FindFirst(FSpec, faAnyFile, sr) = 0 then
  524.   begin
  525.     Result := sr.Size;
  526.     SysUtils.FindClose(sr);
  527.   end;
  528. end;
  529.  
  530. (*? ForceDirectory
  531. 1.73 RP utilities
  532. *)
  533. function ForceDirectory(const DirName: String): Boolean;
  534. var
  535.   sDir: String;
  536. begin
  537.   Result := True;
  538.   if DirName <> '' then
  539.   begin
  540.     sDir := DelimitPath(DirName, False);
  541.     if DirExists(sDir) or (ExtractFilePath(sDir) = sDir) then
  542.       exit;                                 // avoid 'c:\xyz:\' problem.
  543.  
  544.     if ForceDirectory(ExtractFilePath(sDir)) then
  545.       Result := CreateDirectory(PChar(sDir), nil)
  546.     else
  547.       Result := False;
  548.   end;
  549. end;
  550.  
  551. (*? HasWild
  552.   returns position of first wild character or 0
  553. *)
  554. function HasWild(const FSpec: String): Integer;
  555. var
  556.   c: Char;
  557.   i: Integer;
  558. begin
  559.   Result := 0;
  560.   for i := 1 to Length(FSpec) do
  561.   begin
  562.     c := FSpec[i];
  563.     if (c = WILD_MULTI) or (c = WILD_CHAR) then
  564.     begin
  565.       Result := i;
  566.       break;
  567.     end;
  568.   end;
  569. end;
  570.  
  571.  
  572. (*? HasWildW
  573.   returns position of first wild character or 0
  574. *)
  575. function HasWildW(const FSpec: WideString): Integer;
  576. var
  577.   c: Widechar;
  578.   i: Integer;
  579. begin
  580.   Result := 0;
  581.   for i := 1 to Length(FSpec) do
  582.   begin
  583.     c := FSpec[i];
  584.     if (c = WILD_MULTI) or (c = WILD_CHAR) then
  585.     begin
  586.       Result := i;
  587.       break;
  588.     end;
  589.   end;
  590. end;
  591.  
  592. (*? IsWild
  593. 1.73.4
  594.  returns true if filespec contains wildcard(s)
  595. *)
  596. function IsWild(const FSpec: String): Boolean;
  597. var
  598.   c: Char;
  599.   i: Integer;
  600.   len: Integer;
  601. begin
  602.   Result := True;
  603.   len := Length(FSpec);
  604.   i := 1;
  605.   while i <= len do
  606.   begin
  607.     c := FSpec[i];
  608.     if (c = WILD_MULTI) or (c = WILD_CHAR) then
  609.       exit;
  610.     Inc(i);
  611.   end;
  612.   Result := False;
  613. end;
  614.  
  615. function CanHash(const FSpec: String): Boolean;
  616. var
  617.   c: Char;
  618.   i: Integer;
  619.   len: Integer;
  620. begin
  621.   Result := False;
  622.   len := Length(FSpec);
  623.   i := 1;
  624.   while i <= len do
  625.   begin
  626.     c := FSpec[i];
  627.     if (c = WILD_MULTI) or (c = WILD_CHAR) or (c = SPEC_SEP) then
  628.       exit;
  629.     Inc(i);
  630.   end;
  631.   Result := True;
  632. end;
  633.  
  634. //  Returns a boolean indicating whether or not we're running under XP or later.
  635. function IsWinXP: Boolean;
  636. var
  637.   osv: TOSVERSIONINFO;
  638. begin
  639.   osv.dwOSVersionInfoSize := sizeOf(OSVERSIONINFO);
  640.   GetVersionEx(osv);
  641.   //   result := ( osv.dwPlatformId = VER_PLATFORM_WIN32_NT );
  642.   Result := (osv.dwMajorVersion > 5) or ((osv.dwMajorVersion = 5) and
  643.     (osv.dwMinorVersion >= 1));
  644. end;
  645.  
  646. //  Returns a boolean indicating whether or not we're running under XP or later.
  647. function WinVersion: Integer;
  648. var
  649.   osv: TOSVERSIONINFO;
  650. begin
  651.   osv.dwOSVersionInfoSize := sizeOf(OSVERSIONINFO);
  652.   GetVersionEx(osv);
  653.   Result := (osv.dwMajorVersion * 100) + osv.dwMinorVersion;
  654. end;
  655.  
  656. (*? SetSlash
  657. 1.76 use enum  TPathSlashDirection = (psdExternal, psdInternal)
  658. 1.73
  659. forwardSlash = false = Windows normal backslash '\'
  660. forwardSlash = true = forward slash '/'
  661. *)
  662. function SetSlash(const path: String; dir: TPathSlashDirection): String;
  663. {$IFDEF Delphi7up}
  664. begin
  665.   if dir = psdInternal then
  666.     Result := AnsiReplaceStr(path, PathDelim, PathDelimAlt)
  667.   else
  668.     Result := AnsiReplaceStr(path, PathDelimAlt, PathDelim);
  669. end;
  670. {$ELSE}
  671. var
  672.   c, f, r: Char;
  673.   i, len:  Integer;
  674. begin
  675.   Result := path;
  676.   len := Length(path);
  677.   if dir = psdInternal then
  678.   begin
  679.     f := PathDelim{'\'};
  680.     r := PathDelimAlt;//'/';
  681.   end
  682.   else
  683.   begin
  684.     f := PathDelimAlt;//'/';
  685.     r := PathDelim{'\'};
  686.   end;
  687.   i := 1;
  688.   while i <= len do
  689.   begin
  690.     c := path[i];
  691. {$ifndef UNICODE}
  692.     if c in LeadBytes then
  693.     begin
  694.       Inc(i, 2);
  695.       continue;
  696.     end;
  697. {$endif}
  698.     if c = f then
  699.       Result[i] := r;
  700.     Inc(i);
  701.   end;
  702. end;
  703.  
  704. {$ENDIF}
  705.  
  706. function SetSlashW(const path: WideString; dir: TPathSlashDirection): WideString;
  707. var
  708.   c: Widechar;
  709.   f: Widechar;
  710.   i: Integer;
  711.   len: Integer;
  712.   r: Widechar;
  713. begin
  714.   Result := path;
  715.   len := Length(path);
  716.   if dir = psdInternal then
  717.   begin
  718.     f := PathDelim{'\'};
  719.     r := PathDelimAlt;//'/';
  720.   end
  721.   else
  722.   begin
  723.     f := PathDelimAlt;//'/';
  724.     r := PathDelim{'\'};
  725.   end;
  726.   i := 1;
  727.   while i <= len do
  728.   begin
  729.     c := path[i];
  730.     if c = f then
  731.       Result[i] := r;
  732.     Inc(i);
  733.   end;
  734. end;
  735.  
  736.  //---------------------------------------------------------------------------
  737.  // concat path
  738. function PathConcat(const path, extra: String): String;
  739. var
  740.   pathLen: Integer;
  741.   pathLst: Char;
  742. begin
  743.   pathLen := Length(path);
  744.   Result  := path;
  745.   if pathLen > 0 then
  746.   begin
  747.     //    pathLst := path[pathLen];
  748.     pathLst := AnsiLastChar(path)^;
  749.     if (pathLst <> DriveDelim{':'}) and (Length(extra) > 0) then
  750.       if (extra[1] = PathDelim{'\'}) = (pathLst = PathDelim{'\'}) then
  751.         if pathLst = PathDelim{'\'} then
  752.           Result := Copy(path, 1, pathLen - 1) // remove trailing
  753.         else
  754.           Result := path + PathDelim;//'\';
  755.   end;
  756.   Result := Result + extra;
  757. end;
  758.  
  759.  
  760.  //const           // QueryZip return bit values and errors
  761.  //  zqbStartEXE    = 1;     // is EXE file may be SFX
  762.  //  zqbStartLocal  = 2;     // normal zip file start
  763.  //  zqbStartSpan   = 4;     // first part of span
  764.  //  zqbStartCentral = 8;    // continuing Central Header
  765.  //  zqbHasComment  = 16;
  766.  ////  zqbGoodComment = 16;  // comment length good (no junk at end)
  767.  //  zqbHasLocal    = 32;    // first Central entry points to local header
  768.  //  zqbHasCentral  = 64;    // Central entry where it should be
  769.  //  zqbHasEOC      = 128;   // End of Central entry
  770.  //  zqbHasLoc64    = 256;   // EOC64 locator entry
  771.  //  zqbHasEOC64    = 512;   // Zip64 EOC
  772.  //  zqbJunkAtEnd   = 1024;  // junk at end of zip
  773.  //  zqbIsDiskZero  = 2048;  // is disk 0
  774.  
  775.  //  zqFieldError   = -5;    // bad field value
  776.  //  zqFileError    = -7;     // file handling error
  777.  //  zqGeneralError = -9;  // unspecified failure
  778.  
  779. function QueryZip(const FName: String): Integer;
  780. const
  781.   FileMask = (zqbStartEXE or zqbStartLocal or zqbStartSpan or
  782.     zqbStartCentral or zqbHasComment or zqbJunkAtEnd);//zqbGoodComment);
  783. var
  784.   Buf: array of Byte;
  785.   BufPos: Integer;
  786.   CenDisk: Cardinal;
  787.   CenOfs: Int64;
  788.   DoCenDir: Boolean;
  789.   EOC: TZipEndOfCentral;
  790.   EOCLoc: TZip64EOCLocator;
  791.   EOCPossible: Boolean;
  792.   FileHandle: Integer;
  793.   File_Sze: Int64;
  794.   fn:  String;
  795.   fs:  Int64;
  796.   Need64: Boolean;
  797.   pEOC: PZipEndOfCentral;
  798.   pEOCLoc: PZip64EOCLocator;
  799.   Pos0: Integer;
  800.   ReadPos: Cardinal;
  801.   res: Integer;
  802.   Sig: Cardinal;
  803.   Size: Integer;
  804.   ThisDisk: Cardinal;
  805.   //  tmp: Integer;
  806.   //  tmp64: int64;
  807.  
  808.   function NeedLoc64(const QEOC: TZipEndOfCentral): Boolean;
  809.   begin
  810.     Result := (QEOC.ThisDiskNo = MAX_WORD) or (QEOC.CentralDiskNo = MAX_WORD) or
  811.       (QEOC.CentralEntries = MAX_WORD) or (QEOC.TotalEntries = MAX_WORD) or
  812.       (QEOC.CentralSize = MAX_UNSIGNED) or (QEOC.CentralOffset = MAX_UNSIGNED);
  813.   end;
  814.   // check central entry and, if same disk, its local header signal
  815.   function CheckCen(fh: Integer; This_Disk: Cardinal; CenOf: Int64): Integer;
  816.   type
  817.     TXData_tag = packed record
  818.       tag: Word;
  819.       siz: Word;
  820.     end;
  821.     PXData_tag = ^TXData_tag;
  822.  
  823.   var
  824.     ret: Integer;
  825.     CentralHead: TZipCentralHeader;
  826.     Sgn: Cardinal;
  827.     Ofs: Int64;
  828.     xbuf: array of Byte;
  829.     xlen, ver: Integer;
  830.     wtg, wsz: Word;
  831.     has64: Boolean;
  832.     p: PByte;
  833.   begin  // verify start of central
  834.     ret := 0;
  835.     Result := zqFieldError;
  836.     if (FileSeek64(fh, CenOf, soFromBeginning) <> -1) and
  837.       (FileRead(fh, CentralHead, sizeof(CentralHead)) = sizeof(CentralHead)) and
  838.       (CentralHead.HeaderSig = CentralFileHeaderSig) then
  839.     begin
  840.       ret := zqbHasCentral;               // has linked Central
  841.       if (CentralHead.DiskStart = This_Disk) then
  842.       begin
  843.         ver := CentralHead.VersionNeeded;
  844.         if (ver and VerMask) > ZIP64_VER then
  845.           exit;
  846.         Ofs := CentralHead.RelOffLocal;
  847.         if (Ofs = MAX_UNSIGNED) and ((ver and VerMask) >= ZIP64_VER) then
  848.         begin
  849.           if ver > 45 then
  850.             exit;     // bad version
  851.           // have to read extra data
  852.           xlen := CentralHead.FileNameLen + CentralHead.ExtraLen;
  853.           SetLength(xbuf, xlen);  // easier to read filename + extra
  854.           if FileRead(fh, xbuf, xlen) <> xlen then
  855.             exit;                  // error
  856.           // find Zip64 extra data
  857.           has64 := False;
  858.           xlen := CentralHead.ExtraLen;
  859.           p := @xbuf[CentralHead.FileNameLen];
  860.           wsz := 0;   // keep compiler happy
  861.           while xlen > sizeof(TXData_tag) do
  862.           begin
  863.             wtg := PXData_tag(p)^.tag;
  864.             wsz := PXData_tag(p)^.siz;
  865.             if wtg = Zip64_data_tag then
  866.             begin
  867.               has64 := xlen >= (wsz + sizeof(TXData_tag));
  868.               break;
  869.             end;
  870.             Inc(p, wsz + sizeof(TXData_tag));
  871.           end;
  872.           if (not has64) or (wsz > (xlen - sizeof(TXData_tag))) then
  873.             exit;              // no data so rel ofs is bad
  874.           Inc(p, sizeof(TXData_tag));  // past header
  875.           // locate offset  - values only exist if needed
  876.           if CentralHead.UncomprSize = MAX_UNSIGNED then
  877.           begin
  878.             if wsz < sizeof(Int64) then
  879.               exit;           // bad
  880.             Inc(p, sizeof(Int64));
  881.             Dec(wsz, sizeof(Int64));
  882.           end;
  883.           if CentralHead.ComprSize = MAX_UNSIGNED then
  884.           begin
  885.             if wsz < sizeof(Int64) then
  886.               exit;           // bad
  887.             Inc(p, sizeof(Int64));
  888.             Dec(wsz, sizeof(Int64));
  889.           end;
  890.           if wsz < sizeof(Int64) then
  891.             exit;             // bad
  892.           Ofs := PInt64(p)^;
  893.         end;
  894.         if (FileSeek64(fh, Ofs{Int64(CentralHead.RelOffLocal)}, 0) <> -1) and
  895.           (FileRead(fh, Sgn, sizeof(Sgn)) = sizeof(Sgn)) and
  896.           (Sgn = LocalFileHeaderSig) then
  897.           ret := zqbHasCentral or zqbHasLocal;     // linked local
  898.       end;
  899.     end;
  900.     Result := ret;
  901.   end;
  902.  
  903. begin
  904.   EOCPossible := False;
  905.   Result := zqFileError;
  906.   DoCenDir := True;   // test central too
  907.   if (FName <> '') and (FName[1] = '|') then
  908.   begin
  909.     DoCenDir := False;
  910.     fn := copy(FName, 2, length(FName) - 1);
  911.   end
  912.   else
  913.     fn := FName;
  914.   fn := Trim(fn);
  915.   if fn = '' then
  916.     exit;
  917.   FileHandle := Invalid_Handle;
  918.   res := 0;
  919.   try
  920.     try
  921.       // Open the input archive, presumably the last disk.
  922.       FileHandle := FileOpen(fn, fmShareDenyWrite or fmOpenRead);
  923.       if FileHandle = Invalid_Handle then
  924.         exit;
  925.       Result := 0;                          // rest errors normally file too small
  926.  
  927.       // first we check if the start of the file has an IMAGE_DOS_SIGNATURE
  928.       if (FileRead(FileHandle, Sig, sizeof(Cardinal)) <> sizeof(Cardinal)) then
  929.         exit;
  930.       if LongRec(Sig).Lo = IMAGE_DOS_SIGNATURE then
  931.         res := zqbStartEXE
  932.       else
  933.       if Sig = LocalFileHeaderSig then
  934.         res := zqbStartLocal
  935.       else
  936.       if Sig = CentralFileHeaderSig then
  937.         res := zqbStartCentral
  938.       // part of split Central Directory
  939.       else
  940.       if Sig = ExtLocalSig then
  941.         res := zqbStartSpan;            // first part of span
  942.  
  943.       // A test for a zip archive without a ZipComment.
  944.       fs := FileSeek64(FileHandle, -Int64(sizeof(EOC)), soFromEnd);
  945.       if fs = -1 then
  946.         exit;                           // not zip - too small
  947.       File_Sze := fs;
  948.       // try no comment
  949.       if (FileRead(FileHandle, EOC, sizeof(EOC)) = sizeof(EOC)) and
  950.         (EOC.HeaderSig = EndCentralDirSig) and (EOC.ZipCommentLen = 0) then
  951.       begin
  952.         EOCPossible := True;
  953.         res := res or zqbHasEOC;// or zqbGoodComment;       // EOC
  954.         CenDisk := EOC.CentralDiskNo;
  955.         ThisDisk := EOC.ThisDiskNo;
  956.         CenOfs := EOC.CentralOffset;
  957.         Need64 := NeedLoc64(EOC);
  958.         if (CenDisk = 0) and (ThisDisk = 0) then
  959.           res := res or zqbIsDiskZero;
  960.         // check Zip64 EOC
  961.         if Need64 and (fs > sizeof(TZip64EOCLocator)) then
  962.         begin   // check for locator
  963.           if (FileSeek64(FileHandle, fs - sizeof(TZip64EOCLocator), soFromBeginning) <>
  964.             -1) and (FileRead(FileHandle, EOCLoc, sizeof(TZip64EOCLocator)) =
  965.             sizeof(TZip64EOCLocator)) and (EOCLoc.LocSig = EOC64LocatorSig) then
  966.           begin  // found possible locator
  967.             res := res or zqbHasLoc64;
  968.             CenDisk := 0;
  969.             ThisDisk := 1;
  970.             CenOfs := -1;
  971.           end;
  972.         end;
  973.         if DoCenDir and (CenDisk = ThisDisk) then
  974.         begin
  975.           res := res or CheckCen(FileHandle, ThisDisk, CenOfs);
  976.           exit;
  977.         end;
  978.         res := res and FileMask;                // remove rest
  979.       end;
  980.       // try to locate EOC
  981.       Inc(File_Sze, sizeof(EOC));
  982.       Size := MAX_WORD + sizeof(EOC) + sizeof(TZip64EOCLocator);
  983.       if Size > File_Sze then
  984.         Size := File_Sze;
  985.       SetLength(Buf, Size);
  986.       Pos0 := Size - (MAX_WORD + sizeof(TZipEndOfCentral));
  987.       if Pos0 < 0 then
  988.         Pos0 := 0;    // lowest buf position for eoc
  989.       ReadPos := File_Sze - Size;
  990.       if (FileSeek64(FileHandle, Int64(ReadPos), soFromBeginning) <> -1) and
  991.         (FileRead(FileHandle, Buf[0], Size) = Size) then
  992.       begin
  993.         // Finally try to find the EOC record within the last 65K...
  994.         BufPos := Size - (sizeof(EOC));
  995.         pEOC := PZipEndOfCentral(@Buf[Size - sizeof(EOC)]);
  996.         // reverse search
  997.         while BufPos > Pos0 do         // reverse search
  998.         begin
  999.           Dec(BufPos);
  1000.           Dec(PAnsiChar(pEOC));
  1001.           if pEOC^.HeaderSig = EndCentralDirSig then
  1002.           begin                             // possible EOC found
  1003.             res := res or zqbHasEOC;        // EOC
  1004.             // check correct length comment
  1005.             if (BufPos + sizeof(EOC) + pEOC^.ZipCommentLen) <= Size then
  1006.               res := res or zqbHasComment;        // good comment length
  1007.             if (BufPos + sizeof(EOC) + pEOC^.ZipCommentLen) <> Size then
  1008.               res := res or zqbJunkAtEnd;        // has junk
  1009.             CenDisk := pEOC^.CentralDiskNo;
  1010.             ThisDisk := pEOC^.ThisDiskNo;
  1011.             if (CenDisk = 0) and (ThisDisk = 0) then
  1012.               res := res or zqbIsDiskZero;
  1013.             CenOfs := pEOC^.CentralOffset;
  1014.             Need64 := NeedLoc64(pEOC^);
  1015.             // check Zip64 EOC
  1016.             if Need64 and ((BufPos - sizeof(TZip64EOCLocator)) >= 0) then
  1017.             begin   // check for locator
  1018.               pEOCLoc := PZip64EOCLocator(@Buf[BufPos - sizeof(TZip64EOCLocator)]);
  1019.               if pEOCLoc^.LocSig = EOC64LocatorSig then
  1020.               begin  // found possible locator
  1021.                 res := res or zqbHasLoc64;
  1022.                 CenDisk := 0;
  1023.                 ThisDisk := 1;
  1024.                 CenOfs := -1;
  1025.               end;
  1026.             end;
  1027.             if DoCenDir and (CenDisk = ThisDisk) then
  1028.             begin                           // verify start of central
  1029.               res := res or CheckCen(FileHandle, ThisDisk, CenOfs);
  1030.               break;
  1031.             end;
  1032.             res := res and FileMask;            // remove rest
  1033.             break;
  1034.           end;
  1035.         end;                                // while
  1036.       end;
  1037.       if EOCPossible then
  1038.         res := res or zqbHasEOC;
  1039.     except
  1040.       Result := zqGeneralError;
  1041.     end;
  1042.   finally
  1043.     File_Close(FileHandle);
  1044.     if Result = 0 then
  1045.       Result := res;
  1046.   end;
  1047. end;
  1048. //? QueryZip
  1049.  
  1050. function GetVolumeLabel(const drive: String): String;
  1051. var
  1052.   Bits: set of 0..25;
  1053.   DriveLetter: Char;
  1054.   drv:  String;
  1055.   NamLen: Cardinal;
  1056.   Num:  Integer;
  1057.   OldErrMode: DWord;
  1058.   SysFlags: DWord;
  1059.   SysLen: DWord;
  1060.   VolNameAry: array[0..MAX_BYTE] of Char;
  1061. begin
  1062.   Result := '';
  1063.   NamLen := MAX_BYTE;
  1064.   SysLen := MAX_BYTE;;
  1065.   VolNameAry[0] := #0;
  1066.   drv := UpperCase(ExpandFileName(drive));
  1067.   DriveLetter := drv[1];
  1068.   if DriveLetter <> PathDelim{'\'} then      // Only for local drives
  1069.   begin
  1070.     if (DriveLetter < 'A') or (DriveLetter > 'Z') then
  1071.       exit;
  1072.     Integer(Bits) := GetLogicalDrives();
  1073.     Num := Ord(DriveLetter) - Ord('A');
  1074.     if not (Num in Bits) then
  1075.       exit;
  1076.   end;
  1077.   OldErrMode := SetErrorMode(SEM_FAILCRITICALERRORS);
  1078.   // Turn off critical errors:
  1079.   if GetVolumeInformation(PChar(drv), VolNameAry, NamLen, nil, SysLen,
  1080.     SysFlags, nil, 0) then
  1081.     Result := VolNameAry;
  1082.   SetErrorMode(OldErrMode);
  1083.   // Restore critical errors:
  1084. end;
  1085.  
  1086. function IsSameFile(const FName1, FName2: String): Boolean;
  1087. var
  1088.   ff1: Boolean;
  1089.   ff2: Boolean;
  1090.   sr1: TSearchRec;
  1091.   sr2: TSearchRec;
  1092. begin
  1093.   if CompareText(ExpandFileName(FName1), ExpandFileName(FName2)) = 0 then
  1094.   begin
  1095.     Result := True;
  1096.     exit;
  1097.   end;
  1098.   Result := False;
  1099.   // in windows no alias so names must match
  1100.   if CompareText(ExtractFileName(FName1), ExtractFileName(FName2)) = 0 then
  1101.   begin
  1102.     ff1 := FindFirst(FName1, faAnyFile, sr1) = 0;
  1103.     ff2 := FindFirst(FName2, faAnyFile, sr2) = 0;
  1104.     if (ff1 = ff2) and not ff1 then
  1105.       exit;// neither found assume different
  1106.     //      Result := CompareText(FName1, FName2) = 0;
  1107.     { $ WARN SYMBOL_PLATFORM OFF}
  1108.     if ff1 = ff2 then
  1109.       Result := CompareMem(@sr1.FindData, @sr2.FindData, 2 + (4 * 4));// both exist
  1110.     if ff1 then
  1111.       SysUtils.FindClose(sr1);
  1112.     if ff2 then
  1113.       SysUtils.FindClose(sr2);
  1114.   end;
  1115. end;
  1116.  
  1117. function OEMToStr(const astr: Ansistring): String;
  1118. var
  1119.   buf: String;
  1120. begin
  1121.   SetLength(buf, Length(astr) + 3); // allow worst case
  1122.   OemToChar(PAnsiChar(astr), PChar(buf));
  1123.   Result := PChar(buf);
  1124. end;
  1125.  
  1126. function StrToOEM(const astr: String): String;
  1127. var
  1128.   buf: Ansistring;
  1129. begin
  1130.   SetLength(buf, Length(astr) + 3); // allow worst case
  1131.   CharToOem(PChar(astr), PAnsiChar(buf));
  1132.   buf := PAnsiChar(buf); // remove trailing nul
  1133.   Result := String(buf);
  1134. end;
  1135.  
  1136. {
  1137.   return true if contains chars (<#31 ?) >#126
  1138. }
  1139. function StrHasExt(const astr: String): Boolean;
  1140. var
  1141.   i: Integer;
  1142. begin
  1143.   Result := False;
  1144.   for i := 1 to Length(astr) do
  1145.     if (astr[i] > #126) or (astr[i] < #31) then
  1146.     begin
  1147.       Result := True;
  1148.       break;
  1149.     end;
  1150. end;
  1151.  
  1152. {$IFDEF UNICODE}
  1153. function StrHasExt(const astr: AnsiString): Boolean;
  1154. var
  1155.   i: integer;
  1156. begin
  1157.   Result := false;
  1158.   for i := 1 to Length(astr) do
  1159.     if (astr[i] > #126) or (astr[i] < #31) then
  1160.     begin
  1161.       Result := True;
  1162.       break;
  1163.     end;
  1164. end;
  1165.  
  1166. function StrHasExt(const astr: TZMRawBytes): Boolean;
  1167. var
  1168.   i: integer;
  1169. begin
  1170.   Result := false;
  1171.   for i := 1 to Length(astr) do
  1172.     if (astr[i] > #126) or (astr[i] < #31) then
  1173.     begin
  1174.       Result := True;
  1175.       break;
  1176.     end;
  1177. end;
  1178. {$ENDIF}
  1179.  
  1180. function CalcCRC32(const mem; len: Integer; init: DWORD): DWORD;
  1181. var
  1182.   i: Integer;
  1183.   p: pByte;
  1184. begin
  1185.   p := @mem;
  1186.   Result := init;
  1187.   if (p <> nil) and (len > 0) then
  1188.   begin
  1189.     Result := Result xor $FFFFFFFF;
  1190.     for i := 1 to len do
  1191.     begin
  1192.       Result := (Result shr 8) xor CRC32Table[(p^ xor Byte(Result))];
  1193.       Inc(p);
  1194.     end;
  1195.     Result := Result xor $FFFFFFFF;
  1196.   end;
  1197. end;
  1198.  
  1199. function LastPos(const s: String; ch: Char; before: Integer = MAXINT): Integer;
  1200. var
  1201.   i: Integer;
  1202. begin
  1203.   Result := 0;  // not found
  1204.   for i := 1 to Length(s) do
  1205.   begin
  1206.     if i >= before then
  1207.       break;
  1208.     if s[i] = ch then
  1209.       Result := i;
  1210.   end;
  1211. end;
  1212.  
  1213. function LastPosW(const s: WideString; wch: Widechar; before: Integer = MAXINT): Integer;
  1214. var
  1215.   i: Integer;
  1216. begin
  1217.   Result := 0;  // not found
  1218.   for i := 1 to Length(s) do
  1219.   begin
  1220.     if i >= before then
  1221.       break;
  1222.     if s[i] = wch then
  1223.       Result := i;
  1224.   end;
  1225. end;
  1226.  
  1227. function IsFolder(const Name: String): Boolean;
  1228. var
  1229.   ch: Char;
  1230. begin
  1231.   Result := False;
  1232.   if Name <> '' then
  1233.   begin
  1234.     ch := Name[Length(Name)];
  1235.     Result := (ch = PathDelim) or (ch = PathDelimAlt);
  1236.   end;
  1237. end;
  1238.  
  1239.  
  1240. {$IFDEF UNICODE}
  1241. function IsFolder(const name: TZMRawBytes): boolean;
  1242. var
  1243.   ch: AnsiChar;
  1244. begin
  1245.   Result := False;
  1246.   if name <> ''  then
  1247.   begin
  1248.     ch := name[Length(name)];
  1249.     Result := (ch = PathDelim) or (ch = PathDelimAlt);
  1250.   end;
  1251. end;
  1252. {$ENDIF}
  1253.  
  1254. // return true if filename is obviously invalid
  1255. function NameIsBad(const astr: String): Boolean;
  1256. var
  1257.   i: Integer;
  1258. begin
  1259.   Result := (astr = '') or (astr[1] = ' ') or (astr[1] = '\') or
  1260.     (Length(astr) > MAX_PATH);
  1261.   if not Result then
  1262.     for i := 1 to Length(astr) do
  1263. {$IFDEF UNICODE}
  1264.       if CharInSet(astr[i], [#0..#31, ':', '<', '>', '|', '*', '?'])  then
  1265. {$ELSE}
  1266.       if astr[i] in [#0..#31, ':', '<', '>', '|', '*', '?'] then
  1267. {$ENDIF}
  1268.       begin
  1269.         Result := True;
  1270.         break;
  1271.       end;
  1272.   if not Result then
  1273.     Result := (AnsiPos('..', astr) > 0) or (AnsiPos('\ ', astr) > 0) or
  1274.       (AnsiPos(' \', astr) > 0);
  1275. end;
  1276.  
  1277.  // return exe size (if < 4G)
  1278.  //    0 _ not exe
  1279. function ExeSize(fileHandle: Integer): Cardinal;
  1280. var
  1281.   bad: Boolean;
  1282.   did: Integer;
  1283.   sig: DWORD;
  1284.   dosHeader: TImageDOSHeader;
  1285.   fileHeader: TImageFileHeader;
  1286.   sectionHeader: TImageSectionHeader;
  1287.   i, NumSections: Integer;
  1288.   sectionEnd: Cardinal;
  1289. const
  1290.   IMAGE_PE_SIGNATURE  = $00004550;
  1291.   IMAGE_DOS_SIGNATURE = $5A4D;
  1292.   IMAGE_FILE_MACHINE_I386 = $14C;
  1293. begin
  1294.   Result := 0;
  1295.   bad := True;
  1296.   if fileHandle <> -1 then
  1297.   begin
  1298.     try
  1299.       FileSeek(fileHandle, 0, soFromBeginning);
  1300.       while True do
  1301.       begin
  1302.         did := FileRead(fileHandle, dosHeader, sizeof(TImageDOSHeader));
  1303.         if (did <> sizeof(TImageDOSHeader)) or
  1304.           (dosHeader.e_magic <> IMAGE_DOS_SIGNATURE) then
  1305.           break;
  1306.         if FileSeek(fileHandle, dosHeader._lfanew, 0) < 0 then
  1307.           break;
  1308.         did := FileRead(fileHandle, sig, sizeof(DWORD));
  1309.         if (did <> sizeof(DWORD)) or (sig <> IMAGE_PE_SIGNATURE) then
  1310.           break;
  1311.         did := FileRead(fileHandle, fileHeader, sizeof(TImageFileHeader));
  1312.         if (did <> sizeof(TImageFileHeader)) or
  1313.           (fileHeader.Machine <> IMAGE_FILE_MACHINE_I386) then
  1314.           break;
  1315.         NumSections := fileHeader.NumberOfSections;
  1316.         if FileSeek(fileHandle, sizeof(TImageOptionalHeader), 1) < 0 then
  1317.           break;
  1318.         bad := False;
  1319.         for i := 1 to NumSections do
  1320.         begin
  1321.           did := FileRead(fileHandle, sectionHeader, sizeof(TImageSectionHeader));
  1322.           if (did <> sizeof(TImageSectionHeader)) then
  1323.           begin
  1324.             bad := True;
  1325.             break;
  1326.           end;
  1327.           sectionEnd := sectionHeader.PointerToRawData + sectionHeader.SizeOfRawData;
  1328.           if sectionEnd > Result then
  1329.             Result := sectionEnd;
  1330.         end;
  1331.       end;
  1332.     except
  1333.       bad := True;
  1334.     end;
  1335.   end;
  1336.   if bad then
  1337.     Result := 0;
  1338. end;
  1339.  
  1340. function ExeSize(const Name: String): Cardinal;
  1341. var
  1342.   fh: Integer;
  1343. begin
  1344.   Result := 0;
  1345.   fh := FileOpen(Name, fmOpenRead);
  1346.   if fh <> -1 then
  1347.   begin
  1348.     Result := ExeSize(fh);
  1349.     File_Close(fh);
  1350.   end;
  1351. end;
  1352.  
  1353. // return <0 error
  1354. //const
  1355. //  cstNone = 0;      // not found
  1356. //  cstExe  = 1;      // might be stub of unknown type
  1357. //  cstSFX17 = 2;     // found 1.7 SFX headers
  1358. //  cstSFX19 = 4;     // found 2.0 SFX headers
  1359. //  cstDetached = 64; // is detached
  1360. // -7  = Open, read or seek error
  1361. // -8  = memory error
  1362. // -9  = exception error
  1363. // -10 = all other exceptions
  1364.  
  1365. // check for SFX header or detached header
  1366. function CheckSFXType(const fileHandle: Integer; var ZipName: String;
  1367.   var size: Integer): Integer;
  1368. type
  1369.   T_header = packed record
  1370.     Sig: DWORD;
  1371.     Size: Word;
  1372.     X: Word;
  1373.   end;
  1374. var
  1375.   nsize: Integer;
  1376.   hed: T_header;
  1377.   SFXHeader_end: TSFXFileEndOfHeader_17;
  1378.   Detached: TSFXDetachedHeader_17;
  1379.   tmp: Ansistring;
  1380. begin
  1381.   Result := 0; // default none
  1382.   try
  1383.     size := ExeSize(fileHandle);
  1384.     if size > 0 then
  1385.     begin
  1386.       ZipName := ExtractNameOfFile(ZipName) + '.zip'; // use default
  1387.       while Result = 0 do // HOTFIX-MARX-A
  1388.       begin
  1389.         Result := -7; // error - maybe read error?
  1390.         if FileSeek(fileHandle, size, soFromBeginning) <> size then
  1391.           Break;
  1392.         // at end of stub - read file header
  1393.         if FileRead(fileHandle, hed, sizeof(T_header)) <> sizeof(T_header) then
  1394.           break;
  1395.         // valid?
  1396.         case hed.Sig of
  1397.           SFX_HEADER_SIG:
  1398.           begin
  1399.             // it is new header
  1400.             size  := size + sizeof(T_header);
  1401.             // skip file header
  1402.             nsize := Hed.Size - SizeOf(T_header);
  1403.             if FileSeek(fileHandle, nsize, soFromCurrent) < 0 then
  1404.               break;   // error
  1405.             // at end of stub - read file header
  1406.             if FileRead(fileHandle, hed, sizeof(T_header)) <> sizeof(T_header) then
  1407.               break;     // invalid
  1408.             size := size + nsize;
  1409.             if hed.Sig = CentralFileHeaderSig then
  1410.               Result := cstSFX19 or cstDetached  // found new detached
  1411.             else
  1412.             if hed.Sig = LocalFileHeaderSig then
  1413.               Result := cstSFX19;  // found new
  1414.             Break;
  1415.           end;
  1416.           SFX_HEADER_SIG_17:
  1417.           begin
  1418.             // is old header
  1419.             size  := size + sizeof(T_header);
  1420.             // skip file header
  1421.             nsize := Hed.Size - SizeOf(T_header);
  1422.             if FileSeek(fileHandle, nsize, soFromCurrent) < 0 then
  1423.               break;   // error
  1424.             if FileRead(fileHandle, SFXHeader_end, sizeof(SFXHeader_end)) <>
  1425.               sizeof(SFXHeader_end) then
  1426.               break;     // invalid
  1427.             if (SFXHeader_end.Signature <> SFX_HEADER_END_SIG_17) then
  1428.               break;  // invalid
  1429.             // ignore header size check
  1430.             size := size + nsize + sizeof(SFXHeader_end);
  1431.             // at end of file header - check for detached header
  1432.             if FileRead(fileHandle, detached, sizeof(TSFXDetachedHeader_17)) <>
  1433.               sizeof(TSFXDetachedHeader_17) then
  1434.               break;     // not detached
  1435.             if detached.Signature = SFX_DETACHED_HEADER_SIG_17 then
  1436.             begin
  1437.               size := size + sizeof(TSFXDetachedHeader_17);
  1438.               if Detached.NameLen > 0 then
  1439.               begin
  1440.                 SetLength(tmp, Detached.NameLen);
  1441.                 if FileRead(fileHandle, PAnsiChar(tmp)^, Detached.NameLen) <>
  1442.                   Integer(Detached.NameLen) then
  1443.                   break;     // invalid
  1444.                 ZipName := String(tmp) + ExtractFileExt(ZipName);
  1445.                 size := size + Integer(Detached.NameLen);
  1446.               end;
  1447.               if Detached.ExtLen > 0 then
  1448.               begin
  1449.                 SetLength(tmp, Detached.ExtLen);
  1450.                 if FileRead(fileHandle, PAnsiChar(tmp)^, Detached.ExtLen) <>
  1451.                   Integer(Detached.ExtLen) then
  1452.                   break;     // invalid
  1453.                 size := size + Integer(Detached.ExtLen);
  1454.                 ZipName := ExtractNameOfFile(ZipName) + '.' + string(tmp);
  1455.               end;
  1456.               // at end of file header - check for detached header end
  1457.               if (FileRead(fileHandle, detached, sizeof(TSFXDetachedHeader_17)) <>
  1458.                 sizeof(TSFXDetachedHeader_17)) or
  1459.                 (detached.Signature <> SFX_DETACHED_HEADER_END_SIG_17) then
  1460.                 break;     // invalid
  1461.               size := size + sizeof(TSFXDetachedHeader_17);
  1462.               if FileRead(fileHandle, hed, sizeof(DWORD)) <> sizeof(DWORD) then
  1463.                 break;     // invalid
  1464.               if hed.Sig = CentralFileHeaderSig then
  1465.                 Result := cstSFX17 or cstDetached;  // found old detached
  1466.             end;
  1467.             if detached.Signature = LocalFileHeaderSig then
  1468.               Result := cstSFX17;  // found old
  1469.             Break;
  1470.           end;
  1471.           else
  1472.             Result := cstExe; // possibly stub of different loader
  1473.         end;
  1474.       end;
  1475.     end;
  1476.   except
  1477.     Result := -10;
  1478.   end;
  1479. end;
  1480.  
  1481. function CheckSFXType(const Name: String; var ZipName: String;
  1482.   var size: Integer): Integer;
  1483. var
  1484.   fh: Integer;
  1485. begin
  1486.   Result := 0;
  1487.   if AnsiCompareText(ExtractFileExt(Name), '.exe') = 0 then
  1488.   begin
  1489.     fh := FileOpen(Name, fmOpenRead);
  1490.     if fh <> -1 then
  1491.     begin
  1492.       ZipName := Name;
  1493.       Result := CheckSFXType(fh, ZipName, size);
  1494.       File_Close(fh);
  1495.     end;
  1496.   end;
  1497. end;
  1498.  
  1499. function FileDateToLocalDateTime(stamp: Integer): TDateTime;
  1500. var
  1501.   LocTime, FTime: TFileTime;
  1502.   SysTime: TSystemTime;
  1503. begin
  1504.   Result := 0;
  1505.   if DosDateTimeToFileTime(LongRec(stamp).Hi, LongRec(stamp).Lo, LocTime) and
  1506.     LocalFileTimeToFileTime(LocTime, FTime) and
  1507.     FileTimeToSystemTime(FTime, SysTime) then
  1508.     Result := SystemTimeToDateTime(SysTime);
  1509. end;
  1510.  
  1511. end.
  1512.  
  1513.