BASIC PRODUCTION
Dos Basic like POKE and PEEK functions for VB6
Original Author: BASIC PRODUCTION
API Declarations
Private Declare Sub GetMem1 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Byte)
Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Integer)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
Private Declare Sub GetMem8 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Currency)
Private Declare Sub PutMem1 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Byte)
Private Declare Sub PutMem2 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Integer)
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Long)
Private Declare Sub PutMem8 Lib "msvbvm60" (ByVal Addr As Long, ByVal NewVal As Currency)
Code
Sub POKE(ByVal Address As Variant, ByVal Value As Variant, Optional ByVal HowMuchBits As Byte = 32)
Select Case HowMuchBits
Case 8
PutMem1 Address, Value
Case 16
PutMem2 Address, Value
Case 32
PutMem4 Address, Value
Case 64
PutMem8 Address, Value
Case Else
MsgBox "Invalid value length" & vbCr & vbCr & "Must be one from: 8/16/32/64" & vbCr & vbCr & vbTab & "8 - Byte (unsigned)" & vbCr & vbTab & "16 - Word/Integer" & vbCr & vbTab & "32 - Dword/Long" & vbCr & vbTab & "64 - Qword/Currency"
End Select
End Sub
Function PEEK(ByVal Address As Long, Optional ByVal HowMuchBits As Byte = 32) As Variant
Dim Value As Variant
Select Case HowMuchBits
Case 8
GetMem1 Address, Value
Case 16
GetMem2 Address, Value
Case 32
GetMem4 Address, Value
Case 64
GetMem8 Address, Value
Case Else
MsgBox "Invalid value length" & vbCr & vbCr & "Must be one from: 8/16/32/64" & vbCr & vbCr & vbTab & "8 - Byte (unsigned)" & vbCr & vbTab & "16 - Word/Integer" & vbCr & vbTab & "32 - Dword/Long" & vbCr & vbTab & "64 - Qword/Currency"
Exit Function
End Select
PEEK = Value
End Function
Private Sub Form_Load()
Dim Var_Byte As Byte, Var_Int As Integer, Var_Lng As Long, Var_Curr As Currency
Var_Byte = 123: Var_Int = 1234: Var_Lng = 123456: Var_Curr = CDec(5234567890#)
Dim strMsg As String
strMsg = "Get value of variables by address with PEEK:" & vbCr
strMsg = strMsg & "BYTE: " & PEEK(VarPtr(Var_Byte), 8) & vbCr
strMsg = strMsg & "INTEGER: " & PEEK(VarPtr(Var_Int), 16) & vbCr
strMsg = strMsg & "LONG: " & PEEK(VarPtr(Var_Lng)) & vbCr
strMsg = strMsg & "CURRENCY: " & PEEK(VarPtr(Var_Curr), 64)
MsgBox strMsg
POKE VarPtr(Var_Byte), 210, 8
POKE VarPtr(Var_Int), 4321, 16
POKE VarPtr(Var_Lng), 654321
POKE VarPtr(Var_Curr), CDec(9999999999#), 64
strMsg = "Values of variables was changed with POKE:" & vbCr
strMsg = strMsg & "BYTE: " & Var_Byte & vbCr
strMsg = strMsg & "INTEGER: " & Var_Int & vbCr
strMsg = strMsg & "LONG: " & Var_Lng & vbCr
strMsg = strMsg & "CURRENCY: " & Var_Curr & vbCr
MsgBox strMsg
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.