VB6中的指针模块（VB、指针）

////既然决定要重新启用这个blog，那么就找点以前的东西贴上来充实下内容吧^_*

VB6中的指针模块

关键词： VB   VB6   指针   模块

很久以前写的一个可以在VB6中实现指针的模块，用于对大量密集数据进行操作（比如per Pixel的图像运算）。

标准支持Byte，Integer，Long，Boolean，四种数据类型的指针，当然还可以很容易修改成为其它类型。 方便程度还行， 速度很快（当然前提要编译成本地EXE），在大量数据运算或密集内存访问的时候还是非常有用的。

 

 

'=============================================================================================================
'================                     *****   VB6 Pointer Module    *****                   ===================
'================                     You can use the pointer like in VC                   ===================
'================                          Copyright: sandy_zc_1                           ===================
'================                     #### Email:[e-mail] ####                   ===================
'=============================================================================================================
'=============================================================================================================
'================                     *****      VB6 指针模块       *****                   ===================
'================                          你可以像在VC中一样使用指针                      ===================
'================                          版权所有： sandy_zc_1                           ===================
'================                     #### Email:[e-mail] ####                   ===================
'=============================================================================================================


Public Declare Sub CopyMemory()Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function VarPtrArray()Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long





'--------------------------------
'－－VB指针结构－－－－－－－－－
Public Type t_Pointer_Long1  '－－－－－－－－－－－－－－－－－Long型指针
    Inited1 As Boolean      '－是否已初始化
    Type1 As Long           '－类型
    PAddress1() As Long        '－指针数据
    PValue1() As Long         '－指向的数据  （*操作符）
    bkPAddrOrg1 As Long     '－系统：释放用数据1 （原PAddr地址）
    bkPValOrg1 As Long      '－系统：释放用数据2 （原PVal地址）
End Type

Public Type t_Pointer_Integer1   '－－－－－－－－－－－－－－－Integer型指针
    Inited1 As Boolean      '－是否已初始化
    Type1 As Long           '－类型
    PAddress1() As Long        '－指针数据
    PValue1() As Integer      '－指向的数据  （*操作符）
    bkPAddrOrg1 As Long     '－系统：释放用数据1 （原PAddr地址）
    bkPValOrg1 As Long      '－系统：释放用数据2 （原PVal地址）
End Type

Public Type t_Pointer_Byte1   '－－－－－－－－－－－－－－－－－Byte型指针
    Inited1 As Boolean      '－是否已初始化
    Type1 As Long           '－类型
    PAddress1() As Long        '－指针数据
    PValue1() As Byte       '－指向的数据  （*操作符）
    bkPAddrOrg1 As Long     '－系统：释放用数据1 （原PAddr地址）
    bkPValOrg1 As Long      '－系统：释放用数据2 （原PVal地址）
End Type

Public Type t_Pointer_Boolean1   '－－－－－－－－－－－－－－－Boolean型指针
    Inited1 As Boolean      '－是否已初始化
    Type1 As Long           '－类型
    PAddress1() As Long        '－指针数据
    PValue1() As Boolean       '－指向的数据  （*操作符）
    bkPAddrOrg1 As Long     '－系统：释放用数据1 （原PAddr地址）
    bkPValOrg1 As Long      '－系统：释放用数据2 （原PVal地址）
End Type



'-------------------------------Long指针操作
Function InitPointerLong1()Function InitPointerLong1(pL1 As t_Pointer_Long1)
    Dim PP1 As Long, tmpP1 As Long
    Dim pAddrSt1 As Long, pValSt1 As Long
    
    ReDim pL1.PAddress1(0 To 0) As Long
    ReDim pL1.PValue1(0 To 0) As Long
    
    pL1.Type1 = vbLong
    
    PP1 = VarPtrArray(pL1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    PP1 = VarPtrArray(pL1.PValue1)
    CopyMemory pValSt1, ByVal PP1, 4
    
    CopyMemory pL1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
    CopyMemory pL1.bkPValOrg1, ByVal (pValSt1 + 12), 4
    
    tmpP1 = pValSt1 + 12
    
    CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
    
    pL1.Inited1 = True
End Function
Function SetPointerLong1()Function SetPointerLong1(pL1 As t_Pointer_Long1, ByRef Target1 As Long)
    pL1.PAddress1(0) = VarPtr(Target1)
End Function

Function FreePointerLong1()Function FreePointerLong1(pL1 As t_Pointer_Long1)
    Dim PP1 As Long, pAddrSt1 As Long
    pL1.PAddress1(0) = pL1.bkPValOrg1
    
    PP1 = VarPtrArray(pL1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    CopyMemory ByVal (pAddrSt1 + 12), pL1.bkPAddrOrg1, 4
    pL1.Inited1 = False
End Function

'-----------------------------Integer指针操作

Function InitPointerInteger1()Function InitPointerInteger1(pI1 As t_Pointer_Integer1)
    Dim PP1 As Long, tmpP1 As Long
    Dim pAddrSt1 As Long, pValSt1 As Long
    
    ReDim pI1.PAddress1(0 To 0) As Long
    ReDim pI1.PValue1(0 To 0) As Integer
    
    pI1.Type1 = vbInteger
    
    PP1 = VarPtrArray(pI1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    PP1 = VarPtrArray(pI1.PValue1)
    CopyMemory pValSt1, ByVal PP1, 4
    
    CopyMemory pI1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
    CopyMemory pI1.bkPValOrg1, ByVal (pValSt1 + 12), 4
    
    tmpP1 = pValSt1 + 12
    
    CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
    
    pI1.Inited1 = True
End Function
Function SetPointerInteger1()Function SetPointerInteger1(pI1 As t_Pointer_Integer1, ByRef Target1 As Integer)
    pI1.PAddress1(0) = VarPtr(Target1)
End Function

Function FreePointerInteger1()Function FreePointerInteger1(pI1 As t_Pointer_Integer1)
    Dim PP1 As Long, pAddrSt1 As Long
    pI1.PAddress1(0) = pI1.bkPValOrg1
    
    PP1 = VarPtrArray(pI1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    CopyMemory ByVal (pAddrSt1 + 12), pI1.bkPAddrOrg1, 4
    pI1.Inited1 = False
End Function

'-----------------------------Byte指针操作

Function InitPointerByte1()Function InitPointerByte1(pByte1 As t_Pointer_Byte1)
    Dim PP1 As Long, tmpP1 As Long
    Dim pAddrSt1 As Long, pValSt1 As Long
    
    ReDim pByte1.PAddress1(0 To 0) As Long
    ReDim pByte1.PValue1(0 To 0) As Byte
    
    pByte1.Type1 = vbByte
    
    PP1 = VarPtrArray(pByte1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    PP1 = VarPtrArray(pByte1.PValue1)
    CopyMemory pValSt1, ByVal PP1, 4
    
    CopyMemory pByte1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
    CopyMemory pByte1.bkPValOrg1, ByVal (pValSt1 + 12), 4
    
    tmpP1 = pValSt1 + 12
    
    CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
    
    pByte1.Inited1 = True
End Function
Function SetPointerByte1()Function SetPointerByte1(pByte1 As t_Pointer_Byte1, ByRef Target1 As Byte)
    pByte1.PAddress1(0) = VarPtr(Target1)
End Function

Function FreePointerByte1()Function FreePointerByte1(pByte1 As t_Pointer_Byte1)
    Dim PP1 As Long, pAddrSt1 As Long
    pByte1.PAddress1(0) = pByte1.bkPValOrg1
    
    PP1 = VarPtrArray(pByte1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    CopyMemory ByVal (pAddrSt1 + 12), pByte1.bkPAddrOrg1, 4
    pByte1.Inited1 = False
End Function

'-----------------------------Boolean指针操作

Function InitPointerBoolean1()Function InitPointerBoolean1(pBool1 As t_Pointer_Boolean1)
    Dim PP1 As Long, tmpP1 As Long
    Dim pAddrSt1 As Long, pValSt1 As Long
    
    ReDim pBool1.PAddress1(0 To 0) As Long
    ReDim pBool1.PValue1(0 To 0) As Boolean
    
    pBool1.Type1 = vbBoolean
    
    PP1 = VarPtrArray(pBool1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    PP1 = VarPtrArray(pBool1.PValue1)
    CopyMemory pValSt1, ByVal PP1, 4
    
    CopyMemory pBool1.bkPAddrOrg1, ByVal (pAddrSt1 + 12), 4
    CopyMemory pBool1.bkPValOrg1, ByVal (pValSt1 + 12), 4
    
    tmpP1 = pValSt1 + 12
    
    CopyMemory ByVal (pAddrSt1 + 12), tmpP1, 4
    
    pBool1.Inited1 = True
End Function
Function SetPointerBoolean1()Function SetPointerBoolean1(pBool1 As t_Pointer_Boolean1, ByRef Target1 As Boolean)
    pBool1.PAddress1(0) = VarPtr(Target1)
End Function

Function FreePointerBoolean1()Function FreePointerBoolean1(pBool1 As t_Pointer_Boolean1)
    Dim PP1 As Long, pAddrSt1 As Long
    pBool1.PAddress1(0) = pBool1.bkPValOrg1
    
    PP1 = VarPtrArray(pBool1.PAddress1)
    CopyMemory pAddrSt1, ByVal PP1, 4
    
    CopyMemory ByVal (pAddrSt1 + 12), pBool1.bkPAddrOrg1, 4
    pBool1.Inited1 = False
End Function

 

使用方法很简单，添加到VB6的工程中去，若需要一个Byte型指针，就定义一个 t_Pointer_Byte类型变量，然后调用InitPointerByte1把它初始化一下，就可以当指针用了。

要让它指向某个Byte变量a只需调用SetPointerByte1，把它和a传过去就可以。当然可以直接操作它的PAddress1(0)成员值来直接指定它指向的位置。获得指向区域的值(*运算)只需要访问它的PValue1(0)成员即可。

使用完成后不要忘了调用FreePointerByte1释放指针（不然VB6的IDE可能会崩掉）就OK了。其它类型的指针使用方法一模一样。

呵呵这样VB6中就可以很方便的使用指针了，当然这样调试的话要学会养成和C程序员一样先保存的习惯哟，毕竟使用指针相对来说还是比较危险的，IDE崩掉了没来得及保存代码别怪我啊，呵呵。

简单例子：

 

Sub Test1()Sub Test1()
Dim p as t_Pointer_Byte1,a as Byte

InitPointerByte1(p) '初始化p
SetPointerByte1(p,a) '让p指向a
'这里可以试试指针的效果了：
p.PValue1(0)=10 '把指针指向的地方值设为10
debug.Print a '看看a的值变了没有
FreePointerByte1 (p) '释放p
End Sub

 

很久以前的代码了，因为觉得差不多够用，也没有做过进一步的改进。有意见或问题的可以留言。