- Код: Выделить всё
'Module
Public Const MIN_SOCKETS_REQD As Long = 1
Public Const WS_VERSION_REQD As Long = &H101
Public Const WS_VERSION_MAJOR As Long = WS_VERSION_REQD \ &H100 And &HFF&
Public Const WS_VERSION_MINOR As Long = WS_VERSION_REQD And &HFF&
Public Const MAX_WSADescription = 256
Public Const MAX_WSASYSStatus = 128
Public Const AF_INET = 2
Public Const SOCK_DGRAM As Long = 2
Public Const INVALID_SOCKET = -1
Public Const SOCKET_ERROR = -1
Public Const INADDR_ANY As Long = &H0
Public Const MSG_PEEK As Long = &H2
Public Const GWL_WNDPROC = (-4)
Public Const WINSOCKMSG = 1025
Public Const WM_USER As Long = &H400
Public Const WSA_NETEVENT = WM_USER + 10
Public Const FD_READ As Long = &H1&
Public Const WM_APP As Long = 32768
Public Const RESOLVE_MESSAGE As Long = WM_APP
Public Const SOCKET_MESSAGE As Long = WM_APP + 1
Public Type WSAData
wVersion As Integer
wHighVersion As Integer
szDescription(0 To MAX_WSADescription) As Byte
szSystemStatus(0 To MAX_WSASYSStatus) As Byte
wMaxSockets As Integer
wMaxUDPDG As Integer
dwVendorInfo As Long
End Type
Public Type sockaddr
sin_family As Integer
sin_port As Integer
sin_addr As Long
sin_zero As String * 8
End Type
Public Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequired As Long, lpWSADATA As WSAData) As Long
Public Declare Function WSACleanup Lib "wsock32" () As Long
Public Declare Function socket Lib "wsock32.dll" (ByVal af As Long, ByVal s_type As Long, ByVal protocol As Long) As Long
Public Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Long) As Integer
Public Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Public Declare Function bind Lib "wsock32" (ByVal socket As Long, addr As sockaddr, ByVal namelen As Long) As Long
Public Declare Function closesocket Lib "wsock32.dll" (ByVal s As Long) As Long
Public Declare Function Connect Lib "wsock32.dll" Alias "connect" (ByVal s As Long, addr As sockaddr, ByVal namelen As Long) As Long
Public Declare Function sendto Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long, ByRef toa As sockaddr, ByVal tolen As Long) As Long
Public Declare Function recvfrom Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long, ByRef from As sockaddr, ByRef fromlen As Long) As Long
Public Declare Function WSAAsyncSelect Lib "wsock32.dll" (ByVal s As Long, ByVal hwnd As Long, ByVal wMsg As Long, ByVal lEvent As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim PrevProc As Long
Public Sub HookForm(F As Form)
PrevProc = SetWindowLong(F.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHookForm(F As Form)
If PrevProc <> 0 Then
SetWindowLong F.hwnd, GWL_WNDPROC, PrevProc
PrevProc = 0
End If
End Sub
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = SOCKET_MESSAGE Then
Debug.Print "Сработало 1"
Sleep 500
Form1.rcv
Debug.Print "Сработало 2"
Sleep 500
Else
WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)
End If
End Function
А вот код формы (на форме 1 текстбокс и одна кнопка):
- Код: Выделить всё
Dim sc As Long, dt As WSAData, ws As sockaddr, bufer As String, bufer2 As String
Dim p As Long
Private Sub Command1_Click()
If WSAStartup(WS_VERSION_REQD, dt) <> 0 Then MsgBox "Ошибка инициализации сокета"
sc = socket(AF_INET, SOCK_DGRAM, 0)
If sc = INVALID_SOCKET Then MsgBox "Ошибка создания сокета"
ws.sin_family = AF_INET
ws.sin_port = 0
ws.sin_addr = INADDR_ANY
If bind(sc, ws, Len(ws)) = SOCKET_ERROR Then
closesocket sc
MsgBox "Ошибка в бинде
"
End If
WSAAsyncSelect sc, Me.hwnd, SOCKET_MESSAGE, FD_READ
bufer = "Тестовая строка"
ws.sin_family = AF_INET
ws.sin_port = htons(<номер порта>)
ws.sin_addr = inet_addr("192.168.ХХХ.ХХХ")
sendto sc, bufer, Len(bufer), 0&, ws, Len(ws)
End Sub
Private Sub Form_Load()
HookForm Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnHookForm Me
closesocket sc
WSACleanup
End Sub
Public Sub rcv()
recvfrom sc, bufer2, 280, MSG_PEEK, ws, Len(ws) 'эта строка вызывает у меня много загадок
ну хотя не так уж и много, вобщем где-то тут прога виснет, но ПОЧЕМУ, а может это и раньше происходит но до этого момента она доходит.
Sleep 1000
Debug.Print "Буфер = " & bufer2
End Sub
