通过油槽实现跨网络进程间的一对多的单向通讯

SKY定格

作用：通过油槽实现跨网络进程间的一对多的单向通讯
******************************************油槽接收端程序(ReadFile)************************************
Private Declare Function CreateMailslot Lib "kernel32" Alias "CreateMailslotA" (ByVal lpName As String, ByVal nMaxMessageSize As Long, ByVal lReadTimeout As Long, ByVal bbb As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const MAILSLOT_WAIT_FOREVER = (-1)
Private Const INVALID_HANDLE_VALUE = -1
Private Const EM_SETSEL = &HB1
Private Const EM_REPLACESEL = &HC2
Private Sub Command1_Click()
    Dim hMailSlot As Long
    Dim buff(1024) As Byte
    Dim ret As Long
    Dim dwRead As Long
    Dim strResult As String
   
    hMailSlot = CreateMailslot("\\.\mailslot\MyMailSlot", ByVal 0&, MAILSLOT_WAIT_FOREVER, ByVal 0&)
    If hMailSlot = -1 Then
        MsgBox "创建油槽失败"
        Exit Sub
    End If
    ret = ReadFile(hMailSlot, buff(0), 1023, dwRead, ByVal 0&)
    If ret = 0 Then
        MsgBox "读取数据失败"
        CloseHandle hMailSlot
        Exit Sub
    End If
   
    '第一种方法：把缓冲区的数据写入到控件
'    SendMessage Text1.hwnd, EM_SETSEL, -1, 0
'    SendMessage Text1.hwnd, EM_REPLACESEL, True, buff(0)
    '第二种方法：Convert Byte Array to String
    strResult = StrConv(buff, vbUnicode)
    MsgBox strResult
    CloseHandle hMailSlot
End Sub
******************************************油槽发送端程序(WriteFile)************************************
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 aaa 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, lpOverlapped As Any) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Const MAILSLOT_WAIT_FOREVER = (-1)
Private Const INVALID_HANDLE_VALUE = -1
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Sub Command1_Click()
    Dim hMailSlot As Long
    Dim Buf As String
    Dim dwWrite As Long
    Dim mRet As Long
    Dim str As String
   
    hMailSlot = CreateFile("\\.\mailslot\MyMailSlot", GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
    If hMailSlot = INVALID_HANDLE_VALUE Then
        MsgBox "打开油槽失败"
        Exit Sub
    End If
        
    str = "油槽客户端程序"
   
    '第一种方法：
'    Dim sBuff() As Byte
'    sBuff = StrConv(str, vbFromUnicode)
'    mRet = WriteFile(hMailSlot, sBuff(0), UBound(sBuff) + 1, dwWrite, ByVal 0&)
   
    '第二种方法简单些：
    mRet = WriteFile(hMailSlot, ByVal str, lstrlen(str), dwWrite, ByVal 0&)
   
    If mRet = 0 Then
        MsgBox "写入数据失败"
        CloseHandle hMailSlot
        Exit Sub
    End If
    CloseHandle hMailSlot '//关闭油槽句柄
End Sub

SKY定格

首先同时运行油槽接收端程序和油槽发送端程序，
然后点击油槽接收端程序响应它的Command1_Click事件，这时程序处于
等待状态，直到用户点击油槽发送端程序的Command1_Click事件后才读取
到消息