|
VB-процедуры обратного вызова. ПОМОГИТЕ!!!
#35095176
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
|
|
|
|
Есть радиотерминал штрихкода. Он обменивается данными с приложением через подключаемую dll - ку. Библиотека CipherLabTCP.dll обменивается данными с окном приложения. Пишу функцию перехвата - вылетает после использования SetWindowLong. Что самое интересное, этот же код в VBA EXCEL работает нормально. А попытка сделать то же самое в VB6 не удается. Посмотрите код, плиз, где я налажал?
Код формы MainForm:
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.
Private Const GWL_WNDPROC = (- 4 )
Public Cipher As Object
Public Msg As Long
Public WinHandle As Long
Public Num As Integer
Public Message As String
Public Connect As Boolean
Private Declare Function CallWindowProc _
Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal WinHandle As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal LParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal WinHandle As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public lpPrevWndProc As Long
Public Sub Con(LongVal) 'Процедура обмена данными
Dim StringComp As String
Dim MyVarStr As Variant
Dim MyVarInt As Variant
Dim rez As Variant
Dim paParams( 10 ) As Variant
Dim buf( 10 ) As Byte
Dim Var As Variant
StringComp = "AddIn.CipherLabTCP.1"
WinHandle = Me.Hwnd
Debug.Print "Handle окна = " & WinHandle
If (Connect = False) Then 'Используется один раз при запуске
Set Cipher = CreateObject("TCPCipher.TCPCipherComponent.1") 'создаем подключение к интерфейсу ITCPCipher
rez = Cipher.ConnectToDll(StringComp, Cipher, WinHandle, LongVal) 'загружаем компоненту
Debug.Print "rez = " & rez
Msg = LongVal
End If
'установка параметров: номер порта, скорость, разделители, IrDa
paParams( 0 ) = 1024 'Устанавливаем номер порта
paParams( 1 ) = 9 'устанавливаем разделитель
paParams( 2 ) = 1 'устанавливаем режим записи
paParams( 3 ) = 1 'устанавливаем режим отладки
Connect = True
StringComp = "УстановитьПараметры"
rez = Cipher.CallMethod(StringComp, Var, paParams) 'установка параметров
Debug.Print "rez=" & rez
StringComp = "Подключить" 'Запуск сервера
rez = Cipher.CallMethod(StringComp, MyVarStr, paParams)
Debug.Print "rez=" & rez
Debug.Print "Var=" & Var
If (Var = 1 ) Then
Me.ListBox1.AddItem ("Сервер запущен...")
End If
lpPrevWndProc = SetWindowLong(WinHandle, GWL_WNDPROC, AddressOf PeekMessage) 'Прикрепление функции к окну
Debug.Print "lpPrevWndProc = " & lpPrevWndProc
End Sub
Private Sub OffButton_Click()
Dim StringComp As String, Var As Variant, paParams( 10 ) As Variant, rez As Variant
StringComp = "Отключить"
rez = Cipher.CallMethod(StringComp, Var, paParams)
Debug.Print "rez = " & rez
Debug.Print "Var = " & Var
If (Var = 1 ) Then
Me.ListBox1.AddItem ("Сервер остановлен...")
End If
End Sub
Private Sub OnButton_Click()
Dim LongVal As Long
LongVal = 1
Call Con(LongVal)
End Sub
Код модуля Module1:
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.
Private Declare Function CallWindowProc _
Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal WinHandle As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal LParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public lpPrevWndProc As Long
'Функция обработки сообщений
Public Function PeekMessage(ByVal WinHandle As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal LParam As Long) As Long
If (MainForm.Msg = uMsg) Then
MainForm.Num = LParam
If (LParam = 1 ) Then
MainForm.Message = "Query" 'событие запроса данных
End If
If (LParam = 2 ) Then
MainForm.Message = "Insert" 'событие для вставки штрих кода в базу данных
End If
If (LParam = 3 ) Then
MainForm.Message = "Update" 'событие обновления данных
End If
If (LParam = 4 ) Then
MainForm.Message = "Make" 'событие создания новой накладной
End If
If (LParam = 5 ) Then
MainForm.Message = "Close" 'событие закрытия накладной
End If
If (LParam = 6 ) Then
MainForm.Message = "Overflow" 'событие переполнения очереди сообщений
End If
MainForm.Num = wParam 'получаем номер сообщения в очереди
Call MainForm.Con 'Вызов функции обрабоки данных
End If
PeekMessage = CallWindowProc(lpPrevWndProc, WinHandle, uMsg, wParam, LParam)' функция обратного вызова
End Function
|
|
|