summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: e21c5a3)
raw | patch | inline | side by side (parent: e21c5a3)
author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
Mon, 18 Apr 2016 14:34:56 +0000 (17:34 +0300) | ||
committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
Mon, 18 Apr 2016 15:30:01 +0000 (18:30 +0300) |
src/sfs/wadcvt.dpr | patch | blob | history |
diff --git a/src/sfs/wadcvt.dpr b/src/sfs/wadcvt.dpr
index 4d2acf17658edf9911d8276e31a08625fa369d79..47a9ffb0ea381940f74e9d5037c073f278579f56 100644 (file)
--- a/src/sfs/wadcvt.dpr
+++ b/src/sfs/wadcvt.dpr
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
+{$DEFINE UTFEXTRA}
program __wadcvt__;
uses
{
-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;
);
-// 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);
crc := crc32(0, @fname[1], length(fname));
sz := 2+2+1+4+length(fu);
SetLength(result, sz);
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): 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($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
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($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
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