Excel VBA:通过命名管道

时间:2015-07-22 12:36:18

标签: excel vba pipe named-pipes kernel32

我试图通过VBA中的named pipe设置通信,但由于某种原因,它永远不会到达服务器中的行Debug.Print "Connected,客户端也不会连接。看起来像一个简单的场景,但一直试图让这个持续数小时。

服务器

Public Sub Server()
      Const szPipeName = "\\.\pipe\bigtest"
      Dim hPipe As Long, readVal As Long, readBytes As Long, sendVal As Long, sentBytes As Long
      Dim sa As SECURITY_ATTRIBUTES

      'Create the NULL security token for the pipe
      pSD = GlobalAlloc(GPTR, SECURITY_DESCRIPTOR_MIN_LENGTH)
      res = InitializeSecurityDescriptor(pSD, SECURITY_DESCRIPTOR_REVISION)
      res = SetSecurityDescriptorDacl(pSD, -1, 0, 0)
      sa.nLength = LenB(sa)
      sa.lpSecurityDescriptor = pSD
      sa.bInheritHandle = True

      'Create the Named Pipe
      hPipe = CreateNamedPipe(szPipeName, PIPE_ACCESS_DUPLEX, PIPE_WAIT Or PIPE_TYPE_MESSAGE Or PIPE_READMODE_MESSAGE, 10, 1000, 1000, 10000, sa)

      'Create separate thread as client
      ID = CreateThread(nil, 0, AddressOf ClientThread, nil, 0, nil)

      Debug.Print "Created thread: " & ID
      Debug.Print "Connecting named pipe: " & hPipe

      res = ConnectNamedPipe(hPipe, ByVal 0)
      'XXXXXXXXXXXXXXXXX NEVER GETS HERE XXXXXXXXXXXXXXXXXXx
      Debug.Print "Connected"
      'Read/Write data over the pipe

      res = ReadFile(hPipe, readVal, LenB(readVal), readBytes, ByVal 0)
      Debug.Print "Read file: " & readVal

      'res = WriteFile(hPipe, sendVal , LenB(sendVal ), sendBytes, ByVal 0)
      res = FlushFileBuffers(hPipe)
      res = DisconnectNamedPipe(hPipe)

      'Close the pipe handle
      CloseHandle hPipe
      GlobalFree (pSD)

   End Sub

客户端

Public Sub ClientThread()
      Const szPipeName As String = "\\.\pipe\bigtest"
      Dim sentBytes As Long, sendVal As Long, fSuccess As Boolean, readVal As Long, readBytes As Long

      sendVal = 500

      'Give server time to ConnectNamedPipe
      Sleep 2000
      Debug.Print "Connecting to pipe..."
      fSuccess= CallNamedPipe(szPipeName, sendVal, LenB(sendVal), readVal, LenB(readVal), readBytes, 5000)
      'XXXXXXXXXXXXXX NEVER GETS HERE XXXXXXXXXXXXXX
      Debug.Print "Successful: " & fSuccess

      '...
   End Sub

0 个答案:

没有答案