VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 记忆体对映档的作法
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:9261, 日期:2001-09-28
 记忆体对映档的作法


作者: Bruce McKinney, cww Modify 

    不同行程间的资讯相互传递,在32位元的环境来说,是有一些困难,因为每个行程有其
自己的4G Byte的位走空间,那如何做到行程间的相互沟通呢?有几个方式可行,例如:
使用SendMessage()将讯息传送给特定的Window,不过这种方式首先要先得到另一个Window
的hWnd,但有时候我们也不知会送之给谁,那就行不通了;再则以SendMessage来说,它
只能传两个整数叁数过去(wParam, lParam),而wMsg是指定所送讯息的代号,一般我们会
自订一个代码(WM_USER + X, X为一整数),只传整数,那大概不太够,不能传字串便很
痛苦,或许会说,如果传过去的是指向一个字串的位址(位址是Long值),再想办法将位
址指向的内容取出不就好了?可是,别忘了,32位元的世界中,位址空间没有共用,也就是
说A行程中位址X的内容和B行程中X位址指向的内容并不相同,除非使用的是系统的资源,
而不是行程的资源。

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

    另外一种行程间的通讯的方式就是透过档案,将之写到档案的方法想必人人都会,但讨
厌的是要杀档,而且过份多的File I/O於Hard Disk的同一地方,可能HardDisk会很决就
玩完了;相对的,如果产生一记忆体对应档,那就比较快,但传的资料数量有限。

    我由Bruce McKinney 书中取出这个记忆体对应档作法的Class。这Class使不同行程可以
传递字串。

该Class有一个Function两个属性,
Create(sName as String)
           这个Function的目的是产生一个记忆体应档,sName是一字串,地位就好比一般
           档案中的档名,不管那个行程,只要传入的sName相同,便是指向相同的记忆体
           对应档 Object。
Data       这个Property负责设定与取出字串。
LastErr    是取得上一次呼叫记忆体对应档的API所产生的错误代码。

使用方式: 制作出以下的专案一.exe 与专案二.exe而後执行这两个专案,首先,先在
专案一的TextBox keyin一些文字,而後按专案二的Command1,可以看到专案二的Label1
变成方才您所Keyin进TextBox的文字,看吧,两个.Exe档已可以互传资料了。

注:专案二中故意把MemString物件宣告成於Command1中的区域物件,当专案二的Command1
    每次按下时都会执行mf.Create("MyMem")的动作,而这个记忆体对应档物件早在专
    案一中Create出了,所以它每次执行CreateFileMapping时时会产生ERROR_ALREADY_EXISTS
    的错误,但这错误没有关系,因仍然传回正确的物件代码(h),而紧接着的MapViewOfFile()
    又把Error物件的讯息清掉,所以如果一切正常,我们查到的LastErr属性会是0。而
    当专案二的Command1_Click()执行完後,也结束了专案二mf的生命周期,所以会执行
    MemString.Cls中的Destory动作,把由系统取得的handle都Release掉(即执行UnmapViewOfFile
    、CloseHandle,然而此时专案一仍对该物件存有引用,所以该记体对应档的物件仍
    然存在,要等到所有引用都结束时,才会真的由系统中Release掉,这也是为什麽
    专案二中明明执行过好多次的Destory,而再按Command1时仍可取得Form1.Text1.Text
    的内容;最後,先结束专案一,再按一下专案二的Command1,Label1.Caption会是""。

注释:专案一 请自行新增物件模组MemString.Clx
注释:需一个Command Button, 一个Text Box
Option Explicit
Private mf As New MemString

注释:设定Text1.Text的资料到记忆体对应档
Private Sub text1_change()
mf.Data = Text1.Text
End Sub

注释:产生一个记忆体对应档
Private Sub Form_Load()
Dim B As Boolean
B = mf.Create("MyMem")
End Sub

专案二 请自行新增物件模组MemString.Clx
注释:需一个Command Button, 一个Label
Option Explicit

注释:取出记忆体对应档内专案一所设的字串
Private Sub Command1_Click()
Dim mf As New MemString
Dim B As Boolean
B = mf.Create("MyMem")
Label1.Caption = mf.Data
End Sub




注释:以下在MemString.Cls
Option Explicit

Const SECTION_MAP_WRITE = &H2
Const SECTION_MAP_READ = &H4
Const FILE_MAP_WRITE = SECTION_MAP_WRITE
Const FILE_MAP_READ = SECTION_MAP_READ
Const PAGE_READONLY = &H2
Const PAGE_READWRITE = &H4
Const ERROR_ALREADY_EXISTS = 183&
Const ERROR_INVALID_DATA = 13&

Private Declare Function CreateFileMapping Lib "KERNEL32" Alias "CreateFileMappingA" _
        (ByVal hFile As Long, lpFileMappigAttributes As Any, _
        ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow 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 Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" ( _
   lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private h As Long, p As Long, e As Long
Const MEM_HANDLE As Long = -1&
注释:产生一个记忆体对应档,名称为sName
注释:该记忆体对应档里面存的资料分成两部份
注释:一个Long值,代表字串的长度,另一为字串,这字串才是要Share部份
Function Create(sName As String) As Boolean
    Create = False
    If sName = "" Then Exit Function
    注释: Try to create file mapping of 65535 (only used pages matter)
    h = CreateFileMapping(MEM_HANDLE, ByVal 0, PAGE_READWRITE, _
                          0, 65535, sName)
    注释:如果sName原本就存在,则传回的h值是先前Call CreateFileMapping的handle of file Mapping Object
    注释:而且Err.LastDllError 传回的是ERROR_ALREADY_EXISTS,如果sName原来不存在,则传回新的Handle值
    注释:且Err.LastDllError = 0
    e = Err.LastDllError
    注释: Unknown error, bail out
    If h = 0 Then Destroy: Exit Function

    注释: Get pointer to mapping
    p = MapViewOfFile(h, FILE_MAP_WRITE, 0, 0, 0)
    If p = 0 Then e = Err.LastDllError: Exit Function
    If e <> ERROR_ALREADY_EXISTS Then
        注释: Set size of new file mapping to 0 by copying first 4 bytes
        Dim c As Long 注释: = 0
        注释:将0放入记忆体对应档中的前4个Byte
        CopyMemory ByVal p, c, 4
    注释: Else
        注释: Existing file mapping
    End If
    e = 0
    Create = True
End Function
Property Get Data() As String
    If h = 0 Or p = 0 Then e = ERROR_INVALID_DATA: Exit Property
    Dim c As Long, sData As String
    CopyMemory c, ByVal p, 4
    注释: Copy rest of memory into string
    If c = 0 Then Exit Property 注释: Data = sEmpty
    sData = String$(c, 0)
    注释:将字串放入记忆体对应档中的第4个Byte之後
    CopyMemory ByVal sData, ByVal (p + 4), c
    Data = sData
End Property

Property Let Data(s As String)
    If h = 0 Or p = 0 Then e = ERROR_INVALID_DATA: Exit Property
    Dim c As Long
    c = Len(s)
    注释: Copy length to first 4 bytes and string to remainder
    CopyMemory ByVal p, c, 4
    CopyMemory ByVal (p + 4), ByVal s, c
End Property

Property Get LastErr() As Long
    LastErr = e
End Property
Private Sub Destroy()
   Dim i As Long
    i = UnmapViewOfFile(p)
    i = CloseHandle(h)
    h = 0
    p = 0
End Sub

Private Sub Class_Terminate()
    If h <> 0 Then Destroy
End Sub