home *** CD-ROM | disk | FTP | other *** search
/ Quake 'em / QUAKEEM.BIN / quake / programs / xpak040 / xpak.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-07-01  |  34.1 KB  |  1,041 lines
  1. program xPak; (* .PAK file manipulator *)
  2.  
  3. {$M 16384,102400,655360}   {Enough heap to load PAK0.PAK directory min}
  4.  
  5. uses wildmat,dos,crt;
  6.  
  7. const
  8.      LUMP_NAME_SIZE      = $40-8;
  9.      END_CHARS           = [#10,#0];
  10.      PAK_HEADER          = 'PACK';
  11.      PAK_PROTECTED       = 'PAK0.PAK';
  12.      MAX_BLOCK_SIZE:word = 65528;
  13.  
  14.      {HALT codes, not fully implemented yet}
  15.      HALT_PARSE          = 1;
  16.      HALT_SAFETY         = 3;
  17.      HALT_QUIT           = 4;
  18.  
  19. type
  20.     Buffer= array[1..65528] of byte;
  21.     LumpNameType= array[1..LUMP_NAME_SIZE] of char;
  22.     Modes=(None,List,Extract,Add,Remove,Rename,Merge);
  23.  
  24.     DirEntry=record
  25.       Lumpname : LumpNameType;
  26.       Pos      : Longint;
  27.       Size     : LongInt;
  28.     end;
  29.  
  30.     PFileSpecList=^TFileSpecList;
  31.     TFileSpecList=record
  32.       FileSpec : string[140];
  33.       LumpName : string[LUMP_NAME_SIZE];
  34.       Remapped : boolean;
  35.       included : boolean;
  36.       Next     : PFileSpecList;
  37.     end;
  38.  
  39.     PMasterDir=^TMasterDir;
  40.     TMasterDir=record         {212 bytes}
  41.       Dir      : DirEntry;
  42.       Filename : string[140];
  43.       Prev     : PMasterDir;
  44.       Next     : PMasterDir;
  45.     end;
  46.  
  47.     TFlags=record
  48.       Override : boolean;
  49.       Verbose  : boolean;
  50.       Force    : boolean;
  51.       Interact : boolean;
  52.       Query    : boolean;
  53.       AccessPAK: boolean;
  54.       Backup   : boolean;
  55.       JustName : boolean;
  56.       Debug    : boolean;
  57.     end;
  58.  
  59.  
  60. var
  61.    Flags: TFlags;
  62. {   o: text;}
  63.  
  64.  
  65. procedure Help;
  66.   begin
  67.        Writeln('usage: xpak <pakfile> -l|-e|-a|-r|-n [lumpname:]filespec [switches]');
  68.        Writeln;
  69.        Writeln('Command line must contain *one* of the following switches:');
  70.        writeln('           (r) = read; (c) = create; (m) = modify');
  71.        writeln('    -l (r) List contents of PAK file');
  72.        writeln('    -e (r) Extract specified files to directory tree');
  73.        writeln('    -a (c) Add specified files to PAK file (also create and update files)');
  74.        writeln('    -r (m) Remove specified lumps');
  75.        writeln('    -n (m) Rename lump in PAK file (renames to :filename');
  76.        writeln('Notice: -u and old -c have been removed.  They have been integrated into -a');
  77.        writeln(#13#10,'Press any key for next page');ReadKey;
  78.        writeln(#13#10,'Modification switches:');
  79.        writeln('    -o     Overrides some of the safety features in xpak.  These include');
  80.        writeln('           not writing to ID1.PAK and requiring existance of ./quake.exe');
  81.        writeln('    -j     (with -l) display just names only (useful to create @file lists)');
  82.        writeln('    -v     verbose mode.  Display names of lumps during processing.');
  83.        writeln('    -d     debug mode.  Displays all sorts of useless debugging info.');
  84.        writeln('    -i     (with -e) Interactive mode.  Prompt to overwrite files');
  85.        writeln('    -f     (with -e) Force overwrites.  Default is to skip existing files');
  86.        writeln(' #  -q     Query mode, ask before adding/extracting/removing each file');
  87.        writeln(' #  -b     backup PAK file before modification / existing extract targets');
  88.        writeln;
  89.        writeln('Lump names may be specified as free * and ? wildcards, but filenames');
  90.        writeln('(excludes -e) require DOS style paths and wildcards.  To access a lump name');
  91.        writeln('with a different filename, use the syntax lumpname:filename.  Wildcards not');
  92.        writeln('allowed.  File lists can be referenced as @filename. # denotes comment line');
  93.        writeln;
  94.        writeln('Remember that this is an early version, and may have ''problems'' =) Note also');
  95.        writeln('that xpak is now more-or-less unsupported, as I am working on a rewrite, sixpak');
  96.        halt;
  97.   end;
  98.  
  99.  
  100. procedure Lower4(var Str: String);
  101.   InLine(          {Adapted From SWAG}
  102.     $8C/$DA/$5E/$1F/$FC/$AC/$30/$E4/$89/$C1/$E3/$12/$BB/Ord('A')/Ord('Z')/
  103.     $AC/$38/$D8/$72/$08/$38/$F8/$77/$04/$80/$44/$FF/$20/$E2/$F1/$8E/$DA);
  104.  
  105.  
  106. procedure cvBackSlash(var ForeStr: string);
  107.   var i: byte;
  108.   begin
  109.        for i:=1 to Length(ForeStr) do
  110.            if ForeStr[i]='/' then ForeStr[i]:='\';
  111.   end;
  112.  
  113.  
  114. procedure cvForeSlash(var BackStr: string);
  115.   var i: byte;
  116.   begin
  117.        for i:=1 to Length(BackStr) do
  118.            if BackStr[i]='\' then BackStr[i]:='/';
  119.   end;
  120.  
  121.  
  122. procedure SetStr(var st:string; const ar:LumpNameType);
  123.   var
  124.      i: byte;
  125.   begin
  126.        st:='';
  127.        for i:=1 to LUMP_NAME_SIZE do
  128.            begin
  129.            if ar[i] in END_CHARS then begin dec(i); break end;
  130.            st[i]:=ar[i];
  131.            end;
  132.        st[0]:=Char(i);
  133.   end;
  134.  
  135.  
  136. procedure SetArr(var ar: LumpNameType; const st:string);
  137.   var
  138.      i,j: byte;
  139.   begin
  140.        FillChar(ar,SizeOf(ar),0);
  141.        j:=Length(st);
  142.        if Length(st)>LUMP_NAME_SIZE then j:=LUMP_NAME_SIZE;
  143.        for i:=1 to j do
  144.            ar[i]:=st[i];
  145.   end;
  146.  
  147.  
  148. function Exist(const filename:string): boolean;
  149.   var
  150.      DirInfo:SearchRec;
  151.   begin
  152.        FindFirst(filename,Anyfile,DirInfo);
  153.         Exist:=(DosError=0);
  154.   end;
  155.  
  156.  
  157. function MakePAKFilename(const oldname:string):string;
  158.   begin
  159.        if Pos('.',oldname)>0 then
  160.           MakePAKFilename:=oldname
  161.        else
  162.            MakePAKFilename:=oldname+'.pak';
  163.   end;
  164.  
  165.  
  166. procedure AddFileSpec(fs:string; yn: boolean; var TempPos: PFileSpecList);
  167.   var
  168.      spec,lump:string;
  169.      cpos: byte;
  170.      remap:boolean;
  171.   begin
  172.        lump:=fs;spec:=fs;
  173.        cpos:=pos(':',fs);
  174.        remap:=false;
  175.        if cpos>0 then
  176.           begin
  177.           if pos('*',fs)>0 then
  178.              begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
  179.           if pos('?',fs)>0 then
  180.              begin writeln('addspec: no wildcards allowed with alternate filenames (yet)'); exit end;
  181.           lump:=Copy(fs,1,cpos-1);
  182.           spec:=Copy(fs,cpos+1,255);
  183.           remap:=true;
  184.           end;
  185.        New(TempPos^.Next);
  186.        TempPos:=TempPos^.Next;
  187.        cvBackslash(spec);
  188.        cvForeslash(lump);
  189.        Lower4(lump);
  190.        TempPos^.Filespec:=spec;
  191.        TempPos^.Lumpname:=lump;
  192.        TempPos^.Included:=yn;
  193.        TempPos^.Remapped:=remap;
  194.        TempPos^.Next:=nil;
  195.   end;
  196.  
  197.  
  198. procedure FromFile(fn:string;Incl: boolean; var ListTemp: PFileSpecList);
  199.   var
  200.      ff: text;
  201.      fs: string;
  202.   begin
  203.        if fn[1]='@' then Delete(fn,1,1);
  204.        Assign(ff,fn);
  205.        {$I-}
  206.        Reset(ff);
  207.        if IOResult<>0 then
  208.           begin writeln('parse: unable to open filespec list file.'); exit end;
  209.        {$I+}
  210.        while not eof(ff) do
  211.              begin
  212.              ReadLn(ff,fs);
  213.              if fs<>'' then
  214.                 if fs[1]<>'#' then
  215.                    if fs[1]='!' then
  216.                       AddFileSpec(Copy(fs,2,Length(fs)-1),not incl,ListTemp)
  217.                    else
  218.                        AddFileSpec(fs,incl,ListTemp);
  219.              end;
  220.   end;
  221.  
  222.  
  223. function CheckParams(var MainPAK:string; var Files: PFileSpecList):Modes;
  224.   var
  225.      Param:string;
  226.      i:byte;
  227.      TempSpec:PFileSpecList;
  228.      SpecStart: PFileSpecList;
  229.      TempMode: Modes;
  230.      Include: boolean;
  231.   begin
  232.        TempMode:=None;Include:=True;MainPAK:='';
  233.        FillChar(Flags,SizeOf(Flags),0);
  234.        New(Files); TempSpec:=Files;
  235.        TempSpec^.Filespec:='*';
  236.        TempSpec^.Included:=True;
  237.        TempSpec^.Next:=nil;
  238.        if ParamCount=0 then begin writeln('Type `xpak -?` for help.');halt end;
  239.        for i:=1 to ParamCount do
  240.            begin
  241.            Param:=ParamStr(i);
  242.            If Param[1]='-' then
  243.               if Length(Param)=1 then begin Writeln('parse: bad parameter ',Param);halt(1) end
  244.               else
  245.                   Case UpCase(Param[2]) of
  246.                        '?': Help;
  247.                        'B': Flags.Backup:=True;
  248.                        'D': Flags.Debug:=True;
  249.                        'F': Flags.Force:=True;
  250.                        'I': Flags.Interact:=True;
  251.                        'J': Flags.JustName:=True;
  252.                        'O': Flags.Override:=True;
  253.                        'Q': Flags.Query:=True;
  254.                        'V': Flags.Verbose:=True;
  255.                        'X': Include:=not Include;
  256.                        'L': if TempMode=None then TempMode:=List
  257.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  258.                        'E': if TempMode=None then TempMode:=Extract
  259.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  260.                        'A': if TempMode=None then TempMode:=Add
  261.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  262.                        'R': if TempMode=None then TempMode:=Remove
  263.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  264.                        'N': if TempMode=None then TempMode:=Rename
  265.                                else begin writeln('parse: mode already set ',Param);halt(1) end;
  266.                        else begin writeln('parse: unknown parameter ',Param);halt(1) end;
  267.                   end
  268.            else if Param[1]='@' then
  269.                    if Length(Param)=1 then begin Writeln('parse: no file specified ',Param);halt(1) end
  270.                    else
  271.                        FromFile(Param,Include,TempSpec)
  272.            else
  273.                if Length(MainPAK)=0 then
  274.                   MainPAK:=MakePakFilename(Param)
  275.                else
  276.                    AddFilespec(Param,Include,TempSpec);
  277.            end;
  278.        if TempMode=None then begin writeln('parse: no operating mode specified'); halt(1) end;
  279.        if MainPAK =''   then begin writeln('parse: no .PAK file specified'); halt(1) end;
  280.        {
  281.        if (not exist('QUAKE.EXE')) and (not Flags.Override) then begin
  282.           writeln('safety: You must run xpak in the same directory as QUAKE.EXE'); halt(3) end;
  283.        }  {old qtest thing}
  284.        CheckParams:=TempMode;
  285.        end;
  286.  
  287.  
  288. function Match(TestStr:string; SpecList: PFileSpecList):boolean;
  289.   var
  290.      Matched: boolean;
  291.      ListTemp: PFileSpecList;
  292.   begin
  293.        cvForeslash(testStr);Lower4(TestStr);
  294.        ListTemp:=SpecList^.Next;
  295.        if ListTemp=nil then Match:=True else Match:=False;
  296.        while ListTemp<>nil do
  297.              begin
  298.              if WildCardMatch(ListTemp^.Lumpname,TestStr) then{in wildmat.tpu}
  299.                 Match:=ListTemp^.Included;
  300.              ListTemp:=ListTemp^.Next;
  301.              end;
  302.   end;
  303.  
  304.  
  305. function GetEntry(srch:string;ListTemp:PMasterDir):PMasterDir;
  306.   var
  307.      fn:string;
  308.   begin
  309.        GetEntry:=nil;
  310.        cvForeslash(srch);Lower4(srch);
  311.        while ListTemp<>nil do
  312.              begin
  313.              SetStr(fn,ListTemp^.Dir.Lumpname);
  314.              if srch=fn then
  315.                 begin
  316.                 GetEntry:=ListTemp;
  317.                 exit;
  318.                 end;
  319.              ListTemp:=ListTemp^.Next;
  320.              end;
  321.   end;
  322.  
  323.  
  324. function OpenPak(var Handle: file; filename: string):boolean;
  325.   var
  326.      IdStr: string[4];
  327.      check: word;
  328.   begin
  329.        Assign(Handle,filename);
  330.        OpenPAK:=False;
  331.  
  332.        {$I-}
  333.        Reset(Handle,1);
  334.        case IOResult of
  335.             0:;
  336.             2:begin writeln('open: file not found'); exit end;
  337.             3:begin writeln('open: path not found'); exit end;
  338.             5:begin writeln('open: access denied'); exit end;
  339.             else begin writeln('open: error accessing file'); exit end;
  340.        end;
  341.        {$I+}
  342.  
  343.        IdStr[0]:=#4;
  344.        BlockRead(Handle,IdStr[1],4,check);
  345.        if check<>4 then begin writeln('open/idstr: read size mismatch.  requested 4, received ',check);OpenPAK:=False end;
  346.        if IdStr<>PAK_HEADER then begin writeln('open: not a valid PAK file.'); exit end;
  347.        OpenPAK:=True;
  348.   end;
  349.  
  350.  
  351. procedure WriteHeader(var pak:file);
  352.   const
  353.        Header:array[1..12] of char=PAK_HEADER+#12#0#0#0#0#0#0#0;
  354.   begin
  355.        if Flags.Verbose then writeln('writehdr: writing PAK header');
  356.        BlockWrite(pak,Header,12);
  357.   end;
  358.  
  359.  
  360. function ReadDirectory(var pak: file): PMasterDir;
  361.   var
  362.      check: word;
  363.      TempDir: DirEntry;
  364.      LumpNum: word;
  365.      ListTemp: PMasterDir;
  366.      ListStart: PmasterDir;
  367.      filename: string;
  368.  
  369.   begin
  370.        readDirectory:=nil;
  371.        New(ListStart);ListTemp:=ListStart;
  372.        BlockRead(pak,TempDir.Pos,4,check);
  373.        if check<>4 then begin writeln('readdir/dirpos: read size mismatch.  requested 4, received ',check);exit end;
  374.        BlockRead(pak,TempDir.Size,4,check);
  375.        if check<>4 then begin writeln('readdir/dirsize: read size mismatch.  requested 4, received ',check);exit end;
  376.        if TempDir.Size=0 then exit;
  377.  
  378.        if Flags.Verbose then writeln('readdir: reading PAK directory');
  379.        Seek(pak,TempDir.Pos);
  380.        for LumpNum:=1 to TempDir.Size div SizeOf(DirEntry) do
  381.            begin
  382.            BlockRead(pak,TempDir,SizeOf(DirEntry),check);
  383.            if check<>SizeOf(DirEntry) then
  384.               begin writeln('readdir/entries: read size mismatch.  requested ',SizeOf(DirEntry),' received ',check);exit end;
  385.            SetStr(filename,TempDir.Lumpname);
  386.            cvBackslash(filename);
  387.            New(ListTemp^.Next);
  388.            ListTemp^.Next^.Prev:=ListTemp;
  389.            ListTemp^.Next^.Next:=nil;
  390.            ListTemp:=ListTemp^.Next;
  391.            ListTemp^.Dir:=TempDir;
  392.            ListTemp^.Filename:=filename;
  393.            end;
  394.        ListTemp:=ListStart^.Next;
  395.        ListTemp^.Prev:=nil;
  396.        Dispose(ListStart);
  397.        ReadDirectory:=ListTemp;
  398.   end;
  399.  
  400.  
  401. function CreateDirectory(Files:PFileSpecList):PMasterDir;
  402.   var
  403.      MstrTemp: PMasterDir;
  404.      MstrStart: PMasterDir;
  405.      MstrMatch: PMAsterDir;
  406.      SpecTemp: PFileSpecList;
  407.      TempStr,TempFile: string;
  408.      DirInfo: SearchRec;
  409.      p:DirStr; f:NameStr; e:ExtStr;
  410.   begin
  411.        New(MstrStart);MstrTemp:=MstrStart;MstrTemp^.Next:=nil;
  412.        SpecTemp:=Files^.Next;
  413.        while SpecTemp<>nil do
  414.              begin
  415.              TempStr:=SpecTemp^.Filespec;
  416.              cvBackslash(TempStr);
  417.              FSplit(TempStr,p,f,e);
  418.              FindFirst(Tempstr,Anyfile-Directory-Hidden-VolumeID,DirInfo);
  419.              while DosError=0 do
  420.                    begin
  421.                    TempFile:=p+DirInfo.Name;
  422.                    cvForeSlash(TempFile);Lower4(TempFile);
  423.                    MstrMatch:=nil;
  424.                    if SpecTemp^.Remapped then
  425.                       begin
  426.                       MstrMatch:=GetEntry(SpecTemp^.Lumpname,MstrStart);
  427.                       if MstrMatch<>nil then
  428.                          begin
  429.                          MstrMatch^.Filename:=p+DirInfo.Name;
  430.                          MstrTemp^.Dir.Size:=DirInfo.Size;
  431.                          end;
  432.                       TempFile:=SpecTemp^.Lumpname;
  433.                       end;
  434.                    if MstrMatch=nil then
  435.                       begin
  436.                       New(MstrTemp^.Next);
  437.                       MstrTemp^.Next^.Prev:=MstrTemp;
  438.                       MstrTemp:=MstrTemp^.Next;
  439.                       MstrTemp^.Next:=nil;
  440.                       MstrTemp^.Filename:=p+DirInfo.name;
  441.                       SetArr(MstrTemp^.Dir.Lumpname,Tempfile);
  442.                       MstrTemp^.Dir.Size:=DirInfo.Size;
  443.                       MstrTemp^.Dir.Pos:=0;
  444.                       end;
  445.                    FindNext(DirInfo);
  446.                    end;
  447.              SpecTemp:=SpecTemp^.Next;
  448.        end;
  449.        MstrTemp:=MstrStart^.Next;
  450.        MstrTemp^.Prev:=nil;
  451.        Dispose(MstrStart);
  452.        CreateDirectory:=MstrTemp;
  453.   end;
  454.  
  455.  
  456. function WriteDirectory(var pak:file;ListTemp:PMasterDir): boolean;
  457.   var
  458.      DirPos,DirLen: Longint;
  459.      check:word;
  460.   begin
  461.        WriteDirectory:=False;
  462.        seek(pak,FileSize(pak));
  463.        DirPos:=FilePos(pak);
  464.        if Flags.Verbose then writeln('writedir: writing new PAK directory');
  465.        DirLen:=0;
  466.        while ListTemp<>nil do
  467.              begin
  468.              BlockWrite(pak,ListTemp^.Dir,Sizeof(DirEntry),check);
  469.              if check<SizeOf(DirEntry) then begin
  470.                 writeln('writedir: write size mismatch.  requested ',SizeOf(DirEntry),' wrote ',check,'. out of disk space?');
  471.                 close(pak); exit end;
  472.              Inc(DirLen,SizeOf(DirEntry));
  473.              ListTemp:=ListTemp^.Next;
  474.              end;
  475.        Seek(pak,4);
  476.        BlockWrite(pak,DirPos,4);
  477.        BlockWrite(pak,DirLen,4);
  478.        WriteDirectory:=True;
  479.   end;
  480.  
  481.  
  482. procedure CropDirectory(var pak:file);
  483.   var
  484.      DirPos,DirLen:LongInt;
  485.   begin
  486.        Reset(pak,1);
  487.        Seek(pak,4);
  488.        BlockRead(pak,DirPos,4);
  489.        BlockRead(pak,DirLen,4);
  490.        Seek(pak,DirPos);
  491.        Truncate(pak);Close(pak);Reset(pak,1);
  492.   end;
  493.  
  494.  
  495. procedure RemapFilenames(MstrList:PMasterDir; Filespec:PFilespecList);
  496.   var
  497.      SpecTemp: PFileSPecList;
  498.      lumpname: string;
  499.   begin
  500.        while MstrList<>nil do
  501.              begin
  502.              SetStr(lumpname,MstrList^.Dir.Lumpname);
  503.              SpecTemp:=FileSpec;
  504.              while SpecTemp<>nil do
  505.                    begin
  506.                    if SpecTemp^.Remapped then
  507.                       if lumpname=SpecTemp^.Lumpname then
  508.                          MstrList^.Filename:=SpecTemp^.filespec;
  509.                    SpecTemp:=SpecTemp^.Next;
  510.                    end;
  511.              MstrList:=MstrList^.Next;
  512.              end;
  513.   end;
  514.  
  515.  
  516. procedure MakePath(const pname: string);
  517.   var
  518.      slashpos: byte;
  519.      TempStr: string;
  520.   begin
  521.        {$I-}
  522.        for slashpos:=1 to Length(pname) do
  523.            if pname[slashpos]='\' then
  524.               begin
  525.               TempStr:=Copy(Pname,1,slashpos-1);
  526.               mkdir(TempStr);
  527.               if IOResult=0 then
  528.                  if Flags.Verbose then
  529.                     begin
  530.                     cvForeslash(tempstr);Lower4(tempstr);
  531.                     writeln('mkdir: ',TempStr);
  532.                     end;
  533.               end;
  534.        {$I+}
  535.   end;
  536.  
  537.  
  538. procedure BAKFile(Filename:string);
  539.   var
  540.      p:Dirstr;n:NameStr;e:extstr;
  541.      NewName:String;
  542.      Regs:Registers;
  543.   begin
  544.        if Flags.Verbose then writeln('backup: ',Filename);
  545.        FSplit(Filename,p,n,e);
  546.        NewName:=p+n+'.bak'+#0;
  547.        Filename:=Filename+#0;
  548.        Regs.AH := $56;
  549.        Regs.DS := Seg(FileName);
  550.        Regs.DX := Ofs(FileName) + 1;
  551.        Regs.ES := Seg(NewName);
  552.        Regs.DI := Ofs(NewName) + 1;
  553.        MsDos(Regs);
  554.   end;
  555.  
  556.  
  557. function CopyData(var src,dest: file; Amount:LongInt):boolean;
  558.   var
  559.      Buf: ^Buffer;
  560.      BlockSize:word;
  561.      check:word;
  562.   begin
  563.        CopyData:=False;
  564.        New(buf);
  565.        If Flags.Debug then writeln('copy: copying ',Amount,' bytes. srcpos=',FilePos(src),' destpos=',FilePos(dest));
  566.        While Amount>0 do
  567.              begin
  568.              if Amount>MAX_BLOCK_SIZE then
  569.                 BlockSize:=MAX_BLOCK_SIZE
  570.              else
  571.                  BlockSize:=Amount;
  572.              Dec(Amount,BlockSize);
  573.              BlockRead(src,buf^,Blocksize,check);
  574.              if check<>BlockSize then begin
  575.                 writeln('copy: read size mismatch.  requested ',BlockSize,' received ',check);
  576.                 Dispose(Buf);exit end;
  577.              BlockWrite(dest,buf^,Blocksize,check);
  578.              if check<>BlockSize then begin
  579.                 writeln('copy: write size mismatch.  requested ',Blocksize,' wrote ',check,'. out of disk space?');
  580.                 Dispose(Buf);exit end;
  581.              end;
  582.        Dispose(buf);
  583.        CopyData:=True;
  584.   end;
  585.  
  586.  
  587. function MoveData(var handle:file;fPos,Size,Offset:LongInt):boolean;
  588.   var                                 {rPos is startpos}
  589.      Buf: ^Buffer;                    {rSize is amout to move}
  590.      Blocksize:Longint;               {rOffset is amount to move by, +/-}
  591.      EndPos:Longint;
  592.      check:word;
  593.   begin
  594.        if (Size=0) or (Offset=0) then begin MoveData:=True;exit end;
  595.        MoveData:=False;
  596.        New(Buf);
  597.        If Flags.Debug then writeln('move: moving ',Size,' bytes from ',fPos,' by ',Offset,' bytes. (to ',fpos+Offset,')');
  598.        if Offset>0 then Inc(fPos,Size);
  599.        while Size>0 do
  600.              begin
  601.              if Size>MAX_BLOCK_SIZE then
  602.                 BlockSize:=MAX_BLOCK_SIZE
  603.              else
  604.                  BlockSize:=Size;
  605.              Dec(Size,BlockSize);
  606.              if OffSet>0 then
  607.                 Seek(Handle,fpos-BlockSize)
  608.              else
  609.                  Seek(handle,fPos);
  610.              BlockRead(handle,Buf^,Blocksize,check);
  611.              if check<>BlockSize then begin
  612.                 writeln('move: read size mismatch.  requested ',Blocksize,' received ',check);
  613.                 Dispose(Buf);Close(handle);exit end;
  614.              Seek(handle,Filepos(Handle)-BlockSize+Offset);
  615.              BlockWrite(handle,buf^,Blocksize,check);
  616.              if check<>BlockSize then begin
  617.                 writeln('delete: write size mismatch.  requested ',Blocksize,' wrote ',check,'. out of disk space?');
  618.                 Dispose(Buf);Close(handle); exit end;
  619.              if Offset>0 then
  620.                 Dec(fpos,BlockSize)
  621.              else
  622.                  Inc(fpos,BlockSize);
  623.              end;
  624.        Dispose(Buf);
  625.        MoveData:=True;
  626.   end;
  627.  
  628.  
  629. procedure ListLump(Entry: DirEntry);
  630.   var
  631.      TempStr: string;
  632.      DispStr: string[40];
  633.   begin
  634.        SetStr(TempStr,Entry.Lumpname);
  635.        if Flags.JustName then
  636.           Writeln(TempStr)
  637.        else
  638.            begin
  639.            FillChar(DispStr[1],40,' ');
  640.            DispStr:=TempStr;
  641.            DispStr[0]:=#40;
  642.            Write(DispStr);
  643.            Write('Pos=',Entry.Pos:8);
  644.            Writeln('  Size=',Entry.Size:8,' (bytes)');
  645.        end;
  646.   end;
  647.  
  648.  
  649. procedure ExtractLump(var pak:file;const Entry: PMasterDir);
  650.   var
  651.      lname:string;
  652.      op: file;
  653.      ky:char;
  654.      tempstr:string;
  655.  
  656.   begin
  657.        SetStr(lname,Entry^.Dir.Lumpname);
  658.        MakePath(Entry^.Filename);
  659.        tempstr:=Entry^.Filename;cvForeslash(tempstr);Lower4(tempstr);
  660.        if not Flags.Force then
  661.           if exist(Entry^.Filename) then
  662.              if Flags.Interact then
  663.                 begin
  664.                 write('extract: overwrite file ',tempstr,'? [ynasq]');
  665.                 ky:=ReadKey;
  666.                 case UpCase(ky) of
  667.                   'N':;
  668.                   'A':Flags.Force:=True;
  669.                   'S':Flags.Interact:=False;
  670.                   'Q':halt(HALT_QUIT);
  671.                   'Y':;
  672.                   else ky:='n';
  673.                   end;
  674.                 writeln(ky);
  675.                 if UpCase(ky)='N' then exit;
  676.                 end
  677.              else
  678.                  begin
  679.                  writeln ('extract: ',tempstr,' exists.  skipping');
  680.                  exit
  681.                  end;
  682.        if Flags.BAckup then
  683.           if Exist(Entry^.Filename) then
  684.              BAKFile(Entry^.Filename);
  685.        if Flags.Verbose then
  686.           if tempstr=lname then
  687.              writeln('extract: ',lname)
  688.           else
  689.               writeln('extract: ',lname,' from file ',tempstr);
  690.        Assign(op,Entry^.Filename);
  691.        Rewrite(op,1);
  692.        if IOResult<>0 then begin writeln('extract: unable to open ',tempstr); exit end;
  693.  
  694.        Seek(pak,Entry^.Dir.Pos);
  695.        CopyData(pak,op,Entry^.Dir.Size);
  696.        Close(op);
  697.   end;
  698.  
  699.  
  700. function AddLump(var Handle: file; Filename: string):Longint;
  701.   var
  702.      ip: file;
  703.      buf: ^Buffer;
  704.      BlockSize: word;
  705.      check: word;
  706.  
  707.   begin
  708.        AddLump:=0;
  709.        New(buf);
  710.        Assign(ip,Filename);
  711.        ReSet(ip,1);
  712.        AddLump:=FileSize(Handle);
  713.        Seek(Handle,FileSize(Handle));
  714.        while not eof(ip) do
  715.              begin
  716.              BlockRead(ip,buf^,MAX_BLOCK_SIZE,BlockSize);
  717.              BlockWrite(Handle,buf^,BlockSize,check);
  718.              if check<BlockSize then begin
  719.                 writeln('addlump: write size mismatch.  Requested ',SizeOf(DirEntry),' wrote ',check,'. out of disk space?');
  720.                 Dispose(Buf);Close(Handle);close(ip);AddLump:=0; exit end;
  721.              end;
  722.        Dispose(buf);
  723.        Close(ip);
  724.   end;
  725.  
  726.  
  727. function UpdateLump(var pak:file;Entry:PMasterDir;ListTemp:PMasterDir):boolean;
  728.   var
  729.      lumpname,tempstr: string;
  730.      ip: file;
  731.   begin
  732.        UpdateLump:=False;
  733.        SetStr(Lumpname,Entry^.Dir.Lumpname);
  734.        if Flags.Verbose then
  735.           begin
  736.           tempstr:=Entry^.filename;cvForeslash(Tempstr);Lower4(tempstr);
  737.           writeln('update: ',lumpname,' with file ',tempstr);
  738.           end;
  739.  
  740.        Assign(ip,Entry^.Filename);
  741.        ReSet(ip,1);
  742.        if not MoveData(pak,Entry^.Dir.Pos+Entry^.Dir.Size,
  743.                            FileSize(pak)-Entry^.Dir.Pos-Entry^.Dir.Size,
  744.                            FileSize(ip)-Entry^.Dir.Size) then begin
  745.           writeln('update: error moving data in PAK file.');Close(ip);exit end;
  746.        Seek(pak,Entry^.Dir.Pos);
  747.        if not CopyData(ip,pak,FileSize(ip)) then begin
  748.           writeln('update: error reading from file.');close(ip);exit end;
  749.        if FileSize(ip) < Entry^.Dir.Size then
  750.           begin
  751.           Seek(pak,FileSize(pak)+FileSize(ip)-Entry^.Dir.Size);
  752.           Truncate(pak);Close(pak);Reset(pak,1);
  753.           end;
  754.        While ListTemp<>nil do
  755.              begin
  756.              if ListTemp^.Dir.Pos>Entry^.Dir.Pos then
  757.                 if ListTemp^.Dir.Pos<>0 then
  758.                    Inc(ListTemp^.Dir.Pos,FileSize(ip)-Entry^.Dir.Size)
  759.                 else
  760.              else if ListTemp^.Dir.Pos=Entry^.Dir.Pos then
  761.                   ListTemp^.Dir.Size:=FileSize(ip);  {Original record}
  762.              ListTemp:=ListTemp^.Next;
  763.              end;
  764.        Close(ip);
  765.        UpdateLump:=true;
  766.   end;
  767.  
  768.  
  769. procedure RemoveLump(var pak:file;Lump: PMasterDir; var MasterDir:PMasterDir);
  770.   var
  771.      ListTemp : PMasterDir;
  772.   begin
  773.        if Lump=nil then exit;
  774.        if Lump^.Prev=nil then
  775.           begin
  776.           Lump:=MasterDir;
  777.           MasterDir:=Lump^.Next;
  778.           MasterDir^.Prev:=nil
  779.           end
  780.        else
  781.            begin
  782.            Lump^.Prev^.Next:=Lump^.Next;
  783.            if Lump^.Next<>nil then Lump^.Next^.Prev:=Lump^.Prev;
  784.            end;
  785.  
  786.        if not MoveData(pak,Lump^.Dir.Pos+Lump^.Dir.Size,
  787.                            FileSize(pak)-Lump^.Dir.Pos-Lump^.Dir.Size,
  788.                            -Lump^.Dir.Size)
  789.           then begin writeln('remove: error moving data in PAK file.'); exit end;
  790.        Seek(pak,FileSize(pak)-Lump^.Dir.Size);
  791.        Truncate(pak);Close(pak);Reset(pak,1);
  792.  
  793.        ListTemp:=MasterDir;
  794.        while ListTemp<>nil do
  795.              begin
  796.              if ListTemp^.Dir.Pos>Lump^.Dir.Pos then
  797.                 Dec(ListTemp^.Dir.Pos,Lump^.Dir.Size);
  798.              ListTemp:=ListTemp^.Next;
  799.              end;
  800.        Dispose(Lump);
  801.   end;
  802.  
  803.  
  804. procedure SafetyPAK(pakfile:string);
  805.   begin
  806.        if not Flags.OverRide then
  807.           begin
  808.           lower4(pakfile);
  809.           if Copy(pakfile,Length(pakfile)-7,7)='pak0.pak' then
  810.              begin writeln('safety: will not write to PAK0.PAK'); halt(HALT_SAFETY) end;
  811.           end;
  812.   end;
  813.  
  814.  
  815. procedure ListPAK(pakfile:string;filespec:PFilespecList);
  816.   var
  817.      ListTemp:PMasterDir;
  818.      pak: file;
  819.   begin
  820.        if not OpenPAK(pak,pakfile) then exit;
  821.        ListTemp:=ReadDirectory(pak);
  822.        Close(pak);
  823.        while ListTemp<>nil do
  824.              begin
  825.              if Match(ListTemp^.Dir.Lumpname,FileSpec) then
  826.                 ListLump(ListTemp^.Dir);
  827.              ListTemp:=ListTemp^.Next;
  828.              end;
  829.  
  830.   end;
  831.  
  832.  
  833. procedure ExtractPAK(pakfile:string;filespec:PFilespecList);
  834.   var
  835.      ListTemp: PMasterDir;
  836.      pak:file;
  837.   begin
  838.        if not OpenPAK(pak,pakfile) then exit;
  839.        ListTemp:=ReadDirectory(pak);
  840.        RemapFilenames(ListTemp,filespec);
  841.        while ListTemp<>nil do
  842.              begin
  843.              if Match(ListTemp^.Dir.Lumpname,filespec) then
  844.                 ExtractLump(pak,ListTemp);
  845.              ListTemp:=ListTemp^.Next;
  846.              end;
  847.   end;
  848.  
  849.  
  850. procedure AddPAK(pakfile:string;filespec:PFilespecList);
  851.   var
  852.      ListPrev,ListTemp,OldEntry:PMasterDir;
  853.      pak:file;
  854.      MstrStart: PMasterDir;
  855.      NewStart: PMAsterDir;
  856.      srcfile,srclump:string;
  857.      tempstr:string;
  858.      ky: char;
  859.      SkipUpdate: boolean;
  860.   begin
  861.        SafetyPAK(pakfile);
  862.        SkipUpdate:=False;
  863.  
  864.        if not exist(pakfile) then
  865.           begin
  866.           Assign(pak,pakfile);ReWrite(pak,1);
  867.           WriteHeader(pak);Close(pak);
  868.           end;
  869.        if not OpenPAK(pak,pakfile) then exit;
  870.  
  871.        NewStart:=CreateDirectory(filespec);     {Get New lumps}
  872.        MstrStart:=ReadDirectory(pak);           {Get original directory}
  873.        ListPrev:=MstrStart;
  874.        if ListPrev<>nil then
  875.           begin
  876.           while ListPrev^.Next<>nil do
  877.                 ListPrev:=ListPrev^.Next;
  878.           ListPrev^.Next:=NewStart;
  879.           NewStart^.Prev:=ListPrev; {Paste New lumps onto end of original}
  880.           end
  881.        else
  882.            begin
  883.            MstrStart:=NewStart;
  884.            NewStart^.Prev:=nil;
  885.            end;
  886.  
  887.        CropDirectory(pak);
  888.  
  889.        ListTemp:=NewStart;
  890.        while ListTemp<>nil do
  891.              begin
  892.              srcfile:=ListTemp^.Filename;
  893.              SetStr(srclump,ListTemp^.Dir.Lumpname);
  894.              OldEntry:=GetEntry(srclump,MstrStart);
  895.              if OldEntry = ListTemp then
  896.                 begin
  897.                 if Flags.Verbose then
  898.                    begin
  899.                    tempstr:=srcfile;cvForeslash(tempstr);Lower4(tempstr);
  900.                    if tempstr=srclump then
  901.                       writeln('add: ',srclump)
  902.                    else
  903.                        writeln('add: ',srclump,' from file ',tempstr);
  904.                    end;
  905.                 ListTemp^.Dir.Pos:=AddLump(pak,srcfile);
  906.                 if ListTemp^.Dir.Pos=0 then
  907.                    begin
  908.                         ListPrev^.Next:=ListTemp^.Next;
  909.                         if ListTemp^.Next<>nil then
  910.                            ListTemp^.Next^.Prev:=ListPrev;
  911.                         ListTemp:=ListTemp^.Next;
  912.                    end
  913.                 else
  914.                     begin
  915.                     Listprev:=ListTemp;
  916.                     ListTemp:=ListTemp^.Next;
  917.                     end
  918.                 end
  919.              else
  920.                  begin
  921.                  ky:='Y';
  922.                  if SkipUpdate then
  923.                     begin
  924.                     ky:='N';
  925.                     if Flags.Verbose then writeln('update: skipping ',srclump);
  926.                     end;
  927.                  if Flags.Interact then
  928.                     begin
  929.                     write('update: update lump ',srclump,'? [ynasq]');
  930.                     ky:=ReadKey;
  931.                     case UpCase(ky) of
  932.                       'A':Flags.Interact:=False;
  933.                       'S':begin SkipUpdate:=True; if Flags.Verbose then writeln('update: skipping ',srclump);end;
  934.                       'Q':halt(HALT_QUIT);
  935.                       'Y':;
  936.                       else ky:='n';
  937.                       end;
  938.                     writeln(ky);
  939.                     end;
  940.                  ListTemp^.Dir:=OldEntry^.Dir;
  941.                  if (UpCase(ky)='Y') or (UpCase(ky)='A') then
  942.                     if UpdateLump(pak,ListTemp,MstrStart) then
  943.                        begin
  944.                        ListPrev^.Next:=ListTemp^.Next;
  945.                        Dispose(ListTemp);
  946.                        ListTemp:=ListPrev^.Next;
  947.                        if ListTemp<>nil then ListTemp^.Prev:=ListPrev;
  948.                        end;
  949.                  end;
  950.              end;
  951.  
  952.        WriteDirectory(pak,MstrStart);
  953.        Close(pak);
  954.   end;
  955.  
  956.  
  957. procedure RemovePAK(pakfile:string;filespec:PFilespecList);
  958.   var
  959.      pak:file;
  960.      ListTemp:PMasterDir;
  961.      MstrStart :PMasterDir;
  962.      DirLen,DirPos: Longint;
  963.      lumpname: string;
  964.   begin
  965.        SafetyPAK(pakfile);
  966.        if not OpenPAK(pak,pakfile) then exit;
  967.        MstrStart:=ReadDirectory(pak);
  968.        if Filespec=nil then writeln('remove: no entries to process');
  969.  
  970.        CropDirectory(pak);
  971.  
  972.        ListTemp:=MstrStart;
  973.        while ListTemp<>nil do
  974.              begin
  975.              SetStr(lumpname,ListTemp^.Dir.Lumpname);
  976.              if Match(lumpname,Filespec) then
  977.                 begin
  978.                 if Flags.Verbose then writeln('remove: ',lumpname);
  979.                 RemoveLump(pak,ListTemp,MstrStart);
  980.                 end;
  981.              ListTemp:=ListTemp^.Next;
  982.              end;
  983.        WriteDirectory(pak,MstrStart);
  984.        Close(pak);
  985.   end;
  986.  
  987.  
  988. procedure RenamePAK(pakfile:string;filespec:PFilespecList);
  989.   var
  990.      MstrStart: PMasterDir;
  991.      MstrTemp:PMasterDir;
  992.      SpecTemp: PFileSPecList;
  993.      lumpname,newname: string;
  994.      pak: file;
  995.   begin
  996.        SafetyPAK(pakfile);
  997.        if not OpenPAK(pak,pakfile) then exit;
  998.        MstrStart:=ReadDirectory(pak);
  999.        MstrTemp:=MstrStart;
  1000.        while MstrTemp<>nil do
  1001.              begin
  1002.              SetStr(lumpname,MstrTemp^.Dir.Lumpname);
  1003.              SpecTemp:=FileSpec;
  1004.              while SpecTemp<>nil do
  1005.                    begin
  1006.                    if SpecTemp^.Remapped then
  1007.                       if lumpname=SpecTemp^.Lumpname then
  1008.                          begin
  1009.                          newname:=SpecTemp^.Filespec;
  1010.                          cvForeslash(newname);Lower4(newname);
  1011.                          SetArr(MstrTemp^.Dir.Lumpname,newname);
  1012.                          if Flags.Verbose then
  1013.                             writeln('rename: ',lumpname,' to ',newname);
  1014.                          end;
  1015.                    SpecTemp:=SpecTemp^.Next;
  1016.                    end;
  1017.              MstrTemp:=MstrTemp^.Next;
  1018.              end;
  1019.        CropDirectory(pak);
  1020.        WriteDirectory(pak,MstrStart);
  1021.        Close(pak);
  1022.   end;
  1023.  
  1024.  
  1025. var
  1026.    pakfile:string;
  1027.    filespec:PFileSpecList;
  1028.  
  1029. begin
  1030.      DirectVideo:=False;
  1031.      Assign(Output,'');ReWrite(Output);
  1032.      Writeln('# XPak v0.4.0; 96/07/01. (c) Tom Wheeley; <splitbung>, tomw@tsys.demon.co.uk; '#13#10);
  1033.      Case CheckParams(pakfile,filespec) of
  1034.           List:    ListPAK(pakfile,filespec);
  1035.           Extract: ExtractPAK(pakfile,filespec);
  1036.           Add:     AddPAK(pakfile,filespec);
  1037.           Remove:  RemovePAK(pakfile,filespec);
  1038.           Rename:  RenamePAK(pakfile,filespec);
  1039.           else writeln('main: mode not yet implemented');
  1040.      end;
  1041. end.