home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / bltq13a.zip / BB_LIN10.BAS < prev    next >
BASIC Source File  |  1993-04-22  |  7KB  |  268 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_lin10.bas 31-May-92 chh
  6. '--insert 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_lin10 /o;
  10. 'C>link bb_lin10,,nul,bullet;
  11.  
  12. UseDir$ = ".\"                  'all files use this directory except   N/A
  13.                                 'the reindex work file which uses the
  14.                                 'SET TMP= directory or the current directory
  15. CLS
  16. PRINT "BB_LIN10.BAS - LONG INT, SIGNED, UNIQUE InsertXB 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 = InsertXB
  133. AP.Handle = HandIX1
  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 insert:"; Recs2Add&
  143.  
  144. level = 1200
  145. low& = -3
  146. high& = low& + Recs2Add& - 1
  147. PRINT "Inserting"; 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 stat = AP.stat: GOTO Abend
  153. NEXT
  154. GOSUB EndTimer
  155. PRINT secs&; "secs."
  156.  
  157. level = 1300
  158. PRINT "  The first 5 keys/recs"
  159. AP.Func = GetFirstXB
  160. stat = BULLET(AP)
  161. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  162. FOR i = 1 TO 4
  163.    IF stat THEN EXIT FOR
  164.    AP.Func = GetNextXB
  165.    stat = BULLET(AP)
  166.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  167. NEXT
  168. IF stat = 202 THEN stat = 0
  169. IF stat THEN GOTO Abend
  170. PRINT
  171.  
  172. level = 1310
  173. PRINT "  The last 5 keys/recs"
  174. AP.Func = GetLastXB
  175. stat = BULLET(AP)
  176. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  177. FOR i = 1 TO 4
  178.    IF stat THEN EXIT FOR
  179.    AP.Func = GetPrevXB
  180.    stat = BULLET(AP)
  181.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  182. NEXT
  183. IF stat THEN GOTO Abend
  184.  
  185. PRINT "Okay."
  186. EndIt:
  187. EP.Func = ExitXB
  188. stat = BULLET(EP)
  189. END
  190.  
  191.  
  192. Abend:
  193. PRINT
  194. PRINT "Error:"; stat; "at level"; level; "while performing ";
  195. SELECT CASE level
  196. CASE IS = 999
  197.    SELECT CASE level
  198.    CASE 100
  199.       PRINT "a memory request of 150K."
  200.    CASE 110
  201.       PRINT "BULLET initialization."
  202.    CASE 120
  203.       PRINT "registering of ExitXB with _atexit."
  204.    CASE ELSE
  205.       PRINT "Preliminaries unknown."
  206.    END SELECT
  207. CASE IS <= 1099
  208.    SELECT CASE level
  209.    CASE 1000
  210.       PRINT "data file create."
  211.    CASE 1010
  212.       PRINT "data file open."
  213.    CASE ELSE
  214.       PRINT "data file unknown."
  215.    END SELECT
  216. CASE IS <= 1199
  217.    SELECT CASE level
  218.    CASE 1000
  219.       PRINT "index file create."
  220.    CASE 1010
  221.       PRINT "index file open."
  222.    CASE ELSE
  223.       PRINT "index file unknown."
  224.    END SELECT
  225. CASE IS <= 1299
  226.    SELECT CASE level
  227.    CASE 1200
  228.       PRINT "inserting records."
  229.    CASE 1210
  230.       PRINT "N/A."
  231.    CASE ELSE
  232.       PRINT "adding unknown."
  233.    END SELECT
  234. CASE IS <= 1399
  235.    SELECT CASE level
  236.    CASE 1300
  237.       PRINT "GetFirst/Next."
  238.    CASE 1310
  239.       PRINT "GetLast/Prev."
  240.    CASE ELSE
  241.       PRINT "Get/unknown."
  242.    END SELECT
  243. CASE ELSE
  244.    PRINT "unknown."
  245. END SELECT
  246. GOTO EndIt
  247.  
  248. '----------
  249. StartTimer:
  250. DEF SEG = &H40
  251. lb1 = PEEK(&H6C)
  252. hb1 = PEEK(&H6D)
  253. lb2 = PEEK(&H6E)
  254. DEF SEG
  255. stime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  256. RETURN
  257.  
  258. EndTimer:
  259. DEF SEG = &H40
  260. lb1 = PEEK(&H6C)
  261. hb1 = PEEK(&H6D)
  262. lb2 = PEEK(&H6E)
  263. DEF SEG
  264. etime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  265. secs& = ((etime& - stime&) * 10) \ 182
  266. RETURN
  267.  
  268.