给你一个内存共享的类模块:(FileMap)
Option Explicit
'#Const Sampling = True '编译常数Sampling=Ture:采样, =False:管理
Private DiskFileName As String '实时样本磁盘文件名
Private MapFileName As String '前者的(内存)映射文件名
Private FileHandle As Long '磁盘文件句柄
Private MapHandle As Long '映射文件句柄
Private MapAddress As Long '映射地址
Public LenBuffer As Long '缓冲区长度
Private Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (DesStr As Any, SrcStr As Any, ByVal MaxLen As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappingAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Private Sub InitVar()
MapFileName = "SampleMap"
LenBuffer = 10
FileHandle = 0
MapHandle = 0
MapAddress = 0
End Sub 'InitVar
Public Sub CopyToMap(S As String)
If MapAddress <> 0 Then
Call lstrcpyn(ByVal MapAddress, ByVal S, LenB(S) + 1)
End If
End Sub
Public Function GetFromMap(Optional LenS As Long) As String
Dim U_s As String
If LenS <= 0 Then LenS = LenBuffer
U_s = Space(LenS)
If MapAddress <> 0 Then
Call lstrcpyn(ByVal U_s, ByVal MapAddress, LenS + 1)
End If
GetFromMap = Trim(U_s)
End Function
Public Sub CloseMap()
If MapAddress <> 0 Then
Call UnmapViewOfFile(ByVal MapAddress)
MapAddress = 0
End If
If MapHandle <> 0 Then
Call CloseHandle(MapHandle)
MapHandle = 0
End If
If FileHandle <> 0 Then
Call CloseHandle(FileHandle)
FileHandle = 0
End If
End Sub 'CloseMap
Public Sub CreateMap(ByVal MapName As String)
Dim w As Long
MapFileName = MapName
MapHandle = CreateFileMapping(&HFFFFFFFF, 0, PAGE_READWRITE, 0, LenBuffer, MapFileName)
MapAddress = MapViewOfFile(MapHandle, FILE_MAP_WRITE, 0, 0, 0)
End Sub 'CreateMap
Public Function OpenMap(ByVal MapName As String) As Long
MapFileName = MapName
'Call InitVar
OpenMap = 0
MapHandle = OpenFileMapping(FILE_MAP_WRITE, False, MapFileName)
If MapHandle = 0 Then Exit Function
MapAddress = MapViewOfFile(MapHandle, FILE_MAP_WRITE, 0, 0, 0)
If MapAddress = 0 Then
Call CloseHandle(MapHandle)
MapHandle = 0
End If
OpenMap = MapAddress
End Function 'OpenMap
Private Sub Class_Initialize()
Call InitVar
End Sub
Public Map As FileMap
Set Map = New FileMap
Map.LenBuffer = 254 '内存空间大小(B)
Map.CreateMap "JianKong" '建立映射
Map.CopyToMap "AABBCCDD" '数据写入内存
-------------------------------------
2-打开映射
-------------------------------------
Public Map1 As FileMap
Set Map1 = New FileMap
Map1.OpenMap "JianKong" '打开映射
MsgBox(Map.GetFromMap) '读出数据