X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fsfs%2Fwadcvt.dpr;h=d8058379b63784914b93e0b581a934e50bc9a236;hb=3c27cda3a6e6188d113073beb31a19b82d21e3b6;hp=66184da7ace4be8342a0315b0f2ed93c46adebec;hpb=d895bd0fb6e73941a62371828bc2de13ff227897;p=d2df-sdl.git

diff --git a/src/sfs/wadcvt.dpr b/src/sfs/wadcvt.dpr
index 66184da..d805837 100644
--- a/src/sfs/wadcvt.dpr
+++ b/src/sfs/wadcvt.dpr
@@ -2,6 +2,7 @@
 {$IFDEF WINDOWS}
   {$APPTYPE CONSOLE}
 {$ENDIF}
+{$DEFINE UTFEXTRA}
 program __wadcvt__;
 
 uses
@@ -13,7 +14,8 @@ uses
   sfs,
   sfsPlainFS,
   sfsZipFS,
-  paszlib;
+  paszlib,
+  ImagingTypes, Imaging, ImagingUtility;
 
 
 procedure processed (count: Cardinal);
@@ -23,93 +25,87 @@ end;
 
 
 // returs crc
-function zpack (ds: TStream; ss: TStream): LongWord;
+function zpack (ds: TStream; ss: TStream; var aborted: Boolean): LongWord;
 const
   IBSize = 65536;
   OBSize = 65536;
 var
   zst: TZStream;
   ib, ob: PByte;
-  ibpos: Cardinal;
   err: Integer;
-  rd, f: Integer;
+  rd: Integer;
   eof: Boolean;
   crc: LongWord;
+  dstp, srcsize: Int64;
 begin
   result := 0;
+  //aborted := true; exit;
+  aborted := false;
   crc := crc32(0, nil, 0);
   GetMem(ib, IBSize);
   GetMem(ob, OBSize);
+  ss.position := 0;
+  dstp := ds.position;
+  srcsize := ss.size;
   try
     zst.next_out := ob;
     zst.avail_out := OBSize;
+    zst.next_in := ib;
+    zst.avail_in := 0;
     err := deflateInit2(zst, Z_BEST_COMPRESSION, Z_DEFLATED, -15, 9, 0);
     if err <> Z_OK then raise Exception.Create(zerror(err));
     try
-      ibpos := 0;
-      zst.next_out := ob;
-      zst.avail_out := OBSize;
       eof := false;
-      while true do
-      begin
-        while not eof and (ibpos < IBSize) do
+      repeat
+        if zst.avail_in = 0 then
         begin
-          rd := ss.read((ib+ibpos)^, IBSize-ibpos);
+          // read input buffer part
+          rd := ss.read(ib^, IBSize);
           if rd < 0 then raise Exception.Create('reading error');
-          eof := (rd <> IBSize-ibpos);
-          if rd <> 0 then begin crc := crc32(crc, Pointer(ib+ibpos), rd); result := crc; end;
-          Inc(ibpos, rd);
-          if rd <> 0 then processed(rd);
+          //writeln('  read ', rd, ' bytes');
+          eof := (rd = 0);
+          if rd <> 0 then begin crc := crc32(crc, Pointer(ib), rd); result := crc; end;
+          zst.next_in := ib;
+          zst.avail_in := rd;
         end;
-        zst.next_in := ib;
-        zst.avail_in := ibpos;
-        if eof then break;
-        err := deflate(zst, Z_NO_FLUSH);
-        if (err <> Z_OK) and (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
-        if zst.avail_out < OBSize then
+        // now process the whole input
+        while zst.avail_in > 0 do
         begin
-          writeln('  written ', OBSize-zst.avail_out, ' bytes');
-          ds.writeBuffer(ob^, OBSize-zst.avail_out);
-          zst.next_out := ob;
-          zst.avail_out := OBSize;
-        end;
-        // shift input buffer
-        if zst.avail_in < ibpos then
-        begin
-          rd := 0;
-          for f := ibpos-zst.avail_in to ibpos-1 do
+          err := deflate(zst, Z_NO_FLUSH);
+          if err <> Z_OK then raise Exception.Create(zerror(err));
+          if zst.avail_out < OBSize then
           begin
-            ib[rd] := ib[f];
-            Inc(rd);
+            //writeln('  written ', OBSize-zst.avail_out, ' bytes');
+            if ds.position+(OBSize-zst.avail_out)-dstp >= srcsize then
+            begin
+              // this will be overwritten anyway
+              aborted := true;
+              exit;
+            end;
+            ds.writeBuffer(ob^, OBSize-zst.avail_out);
+            zst.next_out := ob;
+            zst.avail_out := OBSize;
           end;
-          ibpos := rd;
-          //writeln(' rd: ', zst.avail_in);
-        end;
-      end;
-      // pack leftovers
-      while zst.avail_in > 0 do
-      begin
-        err := deflate(zst, Z_NO_FLUSH);
-        if (err <> Z_OK) and (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
-        if zst.avail_out < OBSize then
-        begin
-          //writeln('  written ', OBSize-zst.avail_out, ' bytes');
-          ds.writeBuffer(ob^, OBSize-zst.avail_out);
-          zst.next_out := ob;
-          zst.avail_out := OBSize;
         end;
-      end;
-      // stream compressed, flush zstream
+      until eof;
+      // do leftovers
       while true do
       begin
         zst.avail_in := 0;
-        zst.next_out := ob;
-        zst.avail_out := OBSize;
         err := deflate(zst, Z_FINISH);
+        if (err <> Z_OK) and (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
         if zst.avail_out < OBSize then
         begin
-          //writeln('  written ', OBSize-zst.avail_out, ' bytes');
+          //writeln('  .written ', OBSize-zst.avail_out, ' bytes');
+          if ds.position+(OBSize-zst.avail_out)-dstp >= srcsize then
+          begin
+            // this will be overwritten anyway
+            aborted := true;
+            exit;
+          end;
           ds.writeBuffer(ob^, OBSize-zst.avail_out);
+          zst.next_out := ob;
+          zst.avail_out := OBSize;
         end;
         if err <> Z_OK then break;
       end;
@@ -126,7 +122,7 @@ end;
 
 
 {
-procedure TProg.putStr (const s: string; newline: Boolean=false);
+procedure TProg.putStr (const s: AnsiString; newline: Boolean=false);
 begin
   write(#13, s);
   while lastlen > length(s) do
@@ -153,7 +149,7 @@ begin
   putStr(Format('compressing %-33s  %3d%%', [lastname, prc]));
 end;
 
-procedure TProg.onFileStart (sender: TObject; const fileName: string);
+procedure TProg.onFileStart (sender: TObject; const fileName: AnsiString);
 begin
   lastname := fileName;
   putStr(Format('compressing %-33s  %3d%%', [lastname, 0]));
@@ -167,12 +163,13 @@ end;
 
 
 // returns new file name
-function detectExt (fpath, fname: string; fs: TStream): string;
+function detectExt (fpath, fname: AnsiString; fs: TStream): AnsiString;
 var
   buf: PChar;
   buflen: Integer;
   f: Integer;
   st: string[24];
+  img: string;
 begin
   result := fname;
   if length(ExtractFileExt(fname)) <> 0 then exit;
@@ -237,6 +234,7 @@ begin
       end;
     end;
     // targa (stupid hack; this "signature" is not required by specs)
+    {
     if buflen >= 18 then
     begin
       Move((buf+buflen-18)^, (PChar(@st[1]))^, 16);
@@ -247,6 +245,27 @@ begin
         exit;
       end;
     end;
+    }
+    // detect image format
+    img := DetermineMemoryFormat(buf, buflen);
+    if length(img) > 0 then
+    begin
+      result := result+'.'+img;
+      exit;
+    end;
+    // check if this is text file
+    if buflen > 16 then
+    begin
+      for f := 0 to buflen-1 do
+      begin
+        if buf[f] = #127 then exit;
+        if buf[f] < #32 then
+        begin
+          if (buf[f] <> #9) and (buf[f] <> #10) and (buf[f] <> #13) then exit;
+        end;
+      end;
+      result := result+'.txt';
+    end;
   finally
     FreeMem(buf);
   end;
@@ -277,21 +296,115 @@ begin
 end;
 
 
-function ZipOne (ds: TStream; fname: string; st: TStream): TFileInfo;
+const
+  uni2wint: array [128..255] of Word = (
+    $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
+    $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
+    $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
+    $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
+    $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
+    $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
+    $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
+    $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
+  );
+
+
+function toUtf8 (const s: AnsiString): AnsiString;
 var
-  oldofs, nfoofs, pkdpos: Int64;
+  uc: PUnicodeChar;
+  xdc: PChar;
+  pos, f: Integer;
+begin
+  GetMem(uc, length(s)*8);
+  GetMem(xdc, length(s)*8);
+  try
+    FillChar(uc^, length(s)*8, 0);
+    FillChar(xdc^, length(s)*8, 0);
+    pos := 0;
+    for f := 1 to length(s) do
+    begin
+      if ord(s[f]) < 128 then
+        uc[pos] := UnicodeChar(ord(s[f]))
+      else
+        uc[pos] := UnicodeChar(uni2wint[ord(s[f])]);
+      Inc(pos);
+    end;
+    FillChar(xdc^, length(s)*8, 0);
+    f := UnicodeToUtf8(xdc, length(s)*8, uc, pos);
+    while (f > 0) and (xdc[f-1] = #0) do Dec(f);
+    SetLength(result, f);
+    Move(xdc^, result[1], f);
+  finally
+    FreeMem(xdc);
+    FreeMem(uc);
+  end;
+end;
+
+// this will write "extra field length" and extra field itself
+{$IFDEF UTFEXTRA}
+const UtfFlags = 0;
+
+type
+  TByteArray = array of Byte;
+
+function buildUtfExtra (fname: AnsiString): TByteArray;
+var
+  crc: LongWord;
+  fu: AnsiString;
+  sz: Word;
+begin
+  fu := toUtf8(fname);
+  if fu = fname then begin result := nil; exit; end; // no need to write anything
+  crc := crc32(0, @fname[1], length(fname));
+  sz := 2+2+1+4+length(fu);
+  SetLength(result, sz);
+  result[0] := ord('u');
+  result[1] := ord('p');
+  Dec(sz, 4);
+  result[2] := sz and $ff;
+  result[3] := (sz shr 8) and $ff;
+  result[4] := 1;
+  result[5] := crc and $ff;
+  result[6] := (crc shr 8) and $ff;
+  result[7] := (crc shr 16) and $ff;
+  result[8] := (crc shr 24) and $ff;
+  Move(fu[1], result[9], length(fu));
+end;
+{$ELSE}
+const UtfFlags = (1 shl 10); // bit 11
+{$ENDIF}
+
+function ZipOne (ds: TStream; fname: AnsiString; st: TStream; dopack: Boolean=true): TFileInfo;
+var
+  oldofs, nfoofs, pkdpos, rd: Int64;
   sign: packed array [0..3] of Char;
+  buf: PChar;
+  bufsz: Integer;
+  aborted: Boolean = false;
+{$IFDEF UTFEXTRA}
+  ef: TByteArray;
+{$ENDIF}
 begin
   result := TFileInfo.Create();
   result.pkofs := ds.position;
   result.size := st.size;
-  result.name := fname;
   if result.size > 0 then result.method := 8 else result.method := 0;
+  if not dopack then
+  begin
+    result.method := 0;
+    result.pksize := result.size;
+  end;
+{$IFDEF UTFEXTRA}
+  result.name := fname;
+  ef := buildUtfExtra(result.name);
+{$ELSE}
+  result.name := toUtf8(fname);
+{$ENDIF}
   // write local header
   sign := 'PK'#3#4;
   ds.writeBuffer(sign, 4);
-  writeInt(ds, Word($10)); // version to extract
-  writeInt(ds, Word(0)); // flags
+  writeInt(ds, Word($0A10)); // version to extract
+  writeInt(ds, Word(UtfFlags)); // flags
   writeInt(ds, Word(result.method)); // compression method
   writeInt(ds, Word(0)); // file time
   writeInt(ds, Word(0)); // file date
@@ -300,21 +413,71 @@ begin
   writeInt(ds, LongWord(result.pksize)); // packed size
   writeInt(ds, LongWord(result.size)); // unpacked size
   writeInt(ds, Word(length(fname))); // name length
+{$IFDEF UTFEXTRA}
+  writeInt(ds, Word(length(ef))); // extra field length
+{$ELSE}
   writeInt(ds, Word(0)); // extra field length
+{$ENDIF}
   ds.writeBuffer(fname[1], length(fname));
-  // now write packed data
-  if result.size > 0 then
+{$IFDEF UTFEXTRA}
+  if length(ef) > 0 then ds.writeBuffer(ef[0], length(ef));
+{$ENDIF}
+  if dopack then
+  begin
+    // now write packed data
+    if result.size > 0 then
+    begin
+      pkdpos := ds.position;
+      st.position := 0;
+      result.crc := zpack(ds, st, aborted);
+      result.pksize := ds.position-pkdpos;
+      if {result.pksize >= result.size} aborted then
+      begin
+        // there's no sence to pack this file, so just store it
+        st.position := 0;
+        ds.position := result.pkofs;
+        result.Free();
+        // store it
+        result := ZipOne(ds, fname, st, false);
+        exit;
+      end
+      else
+      begin
+        // fix header
+        oldofs := ds.position;
+        ds.position := nfoofs;
+        writeInt(ds, LongWord(result.crc)); // crc32
+        writeInt(ds, LongWord(result.pksize)); // crc32
+        ds.position := oldofs;
+      end;
+    end;
+  end
+  else
   begin
-    pkdpos := ds.position;
-    st.position := 0;
-    result.crc := zpack(ds, st);
-    result.pksize := ds.position-pkdpos;
+    bufsz := 1024*1024;
+    GetMem(buf, bufsz);
+    try
+      st.position := 0;
+      result.crc := crc32(0, nil, 0);
+      result.pksize := 0;
+      while result.pksize < result.size do
+      begin
+        rd := result.size-result.pksize;
+        if rd > bufsz then rd := bufsz;
+        st.readBuffer(buf^, rd);
+        ds.writeBuffer(buf^, rd);
+        Inc(result.pksize, rd);
+        result.crc := crc32(result.crc, buf, rd);
+      end;
+    finally
+      FreeMem(buf);
+    end;
     // fix header
     oldofs := ds.position;
     ds.position := nfoofs;
     writeInt(ds, LongWord(result.crc)); // crc32
-    writeInt(ds, LongWord(result.pksize)); // crc32
     ds.position := oldofs;
+    write('(S) ');
   end;
 end;
 
@@ -324,15 +487,21 @@ var
   cdofs, cdend: Int64;
   sign: packed array [0..3] of Char;
   f: Integer;
+{$IFDEF UTFEXTRA}
+  ef: TByteArray;
+{$ENDIF}
 begin
   cdofs := ds.position;
   for f := 0 to high(files) do
   begin
+{$IFDEF UTFEXTRA}
+    ef := buildUtfExtra(files[f].name);
+{$ENDIF}
     sign := 'PK'#1#2;
     ds.writeBuffer(sign, 4);
-    writeInt(ds, Word($10)); // version made by
-    writeInt(ds, Word($10)); // version to extract
-    writeInt(ds, Word(0)); // flags
+    writeInt(ds, Word($0A10)); // version made by
+    writeInt(ds, Word($0010)); // version to extract
+    writeInt(ds, Word(UtfFlags)); // flags
     writeInt(ds, Word(files[f].method)); // compression method
     writeInt(ds, Word(0)); // file time
     writeInt(ds, Word(0)); // file date
@@ -340,13 +509,20 @@ begin
     writeInt(ds, LongWord(files[f].pksize));
     writeInt(ds, LongWord(files[f].size));
     writeInt(ds, Word(length(files[f].name))); // name length
+{$IFDEF UTFEXTRA}
+    writeInt(ds, Word(length(ef))); // extra field length
+{$ELSE}
     writeInt(ds, Word(0)); // extra field length
+{$ENDIF}
     writeInt(ds, Word(0)); // comment length
     writeInt(ds, Word(0)); // disk start
     writeInt(ds, Word(0)); // internal attributes
     writeInt(ds, LongWord(0)); // external attributes
     writeInt(ds, LongWord(files[f].pkofs)); // header offset
     ds.writeBuffer(files[f].name[1], length(files[f].name));
+{$IFDEF UTFEXTRA}
+    if length(ef) > 0 then ds.writeBuffer(ef[0], length(ef));
+{$ENDIF}
   end;
   cdend := ds.position;
   // write end of central dir
@@ -366,10 +542,10 @@ var
   fs, fo: TStream;
   fl: TSFSFileList;
   f: Integer;
-  infname: string;
-  outfname: string;
-  dvfn: string;
-  newname: string;
+  infname: AnsiString;
+  outfname: AnsiString;
+  dvfn: AnsiString;
+  newname: AnsiString;
   files: array of TFileInfo;
   nfo: TFileInfo;
 begin
@@ -414,13 +590,25 @@ begin
       if length(fl[f].fName) = 0 then continue;
       fs := SFSFileOpen(dvfn+'::'+fl[f].fPath+fl[f].fName);
       newname := detectExt(fl[f].fPath, fl[f].fName, fs);
+      //fs.Free();
+      //fs := SFSFileOpen(dvfn+'::'+fl[f].fPath+fl[f].fName);
       fs.position := 0;
-      writeln('[', f+1, '/', fl.Count, ']: ', fl[f].fPath+newname, '  ', fs.size);
-      //ZEntries.AddFileEntry(fs, fl[f].fPath+newname);
-      nfo := ZipOne(fo, fl[f].fPath+fl[f].fName, fs);
+{$IFNDEF WINDOWS}
+      write(#13'[', f+1, '/', fl.Count, ']: ', fl[f].fPath, newname, '  ', fs.size, ' ... '#27'[K');
+{$ELSE}
+      write('[', f+1, '/', fl.Count, ']: ', fl[f].fPath, newname, '  ', fs.size, ' ... ');
+{$ENDIF}
+      nfo := ZipOne(fo, fl[f].fPath+newname, fs);
+      write('DONE');
+{$IFDEF WINDOWS}
+      writeln;
+{$ENDIF}
       SetLength(files, length(files)+1);
       files[high(files)] := nfo;
     end;
+{$IFNDEF WINDOWS}
+    writeln(#13, fl.Count, ' files processed'#27'[K');
+{$ENDIF}
     writeCentralDir(fo, files);
   except
     fo.Free();