diff --git a/src/sfs/wadcvt.dpr b/src/sfs/wadcvt.dpr
index b1bb78698e52eea7f398f9abf720bff09afc4743..66184da7ace4be8342a0315b0f2ed93c46adebec 100644 (file)
--- a/src/sfs/wadcvt.dpr
+++ b/src/sfs/wadcvt.dpr
-{$IFDEF WIN32}
+{$MODE OBJFPC}
+{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
-{$MODE DELPHI}
program __wadcvt__;
uses
SysUtils,
Classes,
- SDL2 in '../lib/sdl2/sdl2.pas',
+ utils in '../shared/utils.pas',
+ xstreams in '../shared/xstreams.pas',
+ crc,
sfs,
sfsPlainFS,
sfsZipFS,
- sfsMemFS,
- zipper;
+ paszlib;
+procedure processed (count: Cardinal);
+begin
+ //writeln(' read ', count, ' bytes');
+end;
+
+
+// returs crc
+function zpack (ds: TStream; ss: TStream): LongWord;
+const
+ IBSize = 65536;
+ OBSize = 65536;
+var
+ zst: TZStream;
+ ib, ob: PByte;
+ ibpos: Cardinal;
+ err: Integer;
+ rd, f: Integer;
+ eof: Boolean;
+ crc: LongWord;
+begin
+ result := 0;
+ crc := crc32(0, nil, 0);
+ GetMem(ib, IBSize);
+ GetMem(ob, OBSize);
+ try
+ zst.next_out := ob;
+ zst.avail_out := OBSize;
+ 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
+ begin
+ rd := ss.read((ib+ibpos)^, IBSize-ibpos);
+ 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;
+ end;
+ // shift input buffer
+ if zst.avail_in < ibpos then
+ begin
+ rd := 0;
+ for f := ibpos-zst.avail_in to ibpos-1 do
+ begin
+ ib[rd] := ib[f];
+ Inc(rd);
+ 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
+ while true do
+ begin
+ zst.avail_in := 0;
+ zst.next_out := ob;
+ zst.avail_out := OBSize;
+ err := deflate(zst, Z_FINISH);
+ if zst.avail_out < OBSize then
+ begin
+ //writeln(' written ', OBSize-zst.avail_out, ' bytes');
+ ds.writeBuffer(ob^, OBSize-zst.avail_out);
+ end;
+ if err <> Z_OK then break;
+ end;
+ // succesfully flushed?
+ if (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
+ finally
+ deflateEnd(zst);
+ end;
+ finally
+ FreeMem(ob);
+ FreeMem(ib);
+ end;
+end;
+
+
+{
+procedure TProg.putStr (const s: string; newline: Boolean=false);
+begin
+ write(#13, s);
+ while lastlen > length(s) do
+ begin
+ write(' ');
+ Dec(lastlen);
+ end;
+ if newline then
+ begin
+ writeln;
+ lastlen := 0;
+ end
+ else
+ begin
+ lastlen := length(s);
+ end;
+end;
+
+procedure TProg.onProgress (sender: TObject; const percent: double);
var
- fs: TStream;
+ prc: Integer;
+begin
+ prc := trunc(percent*100.0);
+ putStr(Format('compressing %-33s %3d%%', [lastname, prc]));
+end;
+
+procedure TProg.onFileStart (sender: TObject; const fileName: string);
+begin
+ lastname := fileName;
+ putStr(Format('compressing %-33s %3d%%', [lastname, 0]));
+end;
+
+procedure TProg.onFileEnd (sender: TObject; const ratio: double);
+begin
+ putStr(Format('compressed %-33s %f', [lastname, ratio]), true);
+end;
+}
+
+
+// returns new file name
+function detectExt (fpath, fname: string; fs: TStream): string;
+var
+ buf: PChar;
+ buflen: Integer;
+ f: Integer;
+ st: string[24];
+begin
+ result := fname;
+ if length(ExtractFileExt(fname)) <> 0 then exit;
+ if fs.size < 16 then exit;
+ buflen := Integer(fs.size);
+ GetMem(buf, buflen);
+ try
+ fs.ReadBuffer(buf^, buflen);
+ // xm
+ Move(buf^, (PChar(@st[1]))^, 16);
+ st[0] := #16;
+ if (st = 'Extended Module:') then
+ begin
+ result := result+'.xm';
+ exit;
+ end;
+ if (buf[0] = 'D') and (buf[1] = 'F') and (buf[2] = 'W') and
+ (buf[3] = 'A') and (buf[4] = 'D') and (buf[5] = #$1) then
+ begin
+ result := result+'.wad';
+ exit;
+ end;
+ if (buf[0] = 'M') and (buf[1] = 'A') and (buf[2] = 'P') and (buf[3] = #$1) then
+ begin
+ result := result+'.dfmap';
+ exit;
+ end;
+ if (buf[0] = 'M') and (buf[1] = 'T') and (buf[2] = 'h') and (buf[3] = 'd') then
+ begin
+ result := result+'.mid';
+ exit;
+ end;
+ if (buf[0] = 'R') and (buf[1] = 'I') and (buf[2] = 'F') and (buf[3] = 'F') and
+ (buf[8] = 'W') and (buf[9] = 'A') and (buf[10] = 'V') and (buf[11] = 'E') then
+ begin
+ result := result+'.wav';
+ exit;
+ end;
+ // mp3 (stupid hack)
+ for f := 0 to 128-6 do
+ begin
+ if (buf[f+0] = #$4) and (buf[f+1] = 'L') and
+ (buf[f+2] = 'A') and (buf[f+3] = 'M') and
+ (buf[f+4] = 'E') and (buf[f+5] = '3') then
+ begin
+ result := result+'.mp3';
+ exit;
+ end;
+ end;
+ // more mp3 hacks
+ if (buf[0] = 'I') and (buf[1] = 'D') and (buf[2] = '3') and (buf[3] <= #4) then
+ begin
+ result := result+'.mp3';
+ exit;
+ end;
+ if buflen > 128 then
+ begin
+ if (buf[buflen-128] = 'T') and (buf[buflen-127] = 'A') and (buf[buflen-126] = 'G') then
+ begin
+ result := result+'.mp3';
+ exit;
+ 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);
+ st[0] := #16;
+ if st = 'TRUEVISION-XFILE' then
+ begin
+ result := result+'.tga';
+ exit;
+ end;
+ end;
+ finally
+ FreeMem(buf);
+ end;
+end;
+
+
+type
+ TFileInfo = class
+ public
+ name: AnsiString;
+ pkofs: Int64; // offset of file header
+ size: Int64;
+ pksize: Int64;
+ crc: LongWord;
+ method: Word;
+
+ constructor Create ();
+ end;
+
+constructor TFileInfo.Create ();
+begin
+ name := '';
+ pkofs := 0;
+ size := 0;
+ pksize := 0;
+ crc := crc32(0, nil, 0);
+ method := 0;
+end;
+
+
+function ZipOne (ds: TStream; fname: string; st: TStream): TFileInfo;
+var
+ oldofs, nfoofs, pkdpos: Int64;
+ sign: packed array [0..3] of Char;
+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;
+ // 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(result.method)); // compression method
+ writeInt(ds, Word(0)); // file time
+ writeInt(ds, Word(0)); // file date
+ nfoofs := ds.position;
+ writeInt(ds, LongWord(result.crc)); // crc32
+ writeInt(ds, LongWord(result.pksize)); // packed size
+ writeInt(ds, LongWord(result.size)); // unpacked size
+ writeInt(ds, Word(length(fname))); // name length
+ writeInt(ds, Word(0)); // extra field length
+ ds.writeBuffer(fname[1], length(fname));
+ // now write packed data
+ if result.size > 0 then
+ begin
+ pkdpos := ds.position;
+ st.position := 0;
+ result.crc := zpack(ds, st);
+ result.pksize := ds.position-pkdpos;
+ // 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;
+
+
+procedure writeCentralDir (ds: TStream; files: array of TFileInfo);
+var
+ cdofs, cdend: Int64;
+ sign: packed array [0..3] of Char;
+ f: Integer;
+begin
+ cdofs := ds.position;
+ for f := 0 to high(files) do
+ begin
+ 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(files[f].method)); // compression method
+ writeInt(ds, Word(0)); // file time
+ writeInt(ds, Word(0)); // file date
+ writeInt(ds, LongWord(files[f].crc));
+ writeInt(ds, LongWord(files[f].pksize));
+ writeInt(ds, LongWord(files[f].size));
+ writeInt(ds, Word(length(files[f].name))); // name length
+ writeInt(ds, Word(0)); // extra field length
+ 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));
+ end;
+ cdend := ds.position;
+ // write end of central dir
+ sign := 'PK'#5#6;
+ ds.writeBuffer(sign, 4);
+ writeInt(ds, Word(0)); // disk number
+ writeInt(ds, Word(0)); // disk with central dir
+ writeInt(ds, Word(length(files))); // number of files on this dist
+ writeInt(ds, Word(length(files))); // number of files total
+ writeInt(ds, LongWord(cdend-cdofs)); // size of central directory
+ writeInt(ds, LongWord(cdofs)); // central directory offset
+ writeInt(ds, Word(0)); // archive comment length
+end;
+
+
+var
+ fs, fo: TStream;
fl: TSFSFileList;
f: Integer;
infname: string;
outfname: string;
- zip: TZipper;
dvfn: string;
- ZEntries: TZipFileEntries;
+ newname: string;
+ files: array of TFileInfo;
+ nfo: TFileInfo;
begin
if ParamCount() < 1 then
begin
end;
infname := ParamStr(1);
- if not SFSStrEqu(ExtractFileExt(infname), '.wad') and not SFSStrEqu(ExtractFileExt(infname), '.dfwad') then
+ if not StrEquCI1251(ExtractFileExt(infname), '.wad') and not StrEquCI1251(ExtractFileExt(infname), '.dfwad') then
begin
writeln('wtf?!');
Halt(1);
if not SFSAddDataFile(infname) then begin WriteLn('shit!'); Halt(1); end;
dvfn := SFSGetLastVirtualName(infname);
- {
- tot := 0;
- fl := SFSFileList(ParamStr(1));
- if fl <> nil then
- begin
- for f := 0 to fl.Count-1 do
- begin
- WriteLn(f:4, ': ', fl[f].fSize:10, ' "', fl[f].fPath, fl[f].fName, '"');
- Inc(tot, fl[f].fSize);
- end;
- WriteLn('===================================================');
- WriteLn(fl.Count, ' files; ', Int64ToStrComma(tot), ' bytes.');
- fl.Free();
- end;
- }
-
- zip := TZipper.Create;
- zip.Filename := outfname;
+ files := nil;
fl := SFSFileList(dvfn);
- if fl <> nil then
+ if fl = nil then
begin
- ZEntries := TZipFileEntries.Create(TZipFileEntry);
+ writeln('wtf?!');
+ Halt(1);
+ end;
+
+ fo := TFileStream.Create(outfname, fmCreate);
+ try
for f := 0 to fl.Count-1 do
begin
if length(fl[f].fName) = 0 then continue;
fs := SFSFileOpen(dvfn+'::'+fl[f].fPath+fl[f].fName);
- writeln('[', f+1, '/', fl.Count, ']: ', fl[f].fPath+fl[f].fName, ' ', fs.size);
- ZEntries.AddFileEntry(fs, fl[f].fPath+fl[f].fName);
- end;
- try
- if ZEntries.Count > 0 then
- begin
- writeln('creating ''', outfname, '''');
- zip.ZipFiles(ZEntries);
- end;
- except
- on E: EZipError do E.CreateFmt('Zipfile could not be created%sReason: %s', [LineEnding, E.Message])
+ newname := detectExt(fl[f].fPath, fl[f].fName, fs);
+ 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);
+ SetLength(files, length(files)+1);
+ files[high(files)] := nfo;
end;
- end
- else
- begin
- writeln('SFSFileList(): faled!');
+ writeCentralDir(fo, files);
+ except
+ fo.Free();
+ fo := nil;
+ DeleteFile(outfname);
end;
+ if fo <> nil then fo.Free();
end.