SendMessage相关 如何告知消息的发送者消息已接收（在线等待）

[Quady515]

如题,

因为消息是在线程中发的,如若告知消息的发送者消息已接收,线程会一直等下去
我试着用PostMessage,但因为附加消息中要发送的是字符串,故lParam传送的是地址,
接收者收到消息后按地址取值(CopyMemory),但取出的值并非就是发送的值,晕！
如果发送时lParam中放的是数值则收到的lParam就是发送的值。。。。。。

在线等待

[Quady515]

'发送
Private Function SendMSG(ByVal hWnd As Long, ByVal sSendText As String) As Boolean

Dim bBuffer() As Byte
Dim bBuffer2() As Byte
Dim lLen As Long

lLen = Len(sSendText)
bBuffer = StrConv(sSendText, vbFromUnicode)

ReDim bBuffer2(lLen + 1)
Call RtlMoveMemory(bBuffer2(0), bBuffer(0), lLen)

' SendMessage hWnd2, WM_DTSInfo, lLen + 1, bBuffer2(0)
PostMessage hWnd2, WM_DTSInfo, lLen + 1, ByVal StrPtr(bBuffer2(0))
End Function

'接收
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'On Error GoTo ErrMin:
Dim sInfo As String
Dim bBuffer() As Byte

sInfo = String(128, Chr(0))

Select Case uMsg
Case WM_DTSInfo
CopyMemory ByVal StrPtr(sInfo), ByVal lParam, wParam
bBuffer = StrConv(sInfo, vbUnicode)
frmMain.lstInfo.AddItem bBuffer
End If
Case Else
WindowProc = CallWindowProc(pOldProc, hwnd, uMsg, wParam, lParam)
End Select

Exit Function
ErrMin:
End Function

[Quady515]

'刚刚的“接收”COPY中有个错误
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'On Error GoTo ErrMin:
Dim sInfo As String
Dim bBuffer() As Byte

sInfo = String(128, Chr(0))

Select Case uMsg
Case WM_DTSInfo
CopyMemory ByVal StrPtr(sInfo), ByVal lParam, wParam
bBuffer = StrConv(sInfo, vbUnicode)
frmMain.lstInfo.AddItem bBuffer
Case Else
WindowProc = CallWindowProc(pOldProc, hwnd, uMsg, wParam, lParam)
End Select

Exit Function
ErrMin:
End Function

[Quady515]

但是在线程中SendMessage之后就死了，更本没有机会发个消息回去。

[Accelerator]

去掉那些0试试

[Quady515]

不行

[Quady515]

朋友们帮帮忙吧!

[用户 昵称]

像线程发送消息需要使用
Public Declare Function PostThreadMessage Lib "user32" Alias "PostThreadMessageA" (ByVal idThread As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

而创建线程的时候可以指定一个窗口的句柄

如果传送字符串可以使用WM_COPYDATA消息，LPARAM是字符串地址。

[Quady515]

试试wm_copydata先

我是从线程里往另一进程的窗体发消息

[Quady515]

An application sends the WM_COPYDATA message to pass data to another application.

To send this message, call the SendMessage function with the following parameters (do not call the PostMessage function).
...
(摘自MSDN)

WM_COPYDATA不能用在postmessage中

[用户 昵称]

some code FYI

功能：进程间的通讯-----使用匿名管道
'环境：vb60 + win2k/win9k 测试下通过

''发送方
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

[Quady515]

下班了,明天再来,

100分太少吗?其它人怎么不来呢?

[chenxin790311]

up,因为有点忙，先做个标记吧。觉的楼上的pipe挺不错的

[Quady515]

看看pipe先.

[differ1]

学习

[Quady515]

好像Pipe不能解决我的问题,

是这样的:
我需要定一个DLL,让其它程序调用,而这个DLL需要处理一些东东,比如装载一个很大的文本文件(1,000,000条记录)到数据库,其中每装载一定的记录数(10,000条记录)就需要告诉DLL的调用者装载的进度.又或者中途出了差错DLL必需告诉调用者出了错.如果仅一个线程我可以直接设置函数的返回值就行,但是这个DLL是多线程的,所以只能发消息才能告诉调用者当前线程发生了什么事,问题就出在这里.

[Quady515]

我试过用SendNotifyMessage替换上面代码中的PostMessage,

在线程中发送消息不能正确接收到lParam中的数据
然而发送消息不是在线程中时就能够正确收到数据

[Quady515]

UP

[kensu]

干吗非得自己发送消息，定义好Event，然后用RaiseEvent通知调用者不就行了，
在API版就非的使用API吗？

[Quady515]

问题并没有真正得到解决,
所以我放弃了题中方法,用其它办法解决了,
不会用到消息,也不用产生事件.

谢谢大家.

[Quady515]

在两个应用之间传递信息应该是发消息是最好的了,

再说了,我传递信息的地方是在一个应用的线程中.