X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fsfs%2Fwadcvt.dpr;h=4885b327e10e3a45ba4e22ee0d72228b2a68319a;hb=8dcef831a5d3ccf3f12b3df9d9d869658d9b93d7;hp=4d2acf17658edf9911d8276e31a08625fa369d79;hpb=e21c5a3813c8eac0b705cc6fe36fca3e0086d869;p=d2df-sdl.git diff --git a/src/sfs/wadcvt.dpr b/src/sfs/wadcvt.dpr index 4d2acf1..4885b32 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 @@ -23,93 +24,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); - 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 - begin - //writeln(' written ', OBSize-zst.avail_out, ' bytes'); - ds.writeBuffer(ob^, OBSize-zst.avail_out); - zst.next_out := ob; - zst.avail_out := OBSize; + //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; - // shift input buffer - if zst.avail_in < ibpos then + // now process the whole input + while zst.avail_in > 0 do 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 +121,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 +148,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,7 +162,7 @@ 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; @@ -290,44 +285,52 @@ const ); -// this will write "extra field length" and extra field itself -type - TByteArray = array of Byte; - -function buildUtfExtra (fname: string): TByteArray; +function toUtf8 (const s: AnsiString): AnsiString; var - crc: LongWord; - fu: string; - sz: Word; uc: PUnicodeChar; xdc: PChar; pos, f: Integer; begin - GetMem(uc, length(fname)*8); - GetMem(xdc, length(fname)*8); + GetMem(uc, length(s)*8); + GetMem(xdc, length(s)*8); try - FillChar(uc^, length(fname)*8, 0); - FillChar(xdc^, length(fname)*8, 0); + FillChar(uc^, length(s)*8, 0); + FillChar(xdc^, length(s)*8, 0); pos := 0; - for f := 1 to length(fname) do + for f := 1 to length(s) do begin - if ord(fname[f]) < 128 then - uc[pos] := UnicodeChar(ord(fname[f])) + if ord(s[f]) < 128 then + uc[pos] := UnicodeChar(ord(s[f])) else - uc[pos] := UnicodeChar(uni2wint[ord(fname[f])]); + uc[pos] := UnicodeChar(uni2wint[ord(s[f])]); Inc(pos); end; - FillChar(xdc^, length(fname)*8, 0); - f := UnicodeToUtf8(xdc, length(fname)*8, uc, pos); + 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(fu, f); - Move(xdc^, fu[1], f); - //writeln('[', fu, ']'); + 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); @@ -342,28 +345,42 @@ begin result[7] := (crc shr 16) and $ff; result[8] := (crc shr 24) and $ff; Move(fu[1], result[9], length(fu)); - //result := nil; end; +{$ELSE} +const UtfFlags = (1 shl 10); // bit 11 +{$ENDIF} - -function ZipOne (ds: TStream; fname: string; st: TStream): TFileInfo; +function ZipOne (ds: TStream; fname: AnsiString; st: TStream; dopack: Boolean=true): TFileInfo; var - oldofs, nfoofs, pkdpos: Int64; + 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($0A10)); // version to extract - //writeInt(ds, Word(1 shl 11)); // flags: utf-8 name - writeInt(ds, Word(0)); // flags + writeInt(ds, Word(UtfFlags)); // flags writeInt(ds, Word(result.method)); // compression method writeInt(ds, Word(0)); // file time writeInt(ds, Word(0)); // file date @@ -372,22 +389,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)); +{$IFDEF UTFEXTRA} if length(ef) > 0 then ds.writeBuffer(ef[0], length(ef)); - // now write packed data - if result.size > 0 then +{$ENDIF} + if dopack then begin - pkdpos := ds.position; - st.position := 0; - result.crc := zpack(ds, st); - result.pksize := ds.position-pkdpos; + // 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 + 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; @@ -397,18 +463,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($0A10)); // version made by writeInt(ds, Word($0010)); // version to extract - //writeInt(ds, Word(1 shl 11)); // flags: utf-8 name - writeInt(ds, Word(0)); // flags + 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 @@ -416,14 +485,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 @@ -443,10 +518,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 @@ -491,9 +566,12 @@ 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); + write('[', f+1, '/', fl.Count, ']: ', fl[f].fPath, newname, ' ', fs.size, ' ... '); nfo := ZipOne(fo, fl[f].fPath+newname, fs); + writeln('DONE'); SetLength(files, length(files)+1); files[high(files)] := nfo; end;