home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 12 / CD_ASCQ_12_0294.iso / maj / 659 / basicsrc / bb_lau10.bas < prev    next >
BASIC Source File  |  1993-08-03  |  9KB  |  338 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_lau10.BAS 31-May-92 chh
  6. '--add/reindex/update using 32-bit long integer key, unique to current files
  7. '1) this code uses a non-standard binary field as a sort field
  8. '2) this code is for raw speed tests--it's straight inline
  9. 'C>bc bb_lau10 /o;
  10. 'C>link bb_lau10,,nul,bullet;
  11.  
  12. UseDir$ = ".\"                  'all files use this directory except
  13.                                 'the reindex work file which uses the
  14.                                 'SET TMP= directory or the current directory
  15. CLS
  16. PRINT "BB_UPD10.BAS - LONG INT, SIGNED, UNIQUE UpdateXB test program (Update)"
  17. PRINT "--uses non-standard data files with binary field values, not DBF"
  18. PRINT ">> USING DIRECTORY "; UseDir$
  19. PRINT
  20.  
  21. TYPE TestRecTYPE
  22. Tag AS STRING * 1
  23. Codenumber AS LONG              'this is the key field (a BINARY type) and
  24. Codename AS STRING * 11         'is not readable by standard dBASE III DBMSs
  25. END TYPE '16                    '--it's used here for speed
  26.                                 'that's it for comments, simple stuff follows
  27. DIM DFP AS DOSFilePack
  28. DIM MP AS MemoryPack
  29. DIM IP AS InitPack
  30. DIM EP AS ExitPack
  31. DIM CDP AS CreateDataPack
  32. DIM CKP AS CreateKeyPack
  33. DIM OP AS OpenPack
  34. DIM AP AS AccessPack
  35.  
  36. DIM FieldList(1 TO 2) AS FieldDescTYPE
  37. DIM TestRec AS TestRecTYPE
  38. DIM ZSTR AS STRING * 1
  39. DIM NameDAT AS STRING * 80
  40. DIM NameIX1 AS STRING * 80
  41. DIM KX1 AS STRING * 136
  42. DIM KeyBuffer AS STRING * 64
  43. DIM CurrKey AS STRING * 64
  44.  
  45. ZSTR = CHR$(0)
  46. NameDAT = UseDir$ + "BINTEST.DBB" + ZSTR   '.DBB since extended DBF type
  47. NameIX1 = UseDir$ + "BINTEST.IX1" + ZSTR
  48.  
  49. FieldList(1).FieldName = "CODENUMBER" + ZSTR
  50. FieldList(1).FieldType = "B"
  51. FieldList(1).FieldLength = CHR$(4)
  52. FieldList(1).FieldDC = CHR$(0)
  53. FieldList(2).FieldName = "CODENAME" + ZSTR + ZSTR
  54. FieldList(2).FieldType = "C"
  55. FieldList(2).FieldLength = CHR$(11)
  56. FieldList(2).FieldDC = CHR$(0)
  57.  
  58. level = 100
  59. MP.Func = MemoryXB
  60. stat = BULLET(MP)
  61. IF MP.Memory < 140000 THEN
  62.     QBheap& = SETMEM(-150000)       'hog wild, 64K would do okay
  63.     MP.Func = MemoryXB
  64.     stat = BULLET(MP)
  65.     IF MP.Memory < 140000 THEN stat = 8: GOTO Abend
  66. END IF
  67.  
  68. level = 110
  69. IP.Func = InitXB
  70. IP.JFTmode = 0
  71. stat = BULLET(IP)
  72. IF stat THEN GOTO Abend
  73.  
  74. level = 120
  75. EP.Func = AtExitXB
  76. stat = BULLET(EP)
  77.  
  78. level = 130
  79. DFP.Func = DeleteFileDOS
  80. DFP.FilenamePtrOff = VARPTR(NameDAT)
  81. DFP.FilenamePtrSeg = VARSEG(NameDAT)
  82. stat = BULLET(DFP)
  83. DFP.FilenamePtrOff = VARPTR(NameIX1)
  84. DFP.FilenamePtrSeg = VARSEG(NameIX1)
  85. stat = BULLET(DFP)
  86.  
  87. level = 1000
  88. CDP.Func = CreateDXB
  89. CDP.FilenamePtrOff = VARPTR(NameDAT)
  90. CDP.FilenamePtrSeg = VARSEG(NameDAT)
  91. CDP.NoFields = 2
  92. CDP.FieldListPtrOff = VARPTR(FieldList(1))
  93. CDP.FieldListPtrSeg = VARSEG(FieldList(1))
  94. CDP.FileID = &HFF  '<<== NON-standard DBF file ID
  95. stat = BULLET(CDP)
  96. IF stat THEN GOTO Abend
  97.  
  98. level = 1010
  99. OP.Func = OpenDXB
  100. OP.FilenamePtrOff = VARPTR(NameDAT)
  101. OP.FilenamePtrSeg = VARSEG(NameDAT)
  102. OP.ASmode = ReadWrite + DenyNone
  103. stat = BULLET(OP)
  104. IF stat THEN GOTO Abend
  105. HandDAT = OP.Handle
  106.  
  107. level = 1100
  108. KX1 = "CODENUMBER" + ZSTR
  109. CKP.Func = CreateKXB
  110. CKP.FilenamePtrOff = VARPTR(NameIX1)
  111. CKP.FilenamePtrSeg = VARSEG(NameIX1)
  112. CKP.KeyExpPtrOff = VARPTR(KX1)
  113. CKP.KeyExpPtrSeg = VARSEG(KX1)
  114. CKP.XBlink = HandDAT
  115. CKP.KeyFlags = cLONG + cSIGNED + cUNIQUE
  116. CKP.CodePageID = -1
  117. CKP.CountryCode = -1
  118. CKP.CollatePtrOff = 0
  119. CKP.CollatePtrSeg = 0
  120. stat = BULLET(CKP)
  121. IF stat THEN GOTO Abend
  122.  
  123. level = 1110
  124. OP.Func = OpenKXB
  125. OP.FilenamePtrOff = VARPTR(NameIX1)
  126. OP.FilenamePtrSeg = VARSEG(NameIX1)
  127. OP.ASmode = ReadWrite + DenyNone
  128. OP.xbHandle = HandDAT
  129. stat = BULLET(OP)
  130. IF stat THEN GOTO Abend
  131. HandIX1 = OP.Handle
  132.  
  133. AP.Func = AddRecordXB
  134. AP.Handle = HandDAT
  135. AP.RecPtrOff = VARPTR(TestRec)
  136. AP.RecPtrSeg = VARSEG(TestRec)
  137. AP.KeyPtrOff = VARPTR(KeyBuffer)
  138. AP.KeyPtrSeg = VARSEG(KeyBuffer)
  139. AP.NextPtrOff = 0
  140. AP.NextPtrSeg = 0
  141. TestRec.Tag = " "
  142. TestRec.Codename = "xxxSAMExxxx"
  143. INPUT "Recs to add/reindex:"; Recs2Add&
  144.  
  145. level = 1200
  146. low& = 1
  147. high& = low& + Recs2Add& - 1
  148. PRINT "Adding"; Recs2Add&; "records ( keys "; low&; "to"; high&; ")...";
  149. GOSUB StartTimer
  150. FOR recs& = low& TO high&
  151.    TestRec.Codenumber = recs&   'key field will be same as record number
  152.    stat = BULLET(AP)            'codename field same for all records
  153.    IF stat THEN GOTO Abend      'in this test
  154. NEXT
  155. GOSUB EndTimer
  156. PRINT secs&; "secs."
  157.  
  158. level = 1210
  159. PRINT "Reindexing...";
  160. AP.Func = ReindexXB
  161. AP.Handle = HandIX1
  162. GOSUB StartTimer
  163. sidx = BULLET(AP)
  164. stat = AP.stat
  165. IF stat THEN GOTO Abend
  166. GOSUB EndTimer
  167. PRINT secs&; "secs."
  168.  
  169. AP.Handle = HandIX1
  170. AP.RecPtrOff = VARPTR(TestRec)
  171. AP.RecPtrSeg = VARSEG(TestRec)
  172. AP.KeyPtrOff = VARPTR(KeyBuffer)
  173. AP.KeyPtrSeg = VARSEG(KeyBuffer)
  174. AP.NextPtrOff = 0
  175. AP.NextPtrSeg = 0
  176. TestRec.Tag = " "
  177. INPUT "Records to update:"; Recs2Upd&
  178. IF Recs2Upd& > Recs2Add& THEN Recs2Upd& = Recs2Add&
  179.  
  180. level = 1250
  181. PRINT "Updating first"; Recs2Upd&; "recs (modifying sign of each key)...";
  182. GOSUB StartTimer
  183. AP.Func = GetFirstXB
  184. cnt& = 0&               'count updates since we skip if error 201 occurs...
  185. DO                      '...it won't in this test since all numbers are +
  186.    stat = BULLET(AP)
  187.    IF stat = 0 THEN
  188.       CurrKey = KeyBuffer            'save current key to reposition later
  189.       IF TestRec.Codenumber > 0 THEN
  190.          TestRec.Codenumber = -TestRec.Codenumber
  191.       ELSE
  192.          TestRec.Codenumber = TestRec.Codenumber * -1
  193.       END IF
  194.       TestRec.Codename = "***UPDATED*"
  195.       AP.Func = UpdateXB
  196.       stat = BULLET(AP)
  197.       IF stat = 0 AND AP.stat = 0 THEN
  198.  
  199.          'must repostion to previous key to continue with GetNextXBs
  200.          'stat will return with key not found as expected, it's been
  201.          'changed to a negative value, no problem, GetNextXB knows...
  202.  
  203.          KeyBuffer = CurrKey
  204.          AP.Func = GetEqualXB
  205.          stat = BULLET(AP)
  206.  
  207.          AP.Func = GetNextXB
  208.          cnt& = cnt& + 1
  209.       ELSE
  210.          IF AP.stat <> 201 THEN
  211.             stat = AP.stat: GOTO Abend
  212.          ELSE
  213.             stat = 0   'if we had negative numbers already then changing the
  214.          END IF        'sign would result in it matching a key already in the
  215.       END IF           'index (this is a very simple test program)
  216.    ELSE
  217.       IF stat = 202 THEN stat = 0
  218.       EXIT DO
  219.    END IF
  220. LOOP UNTIL cnt& >= Recs2Upd&
  221. GOSUB EndTimer
  222. PRINT secs&; "secs."
  223. PRINT "updated:"; cnt&; "keys."
  224.  
  225. level = 1300
  226. PRINT "  The first 5 keys/recs"
  227. AP.Func = GetFirstXB
  228. stat = BULLET(AP)
  229. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  230. FOR i = 1 TO 4
  231. IF stat THEN EXIT FOR
  232.    AP.Func = GetNextXB
  233.    stat = BULLET(AP)
  234.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  235. NEXT
  236. IF stat = 202 THEN stat = 0
  237. IF stat THEN GOTO Abend
  238. PRINT
  239.  
  240. level = 1310
  241. PRINT "  The last 5 keys/recs"
  242. AP.Func = GetLastXB
  243. stat = BULLET(AP)
  244. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  245. FOR i = 1 TO 4
  246.    IF stat THEN EXIT FOR
  247.    AP.Func = GetPrevXB
  248.    stat = BULLET(AP)
  249.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  250. NEXT
  251. IF stat THEN GOTO Abend
  252.  
  253. PRINT "Okay."
  254. EndIt:
  255. EP.Func = ExitXB
  256. stat = BULLET(EP)
  257. END
  258.  
  259.  
  260. Abend:
  261. PRINT
  262. PRINT "Error:"; stat; "at level"; level; "while performing ";
  263. SELECT CASE level
  264. CASE IS = 999
  265.    SELECT CASE level
  266.    CASE 100
  267.       PRINT "a memory request of 150K."
  268.    CASE 110
  269.       PRINT "BULLET initialization."
  270.    CASE 120
  271.       PRINT "registering of ExitXB with _atexit."
  272.    CASE ELSE
  273.       PRINT "Preliminaries unknown."
  274.    END SELECT
  275. CASE IS <= 1099
  276.    SELECT CASE level
  277.    CASE 1000
  278.       PRINT "data file create."
  279.    CASE 1010
  280.       PRINT "data file open."
  281.    CASE ELSE
  282.       PRINT "data file unknown."
  283.    END SELECT
  284. CASE IS <= 1199
  285.    SELECT CASE level
  286.    CASE 1000
  287.       PRINT "index file create."
  288.    CASE 1010
  289.       PRINT "index file open."
  290.    CASE ELSE
  291.       PRINT "index file unknown."
  292.    END SELECT
  293. CASE IS <= 1299
  294.    SELECT CASE level
  295.    CASE 1200
  296.       PRINT "adding."
  297.    CASE 1210
  298.       PRINT "reindexing."
  299.    CASE 1250
  300.       PRINT "updating."
  301.    CASE ELSE
  302.       PRINT "unknown."
  303.    END SELECT
  304. CASE IS <= 1399
  305.    SELECT CASE level
  306.    CASE 1300
  307.       PRINT "GetFirst/Next."
  308.    CASE 1310
  309.       PRINT "GetLast/Prev."
  310.    CASE ELSE
  311.       PRINT "Get/unknown."
  312.    END SELECT
  313. CASE ELSE
  314.    PRINT "unknown."
  315. END SELECT
  316. GOTO EndIt
  317.  
  318. '----------
  319. StartTimer:
  320. DEF SEG = &H40
  321. lb1 = PEEK(&H6C)
  322. hb1 = PEEK(&H6D)
  323. lb2 = PEEK(&H6E)
  324. DEF SEG
  325. stime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  326. RETURN
  327.  
  328. EndTimer:
  329. DEF SEG = &H40
  330. lb1 = PEEK(&H6C)
  331. hb1 = PEEK(&H6D)
  332. lb2 = PEEK(&H6E)
  333. DEF SEG
  334. etime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  335. secs& = ((etime& - stime&) * 10) \ 182
  336. RETURN
  337.  
  338.