vb 利用管道使进程间互相通信

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   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