VB中如何得到一个文件的句柄？

Posted 2023-05-06

我需要读取一个文件的创建时间、修改时间，使用API必须知道这个文件的句柄，请问怎么得到？

\'这是一个获取文件信息的程序
form部分
Private Sub DisplayVerInfo()
\'*** 这个子程序获取文件的版本信息 ****
Dim rc As Long
Dim lDummy As Long
Dim sBuffer() As Byte
Dim lBufferLen As Long
Dim lVerPointer As Long
Dim udtVerBuffer As VS_FIXEDFILEINFO
Dim lVerbufferLen As Long
Dim aBuffer() As Byte
Dim lAdd As Long
Dim astr As String
Dim lTran As Long
\'*** Get size ****
lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
If lBufferLen < 1 Then
MsgBox "无法获取文件版本信息!"
Exit Sub
End If
\'**** 获取文件信息并且保存到udtVerBuffer结构中 ****
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\\", lVerPointer, lVerbufferLen)
MoveMemory udtVerBuffer, lVerPointer, Len(udtVerBuffer)

StrucVer = Format$(udtVerBuffer.dwStrucVersionh) & "." & _
Format$(udtVerBuffer.dwStrucVersionl)
\'**** 获得文件版本 ****
FileVer = Format$(udtVerBuffer.dwFileVersionMSh) & "." & _
Format$(udtVerBuffer.dwFileVersionMSl) & "." & _
Format$(udtVerBuffer.dwFileVersionLSh) & "." & _
Format$(udtVerBuffer.dwFileVersionLSl)
\'**** 获取产品版本 ****
ProdVer = Format$(udtVerBuffer.dwProductVersionMSh) & "." & _
Format$(udtVerBuffer.dwProductVersionMSl) & "." & _
Format$(udtVerBuffer.dwProductVersionLSh) & "." & _
Format$(udtVerBuffer.dwProductVersionLSl)
\'**** 获取文件类型 ****
FileFlags = ""
If udtVerBuffer.dwFileFlags And VS_FF_DEBUG _
Then FileFlags = "Debug "
If udtVerBuffer.dwFileFlags And VS_FF_PRERELEASE _
Then FileFlags = FileFlags & "PreRel "
If udtVerBuffer.dwFileFlags And VS_FF_PATCHED _
Then FileFlags = FileFlags & "Patched "
If udtVerBuffer.dwFileFlags And VS_FF_PRIVATEBUILD _
Then FileFlags = FileFlags & "Private "
If udtVerBuffer.dwFileFlags And VS_FF_INFOINFERRED _
Then FileFlags = FileFlags & "Info "
If udtVerBuffer.dwFileFlags And VS_FF_SPECIALBUILD _
Then FileFlags = FileFlags & "Special "
If udtVerBuffer.dwFileFlags And VFT2_UNKNOWN _
Then FileFlags = FileFlags "Unknown "
\'**** 获取文件所适应的操作系统 ****
Select Case udtVerBuffer.dwFileOS
Case VOS_WINDOWS32
FileOS = "Win32位操作系统"
Case VOS_WINDOWS16
FileOS = "Win16位操作系统"
Case VOS_DOS
FileOS = "DOS操作系统"
Case VOS_DOS_WINDOWS16
FileOS = "DOS-Win16操作系统"
Case VOS_DOS_WINDOWS32
FileOS = "DOS-Win32操作系统"
Case VOS_OS216_PM16
FileOS = "OS/2-16 PM-16操作系统"
Case VOS_OS232_PM32
FileOS = "OS/2-16 PM-32操作系统"
Case VOS_NT_WINDOWS32
FileOS = "NT-Win32操作系统"
Case Else
FileOS = "未知操作系统"
End Select
Select Case udtVerBuffer.dwFileType
Case VFT_APP
FileType = "应用程序"
Case VFT_DLL
FileType = "动态连接库"
Case VFT_DRV
FileType = "驱动程序"
Select Case udtVerBuffer.dwFileSubtype
Case VFT2_DRV_PRINTER
FileSubType = "打印驱动程序"
Case VFT2_DRV_KEYBOARD
FileSubType = "键盘驱动程序"
Case VFT2_DRV_LANGUAGE
FileSubType = "语言模块"
Case VFT2_DRV_DISPLAY
FileSubType = "显示驱动程序"
Case VFT2_DRV_MOUSE
FileSubType = "鼠标驱动程序"
Case VFT2_DRV_NETWORK
FileSubType = "网络驱动程序"
Case VFT2_DRV_SYSTEM
FileSubType = "系统驱动程序"
Case VFT2_DRV_INSTALLABLE
FileSubType = "Installable"
Case VFT2_DRV_SOUND
FileSubType = "声音驱动程序"
Case VFT2_DRV_COMM
FileSubType = "串行驱动程序"
Case VFT2_UNKNOWN
FileSubType = "未知驱动程序"
End Select
Case VFT_FONT
FileType = "字体"
Select Case udtVerBuffer.dwFileSubtype
Case VFT_FONT_RASTER
FileSubType = "光栅字体"
Case VFT_FONT_VECTOR
FileSubType = "矢量字体"
Case VFT_FONT_TRUETYPE
FileSubType = "TrueType字体"
End Select
Case VFT_VXD
FileType = "VxD"
Case VFT_STATIC_LIB
FileType = "Lib"
Case Else
FileType = "未知"
End Select
Form1.CurrentX = 4
Form1.CurrentY = 4
Form1.Print "文件全路径:"
Form1.CurrentX = 4
Form1.Print "文件版本:"
Form1.CurrentX = 4
Form1.Print "产品版本:"
Form1.CurrentX = 4
Form1.Print "文件标志:"
Form1.CurrentX = 4
Form1.Print "操作系统:"
Form1.CurrentX = 4
Form1.Print "文件类型:"
Form1.CurrentX = 4
Form1.Print "文件子类型:"
Form1.CurrentX = 60
Form1.CurrentY = 4
Form1.Print FullFileName
Form1.CurrentX = 60
Form1.Print FileVer
Form1.CurrentX = 60
Form1.Print ProdVer
Form1.CurrentX = 60
Form1.Print FileFlags
Form1.CurrentX = 60
Form1.Print FileOS
Form1.CurrentX = 60
Form1.Print FileType
Form1.CurrentX = 60
Form1.Print FileSubType
\'清除上一次保存的信息
FullFileName = ""
FileVer = ""
ProdVer = ""
FileFlags = ""
FileOS = ""
FileType = ""
FileSubType = ""

ReDim aBuffer(lBufferLen)
Dim ab As VS_NEWINFO

lVerPointer = 0
rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
rc = VerQueryValue(sBuffer(0), "\\VarFileInfo\\Translation", lVerPointer, lVerbufferLen)
MoveMemory lTran, lVerPointer, 4&
astr = "0" Hex$(lTran)
astr = Right$(astr, 4) Left$(astr, 4)
rc = VerQueryValue(sBuffer(0), "\\StringFileInfo\\" astr "\\FileDescription", lVerPointer, lVerbufferLen)
MoveMemory ab, lVerPointer, Len(ab)
Form1.CurrentX = 4
Form1.Print "文件描述";
Form1.CurrentX = 60
Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))

rc = VerQueryValue(sBuffer(0), "\\StringFileInfo\\" astr "\\ProductName", lVerPointer, lVerbufferLen)
If rc Then
MoveMemory ab, lVerPointer, Len(ab)
Form1.CurrentX = 4
Form1.Print "产品名称";
Form1.CurrentX = 60
Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
End If

rc = VerQueryValue(sBuffer(0), "\\StringFileInfo\\" astr "\\OriginalFilename", lVerPointer, lVerbufferLen)
If rc Then
MoveMemory ab, lVerPointer, Len(ab)
Form1.CurrentX = 4
Form1.Print "文件原始名";
Form1.CurrentX = 60
Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
End If

rc = VerQueryValue(sBuffer(0), "\\StringFileInfo\\" astr "\\InternalName", lVerPointer, lVerbufferLen)
If rc Then
MoveMemory ab, lVerPointer, Len(ab)
Form1.CurrentX = 4
Form1.Print "文件内部名";
Form1.CurrentX = 60
Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
End If

rc = VerQueryValue(sBuffer(0), "\\StringFileInfo\\" astr "\\CompanyName", lVerPointer, lVerbufferLen)
If rc Then
MoveMemory ab, lVerPointer, Len(ab)
Form1.CurrentX = 4
Form1.Print "公司名称";
Form1.CurrentX = 60
Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
End If

rc = VerQueryValue(sBuffer(0), "\\StringFileInfo\\" astr "\\LegalCopyright", lVerPointer, lVerbufferLen)
If rc Then
MoveMemory ab, lVerPointer, Len(ab)
Form1.CurrentX = 4
Form1.Print "版权所有";
Form1.CurrentX = 60
Form1.Print Left$(ab.astr, (InStr(ab.astr, Chr$(0)) - 1))
End If
End Sub
Private Sub Command1_Click()
Form1.Cls
CommonDialog1.ShowOpen
FullFileName = CommonDialog1.Filename
If FullFileName = "" Then
Exit Sub
End If
Call DisplayVerInfo
End Sub

模块部分
\' **** 全局定义 ****
Public Filename As String
Public Directory As String
Public FullFileName As String
Public StrucVer As String
Public FileVer As String
Public ProdVer As String
Public FileFlags As String
Public FileOS As String
Public FileType As String
Public FileSubType As String

Type VS_NEWINFO
astr As String * 1024
End Type

Type VS_FIXEDFILEINFO
dwSignature As Long
dwStrucVersionl As Integer
dwStrucVersionh As Integer
dwFileVersionMSl As Integer
dwFileVersionMSh As Integer
dwFileVersionLSl As Integer
dwFileVersionLSh As Integer
dwProductVersionMSl As Integer
dwProductVersionMSh As Integer
dwProductVersionLSl As Integer
dwProductVersionLSh As Integer
dwFileFlagsMask As Long
dwFileFlags As Long
dwFileOS As Long
dwFileType As Long
dwFileSubtype As Long
dwFileDateMS As Long
dwFileDateLS As Long
End Type
Declare Function GetFileVersionInfo Lib "Version.dll" Alias _
"GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal _
dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias _
"GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, _
lpdwHandle As Long) As Long
Declare Function VerQueryValue Lib "Version.dll" Alias _
"VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, _
lplpBuffer As Any, puLen As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(dest As Any, ByVal Source As Long, ByVal length As Long)
Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal Path As String, ByVal cbBytes As Long) As Long

Public Const VS_FFI_SIGNATURE = &HFEEF04BD
Public Const VS_FFI_STRUCVERSION = &H10000
Public Const VS_FFI_FILEFLAGSMASK = &H3F&

Public Const VS_FF_DEBUG = &H1
Public Const VS_FF_PRERELEASE = &H2
Public Const VS_FF_PATCHED = &H4
Public Const VS_FF_PRIVATEBUILD = &H8
Public Const VS_FF_INFOINFERRED = &H10
Public Const VS_FF_SPECIALBUILD = &H20

Public Const VOS_UNKNOWN = &H0
Public Const VOS_DOS = &H10000
Public Const VOS_OS216 = &H20000
Public Const VOS_OS232 = &H30000
Public Const VOS_NT = &H40000
Public Const VOS_BASE = &H0
Public Const VOS_WINDOWS16 = &H1
Public Const VOS_PM16 = &H2
Public Const VOS_PM32 = &H3
Public Const VOS_WINDOWS32 = &H4
Public Const VOS_DOS_WINDOWS16 = &H10001
Public Const VOS_DOS_WINDOWS32 = &H10004
Public Const VOS_OS216_PM16 = &H20002
Public Const VOS_OS232_PM32 = &H30003
Public Const VOS_NT_WINDOWS32 = &H40004

Public Const VFT_UNKNOWN = &H0
Public Const VFT_APP = &H1
Public Const VFT_DLL = &H2
Public Const VFT_DRV = &H3
Public Const VFT_FONT = &H4
Public Const VFT_VXD = &H5
Public Const VFT_STATIC_LIB = &H7

Public Const VFT2_UNKNOWN = &H0
Public Const VFT2_DRV_PRINTER = &H1
Public Const VFT2_DRV_KEYBOARD = &H2
Public Const VFT2_DRV_LANGUAGE = &H3
Public Const VFT2_DRV_DISPLAY = &H4
Public Const VFT2_DRV_MOUSE = &H5
Public Const VFT2_DRV_NETWORK = &H6
Public Const VFT2_DRV_SYSTEM = &H7
Public Const VFT2_DRV_INSTALLABLE = &H8
Public Const VFT2_DRV_SOUND = &H9
Public Const VFT2_DRV_COMM = &HA 参考技术A VB声明
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
说明
寻找窗口列表中第一个符合指定条件的顶级窗口（在vb里使用：FindWindow最常见的一个用途是获得ThunderRTMain类的隐藏窗口的句柄；该类是所有运行中vb执行程序的一部分。获得句柄后，可用api函数GetWindowText取得这个窗口的名称；该名也是应用程序的标题）
返回值
Long，找到窗口的句柄。如未找到相符窗口，则返回零。会设置GetLastError
参数表
参数 类型及说明
lpClassName String，指向包含了窗口类名的空中止（C语言）字串的指针；或设为零，表示接收任何类
lpWindowName String，指向包含了窗口文本（或标签）的空中止（C语言）字串的指针；或设为零，表示接收任何窗口标题

参考资料：http://thetop.xizee.com/VBAPI_web/FindWindow.htm

VB 如何获取屏幕图片数据保存在一个二进制数组里面？

VB程序中我会用BITBLT把flash动画抓到内存中，可是如何把这个图片数据保存在一个二进制数组里面？中间不要经过什么图片等控件，直接根据桌面窗口的设备句柄和位图句柄 存储这个二进制数据(Byte数组)，要和Open语句读取的数据一样，其中不包括文件头信息和图片数据，该怎么实现？即只把RGB信息存入数组即可。我不想先生成BMP图片文件以后再用Open语句读取，请高手不吝赐教！
数组中只存放颜色数据，不需要别的数据，如文件头就不要。我再把颜色数据转换成别的数据，不知道速度能发跟上。每抓一张就转换一张。请高手先讲讲思路，在写源码，最好来点注释，分不够我可以再给。

这种处理就是纯粹位图处理了
既然已经获取了窗口的设备句柄 hdc
那就 由 CreateDIBSection 生成一个位图对象
用 BitBlt 将窗口图象复制到位图对象中
CreateDIBSection 生成的位图对象的数据就可以放到 Byte数组中了

Private Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type

Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type

Private Type BitMap
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type

Private Const BI_RGB As Long = &H0&
Private Const DIB_RGB_COLORS = 0
Private Const DIB_PAL_COLORS = 1
Private Const ERRORAPI = 0

Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFOHEADER, ByVal un As Long, lplpVoid As Long, ByVal Handle As Long, ByVal dw As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Private Declare Function ObjPtr Lib "msvbvm60.dll" Alias "VarPtr" (Var As Object) As Long
Private Declare Function VarPtr Lib "msvbvm60.dll" (Var As Any) As Long
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long

Private m_MyCreated As Boolean
Private m_MyDibInfo As BITMAPINFOHEADER
Private m_Myhdc As Long
Private m_Myhbitmap As Long
Private m_MyhbitmapOld As Long

Private m_MyBuffer As Long
Private m_MyptrByte As Long
Private m_MyWidth As Long
Private m_MyHeight As Long

Private m_MyLineAdd As Long
Private m_MyPixelAdd As Long
Private m_MyLineByteWidth As Long

Private m_pvDataPtrAdd As Long
Private m_InitPtrFlag As Boolean
Private pByte0(0 To 0) As Byte
Private pByte0Ptr(0 To 0) As Long
Private OldpByte0 As Long
Private OldpByte0Ptr As Long

Private pByte1(0 To 0) As Byte
Private pByte1Ptr(0 To 0) As Long
Private OldpByte1 As Long
Private OldpByte1Ptr As Long

Private p3Dest(0 To 2) As Byte
Private p3ByteDest(0 To 0) As Long
Private Oldp3ByteDest As Long
Private Oldp3ByteDestPtr As Long

Private p3Src(0 To 2) As Byte
Private p3ByteSrc(0 To 0) As Long
Private Oldp3ByteSrc As Long
Private Oldp3ByteSrcPtr As Long

Private pLongAll(0 To 0) As Long
Private pLongAllPtr(0 To 0) As Long
Private OldpLongAll As Long
Private OldpLongAllPtr As Long

Private Function CreateDIB(ByVal Width As Long, ByVal Height As Long, Optional ByVal iBitCount As Integer = 24) As Boolean
If m_MyCreated And m_MyWidth = Width And m_MyHeight = Height And m_MyDibInfo.biBitCount = iBitCount Then
CreateDIB = True
Exit Function
End If

DestoryDIB
If iBitCount <> 24 And iBitCount <> 32 Then
CreateDIB = False
Exit Function
End If

m_MyWidth = Width
m_MyHeight = Height
If m_MyWidth < 1 Then m_MyWidth = 1
If m_MyHeight < 1 Then m_MyHeight = 1

m_Myhdc = CreateCompatibleDC(0)
If m_Myhdc = 0 Then
m_MyWidth = 0
m_MyHeight = 0
CreateDIB = False
Exit Function
End If

With m_MyDibInfo
.biSize = Len(m_MyDibInfo)
.biWidth = m_MyWidth
.biHeight = m_MyHeight
.biPlanes = 1
.biBitCount = iBitCount
.biCompression = BI_RGB
.biClrImportant = 0
.biXPelsPerMeter = 0
.biYPelsPerMeter = 0
End With

m_Myhbitmap = CreateDIBSection(m_Myhdc, m_MyDibInfo, 0, m_MyBuffer, 0, 0)
If m_Myhbitmap = 0 Then
DeleteDC m_Myhdc
m_Myhdc = 0
m_MyWidth = 0
m_MyHeight = 0
CreateDIB = False
Exit Function
End If

m_MyhbitmapOld = SelectObject(m_Myhdc, m_Myhbitmap)

m_MyptrByte = m_MyBuffer

Dim dpixeladd As Long
dpixeladd = iBitCount \ 8
m_MyPixelAdd = dpixeladd - 3
m_MyLineByteWidth = m_MyWidth * (dpixeladd)
If (m_MyLineByteWidth Mod 4) <> 0 Then m_MyLineByteWidth = m_MyLineByteWidth + (4 - (m_MyLineByteWidth Mod 4))
m_MyCreated = True

CreateDIB = True

End Function

Private Sub DestoryDIB()
If m_MyCreated Then
DeleteObject (SelectObject(m_Myhdc, m_MyhbitmapOld))
DeleteDC m_Myhdc
m_Myhdc = 0
m_Myhbitmap = 0
m_MyhbitmapOld = 0
m_MyBuffer = 0
m_MyptrByte = 0
m_MyCreated = False
End If

End Sub

CreateDIB 就生成了一个指定宽度,高度和颜色为数的位图对象
位图句柄 m_Myhbitmap
设备描述句柄 m_Myhdc
数据区首地址 m_MyBuffer

生成位图对象后,就可以通过BitBlt做需要的处理

要取数时
ReDim bbuffer(0 To m_MyLineByteWidth * m_MyHeight) As Byte

CopyMemory bbuffer(0), ByVal m_MyBuffer, m_MyLineByteWidth * m_MyHeight

就可以把位图数据放到Byte数组中了

如果希望效率更高的话就借助指针直接读写数据必再复制到 Byte数组中

Private Sub PointInit()
If m_InitPtrFlag Then Exit Sub

MakePoint VarPtrArray(pLongAll), VarPtrArray(pLongAllPtr), OldpLongAll, OldpLongAllPtr
m_InitPtrFlag = True

MakePoint VarPtrArray(p3Dest), VarPtrArray(p3ByteDest), Oldp3ByteDest, Oldp3ByteDestPtr
MakePoint VarPtrArray(p3Src), VarPtrArray(p3ByteSrc), Oldp3ByteSrc, Oldp3ByteSrcPtr

End Sub

Private Sub PointFree()
If m_InitPtrFlag = False Then Exit Sub

FreePoint VarPtrArray(p3Dest), VarPtrArray(p3ByteDest), Oldp3ByteDest, Oldp3ByteDestPtr
FreePoint VarPtrArray(p3Src), VarPtrArray(p3ByteSrc), Oldp3ByteSrc, Oldp3ByteSrcPtr

m_InitPtrFlag = False
FreePoint VarPtrArray(pLongAll), VarPtrArray(pLongAllPtr), OldpLongAll, OldpLongAllPtr

End Sub

Private Sub MakePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, _
ByRef OldArrPtr As Long, ByRef OldpArrPtr As Long)
Dim TempLng As Long
Dim TempPtr As Long

If m_InitPtrFlag Then
pLongAllPtr(0) = DataArrPtr
TempLng = pLongAll(0) + m_pvDataPtrAdd
pLongAllPtr(0) = pDataArrPtr
TempPtr = pLongAll(0) + m_pvDataPtrAdd
pLongAllPtr(0) = TempPtr
OldpArrPtr = pLongAll(0)
pLongAll(0) = TempLng
pLongAllPtr(0) = TempLng
OldArrPtr = pLongAll(0)

Else
CopyMemory TempLng, ByVal DataArrPtr, 4
TempLng = TempLng + m_pvDataPtrAdd
CopyMemory TempPtr, ByVal pDataArrPtr, 4
TempPtr = TempPtr + m_pvDataPtrAdd
CopyMemory OldpArrPtr, ByVal TempPtr, 4
CopyMemory ByVal TempPtr, TempLng, 4
CopyMemory OldArrPtr, ByVal TempLng, 4

End If

End Sub

Private Sub FreePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByVal OldArrPtr As Long, ByVal OldpArrPtr As Long)
Dim TempPtr As Long

If m_InitPtrFlag Then
pLongAllPtr(0) = DataArrPtr
pLongAllPtr(0) = pLongAll(0) + m_pvDataPtrAdd
pLongAll(0) = OldArrPtr
pLongAllPtr(0) = pDataArrPtr
pLongAllPtr(0) = pLongAll(0) + m_pvDataPtrAdd
pLongAll(0) = OldpArrPtr

Else
CopyMemory TempPtr, ByVal DataArrPtr, 4
CopyMemory ByVal (TempPtr + m_pvDataPtrAdd), OldArrPtr, 4
CopyMemory TempPtr, ByVal pDataArrPtr, 4
CopyMemory ByVal (TempPtr + m_pvDataPtrAdd), OldpArrPtr, 4

End If

End Sub

Private Sub Form_Load()
m_pvDataPtrAdd = 12&
m_InitPtrFlag = False
PointInit

End Sub

Private Sub Form_Unload(Cancel As Integer)
PointFree

End Sub

Private Sub Command1_Click()
p3ByteDest(0) = m_MyBuffer
p3ByteSrc(0) = m_MyBuffer

'可以通过 p3Dest(0),p3Dest(1),p3Dest(2),p3Src(0).p3Src(1),p3Src(2)直接读写位图数据
p3Dest(0) = p3Src(0)

p3ByteDest(0) = p3ByteDest(0) + 1
p3ByteSrc(0) = p3ByteSrc(0) + 1

End Sub 参考技术A 存储在数组中，没实现过；存储到文件还是可以的