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 '写vb6匿名通道名柄
'启动进程信息
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
'将数据写入vb6匿名通道
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&) '将数据写入vb6匿名通道
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) '因为本应用只写管道不读vb6匿名通道，所以关闭读管道句柄
CreateSharePipe = True
frm_IPOS_Login.txtUser.SetFocus
Else
CreateSharePipe = False
Call CloseHandle(lngHRead) '因为本应用只写管道不读vb6匿名通道，所以关闭读管道句柄
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
