Listing: 1 IMPLEMENTATION MODULE DBFields; 2 3 (* 4 * ModBase 5 * Release 3.0 6 * (c) Copyright 1986 - 1991 John McMonagle & Donald G. Fletcher 7 * (c) Copyright 1986 - 1991 PMI 8 * P.O. Box 8402 9 * Green Bay Wi 53308 10 * All Rights Reserved 11 * 12 *) 13 IMPORT ModBase3; 14 FROM ModBase3 IMPORT DBFile, GetField,FieldList,DBFieldPtr; ***** ^ duplicate identifier 15 FROM DateFunctions IMPORT Date; 16 FROM StrConv IMPORT RealToStr, StrToReal; 17 FROM NumTypes IMPORT Real8; 18 19 CONST MaxDigits = 18; 20 21 PROCEDURE DataFormatToDate(dbstring: ARRAY OF CHAR; VAR d: Date); ***** ^ not supported yet 22 (* Converts a string from dbase data format (yyyymmdd) to Date *) 23 VAR i: CARDINAL; 24 BEGIN 25 IF dbstring[0] = ' ' THEN ***** ^ not supported yet ***** ^ not supported yet 26 d.yr := 0; d.mo := 0; d.day := 0 ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 27 ELSE 28 d.yr := 0; ***** ^ not supported yet ***** ^ not supported yet 29 FOR i := 0 TO 3 DO 30 d.yr := (d.yr * 10) + (ORD(dbstring[i])-60B) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 31 END; 32 d.mo := (ORD(dbstring[4])-60B) * 10 + (ORD(dbstring[5])-60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 33 d.day := (ORD(dbstring[6])-60B) * 10 + (ORD(dbstring[7])-60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 34 END; 35 END DataFormatToDate; ***** ^ not supported yet 36 37 PROCEDURE DateToDataFormat(d: Date; VAR datestring: ARRAY OF CHAR); ***** ^ not supported yet 38 BEGIN 39 datestring[0] := CHR(d.yr DIV 1000 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 40 d.yr := d.yr MOD 1000; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 41 datestring[1] := CHR(d.yr DIV 100 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 42 d.yr := d.yr MOD 100; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 43 datestring[2] := CHR(d.yr DIV 10 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 44 datestring[3] := CHR(d.yr MOD 10 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 45 datestring[4] := CHR(d.mo DIV 10 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 46 datestring[5] := CHR(d.mo MOD 10 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 47 datestring[6] := CHR(d.day DIV 10 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 48 datestring[7] := CHR(d.day MOD 10 + 60B); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 49 IF HIGH(datestring) > 7 THEN ***** ^ undeclared identifier ***** ^ not supported yet 50 datestring[8] := 0C; ***** ^ not supported yet ***** ^ not supported yet 51 END; 52 END DateToDataFormat; ***** ^ not supported yet 53 54 PROCEDURE GetDateField(VAR alias: DBFile; fieldnum: CARDINAL; 55 VAR d: Date); 56 VAR datestr: ARRAY [0..7] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 57 BEGIN 58 GetField(alias, fieldnum, datestr); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 59 DataFormatToDate(datestr, d); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 60 END GetDateField; ***** ^ not supported yet 61 62 PROCEDURE GetLogicalField(VAR alias: DBFile; fieldnum: CARDINAL; 63 VAR l: BOOLEAN); 64 VAR lstring: ARRAY [0..1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 65 BEGIN 66 GetField(alias, fieldnum, lstring); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 67 IF (CAP(lstring[0]) = 'Y') OR (CAP(lstring[0]) = 'T') THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 68 l := TRUE 69 ELSE 70 l := FALSE 71 END; 72 END GetLogicalField; ***** ^ not supported yet 73 74 PROCEDURE GetNumField(VAR alias: DBFile; fieldnum: CARDINAL; VAR 75 n: Real8); 76 VAR nstring: ARRAY [1..MaxDigits] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 77 ok: BOOLEAN; 78 BEGIN 79 GetField(alias, fieldnum, nstring); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 80 ok:=StrToReal(nstring,0, n) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 81 END GetNumField; ***** ^ not supported yet 82 83 PROCEDURE Replace(VAR alias: DBFile; fieldnum: CARDINAL; s: ARRAY 84 OF CHAR); ***** ^ not supported yet 85 BEGIN 86 ModBase3.Replace(alias,fieldnum,s); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 87 END Replace; ***** ^ not supported yet 88 89 PROCEDURE ReplaceD(VAR alias: DBFile; fieldnum: CARDINAL; d: 90 Date); 91 VAR dstring: ARRAY [0..9] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 92 BEGIN 93 DateToDataFormat(d, dstring); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 94 Replace(alias, fieldnum, dstring); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 END ReplaceD; ***** ^ not supported yet 96 97 PROCEDURE ReplaceL(VAR alias: DBFile; fieldnum: CARDINAL; l: 98 BOOLEAN); 99 VAR lchar: ARRAY [0..0] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 100 BEGIN 101 IF l THEN 102 lchar[0] := 'T' ***** ^ not supported yet ***** ^ not supported yet 103 ELSE 104 lchar[0] := 'F' ***** ^ not supported yet ***** ^ not supported yet 105 END; 106 Replace( alias, fieldnum, lchar ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 107 END ReplaceL; ***** ^ not supported yet 108 109 PROCEDURE ReplaceN(VAR alias: DBFile; fieldnum: CARDINAL; n: 110 Real8); 111 VAR nstring: ARRAY [0..MaxDigits] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 112 fldptr:DBFieldPtr; 113 BEGIN 114 fldptr:=FieldList(alias); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 WITH fldptr^[fieldnum] DO ***** ^ not supported yet ***** ^ not supported yet 116 IF decplaces=0 THEN ***** ^ undeclared identifier 117 RealToStr(n, decplaces, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 118 size+1, nstring);(* assumes that Real to str will insert '.' *) ***** ^ undeclared identifier ***** ^ not supported yet 119 nstring[size]:=0C; ***** ^ not supported yet ***** ^ undeclared identifier 120 ELSE 121 RealToStr(n, decplaces, ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 122 size, nstring); ***** ^ undeclared identifier ***** ^ not supported yet 123 END (* IF decplaces=0 *); 124 Replace(alias, fieldnum, nstring); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 125 END (* With *); ***** ^ not supported yet 126 END ReplaceN; ***** ^ not supported yet 127 128 END DBFields. ***** ^ not supported yet 179 errors