|
|
发表于 2009-11-8 15:20:06
|
显示全部楼层
<div class="msgheader">QUOTE:</div><div class="msgborder"><b>以下是引用<i>马大哈</i>在2009-11-8 12:46:27的发言:</b><br/>
<p>现在这种情况,我觉得比较好的方式是,数据到来时,POST一个消息,在参数里说明一下当前线程的一个唯一身份信息,比如线程ID(<font face="Verdana">App.ThreadID返回当前线程ID),然后等待主线程根据这些信息找到自己,并取走数据.</font></p>
<p> </p>
<p>这对于更新界面的情况,是很有效的,因为这些数据不需要主线程即时处理.</p>
<p> </p>
<p>如果需要即时处理的,就只有直接调用主线程对象的方法了,因为反正要挂起,用API不如直接线程间调度来得简便.....只是需要看看开销带来的影响是否太大,不然还是得用API.....</p></div>
<p> </p>
<p>消息投递我根据10楼写的这句: 主窗体收到后再根据参数向相应的对象里取信息,做出来了。但是遇到了一个郁闷的情况,我称它为“消息阻塞”。</p>
<p>'-------------------------------</p>
<p>我用了以前的键盘钩子的方式,找了个消息挂钩的例子改了一下。做了个消息钩子,</p>
<p>’------------消息钩子模块。</p>
<p><font face="Verdana">Option Explicit</font></p>
<p><font face="Verdana">Private Const GWL_WNDPROC = -4<br/>Private Const GWL_USERDATA = (-21)<br/>Private Const WM_SIZE = &H5<br/>Private Const WM_USER = &H400<br/> <br/>Private Declare Function CallWindowProc Lib "user32" Alias _<br/> "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _<br/> ByVal hwnd As Long, ByVal Msg As Long, _<br/> ByVal wParam As Long, ByVal lParam As Long) As Long<br/> <br/>Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _<br/> (ByVal hwnd As Long, ByVal nIndex As Long) As Long<br/> <br/>Private Declare Function SetWindowLong Lib "user32" Alias _<br/> "SetWindowLongA" (ByVal hwnd As Long, _<br/> ByVal nIndex As Long, ByVal dwNewLong As Long) As Long<br/>'---------------------<br/>Private prevWndProc As Long<br/> <br/>Public Function Hook(ByVal hwnd As Long) As Long<br/> <br/> Dim pOld As Long<br/>' ‘指定自定义的窗口过程<br/> pOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)<br/>' ‘保存原来默认的窗口过程指针<br/> Hook = pOld<br/> prevWndProc = pOld<br/> Debug.Print "原来默认的窗口过程指针Pold:" & pOld<br/>End Function<br/> <br/>Public Sub Unhook(ByVal hwnd As Long, ByVal lpWndProc As Long)<br/> Dim temp As Long<br/> 'Cease subclassing.<br/> temp = SetWindowLong(hwnd, GWL_WNDPROC, lpWndProc)<br/>End Sub<br/> <br/>Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long<br/> Select Case uMsg<br/> Case WM_SIZE<br/> ' ‘处理WM_SIZE消息<br/> Debug.Print "SIZE"<br/> Case WM_USER + 1<br/> Select Case wParam<br/> Case 1<br/> frmMain.Text1(lParam) = mySock_mTh(lParam).Sc'我怀疑消息频繁到达导致这里发生阻塞<br/> Case 2<br/> <br/> Case Else<br/> <br/> End Select<br/> Case Else<br/> <br/> End Select<br/>' ‘调用原来的窗口过程<br/> WindowProc = CallWindowProc(prevWndProc, hw, uMsg, wParam, lParam) 'lpPrevWndProc<br/>End Function<br/>’---------------------使用时-------</font></p>
<p><font face="Verdana">Private Sub Form_Load()<br/> Me.Tag = Hook(Me.hwnd)<br/>End Sub</font></p>
<p><font face="Verdana">Private Sub Form_Unload(Cancel As Integer)<br/> Unhook Me.hwnd, Me.Tag<br/>End Sub</font></p>
<p>'-----------------------------------------在线程里面:</p>
<p> </p>
<p><font face="Verdana">Private Sub Timer1_Timer()<br/> Dim lResult As Long<br/> Dim i As Integer<br/> '给主窗口发送消息。<br/> If Sc < 10 Then<br/> Sc = Sc + 1<br/> lParam = MyIndex<br/> wParam = 1<br/> RaiseEvent SetSc(Sc)<br/> lResult = PostMessage(mHwnd, WM_USER + 1, wParam, lParam)<br/> Else<br/> Sc = 0<br/> Timer1.Enabled = False<br/> TimBl = False<br/> RaiseEvent ImBusy(TimBl)<br/> End If<br/> For i = 0 To 100<br/>' Text1(index).Text = i<br/> lParam = MyIndex<br/> wParam = 1<br/> RaiseEvent SetSc(i)<br/> lResult = PostMessage(mHwnd, WM_USER + 1, wParam, lParam)'发出阻塞的源头。<br/> Sleep 1<br/> DoEvents<br/> If IsStop = True Then Exit For<br/> Next i<br/>End Sub</font></p>
<p>’------------------</p>
<p> </p>
<p>结果在VB编辑器里面运行发现是单线程的,没有发生消息阻塞,编译后再运行,发现已经类似多线程了,但是主窗口消息被阻塞,基本不响应按钮单击等事件了。</p>
<p> </p>
<p>在实际使用过程中,如果连接的客户端很多的发,消息发送频率就会有上面的那么高。我上面只模拟了6个线程。</p>
<p> </p>
<p>不知老马解决这个的好办法?</p>
<p> </p> |
|