home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / ARQS_ZIP / BLTQ12.ZIP / BB_RKL10.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-08-15  |  3.2 KB  |  148 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_rkl10.bas 21-Aug-92 chh
  6. '--lock single data record example
  7. 'C>bc bb_rkl10 /o;
  8. 'C>link bb_rkl10,,nul,bullet;
  9.  
  10. UseDir$ = ".\"                  'all files use this directory except   N/A
  11.                                 'the reindex work file which uses the
  12.                                 'SET TMP= directory or the current directory
  13. CLS
  14. PRINT "BB_RKL10.BAS - Single record lock test"
  15. PRINT ">> USING DIRECTORY "; UseDir$
  16. PRINT
  17.  
  18. TYPE TestRecTYPE
  19. Tag AS STRING * 1
  20. Codenumber AS STRING * 4
  21. Codename AS STRING * 11
  22. END TYPE '16               
  23.                              
  24. DIM DFP AS DOSFilePack
  25. DIM MP AS MemoryPack
  26. DIM IP AS InitPack
  27. DIM EP AS ExitPack
  28. DIM CDP AS CreateDataPack
  29. DIM OP AS OpenPack
  30. DIM AP AS AccessPack
  31.  
  32. DIM FieldList(1 TO 2) AS FieldDescTYPE
  33. DIM TestRec AS TestRecTYPE
  34. DIM ZSTR AS STRING * 1
  35. DIM NameDAT AS STRING * 80
  36.  
  37. ZSTR = CHR$(0)
  38. NameDAT = UseDir$ + "RKLTEST.DBB" + ZSTR
  39. 'no index file is used (or needed)
  40.  
  41. FieldList(1).FieldName = "CODENUMBER" + ZSTR
  42. FieldList(1).FieldType = "C"
  43. FieldList(1).FieldLength = CHR$(4)
  44. FieldList(1).FieldDC = CHR$(0)
  45. FieldList(2).FieldName = "CODENAME" + ZSTR + ZSTR
  46. FieldList(2).FieldType = "C"
  47. FieldList(2).FieldLength = CHR$(11)
  48. FieldList(2).FieldDC = CHR$(0)
  49.  
  50. level = 100
  51. MP.Func = MemoryXB
  52. stat = BULLET(MP)
  53. IF MP.Memory < 140000 THEN
  54.     QBheap& = SETMEM(-150000)       'hog wild, 64K would do okay
  55.     MP.Func = MemoryXB
  56.     stat = BULLET(MP)
  57.     IF MP.Memory < 140000 THEN stat = 8: GOTO Abend
  58. END IF
  59.  
  60. level = 110
  61. IP.Func = InitXB
  62. IP.JFTmode = 0
  63. stat = BULLET(IP)
  64. IF stat THEN GOTO Abend
  65.  
  66. level = 120
  67. EP.Func = AtExitXB
  68. stat = BULLET(EP)
  69.  
  70. level = 130
  71. DFP.Func = DeleteFileDOS
  72. DFP.FilenamePtrOff = VARPTR(NameDAT)
  73. DFP.FilenamePtrSeg = VARSEG(NameDAT)
  74. stat = BULLET(DFP)
  75.  
  76. level = 1000
  77. CDP.Func = CreateDXB
  78. CDP.FilenamePtrOff = VARPTR(NameDAT)
  79. CDP.FilenamePtrSeg = VARSEG(NameDAT)
  80. CDP.NoFields = 2
  81. CDP.FieldListPtrOff = VARPTR(FieldList(1))
  82. CDP.FieldListPtrSeg = VARSEG(FieldList(1))
  83. CDP.FileID = 3
  84. stat = BULLET(CDP)
  85. IF stat THEN GOTO Abend
  86.  
  87. level = 1010
  88. OP.Func = OpenDXB
  89. OP.FilenamePtrOff = VARPTR(NameDAT)
  90. OP.FilenamePtrSeg = VARSEG(NameDAT)
  91. OP.ASmode = ReadWrite + DenyNone
  92. stat = BULLET(OP)
  93. IF stat THEN GOTO Abend
  94. HandDAT = OP.Handle
  95.  
  96. AP.Func = AddRecordXB
  97. AP.Handle = HandDAT
  98. AP.RecPtrOff = VARPTR(TestRec)
  99. AP.RecPtrSeg = VARSEG(TestRec)
  100. TestRec.Tag = " "
  101. Recs2Add& = 100&
  102.  
  103. level = 1200
  104. PRINT "Adding"; Recs2Add&; "records..."
  105. FOR recs& = 1 TO Recs2Add&
  106.    TestRec.Codenumber = STR$(recs&)
  107.    TestRec.Codename = "rec for" + STR$(recs&)
  108.    stat = BULLET(AP)
  109.    IF stat THEN stat = AP.stat: GOTO Abend
  110. NEXT
  111. PRINT
  112.  
  113. level = 1300
  114. PRINT "Locking record 5  stat:";
  115. AP.Func = LockDataXB
  116. AP.RecNo = 5
  117. stat = BULLET(AP)
  118. PRINT stat
  119. PRINT
  120.  
  121. level = 1310
  122. PRINT "Attempting to lock entire data file (this will fail)"
  123. AP.Func = LockDataXB
  124. AP.RecNo = 0
  125. stat = BULLET(AP)
  126. PRINT "Status on full-lock is:"; stat
  127. PRINT
  128.  
  129. level = 1320
  130. PRINT "Unlocking record 5  stat:";
  131. AP.Func = UnlockDataXB
  132. AP.RecNo = 5
  133. stat = BULLET(AP)
  134. PRINT stat
  135. PRINT
  136.  
  137. PRINT "Okay."
  138. EndIt:
  139. EP.Func = ExitXB
  140. stat = BULLET(EP)
  141. END
  142.  
  143. Abend:
  144. PRINT
  145. PRINT "Unexpected error:"; stat; "at level"; level
  146. GOTO EndIt
  147.  
  148.