Garbo/Garbo.cdr/pc/source/dump.lzh/dump

Text File | 1990-08-12 | 16.4 KB | 711 lines

#!/bin/sh
# shar:    Shell Archiver  (v1.27)
#
#    Run the following text with /bin/sh to create:
#      bufio.pas
#      ngdump.pas
#      readme
#
sed 's/^X//' << 'SHAR_EOF' > bufio.pas &&
X{$R+,I+}
X{$M 45000,0,655360}
Xunit BufIO;
X
Xinterface
X
Xprocedure bread(var f:file; var buf; count:word; var result:word);
Xprocedure bskip(var f:file; n:longint);
Xprocedure bseek(var f:file; p:longint);
Xfunction  bpos(var f:file):longint;
X
Ximplementation
X
X{$define Buffered}
X
X{$ifdef Buffered}
X
Xconst MaxFbuf = 1024;
X
Xvar   fbuf   : array [1..MaxFbuf] of byte;
X      inbuf  : 0..MaxFbuf;
X      curbuf : 1..MaxFbuf+1;
X
Xprocedure bread( var f:file; var buf; count:word; var result:word);
Xtype ByteArray = array [1..maxint] of byte;
Xvar done,n:word;
X    abuf : ByteArray absolute buf;
Xbegin
X  result := 0;
X  if (count > inbuf) or (inbuf = 0) then begin
X     if (inbuf > 0)
X      then move(fbuf[curbuf], buf, inbuf);
X     done := inbuf;
X     while (done < count) do begin
X        blockread(f, fbuf, MaxFbuf, result);
X        inbuf := result;
X        if (inbuf < 1) then begin
X{           writeln('BufIO.bread: unexpected eof.'); }
X           FillChar(buf, count, 0);
X           result := 0;
X           exit;
X        end;
X        curbuf := 1;
X        n := count - done;
X        if (n > inbuf) then n := inbuf;
X        move(fbuf[curbuf], abuf[done+1], n);
X        inc(done, n);
X        dec(inbuf, n);
X        inc(curbuf, n);
X     end;
X  end
X  else begin
X     move(fbuf[curbuf], buf, count);
X     dec(inbuf, count);
X     inc(curbuf);
X  end;
X  result := count;
Xend;
X
Xprocedure bseek(var f:file; p:longint);
Xbegin
X  seek(f, p);
X  inbuf := 0; curbuf := 1;       { flush buffer }
Xend;
X
Xfunction bpos(var f:file):longint;
Xbegin
X  bpos := filepos(f) - inbuf;
Xend;
X
Xprocedure bskip(var f:file; n:longint);
Xbegin
X  if (n < inbuf) then begin
X     dec(inbuf, n);
X     inc(curbuf, n);
X  end
X  else begin
X     bseek(f, bpos(f)+n);
X  end;
Xend;
X
X{$else}
X
Xprocedure bread( var f:file; var buf; count:word; var result:word);
Xbegin
X  blockread(f, buf, count, result);
X  if (result < 1) then begin
X     writeln('BufIO.bread: unexpected eof.');
X  end;
Xend;
X
Xprocedure bseek(var f:file; p:longint);
Xbegin
X  seek(f, p);
Xend;
X
Xfunction bpos(var f:file):longint;
Xbegin
X  bpos := filepos(f);
Xend;
X
Xprocedure bskip(var f:file; n:longint);
Xbegin
X  bseek(f, filepos(f)+n);
Xend;
X
X{$endif}
X
X(*
Xvar SaveExitProc : Pointer;
X
X{$F+} procedure MyExitProc; {$F-}
Xbegin
X  ExitProc := SaveExitProc;
Xend;
X*)
X
Xbegin
X{$ifdef Buffered}
X  inbuf := 0;
X  curbuf := 1;
X{$endif}
Xend.
SHAR_EOF
chmod 0644 bufio.pas || echo "restore of bufio.pas fails"
sed 's/^X//' << 'SHAR_EOF' > ngdump.pas &&
X{$R+,I+,V-}
X
Xprogram ngdump;
X
Xuses crt, dos,
X     BufIO;
X
Xconst progname = 'NGDUMP';
X      version  = 'V1.0';
X      copyright = 'Copyright 1989 J.P.Pedersen, 1990 E.v.Asperen';
X
X      MaxNameLen = 40;
X      MaxLineLen = 160;
X
Xtype gentry = record                    {General entry type}
X                filptr:longint;
X                name:string[MaxNameLen];
X              end;
X     line   = string[MaxLineLen];
X
Xvar
X     mennu:array[0..3,0..8] of gentry;  {Buffer to hold variable part of guide menu structure}
X     itemlist:array[0..3] of byte;               {Menu structure info}
X     errorinfo:array[3..6] of string[14];        {Buffer for error messages}
X     f:file;                                                                                    {The guide file}
X     propath,homedir,streng:string;              {String variables, mostly for path and file use}
X     erro,
X        seealsonum,
X        menuantal,
X        menunr : byte;                           {Byte variables}
X     entrytype : (et_misc, et_short, et_long);
X     guidename : line;
X
Xconst MaxLevel = 10;
X      OutBufSize   = 4096;
X
Xtype FileBuffer = array [1..OutBufSize] of byte;
X
Xvar  outf    : array [1..MaxLevel] of text;
X     flevel  : 1..MaxLevel;
X     OutBuf  : array [1..MaxLevel] of ^FileBuffer;
X     Nfiles  : word;
X     numentries : longint;
X
X
X
Xprocedure threenitvars;                 {Initialize variables}
Xbegin
X    menunr := 0;
Xend;
X
Xprocedure twonitvars;                   {Initialize variables}
Xbegin
X    threenitvars;
Xend;
X
Xprocedure initvars;                     {Initialize variables}
Xvar str5:string;
Xbegin
X    twonitvars;
X    errorinfo[3] := 'File not found';
X    errorinfo[4] := 'Not an NG file';
X    errorinfo[5] := 'Unexpected EOF';
X    errorinfo[6] := 'Corrupted file';
X    str5 := '';propath := paramstr(0);
X    while (pos('\',propath) > 0) do begin
X        str5 := str5+copy(propath,1,pos('\',propath));
X        propath := copy(propath,pos('\',propath)+1,length(propath)-(pos('\',propath)+1));
X    end;
X    propath := str5;
Xend;
X
Xvar attr, startattr : byte;
X
Xprocedure WriteNgString(var outf:text; s:string);
Xvar i,j:byte;
X    c:char;
Xbegin
X    i := 1;
X    attr := startattr;
X    while (i <= length(s)) do begin
X        c := s[i];
X        if c = #255 then begin
X            {Expand spaces}
X            inc(i);
X            c := s[i];
X            for j := 1 to ord(c) do begin
X                write(outf, ' ');
X            end;
X        end
X        else begin
X            if (c = '!') and (i = 1) then write(outf, c);
X            write(outf, c);
X        end;
X        inc(i);
X    end;
X
X    writeln(outf);
Xend;
X
Xprocedure WriteString(s:string);
Xbegin
X  WriteNgString(outf[flevel], s);
Xend;
X
Xconst Fx = 10; Fy = 2;
X      Gx = 10; Gy = 3;
X      Mx = 10; My = 5;
X      Cx = 10; Cy = 7;
X      Lx = 10; Ly = 8;
X      Sx = 10; Sy = 10;
X
X
Xprocedure ShowShort(s:string);
Xbegin
X  gotoxy(Sx, Sy);  ClrEol;
X  gotoxy(1, Sy+1); ClrEol;
X  gotoxy(Sx, Sy);  WriteNgString(Output, s);
Xend;
X
Xprocedure ShowLong(n:longint);
Xbegin
X  gotoxy(Lx, Ly); write(n:7);
Xend;
X
Xprocedure ShowEndLong;
Xbegin
X  gotoxy(Lx, Ly); ClrEol;
Xend;
X
Xprocedure ShowFile(s:string);
Xbegin
X  gotoxy(Fx, Fy); ClrEol; write(s);
Xend;
X
Xprocedure ShowGuide(s:string);
Xbegin
X  gotoxy(Gx, Gy); ClrEol; write(s);
Xend;
X
Xprocedure ShowCount(n:longint);
Xbegin
X  gotoxy(Cx, Cy); write(n:7);
Xend;
X
Xprocedure ShowMenu(s:string);
Xbegin
X  gotoxy(Mx, My); ClrEol; WriteNgString(output, s);
Xend;
X
Xprocedure ScreenInit;
Xbegin
X  ClrScr;
X  gotoxy(Fx-8, Fy); write(' file:');
X  gotoxy(Gx-8, Gy); write('guide:');
X  gotoxy(Mx-8, My); write(' menu:');
X  gotoxy(Cx-8, Cy); write('count:');
X  gotoxy(Lx-8, Ly); write('lines:');
X  gotoxy(Sx-8, Sy); write('entry:');
Xend;
X
Xprocedure ScreenExit;
Xbegin
X  gotoxy(1, Sy+3); ClrScr;
Xend;
X
Xprocedure Usage;                        {Write usage info}
Xbegin
X  writeln;
X  writeln('usage:        ngdump filename');
X  writeln;
X  Halt(1);
Xend;
X
Xprocedure slutlort(b:byte);  {Exit on error and display relevant error message}
Xbegin
X  if b > 3 then close(f);
X  if b > 2 then begin
X     writeln('NGDUMP ERROR #', b, ': '+errorinfo[b]+', cannot proceed');
X  end;
X  if b < 3 then usage;
X  halt(0);
Xend;
X
Xprocedure sllut(b:byte); {Error handler without exit, just indicating the error type}
Xvar sl:byte;
Xbegin
X  sl := 0;
X  if b > 3 then close(f);
X  writeln(' ',errorinfo[b],' - Press any key');
X  erro := 1;
Xend;
X
Xfunction decrypt(b:byte):byte;          {Decrypt byte from NG format}
Xbegin
X(*
X  if ((b mod 32)>=16) then b := b-16 else b := b+16;
X  if ((b mod 16)>=8) then b := b-8 else b := b+8;
X  if ((b mod 4)>=2) then b := b-2 else b := b+2;
X  decrypt := b;
X*)
X  decrypt := b xor (16+8+2);   { this is somewhat more efficient... EVAS}
Xend;
X
Xfunction read_byte:byte;                {Read and decrypt byte}
Xvar tb:byte;
X    numread:word;
Xbegin
X  bread(f, tb, 1, numread);
X  read_byte := tb xor 26;
Xend;
X
Xfunction read_word:word;                {Read and decrypt word}
Xvar tb:byte;
Xbegin
X  tb := read_byte;
X  read_word := word(tb) or (word(read_byte) shl 8);
Xend;
X
Xfunction read_long:longint;             {Read and decrypt longint}
Xvar tw:word;
Xbegin
X  tw := read_word;
X  read_long := longint(tw) or (longint(read_word) shl 16);
Xend;
X
Xtype BigStr = string[255];
X
Xprocedure read_string(maxlen:byte; var s:BigStr);
Xvar c,j:byte;
Xbegin
X  j := 0;
X  repeat
X    c := read_byte;
X    inc(j);
X    s[j] := chr(c);
X  until (c = 0) or (j = maxlen);
X  s[0] := chr(j-1);
Xend;
X
Xprocedure read_menu;             {Read a menu structure into the menu buffer}
Xvar items,i,j:word;
Xbegin
X  mennu[menunr,0].filptr := bpos(f)-2;
X  bskip(f, 2);
X  items := read_word;
X  itemlist[menunr] := items;
X  bskip(f, 20);
X  for i := 1 to items-1 do begin
X    mennu[menunr,i].filptr := read_long;
X  end;
X  bskip(f, items * 8);
X  for i := 0 to items-1 do begin
X     with mennu[menunr, i] do begin
X        read_string( 40, name );
X     end;
X  end;
X  bskip(f, 1);
Xend;
X
Xprocedure skip_short_long;       {Skip procedure for the initial menu bseek}
Xvar length:word;
Xbegin
X  length := read_word;
X  bskip(f, length + 22);
Xend;
X
Xprocedure read_header(modf:byte); {Read NG file header and enter the guide name in the screen template}
Xvar buf       : array[0..377] of byte;
X    i,numread : word;
Xbegin
X  bread(f, buf, sizeof(buf), numread);
X  if ((buf[0]<>ord('N')) or (buf[1]<>ord('G'))) then begin
X     {If the two first characters in the file are not 'NG', the file is no guide}
X     if modf = 0
X      then slutlort(4)
X      else sllut(4);
X  end;
X
X  menuantal := buf[6];
X  i := 0;
X  repeat
X    guidename[i+1] := chr(buf[i+8]);
X    inc(i);
X  until (buf[i+8] = 0);
X  guidename[0] := chr(i);
X
X  ShowGuide( guidename );
X  bseek(f, 378);
Xend;
X
Xprocedure read_menus(modf:boolean);  {Initial menu bseek, indexing the whole file}
Xvar id : word;
Xbegin
X  repeat
X    id := read_word;
X    if (id < 2) then begin
X       skip_short_long
X    end
X    else if (id = 2) then begin
X       read_menu;
X       inc(menunr);
X    end
X    else if (id <> 5) then begin
X       if (filesize(f) <> bpos(f)) then begin
X          if (not modf)
X           then slutlort(5)
X           else sllut(5);        {NG file error}
X       end
X       else id := 5;
X    end;
X  until (id = 5);
X
X  if (menunr <> menuantal) then begin
X     if (not modf)
X      then slutlort(6)
X      else sllut(6);                {Incomplete file}
X  end;
Xend;
X
Xfunction MakeName:Dos.PathStr;
Xvar fname:Dos.PathStr;
Xbegin
X  inc(Nfiles);
X  str(Nfiles, fname);
X  MakeName := fname;
Xend;
X
Xprocedure OpenOutFile(n:word; s:Dos.PathStr);
Xbegin
X  assign(outf[n], s); rewrite(outf[n]);
X  SetTextBuf(outf[n], OutBuf[n]^, OutBufSize);
Xend;
X
Xprocedure read_entry(level:byte; fp:longint); forward;
X
Xprocedure read_short_entry(level:byte);
X{Read short entry from file and wring some information out of it}
Xvar i, items: word;
X    subject : line;
X    entrypos, subj_pos, p0, p   : longint;
Xbegin
X  bskip(f, 2);
X  items := read_word;
X  bskip(f, 20);
X  p0 := bpos(f);
X  subj_pos := p0 + longint(items) * 6;
X  for i := 1 to items do begin
X    bskip(f, 2);
X    entrypos := read_long;
X    p := bpos(f);
X    bseek(f, subj_pos);
X    read_string( MaxLineLen, subject );
X    subj_pos := bpos(f);
X    write(outf[flevel], '!short:'); WriteString(subject);
X{}  ShowShort(subject);
X    read_entry(level+1, entrypos);
X    bseek(f, p);
X  end;
Xend;
X
Xprocedure read_long_entry;
X{Read long entry information}
Xconst MaxSeeAlso = 20;
Xvar i, linens, dlength, seealso_num : word;
X    s : line;
Xbegin
X  bskip(f, 2);
X  linens := read_word;
X  dlength := read_word;
X{} ShowLong(linens);
X  bskip(f, 18);       { 10 + links to prev/next entry (long's) }
X  for i := 1 to linens do begin
X    read_string( MaxLineLen, s );
X    WriteString(s);
X  end;
X
X  if dlength <> 0 then begin            {If there are seealso entries, read them}
X     seealso_num := read_word;
X     { skip the offsets for the SeeAlso-items; }
X     bskip(f, seealso_num * 4);
X     { read the items; }
X     for i := 1 to seealso_num do begin
X        if i <= MaxSeeAlso then begin
X           read_string( MaxLineLen, s );
X           writeln(outf[flevel], '!seealso: "', s, '"');
X        end;
X     end;
X  end;
X{} ShowEndLong;
Xend;
X
Xprocedure read_entry(level:byte; fp:longint); {Read some kind of file entry}
Xvar id:word; fname:dos.pathstr;
Xbegin
X  inc(numentries); ShowCount(numentries);
X  bseek(f, fp);
X  id := read_word;
X  case id of
X   0: begin
X        if (level > 0) then begin
X           fname := MakeName;
X           writeln(outf[flevel], '!file: ',fname+'.NGO');
X           inc(flevel);
X{$ifdef Debug}
X           assign(outf[flevel], 'CON'); rewrite(outf[flevel]);
X{$else}
X           OpenOutFile(flevel, fname+'.DAT');
X{$endif}
X           read_short_entry(level);
X           close(outf[flevel]);
X           dec(flevel);
X        end
X        else begin
X           read_short_entry(level);
X        end;
X      end;
X   1: begin
X(*
X        if (level > 0) and (not odd(level)) then begin
X           fname := MakeName;
X           writeln(outf[flevel], '!long: ',fname+'.NGO');
X           inc(flevel);
X{$ifdef Debug}
X           assign(outf[flevel], 'CON'); rewrite(outf[flevel]);
X{$else}
X           OpenOutFile(flevel, fname+'.DAT');
X{$endif}
X           read_long_entry;
X           close(outf[flevel]);
X           dec(flevel);
X        end
X        else begin
X           read_long_entry;
X        end;
X*)
X        read_long_entry;
X      end;
X  end;
Xend;
X
X
Xprocedure Main;
Xlabel Next;
Xvar i,j,k:word;
X    linkf : text;
X    fname : Dos.PathStr;
Xbegin
X  numentries := 0;
X
X  { create Menu Link Control File; }
X  assign(linkf, 'GUIDE.LCF'); rewrite(linkf);
X  writeln(linkf, '!name:'^i, guidename);
X  writeln(linkf);
X
X  for i := 0 to menuantal-1 do begin
X     writeln(linkf, '!menu:'^i, mennu[i,0].name);
X     ShowMenu(mennu[i,0].name);
X     for j := 1 to itemlist[i]-1 do begin
X        close(outf[flevel]);
X        fname := MakeName;
X        OpenOutFile(flevel, fname+'.dat');
X        ShowMenu(mennu[i,j].name);
X        writeln(linkf, ^i, mennu[i,j].name, ^i, fname+'.ngo');
X        read_entry( 0, mennu[i,j].filptr );
XNext:
X     end;
X  end;
X
X  close(linkf);
X
X  { write a makefile; }
X  assign(linkf, 'MAKEGUID'); rewrite(linkf);
X  writeln(linkf, '.dat.ngo:');
X  writeln(linkf, ^i'ngc $<');
X  writeln(linkf);
X  write(linkf, 'OBJECTS=');
X  j := 0;
X  for i := 1 to Nfiles do begin
X     str(i, fname);
X     fname := fname + '.ngo ';
X     write(linkf, fname);
X     inc(j, length(fname));
X     if (j > 65) then begin
X        write(linkf, '\'^m^j^i);
X        j := 0;
X     end;
X  end;
X  writeln(linkf);
X  writeln(linkf);
X  writeln(linkf, 'guide.ng:    $(OBJECTS)');
X  writeln(linkf, ^i'ngml guide.lcf');
X  close(linkf);
Xend;
X
Xvar i:byte;
Xbegin                        {Main loop and command-line parser}
X  flevel := 1;
X  Nfiles := 0;
X  for i := 1 to MaxLevel do begin
X    new(OutBuf[i]);
X  end;
X
X{$ifndef Debug}
X  assign(outf[flevel], 'CON');
X{$else}
X  assign(outf[flevel], 'GUIDE.DAT');
X{$endif}
X  rewrite(outf[flevel]);
X  SetTextBuf(outf[flevel], OutBuf[flevel]^, OutBufSize);
X
X  writeln(progname,' ',version,'. ',copyright,'.');
X  initvars; {Initialize global variables}
X
X  if ((paramstr(1)='/?') or (paramstr(1)='/h') or (paramstr(1)='/H')) then begin
X     Usage;
X  end;
X
X  if (ParamCount <> 1) then begin
X     Usage;
X  end;
X
X  streng := paramstr(1);
X
X  if pos('.',streng)=0
X   then streng := streng+'.NG';        {Expand file name}
X
X  assign(f, streng);
X{$I-}
X  reset(f, 1);
X  if ioresult<>0 then slutlort(3);   {If file does not exist, terminate and write cause of death}
X{$I+}
X
X  ScreenInit;
X  ShowFile(streng);
X  ShowMenu('reading menu-info...');
X  read_header(0);
X  read_menus(False);
X  Main;
X
X  close(f);
X  close(outf[flevel]);
X  ScreenExit;
Xend.
SHAR_EOF
chmod 0644 ngdump.pas || echo "restore of ngdump.pas fails"
sed 's/^X//' << 'SHAR_EOF' > readme &&
X21/06/1990
X
X
XThis is the README for NGDUMP, a decompiler for Norton Guides Database
Xfiles. NGDUMP is based on NG_CLONE, a clone of the NG program I found
Xon SIMTEL (<msdos.txtutl>ng_clone.zip). I modified the program to emit
Xsource code for the NG compiler.
X
Xusage:        ngdump databasefile[.ng]
X
XNGDUMP creates numbered data-files (1.dat, 2.dat, etc.) with the text,
Xa NG linker control file (GUIDE.LCF), and a makefile (MAKEGUID).
X
XEnjoy
X
XEelco van Asperen
[e-mail] ([e-mail])
XErasmus University Rotterdam, The Netherlands
SHAR_EOF
chmod 0644 readme || echo "restore of readme fails"
exit 0

--
bill davidsen    ([e-mail] -or- uunet!crdgw1!crdos1!davidsen)
            "Stupidity, like virtue, is its own reward" -me