🚀 go-pugleaf

So many people have inquired regarding these two items that I think it best
to simply post them.  I haven't taken a really hard look at either;  as far
as I know, both are public domain and to be found on many electronic bulletin
boards.

.......................................................................
.......................................................................
(* xdbase3.inc - Turbo Pascal Definitions for DB3 Records *)

(*  xdbfhdr3.inc = definitions for dbase3 headers and fld defs *)

const

xmaxflds = 128;  (* Maximum number of DB3 Fields in a DBF *)
xdbhsize = 32;   (* Size of DBF Header before Field Definitions *)

type

xflddef3 = array [1..32] of byte;

xflddef = record
     (* Layout of DB3 Field Descriptor Entry *)
             fldname: array [1..11] of char;
             fldtype: char;
             fldlocn: integer; (* excess 7 or 15 x'0f' from recrd start *)
                               (* whatever is displacement of 1st field *)
                               (* Delete Flag field - 1 byte must be    *)
                               (* assumed as 1st true field in Record   *)
             fldgarb: integer; (* reserved - loaded with garbage *)
             fldsize: byte;
             flddec:  byte;
             fldrsv2: array [1..14] of byte;
           end;

xdbfhdr = record
            dbvers:    byte; (* Dbase Version Number, 2 or 3 *)
             (* True Hex values for last yy/mm/dd of change *)
            chgyy:     byte;
            chgmm:     byte;
            chgdd:     byte;

            numrecs:  integer; (* Number of records in DBF *)
            numrecsh: integer; (* high order bytes of 32 bit integer *)
            frstrcd:  integer; (* 0-rel byte locn of 1st record in file *)
                               (* It will point at start of Record's delete *)
                               (* Flag *)
            rcdlgth:  integer; (* Record Length of fixed length DBF Records *)
            resrvd0:  integer;
            resrvd1:  integer;
            resrvd2:  array [1..16] of byte;
            flddef:   xflddef;    (* first field definition *)
            (* 1 32 byte entry for each defined field *)
            (* Last field entry starts with all x'00' *)
            (* 1st DBF Record follows *)
          end;

(* If blockio is used, then physical blocksize is irrelevant to record
   location in file; records are written with no slack space between.
   A ^Z (x'1a') follows the last record. Recommend minimum block of 1024
   bytes  - should otherwise be multiple of 128, programmer can choose *)
(* End of xdbfhdr3 definition *)

(* xndxhdr3.inc - DB3 Index Header and Record Definitions *)

(* DBASE 3 Index File Header - Anchor Block *)

(* observe xxxxh variable names - dB3 is either using or is planning to
   use 32 bit integers *)                                                -

(* All dB3 Index Blocks are 512 bytes *)

type
  xndxhdr  = record
               frstblk:    integer;    (* 1st Index Block/Node - 0 rel *)
               frstbklkh:  integer;    (* filler / may contain junk *)
               nxtalloc:   integer;    (* block number of next to allocate *)
                                       (* 0-rel to start of file *)
               nxtalloch:  integer;    (* filler / may contain junk *)
               fillerxx:   array [1..2] of integer;  (* usually 0's *)
               keylgth:    byte;       (* length of key part of Index/Node *)
               ntrylgth:   byte;   (* dB3 - does not set, dB2 does *)
                                   (* actual value is keylgth + 8 in DB3  *)
               maxents:    integer; (* Maximum number of entries dB3 will *)
                                    (* create in a Node during Update/Create *)
             (* Remaining area includes the
                                   "Index on" Descriptor and garbage *)
             (* Total blocksize is 512 bytes *)
            end;

  xndxrcd  = record
             (* Description applies to both Index Node Entries and to Index *)
             (*  records *)
               DnNode:     integer; (* Next Node "down" - 0 rel file block *)
                                    (*  0 --> real index rcrd *)
               DnNodeH:    integer; (* May be filler or hi-order 16 bits *)
               rcdno:      integer; (* dB3 corresponding DBF Record No.  *)
                                    (* will be 0 if this is Node entry   *)
               rcdnoh:     integer; (* high order 16 bits - 32 bit integer *)
               rcdKey:     array [1..100] of char; (* reserve max allowable *)
                                                   (* key size *)
(* Beware of pure numberic keys: dB3 converts all to 64 bit reals with *)
(* 12 bit exponents and "normalized" 48 bit mantissas *)
(* dB2 creates 32 bit BCD reals *)
(* Both systems do this even when no positions to right of decimal point *)
(* are specified in the database field definition *)
(* None are directly compatible with Turbo, Turbo 8087 or Turbo BCD reals *)

            end;

  xndxblk =   record
     (* Describes Node and Index Record Block  *)
                numents:   byte; (* will contain true number of entries *)
                                 (* in the 512 byte block, if DnNode,   *)
                                 (* is non-zero;                        *)
                                 (* Otherwise it is one less than true  *)
                                 (* number of entries; furthermore, if  *)
                                 (* DnNode of 1st Block Entry is non-zero*)
                                 (* then all entries have non-zero       *)
                                 (* DnNode values, and vice versa *)
                fillerh:   array [1..3]   of byte; (* can include junk *)
                DnNode:    integer; (* DnNode of 1st Block Entry *)
                blkdata:   array [0..505] of byte;
             end;


..............................................................................
..............................................................................
..............................................................................

 program readwks;   {Program to print data in a LOTUS Worksheet file. From P.C.
                                      Tech Journal October 1984 J.P. Holtman
                                      (201) 361-3395}

    const   {1 => floating, 2 => formula, 4 => header}
       debug = 0;

    var
       wks_name : string[20];
       infile : file of byte;

    type
       hex_string = string[4];

    function hexprt(a : integer) : hex_string;   {binary -> HEX conversion}

       const
          hexit : array[0..15] of char = '0123456789ABCDEF';

       var
          strout : hex_string;
          i : integer;

       begin
          strout := '    ';
          for i := 4 downto 1 do begin
             strout[i] := hexit[a and $F];
             a := a shr 4;
             end;
          hexprt := strout;
          end;

    function read_byte : byte;

       var
          i : byte;

       begin
          read(infile,i);
          read_byte := i;
          end;

    function read_word : integer;

       var
          hibyte,lobyte : byte;

       begin
          read(infile,lobyte);
          read(infile,hibyte);
          read_word := hibyte shl 8 or lobyte;
          end;


    function process_record : boolean;

       var
          rec_type, i, fld_value, rec_len, word1 : integer;
          rec_format, junk : byte;
          column, row, fromcol, fromrow, tocol, torow : integer;
          isna : boolean;
          byt : array[1..8] of byte;
          double : real;
          char_string : string[255];

       procedure get_format;

          begin
             rec_format := read_byte;
             column := read_word;
             row := read_word;
             end;

       procedure get_double;   {convert to REAL number}

          var
             sign, exponent,i : integer;
             byt2left, byt2right : integer;
             sum, signicand : real;

          begin
             if (debug and 1) <> 0 then begin
                write('bytes=');
                for i := 1 to 8 do write(' ',copy(hexprt(byt[i]),3,2));
                end;
             if (byt[1] = 255) and (byt[2] = 240) then isna := true
             else begin
                isna := false;
                if (byt[1] = 0) and (byt[2] = 0) then double := 0.0
                else begin
                   if (byt[1] and $80) > 0 then sign := -1
                   else sign := 1;
                   byt[1] := byt[1] and $7F;
                   byt2left := (byt[2] and $F0) shr 4;
                   byt2right := byt[2] and $0F;
                   exponent := byt[1] shl 4 + byt2left - 1023;
                   sum := 0;
                   for i := 8 downto 3 do sum := (sum + byt[i]) / 256.0;
                   signicand := 1+(byt2right/16.0)+sum/16.0;
                   double := sign*(signicand*exp(ln(2.0)*exponent));
                   end   end;
             end;

       procedure print_loc;   {print row/column with proper spacing}

          var
             char1,char2 : integer;
             alpha : string[2];
             val_str : string[10];

          begin
             char1 := column div 26;
             char2 := column mod 26;
             if char1 = 0 then alpha := ' '
             else alpha := chr(64+char1);
             alpha := alpha + chr(65+char2);
             str(row+1,val_str);
             write(copy(alpha+val_str+'         ',1,9));
             end;

       begin
          process_record := true;
          rec_type := read_word;
          rec_len := read_word;
          if (debug and 4) <> 0 then writeln('type=',rec_type,'  len=',rec_len);
          case rec_type of   {header}
             0: begin
                word1 := read_word;
                if (rec_len <> 2) or (word1 <> $404) then begin
                   writeln(#7'Not valid worksheet'#7);
                   halt;
                   end;
                end;

{range}
             6: begin
                fromcol := read_word;
                fromrow := read_word;
                tocol := read_word;
                torow := read_word;
                row := torow-fromrow;
                column := tocol-fromcol;
                write('Lower Right Corner: ');
                print_loc;
                writeln;
                end;

{integer value}
             13: begin
                get_format;
                print_loc;
                fld_value := read_word;
                writeln(fld_value);
                end;

{double precision}
             14: begin
                get_format;
                print_loc;
                for i := 1 to 8 do byt[9-i] := read_byte;
                get_double;
                if isna then writeln('NA')
                else writeln(double);
                end;

{character string}
             15: begin
                get_format;
                print_loc;
                char_string := '';
                for i := 1 to rec_len-5 do char_string := char_string + chr(
                     read_byte);
                writeln(char_string);
                end;

{formula and value}
             16: begin
                get_format;
                print_loc;
                for i := 1 to 8 do byt[9-i] := read_byte;
                get_double;
                if isna then writeln('NA')
                else writeln(double);
                for i := 1 to rec_len-13 do begin   {read rest of formula and
                                      discard}
                   junk := read_byte;
                   if (debug and 2) <> 0 then write(copy(hexprt(junk),3,2),' ');
                   end;
                if (debug and 2) <> 0 then writeln;
                end;

{end of worksheet}
             1: begin
                writeln('End of Worksheet');
                process_record := false;
                end;

             else
                begin   {ignore the record type}
                   for i := 1 to rec_len do junk := read_byte;
                   end;

             end;
          end;

    begin
       write('Worksheet name: ');
       readln(wks_name);
       assign(infile,wks_name+'.wks');
       reset(infile);
       repeat
          until process_record = false;
       end.