作用：通过油槽实现跨网络进程间的一对多的单向通讯
******************************************油槽接收端程序(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