VB指针类

Tesla.Angela

就是集成了的指针操作的函数，能方便地操作BYTE、WORD、LONG、Single、Double、BSTR和UNICODE_STRING的指针。

'//////////////////////////////
'VB Pointer Class v0.1
'Code By Tesla.Angela(GDUT.HWL)
'//////////////////////////////
Option Explicit

Private Type UNICODE_STRING
    Length As Integer
    MaxLength As Integer
    pBuffer As Long
End Type

Private Declare Function lstrlenW Lib "KERNEL32" (ByVal lpString As Long) As Long
Private Declare Function lstrcpyW Lib "KERNEL32" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" (ByVal pDst As Long, ByVal pSrc As Long, ByVal dwLength As Long)

Public Function ChrFromPtr(ByVal pChr As Long) As Byte
    RtlMoveMemory VarPtr(ChrFromPtr), pChr, 1
End Function

Public Function IntFromPtr(ByVal pInt As Long) As Integer
    RtlMoveMemory VarPtr(IntFromPtr), pInt, 2
End Function

Public Function LngFromPtr(ByVal pLng As Long) As Long
    RtlMoveMemory VarPtr(LngFromPtr), pLng, 4
End Function

Public Function SngFromPtr(ByVal pSng As Long) As Single
    RtlMoveMemory VarPtr(SngFromPtr), pSng, 4
End Function

Public Function DblFromPtr(ByVal pDbl As Long) As Double
    RtlMoveMemory VarPtr(DblFromPtr), pDbl, 8
End Function

Public Function StrFromBsPtr(ByVal pString As Long) As String
    StrFromBsPtr = String(lstrlenW(pString), Chr(0))
    lstrcpyW StrPtr(StrFromBsPtr), pString
End Function

Public Function StrFromUsPtr(ByVal pUnicodeString As Long) As String
    Dim uStr As UNICODE_STRING
    RtlMoveMemory VarPtr(uStr), pUnicodeString, 8
    StrFromUsPtr = Space(uStr.Length / 2)
    RtlMoveMemory VarPtr(StrFromUsPtr), VarPtr(uStr.pBuffer), 4
End Function

Tesla.Angela

调用方法：

Option Explicit

Private Declare Function RtlInitUnicodeString Lib "NTDLL.DLL" _
                        (ByVal DestinationString As Long, ByVal SourceString As Long) As Long
Private x As New cls_VB6Ptr

Private Sub Command1_Click()
Dim q As Byte: q = 123
Dim w As Integer: w = 12345
Dim e As Long: e = 12345678
Dim r As Single: r = 12.21
Dim t As Double: t = 123456.654321
MsgBox x.ChrFromPtr(VarPtr(q)), , "q"
MsgBox x.IntFromPtr(VarPtr(w)), , "w"
MsgBox x.LngFromPtr(VarPtr(e)), , "e"
MsgBox x.SngFromPtr(VarPtr(r)), , "r"
MsgBox x.DblFromPtr(VarPtr(t)), , "t"
End Sub

Private Sub Command2_Click()
Dim y As String: y = "helloworld你好世界"
Dim u As String: u = "你好世界helloworld"
Dim pUs As Long: Call RtlInitUnicodeString(VarPtr(pUs), StrPtr(u)) 'pUs是PUNICODE_STRING
MsgBox x.StrFromBsPtr(StrPtr(y)), , "StrFromBsPtr"
MsgBox x.StrFromUsPtr(VarPtr(pUs)), , "StrFromUsPtr"
End Sub

FlamesTsui

:loveliness:收藏看看