myudp.frm

本书源码主要针对目前流行的FTP、HTTP、E-mail、Telnet、ICMP、Modem串口通信编程、拨号网络编程等内容进行详细的讲解

VERSION 5.00
Begin VB.Form myudp 
   Caption         =   "通过Winsock API实现UDP聊天"
   ClientHeight    =   3015
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5835
   LinkTopic       =   "Form1"
   ScaleHeight     =   3015
   ScaleWidth      =   5835
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   100
      Left            =   2760
      Top             =   1320
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭连接"
      Height          =   375
      Left            =   4080
      TabIndex        =   12
      Top             =   2520
      Width           =   1575
   End
   Begin VB.TextBox txtLocalPort 
      Height          =   375
      Left            =   4920
      TabIndex        =   11
      Text            =   "5000"
      Top             =   120
      Width           =   735
   End
   Begin VB.TextBox txtRemotePort 
      Height          =   405
      Left            =   3600
      TabIndex        =   9
      Text            =   "5000"
      Top             =   120
      Width           =   615
   End
   Begin VB.CommandButton cmdBind 
      Caption         =   "绑定到本地端口"
      Height          =   375
      Left            =   120
      TabIndex        =   7
      Top             =   2520
      Width           =   1695
   End
   Begin VB.CommandButton cmdSend 
      Caption         =   "发送信息"
      Height          =   375
      Left            =   2160
      TabIndex        =   6
      Top             =   2520
      Width           =   1695
   End
   Begin VB.TextBox txtRemotePeer 
      Height          =   405
      Left            =   1080
      TabIndex        =   4
      Text            =   "10.11.111.129"
      Top             =   120
      Width           =   1815
   End
   Begin VB.TextBox txtRecv 
      Height          =   1215
      Left            =   3360
      TabIndex        =   1
      Top             =   1080
      Width           =   2295
   End
   Begin VB.TextBox txtSend 
      Height          =   1215
      Left            =   120
      TabIndex        =   0
      Top             =   1080
      Width           =   2415
   End
   Begin VB.Label Label5 
      Caption         =   "本地绑定端口"
      Height          =   375
      Left            =   4320
      TabIndex        =   10
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label4 
      Caption         =   "远程端口"
      Height          =   375
      Left            =   3000
      TabIndex        =   8
      Top             =   120
      Width           =   495
   End
   Begin VB.Label Label3 
      Caption         =   "远处服务器地址"
      Height          =   495
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label2 
      Caption         =   "接收数据"
      Height          =   255
      Left            =   3360
      TabIndex        =   3
      Top             =   720
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "发送数据"
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   720
      Width           =   855
   End
End
Attribute VB_Name = "myudp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim msg_sock As Long, msgstr As String
Dim addr As sockaddr, remote_addr As sockaddr, from_addr As sockaddr
Dim fromlen As Long
Dim hEvent As Long
Dim dwRet As Long, dwyes As Long, dwRc As Long

'
' "关闭连接"按钮单击事件
'
' 程序说明：
'    主要是清空文本框内容，同时设置相关按钮的enable属性
'    并关闭定时器
'
Private Sub cmdClose_Click()
    If msg_sock <> INVALID_SOCKET Then
        closesocket msg_sock
    End If
    txtRecv.Text = ""
    txtSend.Text = ""
    cmdBind.Enabled = True
    cmdSend.Enabled = False
    cmdClose.Enabled = False
    Timer1.Enabled = False
End Sub

'
' "发送信息"按钮单击事件
'
' 该事件主要发送UDP数据到远程主机和端口
Private Sub cmdSend_Click()
    ' 建立远程主机和端口
    '
    remote_addr.sin_family = AF_INET     '
    remote_addr.sin_port = htons(CLng(txtRemotePort.Text))
    remote_addr.sin_addr = GetHostByNameAlias(txtRemotePeer.Text)
    
    ' 发送数据
    dwRet = sendto(msg_sock, ByVal txtSend.Text, Len(txtSend.Text), 0, remote_addr, LenB(remote_addr))
    If dwRet = SOCKET_ERROR Then
        MsgBox "sendto failed. Error: " & Err.LastDllError
    End If
End Sub

'
' "绑定到本地端口"按钮单击事件
'
' 该事件就是把winsock绑定到指定的本地端口上，这样是为了在该端口能够接受数据

Private Sub CmdBind_Click()
   '获得winsock句柄
   msg_sock = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)
   
   If msg_sock = INVALID_SOCKET Then
       MsgBox "Couldn't create socket(). Error: " & Err.LastDllError
   Else
       ' 建立本地地址
       '
       addr.sin_family = AF_INET
       addr.sin_port = htons(CLng(txtLocalPort.Text))
       addr.sin_addr = INADDR_ANY
       
       
       dwyes = 1
       '设定是否能多个进程绑定到同一个端口
       dwRet = setsockopt(msg_sock, SOL_SOCKET, SO_REUSEADDR, dwyes, LenB(dwyes))
       If dwRet = SOCKET_ERROR Then
            MsgBox "SO_REUSERADDR failed. Error: " & Err.LastDllError
       End If
       dwyes = 1
       ' 设定是否进行广播
       dwRet = setsockopt(msg_sock, SOL_SOCKET, SO_BROADCAST, dwyes, LenB(dwyes))
       If dwRet = SOCKET_ERROR Then
            MsgBox "SO_BROADCAST failed. Error: " & Err.LastDllError
       End If
       
       '绑定到socket
       If bind(msg_sock, addr, Len(addr)) = SOCKET_ERROR Then
           MsgBox "Couldn't bind() to socket locally. Error: " & Err.LastDllError
           closesocket (msg_sock)
           msg_sock = INVALID_SOCKET
       Else
           cmdSend.Enabled = True
           cmdBind.Enabled = False
           cmdClose.Enabled = True
           Timer1.Enabled = True
       End If
    End If
   
End Sub

'
'Form_Load事件
'
' 窗体载入时初始化Winsock
'
Private Sub Form_Load()
    If TCPIPStartup Then
        cmdBind.Enabled = True
        cmdSend.Enabled = False
        cmdClose.Enabled = False
        Timer1.Enabled = False
    Else
        MsgBox "Windows Sockets not initialized. Error: " & Err.LastDllError
    End If
    '
    ' 创建一个事件用来获得数据
    '
    msg_sock = INVALID_SOCKET
    hEvent = WSACreateEvent
    If hEvent = 0 Then
        MsgBox "Failed to create event. Error: " & Err.LastDllError
    End If
    
End Sub

'
' 窗体卸载事件
'
' 窗体卸载事件卸载Winsock相关资源
'    This routine unloads Winsock in addition to freeing any resources.
'
Private Sub Form_Unload(Cancel As Integer)
    If msg_sock <> INVALID_SOCKET Then
        closesocket msg_sock
    End If
    TCPIPShutDown
    If hEvent <> 0 Then WSACloseEvent hEvent
End Sub

'
' 定时器事件

'    这始一个回调函数，当定时器启动时，将触发事件FD_READ
'    然后调用WSAWaitForMultipleEvents决定是否有数据到达
'    如果没有，则退出程序，有的话则调用recvfrom函数来读取数据报

Private Sub Timer1_Timer()
    If msg_sock = INVALID_SOCKET Then
        Debug.Print "Create Socket First"
        Exit Sub
    End If
    
    Dim RetMsg As String
    
    RetMsg = String(7000, 0)
    ' Register to see if data is present
    '
    dwRc = WSAEventSelect(msg_sock, hEvent, FD_READ)
    If (dwRc = SOCKET_ERROR) Then
        MsgBox "Failed to select event. Error: " & Err.LastDllError
        Exit Sub
    End If
    '
    ' 查看是否有数据可以获取，不要使用阻塞模式
    '如果等待参数为0则立即返回
    '
    dwRc = WSAWaitForMultipleEvents(1, hEvent, False, 0, False)
       
    Select Case dwRc
    Case WSA_WAIT_TIMEOUT
        Debug.Print "Recv timed out"
        
    Case WSA_WAIT_EVENT_0
        Dim NetworkEvents As WSANETWORKEVENTS
        Dim dwRet As Long
        NetworkEvents.lNetWorkEvents = 0
        dwRet = WSAEnumNetworkEvents(msg_sock, hEvent, NetworkEvents)
        If (dwRet = SOCKET_ERROR) Then
            MsgBox "WSAEnumNetworkEvents failed to select event. Error: " & Err.LastDllError
        Else
            If (FD_READ And NetworkEvents.lNetWorkEvents) Then
                fromlen = LenB(from_addr)
                dwRc = recvfrom(msg_sock, ByVal RetMsg, 7000, 0, from_addr, fromlen)
                If dwRc = SOCKET_ERROR Then
                    MsgBox "Couldn't recieve data from remote Socket. Error: " & Err.LastDllError
                Else
                    txtRecv.Text = Left(RetMsg, InStr(RetMsg, Chr(0)))
                End If
            End If
        End If
    
    Case WSA_WAIT_FAILED
        MsgBox "WSAWaitForMultipleEvents failed. Error: " & Err.LastDllError
    Case Else
        MsgBox "Unexpected WSAWaitForMultipleEvents return. Error: " & Err.LastDllError
    End Select
    
    dwRc = WSAEventSelect(msg_sock, hEvent, 0)
    If (dwRc = SOCKET_ERROR) Then
        MsgBox "Failed to select event. Error: " & Err.LastDllError
        Exit Sub
    End If

End Sub