Listing: 1 2 IMPLEMENTATION MODULE ModBase3; 3 4 (* 5 * ModBase 6 * Release 3.0 7 * (c) Copyright 1986 - 1991 Donald G. Fletcher 8 * (c) Copyright 1986 - 1991 PMI 9 * P.O. Box 8402 10 * Green Bay Wi 53308 11 * All Rights Reserved 12 * August 6, 1987 - modifications to use Logitech 3.0 13 *) 14 15 (* This Module exports a type called DBFile which contains 16 pertinent information concerning the structure of the dBase 17 file. All operations on a dBase data file must specify this 18 parameter usually as an "alias" using the first 2 or 3 letters 19 of the dBase Filename. Date of Last Modification: April 16, 20 1987. Repertoire Input Output routines used. 21 *) 22 23 (* 5/11/88 added safety to modbase; if TRUE file integrity should 24 be preserved as long as the power doesn't fail during a write. 25 also added changes concerning memos to be finished later*) 26 27 (* 6/88 Changed to add transparent handling of memo files *) 28 29 (* 10/20/88 changes to add following: 30 Automatic updating of dbindexes 31 Made fieldlist a Pointer and only allocate as needed 32 saving quite a bit of memory 33 Added appending flag to speed append operations *) 34 (* Logitech modules*) 35 36 37 FROM M2Strings IMPORT 38 Assign,Pos; 39 40 FROM StrEdit IMPORT 41 Append; 42 43 44 FROM SYSTEM IMPORT 45 BYTE,ADDRESS, ADR, TSIZE; 46 47 (* Repertoire modules *) 48 49 IMPORT 50 EnvironUtils; 51 FROM StringIO IMPORT 52 ErrorMessage, NoError, PrintMessage; 53 54 FROM HandleIO IMPORT 55 BlockRead, BlockWrite, CloseHandle, OpenFile, SetFilePtr, 56 CreateFile,UpdateDisk, FileOffSet,GetFilePtr; 57 58 FROM LowLevel IMPORT 59 Address8086, Fill, Move, AddAddr; 60 61 FROM MiscFunctions IMPORT FieldNameChar,Alph; 62 63 FROM Numbers IMPORT 64 Min; 65 66 FROM ErrorManager IMPORT 67 WARN; 68 69 FROM VStorage IMPORT 70 DosAlloc, DosDealloc; 71 72 IMPORT Locks,FAPI; 73 IMPORT PosUtils; 74 75 PROCEDURE DEALLOCATE(VAR loc:ADDRESS;size:CARDINAL); 76 BEGIN 77 DosDealloc(loc,size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 END DEALLOCATE; ***** ^ not supported yet 79 80 PROCEDURE ALLOCATE(VAR loc:ADDRESS;size:CARDINAL); 81 BEGIN 82 DosAlloc(loc,size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 83 END ALLOCATE; ***** ^ not supported yet 84 85 86 CONST 87 Blank = " "; 88 Null = 0C; 89 EndOfHeader = 0DH; 90 HdrLenPos = 8; 91 DatePosition = 1; (* position of the first byte of the last update *) 92 RecNumLoPos = 4; 93 RecNumHiPos = 6; 94 FieldNameLength = 10; 95 InitCode =61353; 96 one=VAL( LONGINT, 1 ); ***** ^ undeclared identifier ***** ^ not supported yet 97 98 (* ************************* EXPORTED PROCEDURES **************************) 99 TYPE 100 101 DBFileRec = 102 RECORD 103 fileID, 104 MemoHandle: CARDINAL; 105 open, 106 MemoOpen, 107 (* will open only if accessed *) 108 Safety: BOOLEAN; 109 (* if true keeps disk up to date *) 110 autolock, 111 exclusive, 112 appending, 113 hasmemo: BOOLEAN; 114 recordmode:RecordModeType; ***** ^ undeclared identifier 115 fixup:FixUpProcedure; ***** ^ undeclared identifier 116 ErrorCode, 117 Init, 118 numberoffields: CARDINAL; 119 lastupdate: ARRAY[0..2] OF CARDINAL; ***** ^ not supported yet ***** ^ not supported yet 120 length: CARDINAL; (* of records in BYTES *) 121 fieldlist: DBFieldPtr; ***** ^ undeclared identifier 122 numofrecords: LONGINT; 123 currentrecnum: LONGINT; 124 headerlength: CARDINAL; 125 ReReadPtr,SavePtr,currentrec,BufferPtr: POINTER TO ARRAY 126 [1..MaxRecLength] OF CHAR; ***** ^ undeclared identifier ***** ^ not supported yet 127 name, 128 MemoName: ARRAY [0..NameLen] OF CHAR; ***** ^ undeclared identifier ***** ^ not supported yet 129 dbbuffer : ADDRESS; 130 buffersize, (* requested size *) 131 size : CARDINAL; (* size of buffer in bytes *) 132 start : LONGINT; (* first record number *) 133 MaxRecords, NumRecords : CARDINAL; 134 IndexList:ADDRESS; 135 END; ***** ^ not supported yet 136 DBFile=POINTER TO DBFileRec; ***** ^ not supported yet 137 138 PROCEDURE DBError( alias:DBFile):CARDINAL; 139 BEGIN 140 RETURN alias^.ErrorCode; ***** ^ not supported yet ***** ^ not supported yet 141 END DBError; ***** ^ not supported yet 142 143 PROCEDURE FileName(alias:DBFile;VAR Name:ARRAY OF CHAR); ***** ^ not supported yet 144 BEGIN 145 Assign(alias^.name,Name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 146 END FileName; ***** ^ not supported yet 147 148 PROCEDURE SafetySet(alias:DBFile):BOOLEAN; 149 BEGIN 150 RETURN alias^.Safety; ***** ^ not supported yet ***** ^ not supported yet 151 END SafetySet; ***** ^ not supported yet 152 153 PROCEDURE RecordLength(alias:DBFile):CARDINAL; 154 BEGIN 155 RETURN alias^.length; ***** ^ not supported yet ***** ^ not supported yet 156 END RecordLength; ***** ^ not supported yet 157 158 PROCEDURE HasMemo(alias:DBFile):BOOLEAN; 159 BEGIN 160 RETURN alias^.hasmemo; ***** ^ not supported yet ***** ^ not supported yet 161 END HasMemo; ***** ^ not supported yet 162 163 PROCEDURE NumberOfFields(alias:DBFile):CARDINAL; 164 BEGIN 165 RETURN alias^.numberoffields; ***** ^ not supported yet ***** ^ not supported yet 166 END NumberOfFields; ***** ^ not supported yet 167 168 PROCEDURE Appending(alias:DBFile):BOOLEAN; 169 BEGIN 170 RETURN alias^.appending; ***** ^ not supported yet ***** ^ not supported yet 171 END Appending; ***** ^ not supported yet 172 173 PROCEDURE RecordPtr(alias:DBFile):ADDRESS; 174 BEGIN 175 RETURN alias^.currentrec; ***** ^ not supported yet ***** ^ not supported yet 176 END RecordPtr; ***** ^ not supported yet 177 178 PROCEDURE IndexList(alias:DBFile):ADDRESS; 179 BEGIN 180 RETURN alias^.IndexList; ***** ^ not supported yet ***** ^ not supported yet 181 END IndexList; ***** ^ not supported yet 182 183 PROCEDURE SetIndexList(alias:DBFile;ndx:ADDRESS); 184 BEGIN 185 alias^.IndexList:=ndx; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 186 END SetIndexList; ***** ^ not supported yet 187 188 PROCEDURE Record(alias:DBFile):LONGINT; 189 BEGIN 190 RETURN alias^.currentrecnum; ***** ^ not supported yet ***** ^ not supported yet 191 END Record; ***** ^ not supported yet 192 193 PROCEDURE FieldList(alias:DBFile):DBFieldPtr; ***** ^ undeclared identifier 194 BEGIN 195 RETURN alias^.fieldlist; ***** ^ not supported yet ***** ^ not supported yet 196 END FieldList; ***** ^ not supported yet 197 198 PROCEDURE BufferSize(alias:DBFile):CARDINAL; 199 BEGIN 200 RETURN alias^.buffersize; ***** ^ not supported yet ***** ^ not supported yet 201 END BufferSize; ***** ^ not supported yet 202 203 PROCEDURE NumberRecords(alias:DBFile):LONGINT; 204 BEGIN 205 IF NOT alias^.exclusive THEN ***** ^ not supported yet ***** ^ not supported yet 206 SetFilePtr( alias^.fileID, FromStart, VAL(LONGINT,4 )); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 207 PrintMessage(Locks.ReadRetry( alias^.fileID, ADR(alias^.numofrecords), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 208 4,10,alias^.name )); ***** ^ not supported yet ***** ^ not supported yet 209 END; 210 RETURN alias^.numofrecords; ***** ^ not supported yet ***** ^ not supported yet 211 END NumberRecords; ***** ^ not supported yet 212 213 PROCEDURE InitDBF(filename: ARRAY OF CHAR; VAR alias: ***** ^ not supported yet 214 DBFile; BufferSize:CARDINAL; safety,Exclusive,AutoLock:BOOLEAN; 215 FixUp:FixUpProcedure ); ***** ^ undeclared identifier 216 217 218 BEGIN 219 NEW(alias); ***** ^ undeclared identifier ***** ^ not supported yet 220 IF Exclusive THEN 221 AutoLock:= FALSE 222 END; 223 WITH alias^ DO ***** ^ not supported yet 224 open:=FALSE; ***** ^ undeclared identifier 225 exclusive:=Exclusive OR Locks.ExclusiveOnly; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 226 autolock:=AutoLock; ***** ^ undeclared identifier 227 fixup:=FixUp; ***** ^ undeclared identifier ***** ^ not supported yet 228 MemoOpen:=FALSE; ***** ^ undeclared identifier 229 Safety:=safety; ***** ^ undeclared identifier 230 Init:=InitCode; ***** ^ undeclared identifier 231 Assign(filename,name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 232 fieldlist:=NIL; ***** ^ undeclared identifier 233 currentrec:=NIL; ***** ^ undeclared identifier 234 BufferPtr:=NIL; ***** ^ undeclared identifier 235 SavePtr:=NIL; ***** ^ undeclared identifier 236 ReReadPtr:=NIL; ***** ^ undeclared identifier 237 dbbuffer:=NIL; ***** ^ undeclared identifier 238 IndexList:=NIL; ***** ^ not supported yet 239 size:=0; ***** ^ undeclared identifier 240 buffersize:=BufferSize; ***** ^ undeclared identifier 241 recordmode:=CurrentRec; ***** ^ undeclared identifier ***** ^ undeclared identifier 242 END; ***** ^ not supported yet 243 244 END InitDBF; ***** ^ not supported yet 245 246 PROCEDURE NilDBF(VAR alias:DBFile); 247 BEGIN 248 alias:=NIL; ***** ^ not supported yet 249 END NilDBF; ***** ^ not supported yet 250 251 PROCEDURE Initialized(alias:DBFile):BOOLEAN; 252 BEGIN 253 IF alias=NIL THEN RETURN FALSE END; ***** ^ not supported yet 254 IF alias^.Init=InitCode THEN ***** ^ not supported yet ***** ^ not supported yet 255 RETURN TRUE 256 END; 257 RETURN FALSE; 258 END Initialized; ***** ^ not supported yet 259 260 PROCEDURE DisposeDBF(VAR alias:DBFile); 261 BEGIN 262 IF alias=NIL THEN RETURN END; ***** ^ not supported yet 263 IF alias^.open THEN CloseDBF(alias) END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 264 DISPOSE(alias); ***** ^ undeclared identifier ***** ^ not supported yet 265 END DisposeDBF; ***** ^ not supported yet 266 267 PROCEDURE OpenMemo(alias:DBFile):BOOLEAN; 268 BEGIN 269 IF alias^.MemoOpen THEN RETURN TRUE END; ***** ^ not supported yet ***** ^ not supported yet 270 alias^.MemoOpen:=OpenFile(alias^.MemoHandle,alias^.MemoName)=0; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 271 RETURN alias^.MemoOpen; ***** ^ not supported yet ***** ^ not supported yet 272 END OpenMemo; ***** ^ not supported yet 273 274 PROCEDURE MemoHandle(alias:DBFile):CARDINAL; 275 BEGIN 276 RETURN alias^.MemoHandle; ***** ^ not supported yet ***** ^ not supported yet 277 END MemoHandle; ***** ^ not supported yet 278 279 PROCEDURE SetDBSafetyOn( alias: DBFile); 280 BEGIN 281 UpdateDBFile(alias); ***** ^ undeclared identifier ***** ^ not supported yet 282 alias^.Safety:=TRUE; ***** ^ not supported yet ***** ^ not supported yet 283 END SetDBSafetyOn; ***** ^ not supported yet 284 285 PROCEDURE SetDBSafetyOff( alias: DBFile); 286 BEGIN 287 alias^.Safety:=FALSE; ***** ^ not supported yet ***** ^ not supported yet 288 END SetDBSafetyOff; ***** ^ not supported yet 289 290 PROCEDURE SetRecordMode(alias: DBFile;Mode:RecordModeType); ***** ^ undeclared identifier 291 BEGIN 292 IF alias^.recordmode=Mode THEN RETURN END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 293 IF alias^.recordmode=CurrentRec ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 294 THEN 295 alias^.SavePtr:=alias^.currentrec; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 296 END; 297 CASE Mode OF ***** ^ not supported yet 298 CurrentRec: alias^.currentrec:=alias^.SavePtr; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 299 |Buffer: alias^.currentrec:=alias^.BufferPtr; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 300 |ReRead: alias^.currentrec:=alias^.ReReadPtr ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 301 END; 302 alias^.recordmode:=Mode; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 303 END SetRecordMode; ***** ^ not supported yet 304 305 306 PROCEDURE OpenDBF 307 (alias : DBFile ):BOOLEAN; 308 309 310 VAR 311 firstbyte : CHAR; 312 i :CARDINAL; 313 ActionTaken:CARDINAL; 314 filemode:BITSET; ***** ^ undeclared identifier 315 316 317 318 PROCEDURE MakeDBFile; 319 320 VAR 321 dbh : ARRAY[ 0 .. MaxHeaderLen - 1 ] OF CHAR; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 322 323 324 PROCEDURE ReadDBHeader; 325 (* HeaderLength must always be 32n+2 where n is a number equal to one 326 more than the number of fields in the record *) 327 328 BEGIN 329 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, HdrLenPos ) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 330 PrintMessage( Locks.ReadRetry( alias^.fileID, ADR( alias^.headerlength ), 2 , ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 331 10,alias^.name)); ***** ^ not supported yet ***** ^ not supported yet 332 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, 0 ) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 333 PrintMessage(Locks.ReadRetry( alias^.fileID, ADR( dbh ), alias^.headerlength, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 334 10,alias^.name )); ***** ^ not supported yet ***** ^ not supported yet 335 END ReadDBHeader; ***** ^ not supported yet 336 337 338 PROCEDURE GetLastUpdate; 339 340 VAR 341 i : CARDINAL; 342 343 BEGIN 344 FOR i := 0 TO 2 DO 345 alias^.lastupdate[i] := ORD( dbh[1 + i] ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 346 END; (* for *) 347 END GetLastUpdate; ***** ^ not supported yet 348 349 350 PROCEDURE GetNumberOfRecords; 351 352 BEGIN 353 Move( ADR( dbh[4] ), ADR( alias^.numofrecords ), 4 ) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 354 END GetNumberOfRecords; ***** ^ not supported yet 355 356 357 PROCEDURE GetHeaderLength; 358 359 BEGIN 360 alias^.headerlength := ( ORD( dbh[9] ) * 100H ) + ORD( dbh[8] ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 361 END GetHeaderLength; ***** ^ not supported yet 362 363 364 PROCEDURE GetRecordLength; 365 366 BEGIN 367 alias^.length := ( ORD( dbh[11] ) * 100H ) + ORD( dbh[10] ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 368 END GetRecordLength; ***** ^ not supported yet 369 370 371 PROCEDURE GetFieldList; 372 373 VAR 374 j, 375 k, 376 fieldindex : CARDINAL; 377 finished : BOOLEAN; 378 379 380 PROCEDURE InitFieldList; 381 382 BEGIN 383 FOR j := 1 TO alias^.numberoffields DO ***** ^ not supported yet ***** ^ not supported yet 384 Fill( ADR( alias^.fieldlist^[j].name ), FieldNameLength, 0C ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 385 alias^.fieldlist^[j].fldtype := " "; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 386 alias^.fieldlist^[j].size := 0; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 387 alias^.fieldlist^[j].decplaces := 0; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 388 alias^.fieldlist^[j].offset := 0; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 389 (* index position in CurrentRecord *) 390 END; (* FOR *) 391 END InitFieldList; ***** ^ not supported yet 392 393 BEGIN 394 alias^.numberoffields:= (alias^.headerlength DIV 32)-1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 395 ALLOCATE(alias^.fieldlist, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 396 (TSIZE(DBFieldArray)DIV MaxField)*(alias^.numberoffields)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 397 InitFieldList; ***** ^ not supported yet 398 alias^.fieldlist^[1].offset := 2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 399 finished := FALSE; 400 FOR j:=1 TO alias^.numberoffields DO ***** ^ not supported yet ***** ^ not supported yet 401 fieldindex := ( j - 1 ) * 32; 402 k := 0; 403 Move( ADR( dbh[32 + fieldindex] ), ADR( alias^.fieldlist^[j].name ), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 404 FieldNameLength ); ***** ^ not supported yet 405 alias^.fieldlist^[j].fldtype := dbh[43 + fieldindex]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 406 alias^.fieldlist^[j].size := ORD( dbh[48 + fieldindex] ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 407 (* Get fieldsize *) 408 alias^.fieldlist^[j].decplaces := ORD( dbh[49 + fieldindex] ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 409 (* Get number of decimal places *) 410 IF j > 1 411 THEN 412 alias^.fieldlist^[j].offset := alias^.fieldlist^[j - 1].offset + ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 413 alias^.fieldlist^[j - 1].size; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 414 END; (* IF *) 415 END; (* for *) 416 END GetFieldList; ***** ^ not supported yet 417 418 BEGIN (* MakeDBFile *) 419 ReadDBHeader; ***** ^ not supported yet 420 (* Fill out the Record *) 421 GetNumberOfRecords; ***** ^ not supported yet 422 GetLastUpdate; ***** ^ not supported yet 423 GetRecordLength; ***** ^ not supported yet 424 GetHeaderLength; ***** ^ not supported yet 425 GetFieldList; ***** ^ not supported yet 426 END MakeDBFile; ***** ^ not supported yet 427 428 (* Procedure Description -- OpendBF -- Looks up a file with the parameter 429 given as a name -- Checks to see if it is a dBaseIII type file -- 430 Creates a record of the type DBFile containing the pertinent information 431 from the header of the dBase File -- If the file is already opened it 432 does nothing *) 433 434 BEGIN (* OpenDBF *) 435 IF alias^.Init=InitCode ***** ^ not supported yet ***** ^ not supported yet 436 THEN 437 IF alias^.open ***** ^ not supported yet ***** ^ not supported yet 438 THEN 439 RETURN TRUE; 440 END; 441 ELSE 442 WARN('UnInititalized DBFile In OpenDBF'); ***** ^ not supported yet ***** ^ not supported yet 443 END; 444 IF alias^.exclusive THEN ***** ^ not supported yet ***** ^ not supported yet 445 filemode:={1,4} ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 446 ELSE 447 filemode:={1,6} (* allow all *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 448 END; 449 alias^.ErrorCode := FAPI.DOSOPEN( ADR(alias^.name), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 450 ADR(alias^.fileID), ADR(ActionTaken), VAL(LONGINT,0), FAPI.FILE_NORMAL, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 451 CARDINAL({0}), CARDINAL(filemode), VAL(LONGINT,0) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 452 453 IF alias^.ErrorCode # NoError ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 454 THEN 455 RETURN FALSE; 456 END; 457 IF (NOT alias^.exclusive) AND Locks.NoLocking(alias^.fileID) THEN ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 458 alias^.exclusive:=TRUE ***** ^ not supported yet ***** ^ not supported yet 459 END; 460 461 (* make sure the file is a dBase file *) 462 IF NoError # Locks.ReadRetry( alias^.fileID, ADR( firstbyte ), 1,10,alias^.name ) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 463 THEN 464 RETURN FALSE 465 END; 466 IF ( firstbyte = CHR( 03H ) ) ***** ^ undeclared identifier ***** ^ not supported yet 467 THEN 468 alias^.hasmemo := FALSE; ***** ^ not supported yet ***** ^ not supported yet 469 alias^.open := TRUE; ***** ^ not supported yet ***** ^ not supported yet 470 ELSIF ( firstbyte = CHR( 83H ) ) ***** ^ undeclared identifier ***** ^ not supported yet 471 THEN 472 alias^.hasmemo := TRUE; ***** ^ not supported yet ***** ^ not supported yet 473 alias^.open := TRUE; ***** ^ not supported yet ***** ^ not supported yet 474 ELSE 475 alias^.ErrorCode := CloseHandle( alias^.fileID ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 476 alias^.open := FALSE; ***** ^ not supported yet ***** ^ not supported yet 477 RETURN FALSE; 478 (* WARN( "File is not a dBase III - type file -- proc-OpenDBF3" );*) 479 END; (* IF *) 480 (* construct a dBFileDesc *) 481 IF alias^.open ***** ^ not supported yet ***** ^ not supported yet 482 THEN 483 MakeDBFile; ***** ^ not supported yet 484 IF alias^.autolock THEN ***** ^ not supported yet ***** ^ not supported yet 485 ALLOCATE( alias^.ReReadPtr, alias^.length ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 486 END; 487 ALLOCATE( alias^.currentrec, alias^.length ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 488 IF alias^.numofrecords=VAL(LONGINT,0) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 489 THEN 490 alias^.currentrecnum:=VAL(LONGINT,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 491 ELSE 492 alias^.currentrecnum:=VAL(LONGINT,1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 493 END; 494 alias^.NumRecords := 0 ; ***** ^ not supported yet ***** ^ not supported yet 495 alias^.start := VAL( LONGINT, 0 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 496 alias^.size := 0; ***** ^ not supported yet ***** ^ not supported yet 497 SetDBBuffer(alias,alias^.buffersize); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 498 IF alias^.hasmemo THEN ***** ^ not supported yet ***** ^ not supported yet 499 alias^.MemoOpen:=FALSE; ***** ^ not supported yet ***** ^ not supported yet 500 Assign(alias^.name,alias^.MemoName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 501 i:=Pos( ".", alias^.MemoName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 502 IF i<=HIGH(alias^.MemoName) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 503 alias^.MemoName[i]:=0C; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 504 END; 505 Append(alias^.MemoName,'.DBT' ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 506 END; 507 END; (* IF alias^.open *) 508 RETURN TRUE; 509 END OpenDBF; ***** ^ not supported yet 510 511 PROCEDURE SetDBBuffer(alias:DBFile ;BufferSize:CARDINAL ); 512 513 BEGIN 514 alias^.buffersize:=BufferSize; ***** ^ not supported yet ***** ^ not supported yet 515 IF alias^.open THEN ***** ^ not supported yet ***** ^ not supported yet 516 IF alias^.size#0 ***** ^ not supported yet ***** ^ not supported yet 517 THEN 518 DEALLOCATE(alias^.dbbuffer, alias^.size ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 519 END; 520 (* calculate buffer size *) 521 alias^.MaxRecords := BufferSize DIV alias^.length ; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 522 IF alias^.MaxRecords=0 ***** ^ not supported yet ***** ^ not supported yet 523 THEN 524 alias^.MaxRecords:=1; ***** ^ not supported yet ***** ^ not supported yet 525 END; 526 alias^.size := alias^.MaxRecords * ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 527 alias^.length; ***** ^ not supported yet ***** ^ not supported yet 528 529 ALLOCATE( alias^.dbbuffer, alias^.size ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 530 alias^.start:=VAL(LONGINT,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 531 alias^.NumRecords:=0; ***** ^ not supported yet ***** ^ not supported yet 532 IF alias^.numofrecords > VAL( LONGINT, 0 ) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 533 THEN 534 ReadDBRec( alias, alias^.currentrecnum ); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 535 (* read the currentrecord *) 536 ELSE 537 alias^.BufferPtr:=alias^.dbbuffer; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 538 Fill( alias^.currentrec, alias^.length, 0C ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 539 Fill( alias^.BufferPtr, alias^.length, 0C ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 540 END (* if alias^.numofrecords *); 541 END; 542 END SetDBBuffer; ***** ^ not supported yet 543 544 PROCEDURE UpdateDBHeader( alias :DBFile ); 545 VAR 546 month, 547 day, 548 year : CARDINAL; 549 datestr : ARRAY[ 1 .. 3 ] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 550 dumstr : ARRAY[ 0 .. 15 ] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 551 lock:Locks.RangeRec; ***** ^ not supported yet 552 553 BEGIN 554 IF NOT alias^.open ***** ^ not supported yet ***** ^ not supported yet 555 THEN 556 RETURN; 557 END (* if not alias^.open *); 558 IF NOT alias^.exclusive THEN ***** ^ not supported yet ***** ^ not supported yet 559 lock.FileOffset := VAL( LONGINT,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 560 lock.RangeLength:=VAL(LONGINT,32); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 561 alias^.ErrorCode:=Locks.LockRetry(alias^.fileID,lock,10,alias^.name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 562 IF alias^.ErrorCode#0 THEN WARN('Unable to lock in UpdateDBHeader') END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 563 END; 564 EnvironUtils.GetDate( month, day, year, dumstr, dumstr ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 565 alias^.numofrecords := NumberRecords(alias); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 566 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, DatePosition ) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 567 datestr[1] := CHR( year MOD 100 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 568 datestr[2] := CHR( month ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 569 datestr[3] := CHR( day ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 570 alias^.ErrorCode := BlockWrite( alias^.fileID, ADR( datestr ), 3 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 571 alias^.ErrorCode := BlockWrite( alias^.fileID, ADR( alias^.numofrecords ), 4 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 572 alias^.ErrorCode := BlockWrite( alias^.fileID, ADR( alias^.headerlength ), 2 ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 573 IF NOT alias^.exclusive THEN ***** ^ not supported yet ***** ^ not supported yet 574 alias^.ErrorCode:=Locks.UnLock(alias^.fileID,lock); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 575 IF alias^.ErrorCode#0 THEN WARN('Unable to Unlock in UpdateDBHeader') END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 576 END; 577 578 END UpdateDBHeader; ***** ^ not supported yet 579 580 PROCEDURE UpdateDBFile(alias :DBFile); 581 582 BEGIN 583 IF alias^.open ***** ^ not supported yet ***** ^ not supported yet 584 THEN 585 UpdateDBHeader(alias); ***** ^ not supported yet ***** ^ not supported yet 586 UpdateDisk(alias^.fileID); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 587 IF alias^.MemoOpen ***** ^ not supported yet ***** ^ not supported yet 588 THEN 589 UpdateDisk(alias^.MemoHandle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 590 END; 591 END; 592 END UpdateDBFile; ***** ^ not supported yet 593 594 PROCEDURE CloseDBF 595 ( alias : DBFile ); 596 (* updates the header and closes the file *) 597 598 BEGIN 599 IF alias = NIL THEN ***** ^ not supported yet 600 RETURN 601 END; 602 IF NOT alias^.open ***** ^ not supported yet ***** ^ not supported yet 603 THEN 604 RETURN; 605 END (* if not alias^.open *); 606 UpdateDBHeader(alias); ***** ^ not supported yet ***** ^ not supported yet 607 DEALLOCATE(alias^.fieldlist, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 608 (TSIZE(DBFieldArray)DIV MaxField)*(alias^.numberoffields)); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 609 DEALLOCATE( alias^.dbbuffer, alias^.size ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 610 DEALLOCATE( alias^.currentrec, alias^.length ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 611 IF alias^.autolock THEN ***** ^ not supported yet ***** ^ not supported yet 612 DEALLOCATE( alias^.ReReadPtr, alias^.length ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 613 END; 614 alias^.ErrorCode := CloseHandle( alias^.fileID ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 615 IF alias^.MemoOpen ***** ^ not supported yet ***** ^ not supported yet 616 THEN 617 alias^.ErrorCode := CloseHandle( alias^.MemoHandle ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 618 alias^.MemoOpen := FALSE; ***** ^ not supported yet ***** ^ not supported yet 619 END; 620 alias^.open := FALSE; ***** ^ not supported yet ***** ^ not supported yet 621 END CloseDBF; ***** ^ not supported yet 622 623 (*$O- *) 624 625 PROCEDURE ReadDBRec 626 (alias : DBFile; 627 recnum : LONGINT ); 628 (* deposits the fetched string in the currentrec field of alias *) 629 CONST 630 one=VAL( LONGINT, 1 ); ***** ^ undeclared identifier ***** ^ not supported yet 631 632 VAR 633 recordpos : LONGINT; 634 i, 635 temp :CARDINAL; 636 long1,long2 :LONGINT; 637 test :BOOLEAN; 638 639 BEGIN 640 IF NOT alias^.open ***** ^ not supported yet ***** ^ not supported yet 641 THEN (* check to make sure the file is open *) 642 WARN('DBF file not open in ReadDBFile'); ***** ^ not supported yet ***** ^ not supported yet 643 END; 644 alias^.appending:=FALSE; ***** ^ not supported yet ***** ^ not supported yet 645 (* compiler bug forced braking down *) 646 long1:= recnum - alias^.start; ***** ^ not supported yet ***** ^ not supported yet 647 long2:=VAL(LONGINT,alias^.NumRecords) - VAL(LONGINT,1); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 648 test:=(long1 > 649 long2 ); 650 IF ( long1 alias^.numofrecords ) OR ***** ^ not supported yet ***** ^ not supported yet 653 (recnum=VAL(LONGINT,0)) ***** ^ undeclared identifier ***** ^ not supported yet 654 THEN 655 WARN( "Record number out of range in ReadDBRec" ) ***** ^ not supported yet ***** ^ not supported yet 656 END; (* IF *) 657 IF VAL(LONGINT,alias^.MaxRecords) > alias^.numofrecords ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 658 THEN (* underflow *) 659 alias^.start := one; ***** ^ not supported yet ***** ^ not supported yet 660 alias^.NumRecords := VAL(CARDINAL,alias^.numofrecords); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 661 ELSE 662 alias^.NumRecords := alias^.MaxRecords; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 663 IF recnum < alias^.start ***** ^ not supported yet ***** ^ not supported yet 664 THEN (* currec at top going down *) 665 IF recnum > VAL(LONGINT,alias^.MaxRecords) ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 666 THEN 667 alias^.start := recnum - VAL(LONGINT,alias^.MaxRecords) + one; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 668 (* 2 to give 1 overlap ??*) 669 ELSE 670 alias^.start := one; ***** ^ not supported yet ***** ^ not supported yet 671 END (* if recnum *); 672 ELSE (* recnum at bottom going up*) 673 IF ( recnum + VAL(LONGINT,alias^.MaxRecords) - one ) > ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 674 alias^.numofrecords ***** ^ not supported yet ***** ^ not supported yet 675 THEN 676 alias^.start := alias^.numofrecords - VAL(LONGINT,alias^.MaxRecords) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 677 + one; 678 ELSE 679 alias^.start := recnum; ***** ^ not supported yet ***** ^ not supported yet 680 END ; 681 END ; 682 END; 683 recordpos := ( alias^.start - one ) * ***** ^ not supported yet ***** ^ not supported yet 684 VAL( LONGINT,alias^.length ) + VAL( LONGINT, alias^.headerlength ); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 685 SetFilePtr( alias^.fileID, FromStart, VAL( LONGINT, recordpos ) ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet 686 PrintMessage( Locks.ReadRetry( alias^.fileID, alias^.dbbuffer , ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 687 alias^.length * alias^.NumRecords ,10,alias^.name )); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 688 END (* if *); 689 recordpos:=recnum - alias^.start; ***** ^ not supported yet ***** ^ not supported yet 690 i:=VAL( CARDINAL, recordpos ); ***** ^ undeclared identifier ***** ^ not supported yet 691 temp:=alias^.length * i; ***** ^ not supported yet ***** ^ not supported yet 692 alias^.BufferPtr := AddAddr( alias^.dbbuffer, temp); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 693 (* Make copy of buffer *) 694 Move(alias^.BufferPtr,alias^.currentrec,alias^.length); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 695 696 alias^.currentrecnum := recnum; ***** ^ not supported yet ***** ^ not supported yet 697 alias^.appending:=FALSE; ***** ^ not supported yet ***** ^ not supported yet 698 END ReadDBRec;(*$O= *) ***** ^ not supported yet 699 700 PROCEDURE CompareBlock( adr1,adr2:ADDRESS;size:CARDINAL):CARDINAL; 701 VAR 702 count:CARDINAL; 703 p1,p2:Address8086; 704 BEGIN 705 count:=0; 706 p1.a:=adr1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 707 p2.a:=adr2; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 708 WHILE count 0 ) ***** ^ not supported yet ***** ^ not supported yet 830 THEN 831 WITH alias^.fieldlist^[fieldnumber] DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 832 limit := Min( HIGH( field )+1, size ); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier 833 Move( ADR( alias^.currentrec^[ offset] ), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier 834 ADR( field ), limit ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 835 END; ***** ^ not supported yet 836 IF ( limit <= HIGH( field ) ) ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier 837 THEN 838 field[limit] := 0C ***** ^ undeclared identifier ***** ^ undeclared identifier 839 END (* if *); 840 ELSE 841 WARN('Ilegal field number in GetField'); ***** ^ not supported yet ***** ^ not supported yet 842 END; (* IF *) 843 END GetField; ***** ^ not supported yet 844 845 PROCEDURE Replace(alias: DBFile; fieldnumber: CARDINAL; 846 field: ARRAY OF CHAR); ***** ^ not supported yet 847 VAR j, k: CARDINAL; 848 EndOfStr: BOOLEAN; 849 BEGIN 850 EndOfStr := FALSE; 851 k := 0; 852 WITH alias^.fieldlist^[fieldnumber] DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 853 FOR j := (offset) TO ***** ^ undeclared identifier 854 (offset ***** ^ undeclared identifier 855 + size - 1) DO ***** ^ undeclared identifier ***** ^ FOR needs integer variable and bounds 856 IF NOT EndOfStr THEN 857 IF (k <= HIGH(field)) AND (field[k] # 0C) THEN ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 858 alias^.currentrec^[j] := field[k]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 859 ELSE 860 EndOfStr := TRUE; 861 alias^.currentrec^[j] := ' '; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 862 END; 863 ELSE 864 alias^.currentrec^[j] := ' '; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 865 END; 866 INC(k); ***** ^ undeclared identifier ***** ^ not supported yet 867 END; (* FOR *) 868 END; ***** ^ not supported yet 869 END Replace; ***** ^ not supported yet 870 871 PROCEDURE PosOfField(alias: DBFile; fieldname: ARRAY OF CHAR): CARDINAL; ***** ^ not supported yet 872 VAR i: CARDINAL; 873 BEGIN 874 i := 1; 875 (* field names are null terminated *) 876 WHILE (i <= alias^.numberoffields) AND (NOT PosUtils.Equal(fieldname, ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 877 878 alias^.fieldlist^[i].name)) DO ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 879 INC(i); ***** ^ undeclared identifier ***** ^ not supported yet 880 END; 881 IF i > alias^.numberoffields THEN ***** ^ not supported yet ***** ^ not supported yet 882 i := 0; 883 END; 884 RETURN i; 885 END PosOfField; ***** ^ not supported yet 886 887 (* $O- *) 888 889 PROCEDURE AppendBlank 890 ( alias : DBFile ); 891 892 893 BEGIN 894 IF NOT alias^.open ***** ^ not supported yet ***** ^ not supported yet 895 THEN (* check to make sure the file is open *) 896 WARN('DBFile not open in Append Blank'); ***** ^ not supported yet ***** ^ not supported yet 897 END; 898 (* set buffer values *) 899 alias^.appending:=TRUE; ***** ^ not supported yet ***** ^ not supported yet 900 alias^.NumRecords:=1; ***** ^ not supported yet ***** ^ not supported yet 901 alias^.BufferPtr:=alias^.dbbuffer; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 902 alias^.currentrecnum:=MAX(LONGINT); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 903 (* Write Recordsize number of blanks *) 904 Fill( alias^.currentrec, alias^.length, Blank ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 905 END AppendBlank; ***** ^ not supported yet 906 907 (* $O= *) 908 909 910 PROCEDURE DeleteRecord 911 ( alias : DBFile ); 912 913 BEGIN 914 alias^.currentrec^[1] := '*'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 915 WriteDBRec( alias ); ***** ^ not supported yet ***** ^ not supported yet 916 END DeleteRecord; ***** ^ not supported yet 917 918 919 PROCEDURE UnDeleteRecord 920 ( alias : DBFile ); 921 922 BEGIN 923 alias^.currentrec^[1] := Blank; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 924 WriteDBRec( alias ); ***** ^ not supported yet ***** ^ not supported yet 925 END UnDeleteRecord; ***** ^ not supported yet 926 927 928 PROCEDURE Deleted 929 ( alias : DBFile ) : BOOLEAN; 930 931 BEGIN 932 RETURN alias^.currentrec^[1] = '*'; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 933 END Deleted; ***** ^ not supported yet 934 935 PROCEDURE LockRec(alias: DBFile;recnum:LONGINT):CARDINAL; 936 VAR 937 lock:Locks.RangeRec; ***** ^ not supported yet 938 BEGIN 939 lock.FileOffset := ( recnum -one) * ***** ^ not supported yet ***** ^ not supported yet 940 VAL( LONGINT,alias^.length ) + VAL( LONGINT, alias^.headerlength ); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 941 lock.RangeLength:=VAL(LONGINT,alias^.length); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 942 RETURN Locks.LockRetry(alias^.fileID,lock,10,alias^.name); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 943 END LockRec; ***** ^ not supported yet 944 945 PROCEDURE UnLockRec(alias: DBFile;recnum:LONGINT):CARDINAL; 946 VAR 947 lock:Locks.RangeRec; ***** ^ not supported yet 948 BEGIN 949 lock.FileOffset := ( recnum -one) * ***** ^ not supported yet ***** ^ not supported yet 950 VAL( LONGINT,alias^.length ) + VAL( LONGINT, alias^.headerlength ); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 951 lock.RangeLength:=VAL(LONGINT,alias^.length); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 952 RETURN Locks.UnLock(alias^.fileID,lock); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 953 END UnLockRec; ***** ^ not supported yet 954 955 PROCEDURE InitMemo(handle:CARDINAL) ; 956 VAR 957 buf:ARRAY[0..511] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 958 i :CARDINAL; 959 BEGIN 960 FOR i:=1 TO 511 DO 961 buf[i]:=0C; ***** ^ not supported yet ***** ^ not supported yet 962 END (* for *); 963 buf[0]:=1C; ***** ^ not supported yet ***** ^ not supported yet 964 PrintMessage(BlockWrite(handle,ADR(buf),512)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 965 END InitMemo; ***** ^ not supported yet 966 967 968 PROCEDURE BuildDBF( fields: ARRAY OF 969 DBFieldDescriptor;NumFields:CARDINAL; alias: DBFile):CARDINAL; ***** ^ undeclared identifier 970 971 (* THIS PROCEDURE WILL SILENTLY OVERWRITE ANY FILE WITH THE 972 SAME NAME AS filename -- When used in a program, the 973 existing files must be checked and an appropriate warning 974 should be given. *) 975 (* THIS PROCEDURE DOES NOT CLOSE THE CREATED FILE -- CloseDBF 976 must be called to close the file *) 977 (* The procedure is to read each field descriptor in the 978 array until an illegal name (ie. any name that doesn't 979 begin with a letter) is encountered) *) 980 (* NOTE THAT FIELDNAMES IN DBASE3 ARE PADDED WITH 0C *) 981 982 VAR month, day, year, i, j, 983 ActionTaken, offset: CARDINAL; 984 dumstr, zstr: ARRAY [1..50] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 985 (* zstr is initialized to nulls (0C) and used with 986 HandleIO.BlockWrite to write blanks to the 987 file *) 988 tmpchar: CHAR; (* used to write CHAR values with BlockWrite *) 989 filemode:BITSET; ***** ^ undeclared identifier 990 longtmp: LONGINT; (* used to avoid Function Type Coercion *) 991 BEGIN 992 IF alias^.Init#InitCode ***** ^ not supported yet ***** ^ not supported yet 993 THEN 994 WARN('Unitalized DBF in DBCreate') ***** ^ not supported yet ***** ^ not supported yet 995 END; 996 alias^.exclusive:=TRUE; ***** ^ not supported yet ***** ^ not supported yet 997 alias^.hasmemo := FALSE; ***** ^ not supported yet ***** ^ not supported yet 998 alias^.length := 1; (* even with no fields, the length is 1 *) ***** ^ not supported yet ***** ^ not supported yet 999 alias^.headerlength := 0; ***** ^ not supported yet ***** ^ not supported yet 1000 alias^.numofrecords := VAL(LONGINT,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1001 alias^.currentrecnum:= VAL(LONGINT,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1002 alias^.open := TRUE; ***** ^ not supported yet ***** ^ not supported yet 1003 EnvironUtils.GetDate( month, day, year, dumstr, dumstr ); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1004 (* open exclusive *) 1005 (* create if the file does not exist; truncate if it does exist *) 1006 IF alias^.exclusive THEN ***** ^ not supported yet ***** ^ not supported yet 1007 filemode:={1,4} ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1008 ELSE 1009 filemode:={1,6} (* allow all *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1010 END; 1011 alias^.ErrorCode := FAPI.DOSOPEN( ADR(alias^.name), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1012 ADR(alias^.fileID), ADR(ActionTaken), VAL(LONGINT,0), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 1013 FAPI.FILE_NORMAL, CARDINAL({1,4}), CARDINAL(filemode), ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1014 VAL(LONGINT,0) ); ***** ^ undeclared identifier ***** ^ not supported yet 1015 IF alias^.ErrorCode#0 THEN RETURN alias^.ErrorCode END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1016 Fill(ADR(zstr),HIGH(zstr), 0C); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 1017 alias^.ErrorCode := BlockWrite(alias^.fileID, ADR(zstr),32); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 1018 (* Initialize the first 32 bytes of the header structure *) 1019 i := 0; 1020 offset := 2; 1021 WHILE (i <= HIGH(fields)) AND ***** ^ undeclared identifier ***** ^ not supported yet 1022 (i