二个可执行文件间的数据传送问题。

功能：进程间的通讯-----使用匿名管道
'环境：vb60 + win2k/win9k 测试下通过''发送方
Option ExplicitPrivate 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 LongPrivate 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 = &H80Dim 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 ExplicitPrivate 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 LongPrivate Const STD_INPUT_HANDLE = -10&
Private Const MEM_SIZE = 4096Private m_lngHPipeRead As LongPrivate Sub Form_Load()
    Dim blnret As Boolean
    m_lngHPipeRead = GetStdHandle(STD_INPUT_HANDLE)
    Me.Hide
End SubPrivate Sub Timer1_Timer()
    Call ReadData
End SubPrivate 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

调试易

二个可执行文件间的数据传送问题。

解决方案 »