home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 12 / CD_ASCQ_12_0294.iso / maj / 421 / bb_laa10.bas < prev    next >
BASIC Source File  |  1993-08-03  |  8KB  |  311 lines
  1.  
  2. DEFINT A-Z
  3.  
  4. REM $INCLUDE: 'BULLET.BI'
  5. 'bb_laa10.BAS 31-May-92 chh
  6. '--insert 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_laa10 /o;
  10. 'C>link bb_laa10,,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_LAA10.BAS - LONG INT, SIGNED, UNIQUE add/reindex/InsertXB test (Attach)"
  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 = 3
  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&
  147. IF low& < 1 THEN high& = high& - 1
  148. PRINT "Adding"; Recs2Add&; "records ( keys "; low&; "to"; high&; ")...";
  149. GOSUB StartTimer
  150. FOR recs& = low& TO high&
  151.    TestRec.Codenumber = recs&
  152.    stat = BULLET(AP)
  153.    IF stat THEN GOTO Abend
  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.Func = InsertXB
  170. AP.Handle = HandIX1
  171. AP.RecPtrOff = VARPTR(TestRec)
  172. AP.RecPtrSeg = VARSEG(TestRec)
  173. AP.KeyPtrOff = VARPTR(KeyBuffer)
  174. AP.KeyPtrSeg = VARSEG(KeyBuffer)
  175. AP.NextPtrOff = 0
  176. AP.NextPtrSeg = 0
  177. TestRec.Tag = " "
  178. TestRec.Codename = "xxxSAMExxxx"
  179. INPUT "RANDOM recs to insert:"; Recs2Add&
  180.  
  181. 'test the insertion of key/recs on an existing file as created above
  182.  
  183. level = 1250
  184. PRINT "Inserting"; Recs2Add&; "random-value records and keys...";
  185. GOSUB StartTimer
  186. DO
  187.    TestRec.Codenumber = 9999999 * RND
  188.    stat = BULLET(AP)
  189.    IF stat = 0 THEN
  190.       cnt& = cnt& + 1
  191.    ELSE
  192.       IF AP.stat <> 201 THEN stat = AP.stat: GOTO Abend
  193.    END IF
  194. LOOP UNTIL cnt& > Recs2Add&
  195. GOSUB EndTimer
  196. PRINT secs&; "secs."
  197.  
  198. level = 1300
  199. PRINT "  The first 5 keys/recs"
  200. AP.Func = GetFirstXB
  201. stat = BULLET(AP)
  202. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  203. FOR i = 1 TO 4
  204.    IF stat THEN EXIT FOR
  205.    AP.Func = GetNextXB
  206.    stat = BULLET(AP)
  207.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  208. NEXT
  209. IF stat = 202 THEN stat = 0
  210. IF stat THEN GOTO Abend
  211. PRINT
  212.  
  213. level = 1310
  214. PRINT "  The last 5 keys/recs"
  215. AP.Func = GetLastXB
  216. stat = BULLET(AP)
  217. PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  218. FOR i = 1 TO 4
  219.    IF stat THEN EXIT FOR
  220.    AP.Func = GetPrevXB
  221.    stat = BULLET(AP)
  222.    PRINT AP.Recno, TestRec.Codenumber; TestRec.Codename
  223. NEXT
  224. IF stat THEN GOTO Abend
  225.  
  226. PRINT "Okay."
  227. EndIt:
  228. EP.Func = ExitXB
  229. stat = BULLET(EP)
  230. END
  231.  
  232.  
  233. Abend:
  234. PRINT
  235. PRINT "Error:"; stat; "at level"; level; "while performing ";
  236. SELECT CASE level
  237. CASE IS = 999
  238.    SELECT CASE level
  239.    CASE 100
  240.       PRINT "a memory request of 150K."
  241.    CASE 110
  242.       PRINT "BULLET initialization."
  243.    CASE 120
  244.       PRINT "registering of ExitXB with _atexit."
  245.    CASE ELSE
  246.       PRINT "Preliminaries unknown."
  247.    END SELECT
  248. CASE IS <= 1099
  249.    SELECT CASE level
  250.    CASE 1000
  251.       PRINT "data file create."
  252.    CASE 1010
  253.       PRINT "data file open."
  254.    CASE ELSE
  255.       PRINT "data file unknown."
  256.    END SELECT
  257. CASE IS <= 1199
  258.    SELECT CASE level
  259.    CASE 1000
  260.       PRINT "index file create."
  261.    CASE 1010
  262.       PRINT "index file open."
  263.    CASE ELSE
  264.       PRINT "index file unknown."
  265.    END SELECT
  266. CASE IS <= 1299
  267.    SELECT CASE level
  268.    CASE 1200
  269.       PRINT "adding."
  270.    CASE 1210
  271.       PRINT "reindexing."
  272.    CASE 1250
  273.       PRINT "inserting."
  274.    CASE ELSE
  275.       PRINT "adding unknown."
  276.    END SELECT
  277. CASE IS <= 1399
  278.    SELECT CASE level
  279.    CASE 1300
  280.       PRINT "GetFirst/Next."
  281.    CASE 1310
  282.       PRINT "GetLast/Prev."
  283.    CASE ELSE
  284.       PRINT "Get/unknown."
  285.    END SELECT
  286. CASE ELSE
  287.    PRINT "unknown."
  288. END SELECT
  289. GOTO EndIt
  290.  
  291. '----------
  292. StartTimer:
  293. DEF SEG = &H40
  294. lb1 = PEEK(&H6C)
  295. hb1 = PEEK(&H6D)
  296. lb2 = PEEK(&H6E)
  297. DEF SEG
  298. stime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  299. RETURN
  300.  
  301. EndTimer:
  302. DEF SEG = &H40
  303. lb1 = PEEK(&H6C)
  304. hb1 = PEEK(&H6D)
  305. lb2 = PEEK(&H6E)
  306. DEF SEG
  307. etime& = CVL(CHR$(lb1) + CHR$(hb1) + CHR$(lb2) + ZSTR)
  308. secs& = ((etime& - stime&) * 10) \ 182
  309. RETURN
  310.  
  311.