v14i044: Norton database dump prog (pascal)
asperen at hroeur5.bitnet
asperen at hroeur5.bitnet
Sat Aug 4 09:22:10 AEST 1990
Posting-number: Volume 14, Issue 44
Submitted-by: asperen at hroeur5.bitnet
Archive-name: ngdump/part01
[Forwarded from comp.binaries.ibm.pc. ++bsa]
#!/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
Xevas at cs.eur.nl (asperen at hroeur5.bitnet)
XErasmus University Rotterdam, The Netherlands
SHAR_EOF
chmod 0644 readme || echo "restore of readme fails"
exit 0
--
bill davidsen (davidsen at crdos1.crd.GE.COM -or- uunet!crdgw1!crdos1!davidsen)
"Stupidity, like virtue, is its own reward" -me
More information about the Comp.sources.misc
mailing list