创建和读取内存映像文件

Module mdlAPI

    Public Declare Function CreateFileMapping Lib "kernel32" _

        Alias "CreateFileMappingA" (ByVal hFile As IntPtr, _

        ByRef lpFileMappigAttributes As IntPtr, _

        ByVal flProtect As IntPtr, ByVal dwMaximumSizeHigh As IntPtr, _

        ByVal dwMaximumSizeLow As IntPtr, ByVal lpName As String) As IntPtr

 

    Public Declare Function OpenFileMapping Lib "kernel32" _

        Alias "OpenFileMappingA" (ByVal dwDesiredAccess As IntPtr, _

        ByVal bInheritHandle As IntPtr, ByVal lpName As String) As IntPtr

 

    Public Declare Function MapViewOfFile Lib "kernel32" _

        Alias "MapViewOfFile" (ByVal hFileMappingObject As IntPtr, _

        ByVal dwDesiredAccess As IntPtr, ByVal dwFileOffsetHigh As IntPtr, _

        ByVal dwFileOffsetLow As IntPtr, ByVal dwNumberOfBytesToMap As IntPtr) As IntPtr

 

    Public Declare Function UnmapViewOfFile Lib "kernel32" _

        Alias "UnmapViewOfFile" (ByVal lpBaseAddress As IntPtr) As IntPtr

 

    Public Declare Function CloseHandle Lib "kernel32" _

        Alias "CloseHandle" (ByVal hObject As IntPtr) As IntPtr

 

    Public Declare Sub CopyMemory Lib "kernel32" _

        Alias "RtlMoveMemory" (ByVal pDst As IntPtr, _

        ByVal pSrc As IntPtr, ByVal ByteLen As Integer)

 

    Public Declare Function GetLastError Lib "kernel32" () As IntPtr

    Public Const Read_Write = &H4

End Module

---

 

    Private Sub 写入映像()

        Dim hMF As Integer = CreateFileMapping(&HFFFFFFFF, 0, Read_Write, 0, 1024, TextBox1.Text)

        If hMF = 0 Then MessageBox.Show(GetLastError, "创建失败") : Return

 

        Dim hMV As IntPtr = MapViewOfFile(hMF, 2, 0, 0, 0)

 

        If hMV = 0 Then MessageBox.Show(GetLastError, "映射失败") : Return

 

        Dim content As String = TextBox2.Text

        Dim ptr As IntPtr = Marshal.StringToHGlobalAuto(content)

        CopyMemory(hMV, ptr, content.Length)

        MessageBox.Show("测试期间，不要点确定！" & vbNewLine & _

            "点确定后内存映射文件自动被撤销！", "内存映射文件创建成功！")

 

        UnmapViewOfFile(hMV)

        CloseHandle(hMF)

    End Sub

 

 

 

 

---

 

 

 

 

    Private Sub 读取映像()

        Dim hmf As Long, hvm As IntPtr

        Dim str As String = ""   ' * 20

        Dim MyLen As IntPtr = 255

        hmf = OpenFileMapping(4, False, TextBox2.Text)

 

        hvm = MapViewOfFile(hmf, 4, 0, 0, 0)

        If hvm = 0 Then TextBox1.Text = "檔沒有找到！" : Return

        Dim ptr As IntPtr = Marshal.StringToHGlobalAuto(str)

 

        CopyMemory(ptr, hvm, MyLen)

        Dim mystring As String = Marshal.PtrToStringAuto(ptr)

        UnmapViewOfFile(hvm)

        CloseHandle(hmf)

        ptr = 0

        TextBox1.Text = Trim(mystring) & "<結束>"

 

    End Sub