ted@imsvax.UUCP (Ted Holden) (11/02/86)
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.