我试图通过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