home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / qbxm10 / xmdemo2.bas < prev    next >
Encoding:
BASIC Source File  |  1991-06-17  |  4.5 KB  |  175 lines
  1. DEFINT A-Z
  2.  
  3. '$INCLUDE: 'QBXM.BI'
  4.  
  5. COMMON SHARED paramBuffer AS STRING * 530
  6.  
  7. '$DYNAMIC:
  8.  
  9. DIM test1(1 TO 32000)
  10. DIM rec1 AS STRING * 20
  11. DIM rec2 AS STRING * 20
  12.  
  13. '========================================================================
  14. '
  15. '   Comment out the below for invoking this program by a RUN command
  16. '   instead of a CHAIN command.
  17. '
  18. '========================================================================
  19.  
  20. 'OPEN "XMPARAM.DAT" FOR BINARY AS #1
  21. 'GET #1, 1, paramBuffer
  22. 'CLOSE
  23.  
  24. '========================================================================
  25. '
  26. '   This is the last program in the chain that will use extra memory, so
  27. '   to be safe, call AutoCloseXM first.
  28. '
  29. '========================================================================
  30.  
  31. CALL AutoCloseXM
  32.  
  33. PRINT
  34. PRINT "********* Now in XMDEMO2. ";
  35. PRINT "Restoring extra memory status."
  36.  
  37. CALL RestParamXM(VARSEG(paramBuffer), VARPTR(paramBuffer), errCode)
  38.  
  39. IF errCode THEN
  40.     PRINT
  41.     PRINT "Error return on RestParamXM."
  42.     PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  43.     END
  44. END IF
  45.  
  46. '========================================================================
  47. '
  48. '   First, GET the array of 32000 integers created in XMDEMO1.
  49. '   then loop through it and see if it's correct.  Need to have
  50. '   the memory handle first, GetNameXM will return it.
  51. '
  52. '========================================================================
  53.  
  54.  
  55. CALL GetNameXM("ARRAY", arrayMemHandle, errCode)
  56.  
  57. IF errCode THEN
  58.     PRINT
  59.     PRINT "Error return on GetNameXm."
  60.     PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  61.     END
  62. END IF
  63.  
  64. CALL XM2Conv(VARSEG(test1(1)), VARPTR(test1(1)), arrayMemHandle, &HFA00, 0, errCode)
  65.  
  66. IF errCode THEN
  67.     PRINT
  68.     PRINT "Error return on XM2Conv."
  69.     PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  70.     END
  71. END IF
  72.  
  73. PRINT "Comparing array integer elements. ";
  74. compErr = 0
  75.  
  76. FOR i = 1 TO 32000
  77.     IF test1(i) <> i THEN
  78.         PRINT "error in array compasion."
  79.         PRINT "element"; i; " is"; test1(i)
  80.         compErr = compErr + 1
  81.     END IF
  82. NEXT
  83.  
  84. PRINT "Comparison errors: "; compErr
  85.  
  86. ERASE test1
  87.  
  88. '========================================================================
  89. '
  90. '   Next display the screen pages generated in XMDEMO1.  As in XMDEMO1,
  91. '   use the ScreenCountXM% to get the last available screen, save the
  92. '   current output screen to that screen number, and save the cursor
  93. '   location.  Then print the prompt and act accordingly.
  94. '
  95. '========================================================================
  96.              
  97. screens = ScreenCountXM%
  98. CALL SaveScreenXM(screens, errCode)
  99. holdRow = CSRLIN
  100. holdCol = POS(0)
  101.  
  102. PRINT "Do you want to inspect each page of the"; screens - 1; "screens that were"
  103. PRINT "generated in XDEMO1? (Y/N)"
  104.  
  105. DO
  106.     z$ = UCASE$(INKEY$)
  107. LOOP WHILE z$ <> "Y" AND z$ <> "N"
  108.  
  109. pause = z$ = "Y"
  110.  
  111. FOR scrNum = 1 TO screens - 1
  112.     CALL RestScreenXM(scrNum, errCode)
  113.  
  114.     IF errCode THEN
  115.         CLS
  116.         PRINT "Error return on RestScreenXM."
  117.         PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  118.         END
  119.     END IF
  120.  
  121.     IF pause THEN DO: LOOP WHILE INKEY$ = ""
  122. NEXT
  123.  
  124. '========================================================================
  125. '
  126. '   Now let's try the 1000 element memory 'file' generated in XMDEMO1.
  127. '   A temporary 'record' is generated just as in XMDEMO1.  The
  128. '   corresponding record is retrieved from the extra memory 'file' and
  129. '   the two are compared.  If you have a comparison error, let me know!
  130. '
  131. '========================================================================
  132.  
  133. CALL RestScreenXM(screens, errCode)
  134. LOCATE holdRow, holdCol
  135. PRINT "Generating records & comparing to eXtraMemory. ";
  136.  
  137. CALL GetNameXM("RECORDS", recordMemhandle, errCode)
  138.  
  139. IF errCode THEN
  140.     PRINT
  141.     PRINT "Error return on GetNameXm."
  142.     PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  143.     END
  144. END IF
  145.  
  146. compErr = 0
  147.  
  148. FOR i& = 1 TO 1000
  149.     rec1 = "Record:" + STR$(i&)
  150.     CALL GetRecXM(recordMemhandle, i&, VARSEG(rec2), VARPTR(rec2), errCode)
  151.    
  152.     IF errCode THEN
  153.         PRINT
  154.         PRINT "Error return on GetRecXM."
  155.         PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  156.         END
  157.     END IF
  158.  
  159.     IF rec1 <> rec2 THEN compErr = compErr + 1
  160. NEXT
  161.  
  162. PRINT "Comparison errors: "; compErr
  163.  
  164. '========================================================================
  165. '
  166. '   Close out all extra memory because technically we're done with it.
  167. '   XMDEMO3 will only display the status of memory again.
  168. '
  169. '========================================================================
  170.  
  171. CALL CloseAllXM
  172. RUN "XMDEMO3"
  173. END
  174.  
  175.