Столкнулся с этим же багом, но с более серьезными последствиями.
Код C++ посылает SendMessage (WM_COPYDATA) с информацией о ходе своих процессов в приложение VB6. Причем подобные отправки происходят из разных мест C-шного кода, в т.ч. из dll и т.п.
1.
2.
3.
4.
5.
6.
процесс
---
SendMessage (WM_COPYDATA) ->
<- возврат результата SendMessage из VB
---
продолжение процесса
На стороне VB6 код был типа:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Public Function NewFormWindowProc _
...
Select Case Msg
Case WM_COPYDATA
Dim cds As COPYDATASTRUCT
Dim the_str as String
Call CopyMemory(cds, ByVal lParam, Len(cds))
the_str = PtrToString_len(cds.lpData, cds.cbData)
Select Case cds.dwData
Case 101
Function1(the_str )
Case 102
Function2(the_str )
End Select
Case Else
End Select
NewFormWindowProc = CallWindowProc _
Причем Function1 например может конвертировать файл запустив через Shell с ожиданием результата отдельный exe,
Function2 например может отправлять e-mail.
Т.е. это требующие времени операции, и при такой архитектуре
процесс C++ будет висеть (пока SendMessage не вернет результат).
А процесс на это такую грубость не рассчитан, в моем случае при нагрузке C++ мог свалиться на 100% CPU Usage с невозможностью вообще что либо сделать с компьютером.
Идея следующая и вроде получилось.
Обработчик WndProc вместо тупого запуска Function1 из-под себя пишет Message в массив-буфер, запускает одноразовый Timer (1 мс!!!) и отфутболивает SendMessage(результат получен).
А ф-ция таймера работает с очередью сообщений.
При этом как в ф-ции таймера, так и в Function1 если она использует цикл ожидания чего-либо используется DoEvents() с целью как минимум не препятствовать приему новых сообщений в буфер-массив.
С буфером-массивом используется та же идея как при создании внутренней очереди Tray Notifications.
Т.е. если принятое сообщение единственное, то оно обрабатывается сразу по тику таймера.
Если не единственное, то просто кладется в конец очереди.
А обработка происходит из ранее запущенной ф-ции таймера, кот. обработав предыдущее сообщение преступает к обработке следующего при его наличии.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
Public Type MyDataMessage
dwData As Long 'тип сообщения
lpData As String 'содержание сообщения
End Type
Public AppDataMessages() As MyDataMessage
===========
'инициализация сообщений
ReDim AppDataMessages(0 To 0) 'очистка-0-й элемент не используется
===========
Public Function NewFormWindowProc _
(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case Msg
Case WM_COPYDATA
Dim cds As COPYDATASTRUCT
Call CopyMemory(cds, ByVal lParam, Len(cds))
Dim the_message As MyDataMessage
the_message.dwData = cds.dwData
the_message.lpData = PtrToString_len(cds.lpData, cds.cbData)
AddDataMessageToQueue the_message
Case Else
End Select
NewFormWindowProc = CallWindowProc _
(OldFormWindowProc, hwnd, Msg, wParam, lParam)
End Function
Private Sub TimerDataMes_Timer()
'Используется первый тик таймера. Интервал = 1 МИЛЛИСЕКУНДА
TimerDataMes.Enabled = False
Do
'обрабатываем первое сообщение
Dim the_message As MyDataMessage
the_message = AppDataMessages(1) 'работаем с копией сообщения, иначе будет temp. locked
ProcessDataMessage the_message
RemoveDataMessageFromQueue
If UBound(AppDataMessages) > 0 Then
DoEvents 'обработка оконных сообщений в промежутке
Else
Exit Do
End If
Loop
End Sub
Private Sub AddDataMessageToQueue(new_message As MyDataMessage)
'добавление сообщения в конец массива
ReDim Preserve AppDataMessages(0 To UBound(AppDataMessages) + 1)
AppDataMessages(UBound(AppDataMessages)) = new_message
'запуск сообщения на исполнение, если нет текущего активного
If UBound(AppDataMessages) = 1 Then 'кроме добавленного сообщения ничего нет
'запуск тика таймера 1мс
Form1.TimerDataMes.Enabled = True
End If
End Sub
Public Sub RemoveDataMessageFromQueue()
'удаляем сообщение из очереди сдвигом элементов массива на единицу и удалением крайнего элемента
'сдвиг на единицу если оно не единственное
If UBound(AppDataMessages) > 1 Then '0-не используется, 1-удаляемое, 2-следующее и т.д.
Dim i As Long
For i = 1 To UBound(AppDataMessages) - 1
AppDataMessages(i) = AppDataMessages(i + 1)
Next
End If
'удаляем старший элемента массива
ReDim Preserve AppDataMessages(0 To UBound(AppDataMessages) - 1)
End Sub
Public Sub ProcessDataMessage(the_message As MyDataMessage)
Dim the_str As String
the_str = the_message.lpData
Select Case the_message.dwData
Case 101: '
Function1 the_str ' сама Function1 может использовать DoEvents(), если в ней цикл
Case 102: '
Function2 the_str ' сама Function2 может использовать DoEvents(), если в ней цикл
Можно конечно
использовать MailSlot вместо SendMessage.
Сообщение кладется в MailSlot без подтверждения его приема (т.е. пославший ничего не ждет и не тормозит).
но есть одно различие.
MailSlot надо долбить по таймеру (на стороне приемника),
а SendMessage принимается как только так сразу. В приведенном коде таймер используется только по факту прихода сообщения и создает минимальную задержку в 1 миллисекунду.
