Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * TopSpeed Modula-2 Interface for BTRIEVE - Supports TopSpeed Extender * 5 * Public Domain - May be used without restriction * 6 * * 7 *--------------------------------------------------------------------------*) 8 IMPLEMENTATION MODULE TSBTRV; 9 IMPORT SYSTEM,Lib,Str; 10 (*%T _XTD*) 11 IMPORT TSXLIB; 12 (*%E*) 13 14 (****************************************************************************) 15 16 17 PROCEDURE BTRV1(fn : CARDINAL); 18 VAR 19 NullControl : FileControlBlock; ***** ^ undeclared identifier 20 NullBuffer : LONGCARD; ***** ^ undeclared identifier 21 NullBufferSize : CARDINAL; 22 NullKey : KeyType; ***** ^ undeclared identifier 23 BEGIN 24 NullBufferSize := SIZE(NullBuffer); ***** ^ undeclared identifier ***** ^ not supported yet 25 StatusCode := BTRV(fn,NullControl,NullBuffer,NullBufferSize,NullKey,0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 26 END BTRV1; ***** ^ not supported yet 27 28 PROCEDURE BTRV2(fn : CARDINAL;VAR FileControl : FileControlBlock); ***** ^ undeclared identifier 29 VAR 30 NullBuffer : LONGCARD; ***** ^ undeclared identifier 31 NullBufferSize : CARDINAL; 32 NullKey : KeyType; ***** ^ undeclared identifier 33 BEGIN 34 NullBufferSize := SIZE(NullBuffer); ***** ^ undeclared identifier ***** ^ not supported yet 35 StatusCode := BTRV(fn,FileControl,NullBuffer,NullBufferSize,NullKey,0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 36 END BTRV2; ***** ^ not supported yet 37 38 PROCEDURE BTRV3(fn : CARDINAL;VAR FileControl : FileControlBlock;Key : SHORTCARD); ***** ^ undeclared identifier 39 VAR 40 NullBuffer : LONGCARD; ***** ^ undeclared identifier 41 NullBufferSize : CARDINAL; 42 NullKey : KeyType; ***** ^ undeclared identifier 43 BEGIN 44 NullBufferSize := SIZE(NullBuffer); ***** ^ undeclared identifier ***** ^ not supported yet 45 StatusCode := BTRV(fn,FileControl,NullBuffer,NullBufferSize,NullKey,Key); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 46 END BTRV3; ***** ^ not supported yet 47 48 PROCEDURE BTRV4(fn : CARDINAL;VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 49 VAR KeyBuffer : ARRAY OF BYTE; Key : SHORTCARD); ***** ^ undeclared identifier 50 VAR 51 NullBuffer : LONGCARD; ***** ^ undeclared identifier 52 NullBufferSize : CARDINAL; 53 BEGIN 54 NullBufferSize := SIZE(NullBuffer); ***** ^ undeclared identifier ***** ^ not supported yet 55 StatusCode := BTRV(fn,FileControl,NullBuffer,NullBufferSize,KeyBuffer,Key); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 56 END BTRV4; ***** ^ not supported yet 57 58 (****************************************************************************) 59 60 PROCEDURE AbortTransaction; 61 BEGIN 62 BTRV1(opAbortTrans); ***** ^ not supported yet ***** ^ undeclared identifier 63 END AbortTransaction; ***** ^ not supported yet 64 65 (****************************************************************************) 66 67 PROCEDURE BeginTransaction; 68 BEGIN 69 BTRV1(opBeginTrans); ***** ^ not supported yet ***** ^ undeclared identifier 70 END BeginTransaction; ***** ^ not supported yet 71 72 (****************************************************************************) 73 74 PROCEDURE ClearOwner(VAR FileControl : FileControlBlock); ***** ^ undeclared identifier 75 BEGIN 76 BTRV2(opClearOwner,FileControl); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 77 END ClearOwner; ***** ^ not supported yet 78 79 (****************************************************************************) 80 81 PROCEDURE Close(VAR FileControl : FileControlBlock); ***** ^ undeclared identifier 82 BEGIN 83 BTRV2(opClose,FileControl); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 84 END Close; ***** ^ not supported yet 85 86 (****************************************************************************) 87 88 PROCEDURE Create( VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 89 FileDescriptor : ARRAY OF BYTE; ***** ^ undeclared identifier 90 DescriptorLength : CARDINAL; 91 FileName : ARRAY OF CHAR); ***** ^ not supported yet 92 VAR 93 KeyBuffer : KeyType; ***** ^ undeclared identifier 94 BEGIN 95 Str.Copy(KeyBuffer,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 96 StatusCode := BTRV(opCreate,FileControl,FileDescriptor,DescriptorLength,KeyBuffer,0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 97 END Create; ***** ^ not supported yet 98 99 (****************************************************************************) 100 PROCEDURE DeleteRec(VAR FileControl : FileControlBlock; KeyID : SHORTCARD); ***** ^ undeclared identifier 101 BEGIN 102 BTRV3(opDelete,FileControl,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 103 END DeleteRec; ***** ^ not supported yet 104 105 (****************************************************************************) 106 107 PROCEDURE EndTransaction; 108 BEGIN 109 BTRV1(opEndTrans); ***** ^ not supported yet ***** ^ undeclared identifier 110 END EndTransaction; ***** ^ not supported yet 111 112 (****************************************************************************) 113 114 PROCEDURE Extend(VAR FileControl : FileControlBlock; FileName : ARRAY OF CHAR; ***** ^ undeclared identifier ***** ^ not supported yet 115 UseNow : BOOLEAN); 116 VAR 117 KeyBuffer : KeyType; ***** ^ undeclared identifier 118 KeyID : SHORTCARD; 119 BEGIN 120 Str.Copy(KeyBuffer,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 121 IF UseNow THEN KeyID := 255 ELSE KeyID := 0; END; 122 BTRV4(opExtend,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 123 END Extend; ***** ^ not supported yet 124 125 (****************************************************************************) 126 127 PROCEDURE FindEQ(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 128 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 129 KeyID : SHORTCARD); 130 BEGIN 131 BTRV4(opGetEQ+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 132 END FindEQ; ***** ^ not supported yet 133 134 (****************************************************************************) 135 136 PROCEDURE FindGT(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 137 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 138 KeyID : SHORTCARD); 139 BEGIN 140 BTRV4(opGetGT+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 141 END FindGT; ***** ^ not supported yet 142 143 (****************************************************************************) 144 145 PROCEDURE FindGE(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 146 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 147 KeyID : SHORTCARD); 148 BEGIN 149 BTRV4(opGetGE+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 150 END FindGE; ***** ^ not supported yet 151 152 (****************************************************************************) 153 154 PROCEDURE FindLast(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 155 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 156 KeyID : SHORTCARD); 157 BEGIN 158 BTRV4(opGetLast+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 159 END FindLast; ***** ^ not supported yet 160 161 (****************************************************************************) 162 163 PROCEDURE FindLT(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 164 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 165 KeyID : SHORTCARD); 166 BEGIN 167 BTRV4(opGetLT+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 168 END FindLT; ***** ^ not supported yet 169 170 (****************************************************************************) 171 172 PROCEDURE FindLE(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 173 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 174 KeyID : SHORTCARD); 175 BEGIN 176 BTRV4(opGetLE+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 177 END FindLE; ***** ^ not supported yet 178 179 (****************************************************************************) 180 181 PROCEDURE FindFirst(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 182 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 183 KeyID : SHORTCARD); 184 BEGIN 185 BTRV4(opGetFirst+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 186 END FindFirst; ***** ^ not supported yet 187 188 (****************************************************************************) 189 190 PROCEDURE FindNext(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 191 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 192 KeyID : SHORTCARD); 193 BEGIN 194 BTRV4(opGetNext+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 195 END FindNext; ***** ^ not supported yet 196 197 (****************************************************************************) 198 199 PROCEDURE FindPrev(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 200 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 201 KeyID : SHORTCARD); 202 BEGIN 203 BTRV4(opGetPrev+opKeyOnly,FileControl,KeyBuffer,KeyID); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 204 END FindPrev; ***** ^ not supported yet 205 206 (****************************************************************************) 207 208 PROCEDURE GetDirect(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 209 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 210 VAR BufferLength : CARDINAL; 211 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 212 KeyID : SHORTCARD); 213 BEGIN 214 StatusCode := BTRV(opGetDirect,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 215 END GetDirect; ***** ^ not supported yet 216 217 (****************************************************************************) 218 219 PROCEDURE GetDir(Drive : SHORTCARD; VAR DirName : ARRAY OF CHAR); ***** ^ not supported yet 220 VAR 221 NullControl : FileControlBlock; ***** ^ undeclared identifier 222 BEGIN 223 BTRV4(opGetDir,NullControl,DirName,Drive); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 224 END GetDir; ***** ^ not supported yet 225 226 (****************************************************************************) 227 228 PROCEDURE GetEQ(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 229 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 230 VAR BufferLength : CARDINAL; 231 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 232 KeyID : SHORTCARD); 233 BEGIN 234 StatusCode := BTRV(opGetEQ,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 235 END GetEQ; ***** ^ not supported yet 236 237 (****************************************************************************) 238 239 PROCEDURE GetGT(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 240 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 241 VAR BufferLength : CARDINAL; 242 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 243 KeyID : SHORTCARD); 244 BEGIN 245 StatusCode := BTRV(opGetGT,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 246 END GetGT; ***** ^ not supported yet 247 248 (****************************************************************************) 249 250 PROCEDURE GetGE(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 251 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 252 VAR BufferLength : CARDINAL; 253 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 254 KeyID : SHORTCARD); 255 BEGIN 256 StatusCode := BTRV(opGetGE,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 257 END GetGE; ***** ^ not supported yet 258 259 (****************************************************************************) 260 261 PROCEDURE GetLast(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 262 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 263 VAR BufferLength : CARDINAL; 264 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 265 KeyID : SHORTCARD); 266 BEGIN 267 StatusCode := BTRV(opGetLast,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 268 END GetLast; ***** ^ not supported yet 269 270 (****************************************************************************) 271 272 PROCEDURE GetLT(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 273 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 274 VAR BufferLength : CARDINAL; 275 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 276 KeyID : SHORTCARD); 277 BEGIN 278 StatusCode := BTRV(opGetLT,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 279 END GetLT; ***** ^ not supported yet 280 281 (****************************************************************************) 282 283 PROCEDURE GetLE(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 284 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 285 VAR BufferLength : CARDINAL; 286 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 287 KeyID : SHORTCARD); 288 BEGIN 289 StatusCode := BTRV(opGetLE,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 290 END GetLE; ***** ^ not supported yet 291 292 (****************************************************************************) 293 294 PROCEDURE GetFirst(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 295 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 296 VAR BufferLength : CARDINAL; 297 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 298 KeyID : SHORTCARD); 299 BEGIN 300 StatusCode := BTRV(opGetFirst,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 301 END GetFirst; ***** ^ not supported yet 302 303 (****************************************************************************) 304 305 PROCEDURE GetNext(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 306 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 307 VAR BufferLength : CARDINAL; 308 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 309 KeyID : SHORTCARD); 310 BEGIN 311 StatusCode := BTRV(opGetNext,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 312 END GetNext; ***** ^ not supported yet 313 314 (****************************************************************************) 315 316 PROCEDURE GetPosition(VAR FileControl :FileControlBlock; ***** ^ undeclared identifier 317 VAR pos : ARRAY OF BYTE); ***** ^ undeclared identifier 318 VAR BufferSize : CARDINAL; 319 NullKey : KeyType; ***** ^ undeclared identifier 320 BEGIN 321 BufferSize := SIZE(pos); ***** ^ undeclared identifier ***** ^ not supported yet 322 StatusCode := BTRV(opGetPos,FileControl,pos,BufferSize,NullKey,0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 323 END GetPosition; ***** ^ not supported yet 324 325 (****************************************************************************) 326 327 PROCEDURE GetPrev(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 328 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 329 VAR BufferLength : CARDINAL; 330 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 331 KeyID : SHORTCARD); 332 BEGIN 333 StatusCode := BTRV(opGetPrev,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 334 END GetPrev; ***** ^ not supported yet 335 336 (****************************************************************************) 337 338 PROCEDURE Insert(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 339 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 340 VAR BufferLength : CARDINAL; 341 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 342 KeyID : SHORTCARD); 343 BEGIN 344 StatusCode := BTRV(opInsert,FileControl,DataBuffer,BufferLength,KeyBuffer,KeyID); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 345 END Insert; ***** ^ not supported yet 346 347 (****************************************************************************) 348 349 PROCEDURE Open(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 350 FileName,OwnerName : ARRAY OF CHAR; ***** ^ not supported yet 351 OpenMode : SHORTCARD); 352 VAR 353 DataBuffer : ARRAY [0..7] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 354 KeyBuffer : KeyType; ***** ^ undeclared identifier 355 BufferLength : CARDINAL; 356 357 BEGIN 358 Str.Copy(KeyBuffer,FileName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 359 Str.Copy(DataBuffer,OwnerName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 360 DataBuffer[7] := 0C; ***** ^ not supported yet ***** ^ not supported yet 361 BufferLength := Str.Length(DataBuffer) + 1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 362 StatusCode := BTRV(opOpen,FileControl,DataBuffer,BufferLength, ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 363 KeyBuffer,OpenMode); ***** ^ not supported yet ***** ^ not supported yet 364 END Open; ***** ^ not supported yet 365 366 (****************************************************************************) 367 368 PROCEDURE Reset; 369 BEGIN 370 BTRV1(opReset); ***** ^ not supported yet ***** ^ undeclared identifier 371 END Reset; ***** ^ not supported yet 372 373 (****************************************************************************) 374 375 PROCEDURE SetDirectory(DirName : ARRAY OF CHAR); ***** ^ not supported yet 376 VAR 377 KeyBuffer : KeyType; ***** ^ undeclared identifier 378 NullControl : FileControlBlock; ***** ^ undeclared identifier 379 BEGIN 380 Str.Copy(KeyBuffer,DirName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 381 BTRV4(opSetDir,NullControl,KeyBuffer,0); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 382 END SetDirectory; ***** ^ not supported yet 383 384 (****************************************************************************) 385 386 PROCEDURE SetOwner(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 387 OwnerName : ARRAY OF CHAR; ***** ^ not supported yet 388 AccessMode : SHORTCARD); 389 VAR 390 DataBuffer : OwnerType; ***** ^ undeclared identifier 391 KeyBuffer : KeyType; ***** ^ undeclared identifier 392 BufferLength : CARDINAL; 393 394 BEGIN 395 Str.Copy(DataBuffer,OwnerName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 396 Str.Copy(KeyBuffer,OwnerName); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 397 DataBuffer[7] := 0C; ***** ^ not supported yet ***** ^ not supported yet 398 BufferLength := Str.Length(DataBuffer) + 1; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 399 StatusCode := BTRV(opSetOwner,FileControl,DataBuffer, ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 400 BufferLength,KeyBuffer,AccessMode); ***** ^ not supported yet ***** ^ not supported yet 401 END SetOwner; ***** ^ not supported yet 402 403 (****************************************************************************) 404 405 PROCEDURE Status(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 406 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 407 VAR BufferLength : CARDINAL; 408 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 409 KeyID : SHORTCARD); 410 BEGIN 411 StatusCode := BTRV(opStat,FileControl,DataBuffer,BufferLength,KeyBuffer,0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 412 END Status; ***** ^ not supported yet 413 414 (****************************************************************************) 415 416 PROCEDURE StepDirect(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 417 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 418 VAR BufferLength : CARDINAL); 419 VAR 420 NullKey : KeyType; ***** ^ undeclared identifier 421 BEGIN 422 StatusCode := BTRV(opStepDirect,FileControl,DataBuffer, ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 423 BufferLength,NullKey,0); ***** ^ not supported yet ***** ^ not supported yet 424 END StepDirect; ***** ^ not supported yet 425 426 (****************************************************************************) 427 428 PROCEDURE Stop; 429 BEGIN 430 BTRV1(opStop); ***** ^ not supported yet ***** ^ undeclared identifier 431 END Stop; ***** ^ not supported yet 432 433 (****************************************************************************) 434 435 PROCEDURE Update(VAR FileControl : FileControlBlock; ***** ^ undeclared identifier 436 VAR DataBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 437 VAR BufferLength : CARDINAL; 438 VAR KeyBuffer : ARRAY OF BYTE; ***** ^ undeclared identifier 439 KeyID : SHORTCARD); 440 BEGIN 441 StatusCode := BTRV(opUpdate,FileControl,DataBuffer,BufferLength,KeyBuffer,0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 442 END Update; ***** ^ not supported yet 443 444 (****************************************************************************) 445 446 PROCEDURE Version(VAR DataBuffer : ARRAY OF BYTE ); ***** ^ undeclared identifier 447 VAR 448 NullControl : FileControlBlock; ***** ^ undeclared identifier 449 BufferSize : CARDINAL; 450 NullKey : KeyType; ***** ^ undeclared identifier 451 BEGIN 452 BufferSize := SIZE(DataBuffer); ***** ^ undeclared identifier ***** ^ not supported yet 453 StatusCode := BTRV(opVersion,NullControl,DataBuffer,BufferSize,NullKey,0); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 454 END Version; ***** ^ not supported yet 455 456 (****************************************************************************) 457 (* Low Level Btrieve Call *) 458 (****************************************************************************) 459 460 VAR 461 ProcId: CARDINAL; (* initialize to no process id *) 462 Multi: BOOLEAN; (* set to true if BMulti is loaded *) 463 VSet: BOOLEAN; (* set to true if we have checked for BMulti *) 464 465 (*%T _XTD*) 466 467 TYPE 468 rADDRESS = LONGCARD; ***** ^ undeclared identifier 469 470 PROCEDURE RealAlloc(VAR handle : CARDINAL; size : CARDINAL; VAR src : ARRAY OF BYTE):rADDRESS; ***** ^ undeclared identifier 471 (* Needed to copy to Real Memory (i.e. addressable from real mode) *) 472 VAR csize : CARDINAL; 473 BEGIN 474 IF size=0 THEN handle:=0; RETURN 0 END; ***** ^ bad RETURN 475 handle := TSXLIB.ALLOCLOWSEG(size); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 476 IF Seg(src)<>0 THEN (* copy in *) ***** ^ undeclared identifier ***** ^ not supported yet 477 (* protect against buffers that are too short *) 478 csize := TSXLIB.GETSEGLIMIT(Seg(src)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 479 IF (csize>=Ofs(src)) THEN ***** ^ undeclared identifier ***** ^ not supported yet 480 DEC(csize,Ofs(src)-1); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 481 IF (csize=0)OR(csize>size) THEN csize := size END; 482 Lib.FastMove(ADR(src),[handle:0],csize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 483 END; 484 ELSE 485 Lib.Fill([handle:0],size,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 486 END; 487 RETURN TSXLIB.MAKEREALADDR(handle,0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 488 END RealAlloc; ***** ^ not supported yet 489 490 PROCEDURE RealFree(handle :CARDINAL; size : CARDINAL; VAR dst : ARRAY OF BYTE); ***** ^ undeclared identifier 491 VAR csize : CARDINAL; 492 BEGIN 493 IF handle=0 THEN RETURN END; 494 IF Seg(dst)<>0 THEN (* copy out *) ***** ^ undeclared identifier ***** ^ not supported yet 495 (* protect against buffers that are too short *) 496 csize := TSXLIB.GETSEGLIMIT(Seg(dst)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 497 IF (csize>=Ofs(dst)) THEN ***** ^ undeclared identifier ***** ^ not supported yet 498 DEC(csize,Ofs(dst)-1); ***** ^ undeclared identifier ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 499 IF (csize=0)OR(csize>size) THEN csize := size END; 500 Lib.FastMove([handle:0],ADR(dst),csize); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 501 END; 502 END; 503 TSXLIB.FREESEG(handle); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 504 END RealFree; ***** ^ not supported yet 505 506 PROCEDURE BTRV ( op: CARDINAL; (* Operation *) 507 VAR pos: FileControlBlock; (* Position Block *) ***** ^ undeclared identifier 508 VAR data: ARRAY OF BYTE; (* Data Buffer *) ***** ^ undeclared identifier 509 VAR datalen: CARDINAL; (* Data Length *) 510 VAR kbuf: ARRAY OF BYTE; (* Key Buffer *) ***** ^ undeclared identifier 511 key: SHORTCARD (* Key Number *) 512 513 ): StatusCodes ; (* Btrieve error code *) ***** ^ undeclared identifier 514 515 CONST 516 VarID = 06176H; (* id for variable length records - 'va'*) 517 BtrInt = 07BH; 518 Btr2Int = 02FH; 519 BtrOffset = 00033H; 520 MultiFunction = 0AB00H; 521 522 TYPE 523 rBtrParms = RECORD 524 UserBufAddr : rADDRESS; (* data buffer address *) 525 UserBufLen : CARDINAL; (* data buffer length *) 526 UserCurAddr : rADDRESS; (* currency block address *) 527 UserFCBAddr : rADDRESS; (* file control block address *) 528 UserFunction : CARDINAL; (* Btrieve operation *) 529 UserKeyAddr : rADDRESS; (* key buffer address *) 530 UserKeyLength: SHORTCARD; (* key buffer length *) 531 UserKeyNumber: SHORTCARD; (* key number *) 532 UserStatAddr : rADDRESS; (* return status address *) 533 xFaceID : CARDINAL; (* language interface id *) 534 END; ***** ^ not supported yet 535 VAR 536 Stat: CARDINAL; (* Btrieve status code *) 537 Params: rBtrParms; (* Btrieve parameter block *) ***** ^ not supported yet 538 r: SYSTEM.Registers; (* register structure used on interrrupt call *) ***** ^ not supported yet 539 DataSel,PosSel,KeySel,StatSel,ParamSel : CARDINAL; 540 rParams : rADDRESS; 541 BEGIN 542 Lib.Fill(ADR(r),SIZE(r),0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 543 r.AX:= 03500H + BtrInt; ***** ^ not supported yet ***** ^ not supported yet 544 TSXLIB.REALINTR(ADR(r), 21H); (* NB using Lib.Intr will return ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 545 prot mode address *) 546 IF r.BX # BtrOffset THEN (* make sure Btrieve is installed *) ***** ^ not supported yet ***** ^ not supported yet 547 RETURN BtrieveAbsent ***** ^ undeclared identifier 548 END; 549 IF NOT VSet THEN (* if we haven't checked for Multi-User version *) 550 r.AX:= 03000H; ***** ^ not supported yet ***** ^ not supported yet 551 Lib.Intr(r, 021H); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 552 IF r.AL >= 3 THEN (* DOS version >= 3.0 *) ***** ^ not supported yet ***** ^ not supported yet 553 VSet:= TRUE; 554 r.AX:= MultiFunction; ***** ^ not supported yet ***** ^ not supported yet 555 Lib.Intr(r, Btr2Int); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 556 Multi:= r.AL = 4DH (* ORD('M') *) ***** ^ not supported yet ***** ^ not supported yet 557 ELSE 558 Multi:= FALSE 559 END 560 END; (* make normal btrieve call *) 561 IF datalen > HIGH(data)+1 THEN datalen:= HIGH(data)+1 END; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 562 WITH Params DO ***** ^ not supported yet 563 UserBufAddr := RealAlloc(DataSel,datalen,data); (* set data buffer address *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 564 UserBufLen := datalen; (* set length *) ***** ^ not supported yet ***** ^ incompatible assignment 565 UserFCBAddr := RealAlloc(PosSel,38+90,pos); (* set FCB address*) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 566 UserCurAddr := UserFCBAddr+38; ***** ^ not supported yet ***** ^ not supported yet 567 UserFunction := op; (* set Btrieve operation code *) ***** ^ not supported yet ***** ^ incompatible assignment 568 UserKeyAddr := RealAlloc(KeySel,255,kbuf); (* set key buffer address *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 569 UserKeyLength := 255; ***** ^ not supported yet ***** ^ incompatible assignment 570 UserKeyNumber := key; (* set key number *) ***** ^ not supported yet ***** ^ incompatible assignment 571 UserStatAddr := RealAlloc(StatSel,SIZE(Stat),Stat);; ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 572 xFaceID := VarID; (* set language id *) ***** ^ not supported yet ***** ^ incompatible assignment 573 END; ***** ^ not supported yet 574 rParams := RealAlloc(ParamSel,SIZE(Params),Params); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 575 r.DX := CARDINAL(rParams); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 576 r.DS := CARDINAL(rParams>>16); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ arithmetic operand must be numeric 577 IF NOT Multi THEN (* MultiUser version not installed *) 578 TSXLIB.REALINTR(ADR(r), BtrInt); (* passing real addresses *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 579 ELSE 580 LOOP 581 r.BX:= ProcId; ***** ^ not supported yet ***** ^ not supported yet 582 IF r.BX # 0 THEN r.AX:= 2 ELSE r.AX:= 1 END; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 583 INC(r.AX, MultiFunction); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 584 Lib.Intr(r, Btr2Int); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 585 IF r.AL = 0 THEN EXIT END; ***** ^ not supported yet ***** ^ not supported yet 586 r.AX:= 200H; ***** ^ not supported yet ***** ^ not supported yet 587 TSXLIB.REALINTR(ADR(r), 07FH); (* passing real addresses *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 588 END; 589 IF ProcId = 0 THEN ProcId:= r.BX END ***** ^ not supported yet ***** ^ not supported yet 590 END; 591 RealFree(ParamSel,SIZE(Params),Params); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 592 RealFree(DataSel,datalen,data); ***** ^ not supported yet ***** ^ not supported yet 593 RealFree(PosSel,38,pos); ***** ^ not supported yet ***** ^ not supported yet 594 RealFree(KeySel,255,kbuf); ***** ^ not supported yet ***** ^ not supported yet 595 RealFree(StatSel,SIZE(Stat),Stat); ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 596 datalen:= Params.UserBufLen; ***** ^ not supported yet ***** ^ not supported yet 597 RETURN StatusCodes(Stat); ***** ^ undeclared identifier ***** ^ not supported yet 598 END BTRV; ***** ^ not supported yet 599 600 (*%E*) 601 602 (*%F _XTD*) 603 604 605 PROCEDURE BTRV ( op: CARDINAL; (* Operation *) 606 VAR pos: FileControlBlock; (* Position Block *) 607 VAR data: ARRAY OF BYTE; (* Data Buffer *) 608 VAR datalen: CARDINAL; (* Data Length *) 609 VAR kbuf: ARRAY OF BYTE; (* Key Buffer *) 610 key: SHORTCARD (* Key Number *) 611 ): StatusCodes ; (* Btrieve error code *) 612 CONST 613 VarID = 06176H; (* id for variable length records - 'va'*) 614 BtrInt = 07BH; 615 Btr2Int = 02FH; 616 BtrOffset = 00033H; 617 MultiFunction = 0AB00H; 618 619 TYPE 620 BtrParms = RECORD 621 UserBufAddr : ADDRESS; (* data buffer address *) 622 UserBufLen : CARDINAL; (* data buffer length *) 623 UserCurAddr : ADDRESS; (* currency block address *) 624 UserFCBAddr : ADDRESS; (* file control block address *) 625 UserFunction : CARDINAL; (* Btrieve operation *) 626 UserKeyAddr : ADDRESS; (* key buffer address *) 627 UserKeyLength: SHORTCARD; (* key buffer length *) 628 UserKeyNumber: SHORTCARD; (* key number *) 629 UserStatAddr : ADDRESS; (* return status address *) 630 xFaceID : CARDINAL; (* language interface id *) 631 END; 632 VAR 633 Stat: CARDINAL; (* Btrieve status code *) 634 XData: BtrParms; (* Btrieve parameter block *) 635 r: SYSTEM.Registers; (* register structure used on interrrupt call *) 636 637 BEGIN 638 r.AX:= 03500H + BtrInt; 639 Lib.Intr(r, 021H); 640 IF r.BX # BtrOffset THEN (* make sure Btrieve is installed *) 641 RETURN BtrieveAbsent 642 END; 643 IF NOT VSet THEN (* if we haven't checked for Multi-User version *) 644 r.AX:= 03000H; 645 Lib.Intr(r, 021H); 646 IF r.AL >= 3 THEN (* DOS version >= 3.0 *) 647 VSet:= TRUE; 648 r.AX:= MultiFunction; 649 Lib.Intr(r, Btr2Int); 650 Multi:= r.AL = 4DH (* ORD('M') *) 651 ELSE 652 Multi:= FALSE 653 END 654 END; (* make normal btrieve call *) 655 IF datalen > HIGH(data)+1 THEN datalen:= HIGH(data)+1 END; 656 WITH XData DO 657 UserBufAddr := ADR(data); (* set data buffer address *) 658 UserBufLen := datalen; (* set length *) 659 UserFCBAddr := ADR(pos); (* set FCB address*) 660 UserCurAddr := ADR(pos[38]); 661 UserFunction := op; (* set Btrieve operation code *) 662 UserKeyAddr := ADR(kbuf); (* set key buffer address *) 663 UserKeyLength := 255; 664 UserKeyNumber:= key; (* set key number *) 665 UserStatAddr := ADR(Stat); (* set status address *) 666 xFaceID := VarID; (* set language id *) 667 END; 668 r.DX:= SYSTEM.Ofs(XData); 669 r.DS:= SYSTEM.Seg(XData); 670 IF NOT Multi THEN (* MultiUser version not installed *) 671 Lib.Intr(r, BtrInt) 672 ELSE 673 LOOP 674 r.BX:= ProcId; 675 IF r.BX # 0 THEN r.AX:= 2 ELSE r.AX:= 1 END; 676 INC(r.AX, MultiFunction); 677 Lib.Intr(r, Btr2Int); 678 IF r.AL = 0 THEN EXIT END; 679 r.AX:= 200H; 680 Lib.Intr(r, 07FH) 681 END; 682 IF ProcId = 0 THEN ProcId:= r.BX END 683 END; 684 datalen:= XData.UserBufLen; 685 RETURN StatusCodes(Stat); 686 END BTRV; 687 (*%E*) 688 689 BEGIN 690 VSet := FALSE; 691 Multi := FALSE; 692 ProcId:= 0; 693 END TSBTRV. ***** ^ not supported yet 632 errors