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
