home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 12 / CD_ASCQ_12_0294.iso / maj / 421 / bb_lai10.bas < prev    next >
BASIC Source File  |  1993-08-03  |  7KB  |  279 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_lai10.bas 31-May-92 chh
  6. '--test raw speed using 32-bit long integer key, unique
  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_lai10 /o;
  10. 'C>link bb_lai10,,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_LAI10.BAS - LONG INT, SIGNED, UNIQUE long int, add/reindex speed test"
  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.  
  44. ZSTR = CHR$(0)
  45. NameDAT = UseDir$ + "BINTEST.DBB" + ZSTR
  46. NameIX1 = UseDir$ + "BINTEST.IX1" + ZSTR
  47.  
  48. FieldList(1).FieldName = "CODENUMBER" + ZSTR
  49. FieldList(1).FieldType = "B"
  50. FieldList(1).FieldLength = CHR$(4)
  51. FieldList(1).FieldDC = CHR$(0)
  52. FieldList(2).FieldName = "CODENAME" + ZSTR + ZSTR
  53. FieldList(2).FieldType = "C"
  54. FieldList(2).FieldLength = CHR$(11)
  55. FieldList(2).FieldDC = CHR$(0)
  56.  
  57. level = 100
  58. MP.Func = MemoryXB
  59. stat = BULLET(MP)
  60. IF MP.Memory < 140000 THEN
  61.     QBheap& = SETMEM(-150000)       'hog wild, 64K would do okay
  62.     MP.Func = MemoryXB
  63.     stat = BULLET(MP)
  64.     IF MP.Memory < 140000 THEN stat = 8: GOTO Abend
  65. END IF
  66.  
  67. level = 110
  68. IP.Func = InitXB
  69. IP.JFTmode = 0
  70. stat = BULLET(IP)
  71. IF stat THEN GOTO Abend
  72.  
  73. level = 120
  74. EP.Func = AtExitXB
  75. stat = BULLET(EP)
  76.  
  77. level = 130
  78. DFP.Func = DeleteFileDOS
  79. DFP.FilenamePtrOff = VARPTR(NameDAT)
  80. DFP.FilenamePtrSeg = VARSEG(NameDAT)
  81. stat = BULLET(DFP)
  82. DFP.FilenamePtrOff = VARPTR(NameIX1)
  83. DFP.FilenamePtrSeg = VARSEG(NameIX1)
  84. stat = BULLET(DFP)
  85.  
  86. level = 1000
  87. CDP.Func = CreateDXB
  88. CDP.FilenamePtrOff = VARPTR(NameDAT)
  89. CDP.FilenamePtrSeg = VARSEG(NameDAT)
  90. CDP.NoFields = 2
  91. CDP.FieldListPtrOff = VARPTR(FieldList(1))
  92. CDP.FieldListPtrSeg = VARSEG(FieldList(1))
  93. CDP.FileID = &HFF  '<<== NON-standard DBF file ID
  94. stat = BULLET(CDP)
  95. IF stat THEN GOTO Abend
  96.  
  97. level = 1010
  98. OP.Func = OpenDXB
  99. OP.FilenamePtrOff = VARPTR(NameDAT)
  100. OP.FilenamePtrSeg = VARSEG(NameDAT)
  101. OP.ASmode = ReadWrite + DenyNone
  102. stat = BULLET(OP)
  103. IF stat THEN GOTO Abend
  104. HandDAT = OP.Handle
  105.  
  106. level = 1100
  107. KX1 = "CODENUMBER" + ZSTR
  108. CKP.Func = CreateKXB
  109. CKP.FilenamePtrOff = VARPTR(NameIX1)
  110. CKP.FilenamePtrSeg = VARSEG(NameIX1)
  111. CKP.KeyExpPtrOff = VARPTR(KX1)
  112. CKP.KeyExpPtrSeg = VARSEG(KX1)
  113. CKP.XBlink = HandDAT
  114. CKP.KeyFlags = cLONG + cSIGNED + cUNIQUE
  115. CKP.CodePageID = -1
  116. CKP.CountryCode = -1
  117. CKP.CollatePtrOff = 0
  118. CKP.CollatePtrSeg = 0
  119. stat = BULLET(CKP)
  120. IF stat THEN GOTO Abend
  121.  
  122. level = 1110
  123. OP.Func = OpenKXB
  124. OP.FilenamePtrOff = VARPTR(NameIX1)
  125. OP.FilenamePtrSeg = VARSEG(NameIX1)
  126. OP.ASmode = ReadWrite + DenyNone
  127. OP.xbHandle = HandDAT
  128. stat = BULLET(OP)
  129. IF stat THEN GOTO Abend
  130. HandIX1 = OP.Handle
  131.  
  132. AP.Func = AddRecordXB
  133. AP.Handle = HandDAT
  134. AP.RecPtrOff = VARPTR(TestRec)
  135. AP.RecPtrSeg = VARSEG(TestRec)
  136. AP.KeyPtrOff = VARPTR(KeyBuffer)
  137. AP.KeyPtrSeg = VARSEG(KeyBuffer)
  138. AP.NextPtrOff = 0
  139. AP.NextPtrSeg = 0
  140. TestRec.Tag = " "
  141. TestRec.Codename = "xxxSAMExxxx"
  142. INPUT "Recs to add/reindex:"; Recs2Add&
  143.  
  144. level = 1200
  145. low& = -3
  146. high& = low& + Recs2Add& - 1
  147. PRINT "Adding"; Recs2Add&; "records ( keys "; low&; "to"; high&; ")...";
  148. GOSUB StartTimer
  149. FOR recs& = low& TO high&
  150.    TestRec.Codenumber = recs&
  151.    stat = BULLET(AP)
  152.    IF stat THEN GOTO Abend
  153. NEXT
  154. GOSUB EndTimer
  155. PRINT secs&; "secs."
  156.  
  157. level = 1210
  158. PRINT "Reindexing...";
  159. AP.Func = ReindexXB
  160. AP.Handle = HandIX1
  161. GOSUB StartTimer
  162. sidx = BULLET(AP)
  163. stat = AP.stat
  164. IF stat THEN GOTO Abend
  165. GOSUB EndTimer
  166. PRINT secs&; "secs."
  167.  
  168. level = 1300
  169. PRINT "  The first 5 keys/recs"
  170. AP.Func = GetFirstXB
  171. stat = BULLET(AP)
  172. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  173. FOR i = 1 TO 4
  174.    IF stat THEN EXIT FOR
  175.    AP.Func = GetNextXB
  176.    stat = BULLET(AP)
  177.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  178. NEXT
  179. IF stat = 202 THEN stat = 0
  180. IF stat THEN GOTO Abend
  181. PRINT
  182.  
  183. level = 1310
  184. PRINT "  The last 5 keys/recs"
  185. AP.Func = GetLastXB
  186. stat = BULLET(AP)
  187. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  188. FOR i = 1 TO 4
  189.    IF stat THEN EXIT FOR
  190.    AP.Func = GetPrevXB
  191.    stat = BULLET(AP)
  192.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  193. NEXT
  194. IF stat THEN GOTO Abend
  195.  
  196. PRINT "Okay."
  197. EndIt:
  198. EP.Func = ExitXB
  199. stat = BULLET(EP)
  200. END
  201.  
  202.  
  203. Abend:
  204. PRINT
  205. PRINT "Error:"; stat; "at level"; level; "while performing ";
  206. SELECT CASE level
  207. CASE IS = 999
  208.    SELECT CASE level
  209.    CASE 100
  210.       PRINT "a memory request of 150K."
  211.    CASE 110
  212.       PRINT "BULLET initialization."
  213.    CASE 120
  214.       PRINT "registering of ExitXB with _atexit."
  215.    CASE ELSE
  216.       PRINT "Preliminaries unknown."
  217.    END SELECT
  218. CASE IS <= 1099
  219.    SELECT CASE level
  220.    CASE 1000
  221.       PRINT "data file create."
  222.    CASE 1010
  223.       PRINT "data file open."
  224.    CASE ELSE
  225.       PRINT "data file unknown."
  226.    END SELECT
  227. CASE IS <= 1199
  228.    SELECT CASE level
  229.    CASE 1000
  230.       PRINT "index file create."
  231.    CASE 1010
  232.       PRINT "index file open."
  233.    CASE ELSE
  234.       PRINT "index file unknown."
  235.    END SELECT
  236. CASE IS <= 1299
  237.    SELECT CASE level
  238.    CASE 1200
  239.       PRINT "adding records."
  240.    CASE 1210
  241.       PRINT "reindexing."
  242.    CASE ELSE
  243.       PRINT "adding unknown."
  244.    END SELECT
  245. CASE IS <= 1399
  246.    SELECT CASE level
  247.    CASE 1300
  248.       PRINT "GetFirst/Next."
  249.    CASE 1310
  250.       PRINT "GetLast/Prev."
  251.    CASE ELSE
  252.       PRINT "Get/unknown."
  253.    END SELECT
  254. CASE ELSE
  255.    PRINT "unknown."
  256. END SELECT
  257. GOTO EndIt
  258.  
  259. '----------
  260. StartTimer:
  261. DEF SEG = &H40
  262. lb1 = PEEK(&H6C)
  263. hb1 = PEEK(&H6D)
  264. lb2 = PEEK(&H6E)
  265. DEF SEG
  266. stime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  267. RETURN
  268.  
  269. EndTimer:
  270. DEF SEG = &H40
  271. lb1 = PEEK(&H6C)
  272. hb1 = PEEK(&H6D)
  273. lb2 = PEEK(&H6E)
  274. DEF SEG
  275. etime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  276. secs& = ((etime& - stime&) * 10) \ 182
  277. RETURN
  278.  
  279.