home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / qbxm10 / xmdemo1.bas < prev    next >
Encoding:
BASIC Source File  |  1991-06-17  |  11.3 KB  |  330 lines
  1. DEFINT A-Z
  2.  
  3. '$INCLUDE: 'QBXM.BI'
  4.  
  5. '=========================================================================
  6. '
  7. '   XMDEMO1.BAS a simple demo of a few of the QBXM routines.  Note that
  8. '   these programs can be run in the QB environment as is.  If compiled
  9. '   to an EXE, the BASIC run time library must be used (No /O on the
  10. '   command line) because of the CHAIN statement at the end of the code
  11. '   to XMDEMO2.  To use as a stand alone program, change the commented
  12. '   out code at the end of the file, so that the extra memory parameters
  13. '   are written out to disk, and XMDEMO2 is RUN instead of CHAINed to.
  14. '
  15. '=========================================================================
  16.  
  17. COMMON SHARED paramBuffer AS STRING * 530
  18.  
  19. DIM rec1 AS STRING * 20
  20. REDIM test1(1 TO 32000)       'REDIM forces array to be $DYNAMIC
  21.  
  22. '=========================================================================
  23. '
  24. '   The GetXM routine is called first.  It returns a flag indicating the
  25. '   type of memory installed, expanded or extended.  It's just there of
  26. '   course if you're interested.  The type of memory has no effect on any
  27. '   of the routines.  The SELECT CASE statement illustrates the values
  28. '   returned.  The major and minor version numbers of the driver in use
  29. '   are also returned.  Care must be taken if an EMS driver earlier than
  30. '   version 4.0 is in use.  If that is the case, the named handle routines
  31. '   should not be called.  EMS 3.0 and 3.2 did not support named handles.
  32. '
  33. '=========================================================================
  34.  
  35. CLS
  36. CALL GetXM(major, minor, flag)
  37.  
  38. SELECT CASE flag
  39.     CASE 0
  40.         PRINT "No extra memory is installed."
  41.         END
  42.     CASE 1
  43.         PRINT "Expanded memory is in use, version:";
  44.     CASE 2
  45.         PRINT "Extended memory is in use, version:";
  46.     CASE ELSE
  47.         PRINT "An error was returned.  Code: ";
  48.         PRINT RIGHT$("0000" + HEX$(flag), 4)
  49.         END
  50. END SELECT
  51.  
  52. PRINT USING "##.##"; major + minor / 10
  53.  
  54. '=========================================================================
  55. '
  56. '   Now, find out how much memory is installed and how much is free.
  57. '
  58. '   GetPagesXM returns:
  59. '
  60. '   'total' as the number of 16k pages installed for EMS,
  61. '           or the number of 16k pages free at the moment for XMS.
  62. '
  63. '   'pages' as the count of free pages for EMS, all this could be allocated
  64. '           to 1 handle in an EMS system,
  65. '           with XMS this indicates the largest block that can be allocated
  66. '           to one handle.  The 'total' and 'pages' should be equal most of
  67. '           the time.  A multitasker with another program running may cause
  68. '           memory to become fragmented.
  69. '
  70. '=========================================================================
  71.  
  72.  
  73. CALL GetPagesXM(total, pages)
  74.  
  75. SELECT CASE flag
  76.     CASE 1
  77.         PRINT USING "Expanded memory total: ###,###,###"; CLNG(total) * 16384&
  78.         PRINT "Expanded";
  79.     CASE 2
  80.         PRINT USING "Extended memory total: ###,###,###"; CLNG(total) * 16384&
  81.         PRINT "Extended";
  82. END SELECT
  83.        
  84. PRINT USING " memory free:  ###,###,###"; CLNG(pages) * 16384&
  85.  
  86. '=========================================================================
  87. '
  88. '   An example of the 'Bulk' memory handling routines.
  89. '
  90. '   First, fill an array of 32000 integers and store it in eXtraMem:
  91. '   32,000 integers require 64,000 bytes.  64,000 / 16384 page size
  92. '   means that we need 4 pages (65,536 bytes)
  93. '
  94. '=========================================================================
  95.  
  96. pages = 4
  97. CALL OpenXM(pages, handle, errCode)
  98. PRINT
  99. PRINT "OpenXM call: ";
  100. PRINT "Requested:"; pages; "pages,";
  101. PRINT " Handle assigned: "; handle;
  102. PRINT " ErrCode: "; RIGHT$("0000" + HEX$(errCode), 4)
  103.  
  104. IF errCode THEN GOSUB CloseExtraMem
  105.  
  106. '=========================================================================
  107. '
  108. '   Just out of curiousity, see if PageCountXM returns 4....
  109. '
  110. '=========================================================================
  111.  
  112. x = PageCountXM(handle)
  113.  
  114. IF x <> pages THEN
  115.     PRINT "GetPagesXM error, returned: "; x
  116.     GOSUB CloseExtraMem
  117. END IF
  118.  
  119. PRINT
  120. PRINT USING "Conventional memory free with array:    ###,###"; FRE(-1)
  121. PRINT "Filling array, ";
  122.  
  123. FOR i = 1 TO 32000
  124.     test1(i) = i
  125. NEXT
  126.  
  127. PRINT "storing array in extra memory, ";
  128.  
  129. '=========================================================================
  130. '
  131. '   To move x number of bytes from conventional memory to extra memory,
  132. '   you need to specify the starting address in conventional memory as
  133. '   a segment offset pair.  VARSEG and VARPTR do the trick.  (I embed the
  134. '   function right in the call because BASIC may move things around in
  135. '   memory, and I'm BASICly a chicken.)  Next you need the extra memory
  136. '   handle that you want to store the data in, then the number of bytes
  137. '   to move.  Because the bytes to move value is really an unsigned integer
  138. '   it can range from 0-65535.  BASIC won't take 64,000 in a signed integer,
  139. '   so for ease of use I specified a hex value.  Equates to -1536, if your
  140. '   interested.  When an unknown number of bytes must be moved you can use
  141. '   a loop instead.  See the doc file for an example.  Finally, you have
  142. '   to say where in the extra memory handle you want to store the data.
  143. '   This value is a long integer and is treated as an offset into the extra
  144. '   memory handle, the first byte is at offset 0, so that's where this array
  145. '   is going.
  146. '
  147. '=========================================================================
  148.  
  149. CALL Conv2XM(VARSEG(test1(1)), VARPTR(test1(1)), handle, &HFA00, 0, errCode)
  150.  
  151. IF errCode THEN
  152.     PRINT : PRINT "Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  153.     GOSUB CloseExtraMem
  154. END IF
  155.  
  156. '=========================================================================
  157. '
  158. '   Don't need the array any more, so free up the memory for other uses.
  159. '
  160. '=========================================================================
  161.  
  162. PRINT "erasing array."
  163. ERASE test1
  164. PRINT USING "Conventional memory free without array: ###,###"; FRE(-1)
  165.  
  166. '=========================================================================
  167. '
  168. '   Have the array in eXtraMemory in handle number "handle" so we'll name
  169. '   it so XMDEMO2 can use it.   You could pass the handle to the next
  170. '   program in the chain via a variable, or write it to disk, but why use
  171. '   up limited memory (with COMMON SHARED) or take time to write a file
  172. '   if you don't have to.
  173. '
  174. '=========================================================================
  175.  
  176. CALL PutNameXM("ARRAY", handle, errCode)
  177.  
  178. IF errCode THEN
  179.     PRINT "Error on PutNameXM: "; RIGHT$("0000" + HEX$(errCode), 4)
  180.     GOSUB CloseExtraMem
  181. END IF
  182.  
  183. '=========================================================================
  184. '
  185. '   Now let's try the record orientated routines.  We will generate 1,000
  186. '   records that look like "Record: 1", "Record: 2", "Record: 3" etc.
  187. '   Then each record is put to the extra memory 'file'.  XMDEMO2 will use
  188. '   the same code to generate a 'record' then get the corresponding record
  189. '   from the extra memory 'file' and compare the results. Pages should
  190. '   equal, for 1,000 20 byte records:  (2)
  191. '
  192. '=========================================================================
  193.  
  194.  
  195. pages = 20000 \ 16384 + 1
  196.  
  197. '=========================================================================
  198. '
  199. '   OpenRecXM needs the number of 16k pages, then the length of each
  200. '   record associated with the 'file'.  It will return a handle to use
  201. '   with this allocation of memory.
  202. '
  203. '=========================================================================
  204.  
  205. CALL OpenRecXM(pages, 20, handle, errCode)
  206.  
  207. PRINT
  208. PRINT "OpenRecXM call: ";
  209. PRINT "Requested:"; pages; "pages,";
  210. PRINT " Handle assigned: "; handle;
  211. PRINT " ErrCode: "; RIGHT$("0000" + HEX$(errCode), 4)
  212. IF errCode THEN GOSUB CloseExtraMem
  213.  
  214. FOR i& = 1 TO 1000
  215.     rec1 = "Record:" + STR$(i&)
  216.     
  217.  
  218. '=========================================================================
  219. '
  220. '   PutRecXM needs the 'file' handle, the record number as a long
  221. '   integer, and the segment:offset address of the data to put in
  222. '   the file.  Same route to determine the address of the record to
  223. '   put into extra memory as in Conv2XM, VARSEG and VARPTR.
  224. '   Note that the record length doesn't have to be referred to any
  225. '   more because it was specified when the memory was allocated.
  226. '
  227. '=========================================================================
  228.  
  229.     CALL PutRecXM(handle, i&, VARSEG(rec1), VARPTR(rec1), errCode)
  230.   
  231.     IF errCode THEN
  232.         PRINT "Put Record Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  233.         GOSUB CloseExtraMem
  234.     END IF
  235. NEXT
  236.  
  237. '=========================================================================
  238. '
  239. '   Have all 1000 records in eXtraMem in handle number "handle" so name
  240. '   it for XMDEMO2's use:
  241. '
  242. '=========================================================================
  243.  
  244. CALL PutNameXM("RECORDS", handle, errCode)
  245.  
  246.  
  247. '=========================================================================
  248. '
  249. '   Now for the screen handling routines.  This is pretty boring, but
  250. '   what the routine does is generate 102 screens and stores each screen
  251. '   in extra memory.  First thing is to save the current screen with the
  252. '   information that has been printed so far.
  253. '
  254. '=========================================================================
  255.  
  256. screens = 100                            'Request 100, results in 102
  257. CALL OpenScreenXM(screens, errCode)
  258.  
  259. IF errCode THEN
  260.     PRINT "Open Screen Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  261.     GOSUB CloseExtraMem
  262. END IF
  263.  
  264. screens = ScreenCountXM%        'This gives us the total available.
  265. CALL SaveScreenXM(screens, errCode)
  266.  
  267. '=========================================================================
  268. '
  269. '   The above saves the current output screen in the last screen available.
  270. '   so that when when it's restored, the prompt below won't be on it.
  271. '   Note also that the current cursor position is saved.  As the test
  272. '   screens are drawn, the cursor location will be changed, this allows
  273. '   the cursor to be restored to it's proper location later.
  274. '
  275. '=========================================================================
  276.  
  277. holdRow = CSRLIN
  278. holdCol = POS(0)
  279. PRINT "press a key to start generating screens."
  280. DO: LOOP WHILE INKEY$ = ""
  281.  
  282. FOR scrNum = 1 TO screens - 1
  283.     a$ = LTRIM$(RTRIM$(STR$(scrNum)))
  284.     a$ = RIGHT$("****" + a$, 4)
  285.     FOR row = 1 TO 25
  286.         FOR col = 1 TO 79 STEP 4
  287.             LOCATE row, col
  288.             PRINT a$;
  289.         NEXT
  290.     NEXT
  291.  
  292.     CALL SaveScreenXM(scrNum, errCode)
  293.    
  294.     IF errCode THEN
  295.         CLS
  296.         PRINT "Save Screen Error: "; RIGHT$("0000" + HEX$(errCode), 4)
  297.         GOSUB CloseExtraMem
  298.     END IF
  299. NEXT
  300.  
  301. CALL RestScreenXM(screens, errCode)    'Redisplay the status screen
  302. LOCATE holdRow, holdCol                'restore the cursor
  303.  
  304. '=========================================================================
  305. '
  306. '   OK, that should be enough for now.  Fill out the parameter buffer for
  307. '   everything we've put in memory, and save it for XMDEMO2's use.
  308. '
  309. '   Adjust the commented code below to change from a CHAIN to a RUN
  310. '   start up for XMDEMO2.
  311. '
  312. '=========================================================================
  313.  
  314. CALL SaveParamXM(VARSEG(paramBuffer), VARPTR(paramBuffer), errCode)
  315.  
  316. CHAIN "XMDEMO2"         'Comment out for a RUN command.
  317.  
  318. '   OPEN "XMPARAM.DAT" FOR BINARY AS #1
  319. '   PUT #1, 1, paramBuffer
  320. '   CLOSE
  321. '   RUN "XMDEMO2"
  322.  
  323. END
  324.  
  325. CloseExtraMem:
  326.  
  327.     CALL CloseAllXM
  328.     END
  329.  
  330.