home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / aimqb4 / sample / memalloc.bas < prev    next >
Encoding:
BASIC Source File  |  1988-04-03  |  2.1 KB  |  96 lines
  1. '*****************************************************************************
  2.  
  3. 'Copyright (c) 1987 Marcel Madonna
  4.  
  5. 'MEMALLOC.BAS is an example of the use of the memory management routines.
  6. '
  7. ' ********************* N O T E *************************
  8. '
  9. 'This program cannot be used from the DOS prompt without Microsoft
  10. 'QuickBasic V4.0 and a registered copy of QBWARE.
  11. '
  12. 'To compile it, at the DOS prompt type:
  13.  
  14. '               bc memalloc;
  15. '               link /ex /noe memalloc,,,brun40 qbware;
  16. '               del memalloc.obj
  17. '               del memalloc.map
  18.  
  19. 'To run it fromthe QuickBasic development environment, type:
  20. '
  21. '               qb memalloc /l qbware
  22. '               [Shift] + F5
  23. '*****************************************************************************
  24.  
  25.  
  26. ' Allocate 64K of memory - indicate that each array element will be
  27. ' 80 characters long
  28.  
  29.     CLS
  30.     FreeSpace = FRE(-1)
  31.     IF FreeSpace < 100000 THEN
  32.         CLS
  33.         PRINT " ...Not enough storage to demonstrate this program"
  34.         PRINT " ...Terminating"
  35.         END
  36.     ELSE
  37.         PRINT " ...Working"
  38.     END IF
  39.  
  40.     Release = SETMEM(-80000)
  41.  
  42.     MemSize% = 64
  43.     Array.Size% = 80
  44.  
  45.     CALL DosMAllc(Block%, MemSize%, Array.Size%, Rc%)
  46.     IF Rc% <> 0 THEN
  47.         PRINT "Error allocating memory: code "; Rc%
  48.         END
  49.     END IF
  50.  
  51. ' Let's fill the array with consecutive numbers
  52.  
  53.     String.out$ = SPACE$(Array.Size%)
  54.     Index% = 0
  55.     WHILE Rc% = 0
  56.         MID$(String.out$, 1, LEN(STR$(Index%))) = STR$(Index%)
  57.         CALL DosMPut(Block%, Index%, String.out$, Rc%)
  58.         IF Rc% <> 0 THEN
  59.             PRINT Rc%, "Memory array is filled with "; Index%; " records";
  60.         ELSE
  61.             Index% = Index% + 1
  62.         END IF
  63.     WEND
  64.     Rc% = 0
  65.     Mem.Ubound% = Index% - 1
  66.  
  67. ' Let's retrieve every element in the array and print it on the console
  68.  
  69.     String.out$ = SPACE$(Array.Size%)
  70.     Index% = 0
  71.     WHILE Rc% = 0
  72.         CALL DosMGet(Block%, Index%, String.out$, Rc%)
  73.         IF Rc% <> 0 THEN
  74.             PRINT "All records have been re-read"
  75.         ELSE
  76.             PRINT String.out$
  77.             Index% = Index% + 1
  78.         END IF
  79.     WEND
  80.  
  81. ' Finally, let's de-allocate the array
  82.  
  83.     CALL DosMFree(0, Rc%)
  84.  
  85. ' Return it to QB far heap
  86.  
  87.     Allocate = SETMEM(80000)
  88.  
  89.     END
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.