VB读写进程句柄-共享内存-内存映射CreateFileMapping

 

共享内存 其实就是 一个 句柄
可以用工具查看进程句柄 中就可以发现，类似 互斥体一样的东西
然后共享内存 ，创建的是一个句柄名称 "Global\{FD921876-60EB-4799-A084-872BEDB29151}")
不过这个东西在 用XT工具查看进程句柄的时候 发现 并没有 Global\ 这个字符串名，而是 

\BaseNamedObjects\{FD921876-60EB-4799-A084-872BEDB29151}

句柄类型          句柄名称
Section        \BaseNamedObjects\{FD921876-60EB-4799-A084-872BEDB29151}

vb6读取共享内存的代码如下：模块代码如下

Option Explicit
'
'通常使用CreateFileMapping建立共享内存时名称中没有加入 "Global\", 这使得共享的内存只能在当前用户下被另一个或多个进程访问, 例如:
'
'　　CreateFileMapping(INVALID_HANDLE_VALUE, NULL, PAGE_READWRITE | SEC_COMMIT, 0, 1024, TEXT("MyShare"));
'
'　　当把程序放到服务器上并运行,然后用远程桌面连接服务器时的用户身份作为了另一用户,这时运行访问共享内存的程序将产生错误[代码是2]。根据错误代码认为是权限问题,通常会去添加安全描述符,也就是设置CreateFileMapping的LPSECURITY_ATTRIBUTES参数,会这样做：

'
'　 Global\*** 可以保证：在创建命名时间对象时指定名字是全局的，使用全局名称创建的内核对象无论出于服务，还是内核中，应用层都可以打开并使用这个内核对象。
'
'　　然后改为使用全局名称，用远程桌面登陆到服务器在不同的用户下就能够运行访问共享内存的程序了！
'
'　　CreateFileMapping(INVALID_HANDLE_VALUE, NULL, PAGE_READWRITE | SEC_COMMIT, 0, 1024, TEXT("Global\MyShare"));
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const PAGE_READWRITE = &H4&
Public Const FILE_MAP_WRITE = &H2&
Public Const FILE_MAP_READ = &H4&
Public Const MEMPAGE = &HFFFFFFFF

Public Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, lpFileMappigAttributes As SECURITY_ATTRIBUTES, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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
Public Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Public Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public fMapHandle As Long
Public pFileMap As Long
Public Sub MyInitialize()

Dim TemSa As SECURITY_ATTRIBUTES
Dim TemLng As Long

TemSa.bInheritHandle = 1
TemSa.lpSecurityDescriptor = 0
TemSa.nLength = Len(TemSa)

fMapHandle = OpenFileMapping(FILE_MAP_READ, False, "Global\{FD921876-60EB-4799-A084-872BEDB29151}")
If fMapHandle = -1 Then
MsgBox "文件MAP失败！"
Exit Sub
End If
pFileMap = MapViewOfFile(fMapHandle, FILE_MAP_READ, 0, 0, 100)

'MsgBox fMapHandle
'MsgBox pFileMap

TemLng = GetLastError
If TemLng <> 0 Then
    MsgBox TemLng
End If

End Sub

Public Sub MyTerminate()

'释放对象
If pFileMap <> 0 Then
UnmapViewOfFile pFileMap
End If

If fMapHandle <> 0 Then
CloseHandle fMapHandle
End If

End Sub

Public Function GetOne() As Long
        
        Dim byt(9) As Byte
        Dim TemLng As Long
        
        CopyMemory byt(0), ByVal pFileMap, 8
        
        Dim i As Long, tem As String
        For i = 0 To 7
        tem = tem & VBA.Replace(Hex(byt(i)), "3", "")
        Next i
        GetOne = Val(tem)
End Function

窗体代码如下

Private Sub Command2_Click()
   Dim x As String
   x = GetOne
   MsgBox x
End Sub

Private Sub Form_Load()
   MyInitialize
End Sub

---

下面是 VB创建共享内存的代码

窗体代码如下

Private Sub Command1_Click()

   SetOne 1
End Sub

Private Sub Command2_Click()
   Dim x As Long
   x = GetOne
   MsgBox x
End Sub

Private Sub Form_Load()
   MyInitialize
End Sub

模块代码如下

Option Explicit

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const PAGE_READWRITE = &H4&
Public Const FILE_MAP_WRITE = &H2&
Public Const FILE_MAP_READ = &H4&
Public Const MEMPAGE = &HFFFFFFFF

Public Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, lpFileMappigAttributes As SECURITY_ATTRIBUTES, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public 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
Public Declare Function UnmapViewOfFile Lib "kernel32" (lpBaseAddress As Any) As Long
Public Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public fMapHandle As Long
Public pFileMap As Long

Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any) As Long

Public Sub MyInitialize()

Dim TemSa As SECURITY_ATTRIBUTES
Dim TemLng As Long

TemSa.bInheritHandle = 1
TemSa.lpSecurityDescriptor = 0
TemSa.nLength = Len(TemSa)

fMapHandle = CreateFileMapping(MEMPAGE, TemSa, PAGE_READWRITE, 0, 1024, "Global\{FD921876-60EB-4799-A084-872BEDB29151}")  'FILE_MAP_READ
If fMapHandle = -1 Then
MsgBox "文件MAP失败！"
Exit Sub
End If
pFileMap = MapViewOfFile(fMapHandle, FILE_MAP_WRITE, 0, 0, 100)

'MsgBox fMapHandle
'MsgBox pFileMap

TemLng = GetLastError
If TemLng <> 0 Then
    MsgBox TemLng
End If

End Sub

Public Sub MyTerminate()

'释放对象
If pFileMap <> 0 Then
UnmapViewOfFile pFileMap
End If

If fMapHandle <> 0 Then
CloseHandle fMapHandle
End If

End Sub

Public Function SetOne(ByVal WhichData As Long) As Long
Dim byt(9) As Byte
byt(0) = &H31
byt(1) = &H32
byt(2) = &H33
byt(3) = &H34
byt(4) = &H35
byt(5) = &H36
byt(6) = &H37
byt(7) = &H38
CopyMemory ByVal pFileMap, byt(0), 8

End Function

Public Function SetOne1(ByRef WhichData As Variant) As Long

CopyMemory ByVal pFileMap, WhichData, 8

End Function

Public Function GetOne() As Long
Dim byt(9) As Byte
Dim TemLng As Long

CopyMemory byt(0), ByVal pFileMap, 8

Dim i As Long, tem As String
For i = 0 To 7
tem = tem & VBA.Replace(Hex(byt(i)), "3", "")
Next i
GetOne = Val(tem)

End Function