Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / misc / volume14 / ngdump / part01 next >

Wrap

Text File | 1990-08-03 | 16.7 KB | 720 lines

Newsgroups: comp.sources.misc subject: v14i044: Norton database dump prog (pascal) from: asperen@hroeur5.bitnet Sender: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc) Posting-number: Volume 14, Issue 44 Submitted-by: asperen@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@cs.eur.nl (asperen@hroeur5.bitnet) XErasmus University Rotterdam, The Netherlands SHAR_EOF chmod 0644 readme || echo "restore of readme fails" exit 0 -- bill davidsen (davidsen@crdos1.crd.GE.COM -or- uunet!crdgw1!crdos1!davidsen) "Stupidity, like virtue, is its own reward" -me