src/sfs/sfsZipFS.pas

   1 // Streaming R/O Virtual File System v0.2.0
   2 // Copyright (C) XL A.S. Ketmar.  All rights reserved
   3 // See the file aplicense.txt for conditions of use.
   4 //
   5 // grouping files with packing:
   6 //   zip, jar: PKZIP-compatible archives (store, deflate)
   7 //   fout2   : Fallout II .DAT
   8 //   vtdb    : Asphyre's VTDb
   9 //   dfwad   : D2D:F wad archives
  10 //
  11 {.$DEFINE SFS_DEBUG_ZIPFS}
  12 {.$DEFINE SFS_ZIPFS_FULL}
  13 {$MODE OBJFPC}
  14 {$R+}
  15 unit sfsZipFS;
  16
  17 interface
  18
  19 uses
  20   SysUtils, Classes, Contnrs, sfs;
  21
  22
  23 type
  24   TSFSZipVolumeType = (
  25     sfszvNone,
  26     sfszvZIP,
  27     {$IFDEF SFS_ZIPFS_FULL}
  28     sfszvF2DAT,
  29     sfszvVTDB,
  30     {$ENDIF}
  31     sfszvDFWAD
  32   );
  33
  34   TSFSZipVolume = class(TSFSVolume)
  35   protected
  36     fType: TSFSZipVolumeType;
  37
  38     procedure ZIPReadDirectory ();
  39     procedure DFWADReadDirectory ();
  40     {$IFDEF SFS_ZIPFS_FULL}
  41     procedure F2DATReadDirectory ();
  42     procedure VTDBReadDirectory ();
  43     {$ENDIF}
  44
  45     procedure ReadDirectory (); override;
  46     procedure removeCommonPath (); override;
  47
  48   public
  49     function OpenFileByIndex (const index: Integer): TStream; override;
  50   end;
  51
  52   TSFSZipVolumeFactory = class (TSFSVolumeFactory)
  53   public
  54     function IsMyVolumePrefix (const prefix: AnsiString): Boolean; override;
  55     function Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume; override;
  56     procedure Recycle (vol: TSFSVolume); override;
  57   end;
  58
  59
  60
  61 implementation
  62
  63 uses
  64   zstream, xstreams, utils;
  65
  66
  67 type
  68   TZDecompressionStream = TDecompressionStream;
  69
  70 type
  71   TSFSZipFileInfo = class (TSFSFileInfo)
  72   public
  73     fMethod: Byte; // 0: store; 8: deflate; 255: other
  74     fPackSz: Int64;
  75   end;
  76
  77   TZLocalFileHeader = packed record
  78     version: Byte;
  79     hostOS: Byte;
  80     flags: Word;
  81     method: Word;
  82     time: LongWord;
  83     crc: LongWord;
  84     packSz: LongWord;
  85     unpackSz: LongWord;
  86     fnameSz: Word;
  87     localExtraSz: Word;
  88   end;
  89
  90
  91 function ZIPCheckMagic (st: TStream): Boolean;
  92 var
  93   sign: packed array [0..3] of Char;
  94 begin
  95   result := false;
  96   st.ReadBuffer(sign[0], 4);
  97   st.Seek(-4, soCurrent);
  98   if (sign <> 'PK'#3#4) and (sign <> 'PK'#5#6) then exit;
  99   result := true;
 100 end;
 101
 102 {$IFDEF SFS_ZIPFS_FULL}
 103 function F2DATCheckMagic (st: TStream): Boolean;
 104 var
 105   dsize, fiSz: Integer;
 106 begin
 107   result := false;
 108   st.Position := st.Size-8;
 109   st.ReadBuffer(dsize, 4); st.ReadBuffer(fiSz, 4);
 110   st.Position := 0;
 111   if (fiSz <> st.Size) or (dsize < 5+13) or (dsize > fiSz-4) then exit;
 112   result := true;
 113 end;
 114
 115 function VTDBCheckMagic (st: TStream): Boolean;
 116 var
 117   sign: packed array [0..3] of Char;
 118   fcnt, dofs: Integer;
 119 begin
 120   result := false;
 121   if st.Size < 32 then exit;
 122   st.ReadBuffer(sign[0], 4);
 123   st.ReadBuffer(fcnt, 4); st.ReadBuffer(dofs, 4);
 124   st.Seek(-12, soCurrent);
 125   if sign <> 'vtdm' then exit;
 126   if (fcnt < 0) or (dofs < 32) or (dofs+fcnt*8 > st.Size) then exit;
 127   result := true;
 128 end;
 129 {$ENDIF}
 130
 131 function DFWADCheckMagic (st: TStream): Boolean;
 132 var
 133   sign: packed array [0..5] of Char;
 134   fcnt: Word;
 135 begin
 136   result := false;
 137   if st.Size < 10 then exit;
 138   st.ReadBuffer(sign[0], 6);
 139   st.ReadBuffer(fcnt, 2);
 140   st.Seek(-8, soCurrent);
 141   //writeln('trying DFWAD... [', sign, ']');
 142   if (sign[0] <> 'D') and (sign[1] <> 'F') and (sign[2] <> 'W') and
 143      (sign[3] <> 'A') and (sign[4] <> 'D') and (sign[5] <> #$01) then exit;
 144   //writeln('DFWAD FOUND, with ', fcnt, ' files');
 145   //if (fcnt < 0) then exit;
 146   result := true;
 147 end;
 148
 149 function maxPrefix (s0: string; s1: string): Integer;
 150 var
 151   f: Integer;
 152 begin
 153   for f := 1 to length(s0) do
 154   begin
 155     if f > length(s1) then begin result := f; exit; end;
 156     if UpCase1251(s0[f]) <> UpCase1251(s1[f]) then begin result := f; exit; end;
 157   end;
 158   result := length(s0);
 159 end;
 160
 161 procedure TSFSZipVolume.removeCommonPath ();
 162 var
 163   f, pl, maxsc, sc, c: integer;
 164   cp, s: string;
 165   fi: TSFSZipFileInfo;
 166 begin
 167   if fType <> sfszvZIP then exit;
 168   maxsc := 0;
 169   if fFiles.Count = 0 then exit;
 170   cp := '';
 171   for f := 0 to fFiles.Count-1 do
 172   begin
 173     fi := TSFSZipFileInfo(fFiles[f]);
 174     s := fi.fPath;
 175     if length(s) > 0 then begin cp := s; break; end;
 176   end;
 177   if length(cp) = 0 then exit;
 178   for f := 0 to fFiles.Count-1 do
 179   begin
 180     fi := TSFSZipFileInfo(fFiles[f]);
 181     s := fi.fPath;
 182     if length(s) = 0 then continue;
 183     pl := maxPrefix(cp, s);
 184     //writeln('s=[', s, ']; cp=[', cp, ']; pl=', pl);
 185     if pl = 0 then exit; // no common prefix at all
 186     cp := Copy(cp, 1, pl);
 187     sc := 0;
 188     for c := 1 to length(s) do if s[c] = '/' then Inc(sc);
 189     if sc > maxsc then maxsc := sc;
 190   end;
 191   if maxsc < 2 then exit; // alas
 192   while (length(cp) > 0) and (cp[length(cp)] <> '/') do cp := Copy(cp, 1, length(cp)-1);
 193   if length(cp) < 2 then exit; // nothing to do
 194   for f := 0 to fFiles.Count-1 do
 195   begin
 196     fi := TSFSZipFileInfo(fFiles[f]);
 197     if length(fi.fPath) >= length(cp) then
 198     begin
 199       s := fi.fPath;
 200       fi.fPath := Copy(fi.fPath, length(cp)+1, length(fi.fPath));
 201       //writeln('FIXED [', s, '] -> [', fi.fPath, ']');
 202     end;
 203   end;
 204 end;
 205
 206
 207 { TSFSZipVolume }
 208 procedure TSFSZipVolume.ZIPReadDirectory ();
 209 var
 210   fi: TSFSZipFileInfo;
 211   name: ShortString;
 212   sign, dSign: packed array [0..3] of Char;
 213   lhdr: TZLocalFileHeader;
 214   ignoreFile, skipped: Boolean;
 215   crc, psz, usz: LongWord;
 216   buf: packed array of Byte;
 217   bufPos, bufUsed: Integer;
 218   efid, efsz: Word;
 219   izver: Byte;
 220   izcrc: LongWord;
 221 begin
 222   SetLength(buf, 0);
 223   // read local directory
 224   repeat
 225     fFileStream.ReadBuffer(sign[0], Length(sign));
 226
 227     if sign <> 'PK'#3#4 then break;
 228
 229     ignoreFile := false;
 230     skipped := false;
 231
 232     fi := TSFSZipFileInfo.Create(self);
 233     fi.fPackSz := 0;
 234     fi.fMethod := 0;
 235
 236     //fi.fOfs := fFileStream.Position;
 237
 238     fFileStream.ReadBuffer(lhdr, SizeOf(lhdr));
 239     if lhdr.fnameSz > 255 then name[0] := #255 else name[0] := chr(lhdr.fnameSz);
 240     fFileStream.ReadBuffer(name[1], Length(name));
 241     fFileStream.Seek(lhdr.fnameSz-Length(name), soCurrent); // rest of the name (if any)
 242     fi.fName := utf8to1251(name);
 243     //writeln(Format('0x%08x : %s', [Integer(fi.fOfs), name]));
 244
 245     // here we should process extra field: it may contain utf8 filename
 246     //fFileStream.Seek(lhdr.localExtraSz, soCurrent);
 247     while lhdr.localExtraSz >= 4 do
 248     begin
 249       efid := 0;
 250       efsz := 0;
 251       fFileStream.ReadBuffer(efid, 2);
 252       fFileStream.ReadBuffer(efsz, 2);
 253       Dec(lhdr.localExtraSz, 4);
 254       if efsz > lhdr.localExtraSz then break;
 255       // Info-ZIP Unicode Path Extra Field?
 256       if (efid = $7075) and (efsz <= 255+5) and (efsz > 5) then
 257       begin
 258         fFileStream.ReadBuffer(izver, 1);
 259         if izver <> 1 then
 260         begin
 261           // skip it
 262           Dec(efsz, 1);
 263         end
 264         else
 265         begin
 266           Dec(lhdr.localExtraSz, efsz);
 267           fFileStream.ReadBuffer(izcrc, 4); // name crc, ignore it
 268           Dec(efsz, 5);
 269           name[0] := chr(efsz);
 270           fFileStream.ReadBuffer(name[1], Length(name));
 271           fi.fName := utf8to1251(name);
 272           break;
 273         end;
 274       end;
 275       // skip it
 276       if efsz > 0 then
 277       begin
 278         fFileStream.Seek(efsz, soCurrent);
 279         Dec(lhdr.localExtraSz, efsz);
 280       end;
 281     end;
 282     // skip the rest
 283     if lhdr.localExtraSz > 0 then fFileStream.Seek(lhdr.localExtraSz, soCurrent);
 284
 285     if (lhdr.flags and 1) <> 0 then
 286     begin
 287       // encrypted file: skip it
 288       ignoreFile := true;
 289     end;
 290
 291     if (lhdr.method <> 0) and (lhdr.method <> 8) then
 292     begin
 293       // not stored. not deflated. skip.
 294       ignoreFile := true;
 295     end;
 296
 297     fi.fOfs := fFileStream.Position;
 298     fi.fSize := lhdr.unpackSz;
 299     fi.fPackSz := lhdr.packSz;
 300     fi.fMethod := lhdr.method;
 301
 302     if (lhdr.flags and (1 shl 3)) <> 0 then
 303     begin
 304       // it has a descriptor. stupid thing at all...
 305       {$IFDEF SFS_DEBUG_ZIPFS}
 306       WriteLn(ErrOutput, 'descr: $', IntToHex(fFileStream.Position, 8));
 307       WriteLn(ErrOutput, 'size: ', lhdr.unpackSz);
 308       WriteLn(ErrOutput, 'psize: ', lhdr.packSz);
 309       {$ENDIF}
 310       skipped := true;
 311
 312       if lhdr.packSz <> 0 then
 313       begin
 314         // some kind of idiot already did our work (maybe paritally)
 315         // trust him (her? %-)
 316         fFileStream.Seek(lhdr.packSz, soCurrent);
 317       end;
 318
 319       // scan for descriptor
 320       if Length(buf) = 0 then SetLength(buf, 65536);
 321       bufPos := 0; bufUsed := 0;
 322       fFileStream.ReadBuffer(dSign[0], 4);
 323       repeat
 324         if dSign <> 'PK'#7#8 then
 325         begin
 326           // skip one byte
 327           Move(dSign[1], dSign[0], 3);
 328           if bufPos >= bufUsed then
 329           begin
 330             bufPos := 0;
 331             // int64!
 332             if fFileStream.Size-fFileStream.Position > Length(buf) then bufUsed := Length(buf)
 333             else bufUsed := fFileStream.Size-fFileStream.Position;
 334             if bufUsed = 0 then raise ESFSError.Create('invalid ZIP file');
 335             fFileStream.ReadBuffer(buf[0], bufUsed);
 336           end;
 337           dSign[3] := chr(buf[bufPos]); Inc(bufPos);
 338           Inc(lhdr.packSz);
 339           continue;
 340         end;
 341         // signature found: check if it is a real one
 342         // ???: make stronger check (for the correct following signature)?
 343         // sign, crc, packsize, unpacksize
 344         fFileStream.Seek(-bufUsed+bufPos, soCurrent); bufPos := 0; bufUsed := 0;
 345         fFileStream.ReadBuffer(crc, 4); // crc
 346         fFileStream.ReadBuffer(psz, 4); // packed size
 347         // is size correct?
 348         if psz = lhdr.packSz then
 349         begin
 350           // this is a real description. fuck it off
 351           fFileStream.ReadBuffer(usz, 4); // unpacked size
 352           break;
 353         end;
 354         // this is just a sequence of bytes
 355         fFileStream.Seek(-8, soCurrent);
 356         fFileStream.ReadBuffer(dSign[0], 4);
 357         Inc(lhdr.packSz, 4);
 358       until false;
 359       // store correct values
 360       fi.fSize := usz;
 361       fi.fPackSz := psz;
 362     end;
 363
 364     // skip packed data
 365     if not skipped then fFileStream.Seek(lhdr.packSz, soCurrent);
 366     if ignoreFile then fi.Free();
 367   until false;
 368
 369   if (sign <> 'PK'#1#2) and (sign <> 'PK'#5#6) then
 370   begin
 371     {$IFDEF SFS_DEBUG_ZIPFS}
 372     WriteLn(ErrOutput, 'end: $', IntToHex(fFileStream.Position, 8));
 373     WriteLn(ErrOutput, 'sign: $', sign[0], sign[1], '#', ord(sign[2]), '#', ord(sign[3]));
 374     {$ENDIF}
 375     raise ESFSError.Create('invalid .ZIP archive (no central dir)');
 376   end;
 377 end;
 378
 379 {$IFDEF SFS_ZIPFS_FULL}
 380 procedure TSFSZipVolume.F2DATReadDirectory ();
 381 var
 382   dsize: Integer;
 383   fi: TSFSZipFileInfo;
 384   name: ShortString;
 385   f: Integer;
 386   b: Byte;
 387 begin
 388   fFileStream.Position := fFileStream.Size-8;
 389   fFileStream.ReadBuffer(dsize, 4);
 390   fFileStream.Seek(-dsize, soCurrent); Dec(dsize, 4);
 391   while dsize > 0 do
 392   begin
 393     fi := TSFSZipFileInfo.Create(self);
 394     fFileStream.ReadBuffer(f, 4);
 395     if (f < 1) or (f > 255) then raise ESFSError.Create('invalid Fallout II .DAT file');
 396     Dec(dsize, 4+f+13);
 397     if dsize < 0 then raise ESFSError.Create('invalid Fallout II .DAT file');
 398     name[0] := chr(f); if f > 0 then fFileStream.ReadBuffer(name[1], f);
 399     f := 1; while (f <= ord(name[0])) and (name[f] <> #0) do Inc(f); name[0] := chr(f-1);
 400     fi.fName := name;
 401     fFileStream.ReadBuffer(b, 1); // packed?
 402     if b = 0 then fi.fMethod := 0 else fi.fMethod := 255;
 403     fFileStream.ReadBuffer(fi.fSize, 4);
 404     fFileStream.ReadBuffer(fi.fPackSz, 4);
 405     fFileStream.ReadBuffer(fi.fOfs, 4);
 406   end;
 407 end;
 408
 409 procedure TSFSZipVolume.VTDBReadDirectory ();
 410 // idiotic format
 411 var
 412   fcnt, dofs: Integer;
 413   keys: array of record name: string; ofs: Integer; end;
 414   fi: TSFSZipFileInfo;
 415   f, c: Integer;
 416   rtype: Word;
 417 begin
 418   fFileStream.Seek(4, soCurrent); // skip signature
 419   fFileStream.ReadBuffer(fcnt, 4);
 420   fFileStream.ReadBuffer(dofs, 4);
 421   fFileStream.Seek(dofs, soBeginning);
 422
 423   // read keys
 424   SetLength(keys, fcnt);
 425   for f := 0 to fcnt-1 do
 426   begin
 427     fFileStream.ReadBuffer(c, 4);
 428     if (c < 0) or (c > 1023) then raise ESFSError.Create('invalid VTDB file');
 429     SetLength(keys[f].name, c);
 430     if c > 0 then
 431     begin
 432       fFileStream.ReadBuffer(keys[f].name[1], c);
 433       keys[f].name := SFSReplacePathDelims(keys[f].name, '/');
 434       if keys[f].name[1] = '/' then Delete(keys[f].name, 1, 1);
 435     end;
 436     fFileStream.ReadBuffer(keys[f].ofs, 4);
 437   end;
 438
 439   // read records (record type will be converted to directory name)
 440   for f := 0 to fcnt-1 do
 441   begin
 442     fFileStream.Position := keys[f].ofs;
 443     fi := TSFSZipFileInfo.Create(self);
 444     fFileStream.ReadBuffer(rtype, 2);
 445     fFileStream.ReadBuffer(fi.fSize, 4);
 446     fFileStream.ReadBuffer(fi.fPackSz, 4);
 447     fi.fOfs := fFileStream.Position+12;
 448     fi.fName := keys[f].name;
 449     fi.fPath := IntToHex(rtype, 4)+'/';
 450     fi.fMethod := 255;
 451   end;
 452 end;
 453 {$ENDIF}
 454
 455 procedure TSFSZipVolume.DFWADReadDirectory ();
 456 // idiotic format
 457 var
 458   fcnt: Word;
 459   fi: TSFSZipFileInfo;
 460   f, c, fofs, fpksize: Integer;
 461   curpath, fname: string;
 462   name: packed array [0..15] of Char;
 463 begin
 464   curpath := '';
 465   fFileStream.Seek(6, soCurrent); // skip signature
 466   fFileStream.ReadBuffer(fcnt, 2);
 467   if fcnt = 0 then exit;
 468   // read files
 469   for f := 0 to fcnt-1 do
 470   begin
 471     fFileStream.ReadBuffer(name[0], 16);
 472     fFileStream.ReadBuffer(fofs, 4);
 473     fFileStream.ReadBuffer(fpksize, 4);
 474     c := 0;
 475     fname := '';
 476     while (c < 16) and (name[c] <> #0) do
 477     begin
 478       if name[c] = '\' then name[c] := '/'
 479       else if name[c] = '/' then name[c] := '_';
 480       fname := fname+name[c];
 481       Inc(c);
 482     end;
 483     // new directory?
 484     if (fofs = 0) and (fpksize = 0) then
 485     begin
 486       if length(fname) <> 0 then fname := fname+'/';
 487       curpath := fname;
 488       continue;
 489     end;
 490     if length(fname) = 0 then continue; // just in case
 491     //writeln('DFWAD: [', curpath, '] [', fname, '] at ', fofs, ', size ', fpksize);
 492     // create file record
 493     fi := TSFSZipFileInfo.Create(self);
 494     fi.fOfs := fofs;
 495     fi.fSize := -1;
 496     fi.fPackSz := fpksize;
 497     fi.fName := fname;
 498     fi.fPath := curpath;
 499     fi.fMethod := 255;
 500   end;
 501 end;
 502
 503 procedure TSFSZipVolume.ReadDirectory ();
 504 begin
 505   case fType of
 506     sfszvZIP: ZIPReadDirectory();
 507     {$IFDEF SFS_ZIPFS_FULL}
 508     sfszvF2DAT: F2DATReadDirectory();
 509     sfszvVTDB: VTDBReadDirectory();
 510     {$ENDIF}
 511     sfszvDFWAD: DFWADReadDirectory();
 512     else raise ESFSError.Create('invalid zipped SFS');
 513   end;
 514 end;
 515
 516 function TSFSZipVolume.OpenFileByIndex (const index: Integer): TStream;
 517 var
 518   zs: TZDecompressionStream;
 519   fs, rs: TStream;
 520   gs: TSFSGuardStream;
 521   kill: Boolean;
 522   buf: packed array [0..1023] of Char;
 523   rd: LongInt;
 524 begin
 525   result := nil;
 526   zs := nil;
 527   fs := nil;
 528   gs := nil;
 529   rs := nil;
 530   if fFiles = nil then exit;
 531   if (index < 0) or (index >= fFiles.Count) or (fFiles[index] = nil) then exit;
 532   kill := false;
 533   try
 534     {
 535     try
 536       fs := TFileStream.Create(fFileName, fmOpenRead or fmShareDenyWrite);
 537       kill := true;
 538     except
 539       fs := fFileStream;
 540     end;
 541     }
 542     fs := fFileStream;
 543     if TSFSZipFileInfo(fFiles[index]).fMethod = 0 then
 544     begin
 545       result := TSFSPartialStream.Create(fs,
 546         TSFSZipFileInfo(fFiles[index]).fOfs,
 547         TSFSZipFileInfo(fFiles[index]).fSize, kill);
 548     end
 549     else
 550     begin
 551       fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning);
 552       if TSFSZipFileInfo(fFiles[index]).fMethod = 255 then
 553       begin
 554         // sorry, pals, DFWAD is completely broken, so users of it should SUFFER
 555         if TSFSZipFileInfo(fFiles[index]).fSize = -1 then
 556         begin
 557           TSFSZipFileInfo(fFiles[index]).fSize := 0;
 558           //writeln('trying to determine file size for [', TSFSZipFileInfo(fFiles[index]).fPath, TSFSZipFileInfo(fFiles[index]).fName, ']');
 559           zs := TZDecompressionStream.Create(fs);
 560           try
 561             while true do
 562             begin
 563               rd := zs.read(buf, 1024);
 564               //writeln('  got ', rd, ' bytes');
 565               if rd > 0 then Inc(TSFSZipFileInfo(fFiles[index]).fSize, rd);
 566               if rd < 1024 then break;
 567             end;
 568             //writeln('  resulting size: ', TSFSZipFileInfo(fFiles[index]).fSize, ' bytes');
 569             // recreate stream
 570             FreeAndNil(zs);
 571             fs.Seek(TSFSZipFileInfo(fFiles[index]).fOfs, soBeginning);
 572           except
 573             //writeln('*** CAN''T determine file size for [', TSFSZipFileInfo(fFiles[index]).fPath, TSFSZipFileInfo(fFiles[index]).fName, ']');
 574             FreeAndNil(zs);
 575             if kill then FreeAndNil(fs);
 576             result := nil;
 577             exit;
 578           end;
 579         end;
 580         rs := TSFSPartialStream.Create(fs, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fPackSz, true);
 581         zs := TZDecompressionStream.Create(rs);
 582         rs := nil;
 583       end
 584       else
 585       begin
 586         rs := TSFSPartialStream.Create(fs, TSFSZipFileInfo(fFiles[index]).fOfs, TSFSZipFileInfo(fFiles[index]).fPackSz, true);
 587         zs := TZDecompressionStream.Create(rs, true {-15}{MAX_WBITS});
 588         rs := nil;
 589       end;
 590       gs := TSFSGuardStream.Create(zs, fs, true, kill, false);
 591       zs := nil;
 592       fs := nil;
 593       result := TSFSPartialStream.Create(gs, 0, TSFSZipFileInfo(fFiles[index]).fSize, true);
 594     end;
 595   except
 596     FreeAndNil(rs);
 597     FreeAndNil(gs);
 598     FreeAndNil(zs);
 599     if kill then FreeAndNil(fs);
 600     result := nil;
 601     exit;
 602   end;
 603 end;
 604
 605
 606 { TSFSZipVolumeFactory }
 607 function TSFSZipVolumeFactory.IsMyVolumePrefix (const prefix: AnsiString): Boolean;
 608 begin
 609   result :=
 610     StrEquCI1251(prefix, 'zip') or
 611     StrEquCI1251(prefix, 'dfwad')
 612     {$IFDEF SFS_ZIPFS_FULL}
 613     or StrEquCI1251(prefix, 'jar') or
 614     StrEquCI1251(prefix, 'fout2') or
 615     StrEquCI1251(prefix, 'vtdb') or
 616     StrEquCI1251(prefix, 'wad')
 617     {$ENDIF}
 618     ;
 619 end;
 620
 621 procedure TSFSZipVolumeFactory.Recycle (vol: TSFSVolume);
 622 begin
 623   vol.Free();
 624 end;
 625
 626 function TSFSZipVolumeFactory.Produce (const prefix, fileName: AnsiString; st: TStream): TSFSVolume;
 627 var
 628   vt: TSFSZipVolumeType;
 629 begin
 630   vt := sfszvNone;
 631        if ZIPCheckMagic(st) then vt := sfszvZIP
 632   else if DFWADCheckMagic(st) then vt := sfszvDFWAD
 633   {$IFDEF SFS_ZIPFS_FULL}
 634   else if F2DATCheckMagic(st) then vt := sfszvF2DAT
 635   else if VTDBCheckMagic(st) then vt := sfszvVTDB
 636   {$ENDIF}
 637   ;
 638
 639   if vt <> sfszvNone then
 640   begin
 641     result := TSFSZipVolume.Create(fileName, st);
 642     TSFSZipVolume(result).fType := vt;
 643     try
 644       result.DoDirectoryRead();
 645     except {$IFDEF SFS_DEBUG_ZIPFS} on e: Exception do begin
 646       WriteLn(errOutput, 'ZIP ERROR: [', e.ClassName, ']: ', e.Message);
 647       {$ENDIF}
 648       FreeAndNil(result);
 649       raise;
 650       {$IFDEF SFS_DEBUG_ZIPFS}end;{$ENDIF}
 651     end;
 652   end
 653   else
 654   begin
 655     result := nil;
 656   end;
 657 end;
 658
 659
 660 var
 661   zipf: TSFSZipVolumeFactory;
 662 initialization
 663   zipf := TSFSZipVolumeFactory.Create();
 664   SFSRegisterVolumeFactory(zipf);
 665 //finalization
 666 //  SFSUnregisterVolumeFactory(zipf);
 667 end.