diff --git a/src/sfs/wadcvt.dpr b/src/sfs/wadcvt.dpr
index 66184da7ace4be8342a0315b0f2ed93c46adebec..85666cfabe50a5811e8fbb354627f3a6254fd386 100644 (file)
--- a/src/sfs/wadcvt.dpr
+++ b/src/sfs/wadcvt.dpr
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
+{$DEFINE UTFEXTRA}
program __wadcvt__;
uses
var
zst: TZStream;
ib, ob: PByte;
- ibpos: Cardinal;
err: Integer;
- rd, f: Integer;
+ rd: Integer;
eof: Boolean;
crc: LongWord;
begin
crc := crc32(0, nil, 0);
GetMem(ib, IBSize);
GetMem(ob, OBSize);
+ ss.position := 0;
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');
+ 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');
ds.writeBuffer(ob^, OBSize-zst.avail_out);
+ zst.next_out := ob;
+ zst.avail_out := OBSize;
end;
if err <> Z_OK then break;
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
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]));
// 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;
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
+ 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);
+ 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): TFileInfo;
var
oldofs, nfoofs, pkdpos: Int64;
sign: packed array [0..3] of Char;
+{$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;
+{$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
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));
+{$ENDIF}
// now write packed data
if result.size > 0 then
begin
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
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
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
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);
+ writeln('[', f+1, '/', fl.Count, ']: ', fl[f].fPath, newname, ' ', fs.size);
+ nfo := ZipOne(fo, fl[f].fPath+newname, fs);
SetLength(files, length(files)+1);
files[high(files)] := nfo;
end;