功能：进程间的通讯-----使用匿名管道
'环境：vb60 + win2k/win9k 测试下通过

''发送方
Option Explicit

Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long

Private Const INVALID_HANDLE_VALUE = -1
Private Const STARTF_USESTDHANDLES = &H100
Private Const STARTF_USESHOWWINDOW = &H1
Private Const SW_HIDE = 0
Private Const STD_ERROR_HANDLE = -12&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const HIGH_PRIORITY_CLASS = &H80

Dim m_lngHWrite As Long '写管道名柄

'启动进程信息
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

'进程信息
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

'安全属性
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

'将数据写入管道
Public Function SendDataToPrintApp(ByVal strBuf As String) As Boolean
Dim lngBufSize As Long
Dim lngWriteByte As Long
Dim lngRet As Long

strBuf = strBuf & Chr(0)

lngBufSize = LenB(StrConv(strBuf, vbFromUnicode)) '取发送数据的实际字节
lngRet = WriteFile(m_lngHWrite, ByVal strBuf, lngBufSize + 1, lngWriteByte, ByVal 0&) '将数据写入管道

If lngRet = 0 Then
SendDataToPrintApp = False
Else
SendDataToPrintApp = True
End If
End Function

'建立共享匿名管道
Public Function CreateSharePipe() As Boolean
On Error Resume Next
Dim lngHRead As Long
Dim lngWriteByte As Long
Dim lngBufSize As Long
Dim sec_attr As SECURITY_ATTRIBUTES
Dim proc_info As PROCESS_INFORMATION
Dim lngRet As Long
Dim start_info As STARTUPINFO
Dim strCmdLine As String

sec_attr.nLength = Len(sec_attr)
sec_attr.bInheritHandle = True

lngRet = CreatePipe(lngHRead, m_lngHWrite, sec_attr, ByVal 4096&) '建立管道 0失败

If lngRet <> 0 Then
start_info.cb = Len(start_info)
start_info.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
start_info.hStdInput = lngHRead '重置子进程的输入设备为读管道的句柄
start_info.hStdError = GetStdHandle(STD_ERROR_HANDLE) '置子进程的输出错误设备为标准设备
start_info.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE) '置子进程的输出设备为标准输出设备

start_info.wShowWindow = SW_HIDE
If Right(App.Path, 1) <> "\" Then
strCmdLine = App.Path & "\PrintBill.Exe" & Chr(0)
Else
strCmdLine = App.Path & "PrintBill.Exe" & Chr(0)
End If

'创建子进程
lngRet = CreateProcess(vbNullString, strCmdLine, ByVal 0&, ByVal 0&, True, HIGH_PRIORITY_CLASS, ByVal 0&, vbNullString, start_info, proc_info)

If lngRet <> 0 Then
Call CloseHandle(proc_info.hThread)
Call CloseHandle(lngHRead) '因为本应用只写管道不读管道，所以关闭读管道句柄
CreateSharePipe = True

frm_IPOS_Login.txtUser.SetFocus
Else
CreateSharePipe = False
Call CloseHandle(lngHRead) '因为本应用只写管道不读管道，所以关闭读管道句柄
End If
Else
CreateSharePipe = False
End If
End Function


'''''接收方
Option Explicit

Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, lpBytesRead As Long, lpTotalBytesAvail As Long, lpBytesLeftThisMessage As Long) As Long

Private Const STD_INPUT_HANDLE = -10&
Private Const MEM_SIZE = 4096

Private m_lngHPipeRead As Long

Private Sub Form_Load()
Dim blnret As Boolean
m_lngHPipeRead = GetStdHandle(STD_INPUT_HANDLE)
Me.Hide
End Sub

Private Sub Timer1_Timer()
Call ReadData
End Sub

Private Sub ReadData()
On Error Resume Next

Dim lngRet As Long
Dim strBuf As String
Dim lngRealRead As Long
Dim lngBufLen As Long
Dim str As String

Timer1.Enabled = False
strBuf = String(MEM_SIZE, " ")

str = Space(1)

Call PeekNamedPipe(m_lngHPipeRead, ByVal str, ByVal 1&, lngBufLen, ByVal 0&, ByVal 0&)

If lngBufLen > 0 Then
lngBufLen = Len(strBuf)
lngRet = ReadFile(m_lngHPipeRead, ByVal strBuf, lngBufLen, lngRealRead, ByVal 0&)
strBuf = Left(strBuf, InStr(1, strBuf, Chr(0)))
End If

Timer1.Enabled = True
End Sub