frmmain.frm

此程序为标准的ＴＣＰＩＰ网络编程

End Sub

Private Sub about_Click()
frmAbout.Show 1, Me
End Sub

Private Sub Check1_Click()
If Check1.Value = Checked Then
    CmdSend.Enabled = False
Else
    CmdSend.Enabled = True
End If
End Sub

Private Sub Check2_Click()
If Check2.Value = Checked Then
    Timer3.Interval = TxtInterval.Text
    Timer3.Enabled = True
Else
    Timer3.Enabled = False
End If
End Sub

Private Sub CmdClearR_Click()
TxtRecv.Text = ""
End Sub

Private Sub CmdClearS_Click()
TxtSend.Text = ""
End Sub

Private Sub CmdCtrz_Click()
TxtSend.Text = TxtSend.Text + Chr(26)
End Sub

Private Sub CmdExit_Click()
Unload Me
End Sub

Private Sub CmdKW_Click()
TxtSend.Text = Chr(2) & "[001]" & TxtSend.Text + Chr(3)
End Sub

'连接网络
Private Sub CmdOpenPort_Click()
    OpenNetwork
End Sub

Private Sub Cmdsend_Click()
On Error Resume Next
If Winsock1.State = 7 Or (Winsock1.Protocol = sckUDPProtocol And udpEnabled = True) Then
    'Winsock1.SendData TxtSend.Text
    
    sendLen = sendLen + WinsockSend(TxtSend.Text)
    StatusBar1.Panels(3).Text = "发送:" & sendLen
Else
    MsgBox "网络通信没有建立，因此不能操作！请检查网络是否通畅。"
End If
End Sub

Private Sub ComboPort_Click()
If Winsock1.State = 7 Then
    StatusBar1.Panels(1).Text = "参数已改变，请重新连接网络"
    Timer2.Enabled = True
End If
End Sub

Private Sub exit_Click()
Unload Me
End Sub

Private Sub fileData_Click()
frmCycFile.Show 1, Me
End Sub

Private Sub Form_Load()
InitPara

PicState.Picture = ImageList1.ListImages(1).Picture
recvLen = 0
sendLen = 0
txtSendLen = 0

sending.Enabled = False
repeatSend.Enabled = False

StatusBar1.Panels(1).Text = "本地IP：" & Winsock1.LocalIP & " 无连接"
End Sub

'窗体发生变化时，一些控件大小需相应调整
Private Sub Form_Resize()
On Error Resume Next
If frmMain.Width < 8895 Then
    frmMain.Width = 8895
End If
If frmMain.Height < 6675 Then
    frmMain.Height = 6675
End If

Frame4.Width = frmMain.Width - Frame4.Left - 240
Frame4.Height = frmMain.Height - Frame4.Top - 980
TxtRecv.Width = Frame4.Width '- 240
TxtRecv.Height = Frame4.Height * 3540 / 5655
TxtSend.Top = TxtRecv.Top + TxtRecv.Height + 300
TxtSend.Width = Frame4.Width '- 240
TxtSend.Height = Frame4.Height - TxtSend.Top - 60 '- 180
LabelR.Width = TxtRecv.Width
LabelS.Width = TxtSend.Width
LabelS.Top = TxtSend.Top - LabelS.Height
FrameSend.Top = LabelS.Top

CmdCtrz.Top = LabelS.Top
CmdKW.Top = LabelS.Top

Check2.Top = LabelS.Top
TxtInterval.Top = LabelS.Top - 10

CheckRecv.Left = Frame4.Width - 2055
CheckRecv.Top = LabelR.Top + 40
CheckSend.Left = Frame4.Width - 2055
CheckSend.Top = LabelS.Top + 40

End Sub

Private Sub GBCode_Click()
If GBCode.Checked Then
    GBCode.Checked = False
Else
    GBCode.Checked = True
    Unicode.Checked = False
    codeM = codeGB
End If
End Sub

Private Sub OptionTCPC_Click()
ipHost.Enabled = True
ComboPort.Enabled = True
ComboPortLocal.Enabled = False
CmdOpenPort.Caption = "连接网络"

If Winsock1.Protocol <> sckTCPProtocol Then
    Winsock1.Protocol = sckTCPProtocol
End If
End Sub

Private Sub OptionTCPS_Click()
ipHost.Enabled = False
ComboPort.Enabled = False
ComboPortLocal.Enabled = True
CmdOpenPort.Caption = "开始监听"

If Winsock1.Protocol <> sckTCPProtocol Then
    Winsock1.Protocol = sckTCPProtocol
End If
End Sub

Private Sub OptionUDP_Click()
ipHost.Enabled = True
ComboPort.Enabled = True
ComboPortLocal.Enabled = True
CmdOpenPort.Caption = "开启UDP"

If Winsock1.Protocol <> sckUDPProtocol Then
    Winsock1.Protocol = sckUDPProtocol
End If
End Sub

Private Sub sending_Click()

'调出打开文件对话框
' Set CancelError is True
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
' Set flags
CommonDialog1.Flags = cdlOFNHideReadOnly
' Set filters
CommonDialog1.Filter = "All Files (*.*)|*.*|Text Files" & "(*.txt)|*.txt|"
' Specify default filter
CommonDialog1.FilterIndex = 2
' Display the Open dialog box
CommonDialog1.ShowOpen
' Display name of selected file
MsgBox CommonDialog1.FileName

'打开文件，并存入二进制流中
Dim fLen As Long '文件的长度
Dim fName As String '文件名（包括路径）
fName = CommonDialog1.FileName
fLen = FileLen(fName)
Dim sendByte() As Byte '文件二进制流
ReDim sendByte(fLen - 1) '重新定义二进制流的长度
Open fName For Binary As #1
Get #1, , sendByte
Close #1

'发送二进制流
If Winsock1.State = 7 Then
    Winsock1.sendData sendByte
    sendLen = sendLen + fLen
    StatusBar1.Panels(3).Text = "发送:" & sendLen
Else
    MsgBox "网络没有连接，因此不能操作！请检查网络是否通畅。"
End If

Exit Sub
 
ErrHandler:
    'User pressed the Cancel button
    Exit Sub
End Sub

Private Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)
If Panel.Index = 1 Then
MsgBox StatusBar1.Panels(1).Text
End If
If Panel.Index = 4 Then
    recvLen = 0
    sendLen = 0
    StatusBar1.Panels(2).Text = "收到:0"
    StatusBar1.Panels(3).Text = "发送:0"
    StatusBar1.Panels(4).Bevel = sbrInset
    Timer1.Enabled = True
End If
End Sub

Private Sub strData_Click()
frmSendStr.Show 1, Me
End Sub

'控制状态栏中的“计数器清零”按钮，当它按下后，马上使它凸起，从而实现按钮效果
Private Sub Timer1_Timer()
StatusBar1.Panels(4).Bevel = sbrRaised
Timer1.Enabled = False
End Sub

'当参数发生变化时，控制指示灯和状态栏文字，使之有规律的闪烁
Private Sub Timer2_Timer()
If Not leadOn Then
    leadOn = True
    PicState.Picture = ImageList1.ListImages(1).Picture
    StatusBar1.Panels(1).Text = ""
Else
    leadOn = False
    PicState.Picture = ImageList1.ListImages(2).Picture
    StatusBar1.Panels(1).Text = "参数已改变，请重新建立网络连接！"
End If
End Sub

Private Sub Timer3_Timer()
On Error Resume Next
If Winsock1.State = 7 Or (Winsock1.Protocol = sckUDPProtocol And udpEnabled = True) Then
    'Winsock1.SendData TxtSend.Text
    
    sendLen = sendLen + WinsockSend(TxtSend.Text)
    StatusBar1.Panels(3).Text = "发送:" & sendLen
Else
    MsgBox "网络通信没有建立，因此不能操作！请检查网络是否通畅。"
    Check2.Value = Unchecked
End If
End Sub

Private Sub TxtRecv_Change()
If Len(TxtRecv.Text) > 30000 Then
    TxtRecv.Text = ""
End If
End Sub

'实时传输：文本框内容一旦发生变化，就发送刚输入的字符或字符串
Private Sub TxtSend_Change()

On Error Resume Next

Dim sLen As Long '刚输入的字符或字符串（比如拷贝的字符串）的长度


If Check1.Value = Checked Then
    If Winsock1.State = 7 Or (Winsock1.Protocol = sckUDPProtocol And udpEnabled) Then
        Dim sData As String
        'If TxtSend.Text = "" Then Exit Sub
        sLen = ByteLen(TxtSend.Text) - txtSendLen
        If sLen = 0 Then Exit Sub
        
        '取出刚才输入的字符或字符串
        sData = Mid(TxtSend.Text, TxtSend.SelStart - sLen + 1, sLen) 'Mid(TxtSend.Text, Len(TxtSend.Text), 1) 'Right(TxtSend.Text, 1)
        '发送数据
        'Winsock1.sendData sData
        WinsockSend sData
        sendLen = sendLen + sLen
        StatusBar1.Panels(3).Text = "发送:" & sendLen
        '将文本框中的光标移至尾部，便于实时查看文本框中的内容
        TxtSend.SelStart = ByteLen(TxtSend.Text)
        '改变全局变量txtSendLen的值，也就是发送区长度有变化就需改变此值
        txtSendLen = ByteLen(TxtSend.Text)
    Else
        MsgBox "网络通信没有建立，无法发送数据！"
    End If
End If
End Sub

Private Sub Unicode_Click()
If Unicode.Checked Then
    Unicode.Checked = False
Else
    Unicode.Checked = True
    GBCode.Checked = False
    codeM = codeUnicode
End If
End Sub

Private Sub Winsock1_Close()
WinsockReset
'再开启网络通信
OpenNetwork
End Sub

Private Sub Winsock1_Connect()
    repeatSend.Enabled = True
    PicState.Picture = ImageList1.ListImages(2).Picture
    sending.Enabled = True
    Timer2.Enabled = False
    CmdOpenPort.Caption = "断开网络"
    StatusBar1.Panels(1).Text = " 已连接到" & Winsock1.RemoteHost & "：" & Winsock1.RemotePort
End Sub

Private Sub Winsock1_ConnectionRequest(ByVal requestID As Long)
If Winsock1.State <> sckClosed Then
    Winsock1.Close
    Winsock1.Accept requestID
    If Winsock1.State = 7 Then
        repeatSend.Enabled = True
        PicState.Picture = ImageList1.ListImages(2).Picture
        sending.Enabled = True
        Timer2.Enabled = False
        'CmdOpenPort.Caption = "断开网络"
        ipHost.Text = Winsock1.RemoteHostIP
        ComboPort.Text = Winsock1.RemotePort
        StatusBar1.Panels(1).Text = " 远程客户" & Winsock1.RemoteHostIP & "：" & Winsock1.RemotePort
    End If
End If
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo ErrHandle
    Dim recvData As String
    
    recvData = WinsockRecv(bytesTotal)
    
    ipHost.Text = Winsock1.RemoteHostIP
    ComboPort.Text = Winsock1.RemotePort

    recvLen = recvLen + bytesTotal
    TxtRecv.Text = TxtRecv.Text & recvData
    
    StatusBar1.Panels(2).Text = "收到:" & recvLen
    TxtRecv.SelStart = ByteLen(TxtRecv.Text)
    
    Exit Sub

ErrHandle:
    Debug.Print Err.Description
    
End Sub

Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
WinsockReset
StatusBar1.Panels(1).Text = "错误" & Number & ":" & Description
MsgBox "错误" & Number & ":" & Description
End Sub