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.