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
'刚刚的“接收”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
但是在线程中SendMessage之后就死了,更本没有机会发个消息回去。
像线程发送消息需要使用 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是字符串地址。
试试wm_copydata先我是从线程里往另一进程的窗体发消息
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 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
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
还有什么不明白?
但用SendMessage发送值就能正确接收,也是取地址。
Private Const WM_MyMSG = WM_USER + 1
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
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
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是字符串地址。
...
(摘自MSDN)WM_COPYDATA不能用在postmessage中
'环境: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
我需要定一个DLL,让其它程序调用,而这个DLL需要处理一些东东,比如装载一个很大的文本文件(1,000,000条记录)到数据库,其中每装载一定的记录数(10,000条记录)就需要告诉DLL的调用者装载的进度.又或者中途出了差错DLL必需告诉调用者出了错.如果仅一个线程我可以直接设置函数的返回值就行,但是这个DLL是多线程的,所以只能发消息才能告诉调用者当前线程发生了什么事,问题就出在这里.
然而发送消息不是在线程中时就能够正确收到数据
在API版就非的使用API吗?