home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / huge / huge.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-09  |  3.8 KB  |  123 lines
  1. 'HUGE.BAS version .01 ⌐1992 Marquis Computing. All rights are reserved.
  2. DefInt A-Z
  3. Declare Function GlobalSize Lib "Kernel" (ByVal hmem As Integer) As Long
  4. Declare Function GlobalAlloc Lib "Kernel" (ByVal wFlags As Integer, ByVal dwbytes As Long) As Integer
  5. Declare Function GlobalFree Lib "Kernel" (ByVal hmem As Integer) As Integer
  6. Declare Function GlobalLock Lib "Kernel" (ByVal hmem As Integer) As Long
  7. Declare Function GlobalUnlock Lib "Kernel" (ByVal hmem As Integer) As Integer
  8. Declare Function lstrcpy Lib "Kernel" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
  9. Declare Sub hmemcpy Lib "kernel" (ByVal lpdest&, ByVal lpsource&, ByVal dwbytes&)
  10. Declare Function GetVersion Lib "Kernel" () As Integer
  11. Dim ha&(0 To 10, 0 To 4)
  12.  
  13.  
  14. Sub GetREC ()
  15.     On Error GoTo GetRECE
  16.     If handle < 1 Or handle > 15 Then Error 104
  17.     recsize = 100
  18.     headsize = 0
  19.     Get handle, (headsize + (recsize * record)) - recsize + 1, recdata
  20.     status = 0
  21. GetRECExit:
  22.     On Error GoTo 0
  23.     Exit Sub
  24. GetRECE:
  25.     status = Err
  26.     Resume GetRECExit
  27. End Sub
  28.  
  29. Sub HugeDIM (handle%, status%, recordsize%, elements%)
  30.     On Error GoTo HugeDIME
  31.     If ha(0, 0) + 1 > UBound(ha, 1) Then Error 171 Else handle = ha(0, 0) + 1
  32.     If GetVersion() \ 256 < 10 Then Error 174
  33.     dwbytes& = CLng(recordsize) * elements
  34.     hmem = GlobalAlloc(64, dwbytes&)
  35.     If GlobalSize(hmem) < dwbytes& Then Error 170 Else hmemptr& = GlobalLock(hmem)
  36.     ha(0, 0) = handle
  37.     ha(handle, 1) = hmem
  38.     ha(handle, 2) = hmemptr&
  39.     ha(handle, 3) = recordsize
  40.     ha(handle, 4) = elements
  41.     status = 0
  42. HugeDIMExit:
  43.     On Error GoTo 0
  44.     Exit Sub
  45. HugeDIME:
  46.     status = Err
  47.     Resume HugeDIMExit
  48. End Sub
  49.  
  50. Function HugeERR (status%) As String
  51.     Select Case status%
  52.         Case 170: msg$ = "Not enough memory to create HUGE array"
  53.         Case 171: msg$ = "No more HUGE handles available"
  54.         Case 172: msg$ = "Invalid HUGE element requested"
  55.         Case 173: msg$ = "HUGE handle invalid"
  56.         Case 174: msg$ = "Windows version 3.10 or higher required"
  57.     End Select
  58.     HugeERR = "Error" + Str$(status) + Chr$(10) + Chr$(10) + msg$
  59. End Function
  60.  
  61. Sub HugeGET (handle%, status%, element%, recdata$)
  62.     On Error GoTo HugeGETE
  63.     If handle < 1 Or handle > UBound(ha, 1) Then Error 173
  64.     If element < 1 Or element > ha(handle, 4) Then Error 172
  65.     recdata$ = Space$(ha(handle, 3))
  66.     hmemcpy lstrcpy(ByVal recdata$, ByVal recdata$), ha(handle, 2) + (CLng(element - 1) * ha(handle, 3)), Len(recdata$)
  67.     status = 0
  68. HugeGETExit:
  69.     On Error GoTo 0
  70.     Exit Sub
  71. HugeGETE:
  72.     status = Err
  73.     Resume HugeGETExit
  74. End Sub
  75.  
  76. Sub HugePUT (handle%, status%, element%, recdata$)
  77.     On Error GoTo HugePUTE
  78.     If handle < 1 Or handle > UBound(ha, 1) Then Error 173
  79.     If element < 1 Or element > ha(handle, 4) Then Error 172
  80.     hmemcpy ha(handle, 2) + (CLng(element - 1) * ha(handle, 3)), lstrcpy(ByVal recdata$, ByVal recdata$), Len(recdata$)
  81.     status = 0
  82. HugePUTExit:
  83.     On Error GoTo 0
  84.     Exit Sub
  85. HugePUTE:
  86.     status = Err
  87.     Resume HugePUTExit
  88. End Sub
  89.  
  90. Sub HugeZAP (handle%, status%)
  91.     On Error GoTo HugeZAPE
  92.     If handle < 1 Or handle > UBound(ha, 1) Then Error 173
  93.     status = GlobalUnlock(ha(handle, 1)) Or GlobalFree(ha(handle, 1))
  94.     ha(0, 0) = ha(0, 0) - 1
  95.     ha(handle, 1) = 0
  96.     ha(handle, 2) = 0
  97.     ha(handle, 3) = 0
  98.     ha(handle, 4) = 0
  99. HugeZAPExit:
  100.     On Error GoTo 0
  101.     handle = 0
  102.     Exit Sub
  103. HugeZAPE:
  104.     status = Err
  105.     Resume HugeZAPExit
  106. End Sub
  107.  
  108. Sub PutREC (handle%, status%, record, recdata$)
  109.     On Error GoTo PutRECE
  110.     If handle < 1 Or handle > 15 Then Error 104
  111.     recsize = 100
  112.     headsize = 0
  113.     Put handle, (headsize + (recsize * record)) - recsize + 1, recdata
  114.     status = 0
  115. PutRECExit:
  116.     On Error GoTo 0
  117.     Exit Sub
  118. PutRECE:
  119.     status = Err
  120.     Resume PutRECExit
  121. End Sub
  122.  
  123.