home *** CD-ROM | disk | FTP | other *** search
/ FMI Superhry 1 / Superhry-I.bin / bonus / darkforc / editors / make_gob / extr_gob.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-19  |  2KB  |  83 lines
  1. Program Extract_Dark_Forces_GOB;
  2.  
  3. var
  4.  file1, file2            : file;
  5.  buffer                  : array[0..32767] of byte;
  6.  infile, outfile,lstfile : string;
  7.  i                       : integer;
  8.  directory               : text;
  9.  offset, len, dirbegin   : longint;
  10.  result                  : word;
  11.  b                       : array[1..13] of byte;
  12.  actlen                  : longint;
  13.  
  14. begin
  15.   if paramcount < 1 then
  16.   begin
  17.     writeLn('Usage:   EXTR_GOB  gobfile');
  18.     halt;
  19.   end;
  20.   infile := paramstr(1);
  21.   for i := 1 to length(infile) do
  22.     infile[i] := upcase(infile[i]);
  23.   if pos('.GOB', infile) = 0 then
  24.   begin
  25.     lstfile := infile + '.LST';
  26.     infile := infile + '.GOB';
  27.   end
  28.   else
  29.   begin
  30.     lstfile := copy(infile, 1, length(infile) - 4) + '.LST';
  31.   end;
  32.   assign(file1, infile);
  33.   {$I-}
  34.   reset(file1,1);
  35.   {$I+}
  36.   if ioresult <> 0  then
  37.   begin
  38.     writeln('Datei ', infile, ' nicht gefunden.');
  39.     halt;
  40.   end;
  41.   blockread(file1, dirbegin, 4, result);
  42.   blockread(file1, dirbegin, 4, result);
  43.   dirbegin := dirbegin + 4;
  44.   assign(directory,lstfile);
  45.   rewrite(directory);
  46.   while dirbegin < filesize(file1) do
  47.   begin
  48.     seek(file1, dirbegin);
  49.     blockread(file1, offset, 4, result);
  50.     blockread(file1, len, 4, result);
  51.     outfile := '';
  52.     blockread (file1, b, 13, result);
  53.     for i := 1 to 13 do
  54.       if b[i] <> 0 then
  55.         outfile := outfile + chr(b[i]);
  56.     dirbegin := filepos(file1);
  57.     seek(file1, offset);
  58.     writeln(outfile);
  59.     writeln(directory,outfile);
  60.     assign(file2, outfile);
  61.     rewrite(file2, 1);
  62.     actlen := 0;
  63.     while actlen < len do
  64.     begin
  65.       blockread(file1, buffer, 32768, result);
  66.       if (actlen + 32768) > len then
  67.       begin
  68.         blockwrite(file2, buffer, len - actlen, result);
  69.         actlen := len;
  70.       end
  71.       else
  72.       begin
  73.         blockwrite(file2, buffer, 32768, result);
  74.         actlen := actlen + 32768;
  75.       end;
  76.     end;
  77.     close(file2);
  78.   end;
  79.   close(file1);
  80.   close(directory);
  81. end.
  82.  
  83.