frmmain.frm

三个串口助手源码.rar

            Else
                For i = 1 To 4
                    mnuCom(i).Checked = False
                Next i
                mnuCom(Index).Checked = True
            End If
        Else
            .CommPort = Index
            For i = 1 To 4
                mnuCom(i).Checked = False
            Next i
            mnuCom(Index).Checked = True
        End If
    End With
    UpdateStatus
End Sub

Private Sub mnuConnect_Click()

    On Error Resume Next
    With MSComm1
        If .PortOpen = True Then
            .PortOpen = False
        Else
            .PortOpen = True
            If Err.Number <> 0 Then
                MsgBox "Com" & .CommPort & " is not available." & vbCrLf & _
                                                Err.Description
                Err.Clear
            End If
        End If
    End With
   UpdateStatus
   
End Sub

Private Sub mnuDataBSel_Click(Index As Integer)
    Dim i As Integer
    Dim NewSettings As String
    
    For i = 4 To 8
        If (i = Index) Then
            mnuDataBSel(i).Checked = True
            Select Case Index
                Case 4      ' 4
                    NewSettings = ",,4,"
                Case 5      ' 5
                    NewSettings = ",,5,"
                Case 6      ' 6
                    NewSettings = ",,6,"
                Case 7      ' 7
                    NewSettings = ",,7,"
                Case 8      ' 8
                    NewSettings = ",,8,"
            End Select
        Else
            mnuDataBSel(i).Checked = False
        End If
    Next i
    SetPort (NewSettings)

End Sub


Private Sub mnuHelpSel_Click(Index As Integer)
    Select Case Index
        Case 0      ' Basic Help
            MsgBox "Basic Communications Program -- Help is in readme file." _
                           , vbInformation, "Help"
        Case 1      ' About
            MsgBox "Basic Communications Program Version 0.91", , "Help About"
    End Select
End Sub

Private Sub mnuParitySel_Click(Index As Integer)
    Dim i As Integer
    Dim NewSettings As String
    
    For i = 0 To 4
        If (i = Index) Then
            mnuParitySel(i).Checked = True
            Select Case Index
                Case 0      ' E
                    NewSettings = ",E,,"
                Case 1      ' M
                    NewSettings = ",M,,"
                Case 2      ' N
                    NewSettings = ",N,,"
                Case 3      ' O
                    NewSettings = ",O,,"
                Case 4      ' S
                    NewSettings = ",S,,"
            End Select
        Else
            mnuParitySel(i).Checked = False
        End If
    Next i
    SetPort (NewSettings)
    
End Sub

Private Sub mnuSpeedSel_Click(Index As Integer)
   Dim i As Integer
   Dim CurPortOpen As Boolean
   Dim NewSettings As String
    
   For i = 0 To 12
        If (i = Index) Then
            mnuSpeedSel(i).Checked = True
            Select Case Index
                Case 0      ' 110
                    NewSettings = "110,,,"
                Case 1      ' 300
                    NewSettings = "300,,,"
                Case 2      ' 600
                    NewSettings = "600,,,"
                Case 3      ' 1200
                    NewSettings = "1200,,,"
                Case 4      ' 2400
                    NewSettings = "2400,,,"
                Case 5      ' 9600
                    NewSettings = "9600,,,"
                Case 6      ' 14400
                    NewSettings = "14400,,,"
                Case 7      ' 19200
                    NewSettings = "19200,,,"
                Case 8      ' 28800
                    NewSettings = "28800,,,"
                Case 9      ' 38400
                    NewSettings = "38400,,,"
                Case 10      ' 56000
                    NewSettings = "56000,,,"
                Case 11      ' 128000
                    NewSettings = "128000,,,"
                Case 12      ' 256000
                    NewSettings = "256000,,,"
            End Select
        Else
            mnuSpeedSel(i).Checked = False
        End If
        Next i
    SetPort (NewSettings)
    
End Sub

Private Sub mnuStopSel_Click(Index As Integer)
    Dim i As Integer
    Dim NewSettings As String
    
    For i = 0 To 2
        If (i = Index) Then
            mnuStopSel(i).Checked = True
            Select Case Index
                Case 0      ' 1
                    NewSettings = ",,,1"
                Case 1      ' 1.5
                    NewSettings = ",,,1.5"
                Case 2      ' 2
                    NewSettings = ",,,2"
            End Select
        Else
            mnuStopSel(i).Checked = False
        End If
    Next i
    
    SetPort (NewSettings)
End Sub

Private Sub mnuViewSel_Click(Index As Integer)
    Dim i As Integer
    Dim j As Integer
    Dim c As String
    
    txtTextOut_LostFocus
    For j = 0 To 1
        If (j = Index) Then
            mnuViewSel(j).Checked = True
            Select Case Index
                Case 0      ' Ascii
                    OutputAscii = True
                    txtResponse = ""
                    For i = 1 To Len(InputString)
                        c = Mid(InputString, i, 1)
                        txtResponse = txtResponse & AsciiRep(c)
                     Next i
                    txtTextOut.Text = ""
                    For i = 1 To Len(OutputString)
                        c = Mid(OutputString, i, 1)
                        txtTextOut.Text = txtTextOut.Text & AsciiRep(c)
                    Next i
                Case 1      ' Hex
                    OutputAscii = False
                    txtResponse = ""
                    For i = 1 To Len(InputString)
                        c = Asc(Mid(InputString, i, 1))
                        txtResponse = txtResponse & " " & Hex2(c)
                    Next i
                    txtTextOut.Text = ""
                    For i = 1 To Len(OutputString)
                        c = Mid(OutputString, i, 1)
                        txtTextOut.Text = txtTextOut.Text & " " & Hex2(Asc(c))
                    Next i
            End Select
        Else
            mnuViewSel(j).Checked = False
         End If
    Next j
    txtResponse.SelStart = Len(txtResponse)
    txtTextOut.SelStart = Len(txtTextOut.Text)
    UpdateStatus
    
End Sub

Private Sub MSComm1_OnComm()
    Dim txtBuf As String
    Dim i As Integer
    Dim c As String
    
    With MSComm1
        Select Case .CommEvent
            Case comEvReceive
                txtBuf = .Input
                InputString = InputString & txtBuf
                For i = 1 To Len(txtBuf)
                    c = Mid(txtBuf, i, 1)
                    If OutputAscii Then
                        txtResponse = txtResponse & AsciiRep(c)
                    Else
                        txtResponse = txtResponse & " " & Hex2(c)
                    End If
                Next i
        End Select
    End With
    txtResponse.SelStart = Len(txtResponse)
    
End Sub

Private Sub UpdateStatus()

    If MSComm1.PortOpen Then
        StatusBar1.Panels(1).Text = "Connected"
        mnuConnect.Caption = "Dis&connect"
        btnSend(1).Enabled = True
    Else
        StatusBar1.Panels(1).Text = "Disconnected"
        mnuConnect.Caption = "&Connect"
        btnSend(1).Enabled = False
    End If
    StatusBar1.Panels(2).Text = "COM" & MSComm1.CommPort
    StatusBar1.Panels(3).Text = MSComm1.Settings
    If (OutputAscii) Then
        StatusBar1.Panels(4) = "ASCII"
    Else
        StatusBar1.Panels(4) = "HEX"
   End If

End Sub
Private Function ValidatePort() As Boolean
    Dim i As Integer
    
    On Error Resume Next
    ValidatePort = False
    With MSComm1
        For i = 4 To 1 Step -1
            .CommPort = i
            Err.Clear
            .PortOpen = True
            If (Err.Number <> 0) Then
                mnuCom(i).Enabled = False
            Else
                ValidatePort = True
                .PortOpen = False
            End If
        Next i
    End With
End Function
Private Function LegalHex(c As String) As String
    c = UCase(c)
    Select Case c
        Case "0" To "9", "A" To "F"
            LegalHex = c
        Case Else
            LegalHex = ""
    End Select
End Function
Private Sub SetPort(NewSettings As String)
    Dim CurPortOpen As Boolean
    Dim OldIndex As Integer
    Dim OldLength As Integer
    Dim NewIndex As Integer
    Dim NewLength As Integer
    Dim i As Integer
    Dim Settings(0 To 3) As String
    Dim Temp As String
    
     With MSComm1
        CurPortOpen = .PortOpen
        If .PortOpen Then
            .PortOpen = False
        End If
        OldIndex = 1
        NewIndex = 1
        For i = 0 To 3
            NewLength = InStr(NewIndex, NewSettings, ",")
            If (NewLength = 0) Then
                NewLength = NewIndex + Len(Mid(NewSettings, NewIndex))
            End If
            OldLength = InStr(OldIndex, .Settings, ",")
            If (OldLength = 0) Then
                OldLength = OldIndex + Len(Mid(.Settings, OldIndex))
            End If
            If (NewLength = NewIndex) Then
                Settings(i) = Mid(.Settings, OldIndex, OldLength - OldIndex)
            Else
                Settings(i) = Mid(NewSettings, NewIndex, NewLength - NewIndex)
            End If
            OldIndex = OldLength + 1
            NewIndex = NewLength + 1
        Next i
        .Settings = Settings(0) & "," & Settings(1) & "," & _
                            Settings(2) & "," & Settings(3)
        If CurPortOpen Then
            .PortOpen = True
        End If
    End With
    UpdateStatus

End Sub

Private Sub txtTextOut_GotFocus()

    txtTextOut.SelStart = 0
    txtTextOut.SelLength = Len(txtTextOut)
    
End Sub
Private Function AsciiRep(c As String) As String

    Select Case Asc(c)
        Case 32 To 91, 93 To 126
            AsciiRep = c
        Case 8
            AsciiRep = "\b"
        Case 9
            AsciiRep = "\t"
        Case 10
            AsciiRep = "\n"
        Case 13
            AsciiRep = "\r"
        Case 92
            AsciiRep = "\\"
        Case Else
            AsciiRep = "\x" & Hex2(Asc(c))
    End Select
    
End Function
Private Function Hex2(c As String) As String
    Hex2 = Hex(c)
    If Len(Hex2) < 2 Then
        Hex2 = "0" & Hex2
    End If
End Function

Private Sub txtTextOut_LostFocus()
    Dim c As String
    Dim i As Long
    Dim Temp As Long

    OutputString = ""
    If (OutputAscii) Then
        For i = 1 To Len(txtTextOut.Text)
            c = Mid(txtTextOut.Text, i, 1)
            If (c = "\") Then
                i = i + 1
                c = Mid(txtTextOut.Text, i, 1)
                Select Case c
                    Case "b"
                        OutputString = OutputString & Chr(8)
                    Case "t"
                        OutputString = OutputString & Chr(9)
                    Case "n"
                        OutputString = OutputString & Chr(10)
                    Case "r"
                        OutputString = OutputString & Chr(13)
                    Case "\"
                        OutputString = OutputString & "\"
                    Case "x"
                        c = HexChar(Mid(txtTextOut.Text, i + 1, 1)) * 16 _
                                        + HexChar(Mid(txtTextOut.Text, i + 2, 1))
                        OutputString = OutputString & Chr(c)
                        i = i + 2
                End Select
            Else
                OutputString = OutputString & c
            End If
        Next i
    
        txtTextOut.Text = ""
        For i = 1 To Len(OutputString)
            c = Mid(OutputString, i, 1)
            txtTextOut.Text = txtTextOut.Text & AsciiRep(c)
        Next i
    Else
        i = 1
        Do While (Len(Mid(txtTextOut.Text, i)) > 0)
            Temp = 0
            Do While (Mid(txtTextOut.Text, i, 1)) = " "
                i = i + 1
            Loop
            c = Mid(txtTextOut.Text, i, 1)
            Do While Not (c = " " Or c = "")
                Temp = (Temp * 16) + HexChar(c)
                i = i + 1
                c = Mid(txtTextOut.Text, i, 1)
            Loop
            If (Temp > 255) Then
                Temp = 0
            End If
            OutputString = OutputString & Chr(Temp)
        Loop
        
        txtTextOut.Text = ""
        For i = 1 To Len(OutputString)
            c = Mid(OutputString, i, 1)
            txtTextOut.Text = txtTextOut.Text & " " & AsciiRep(c)
        Next i
    End If
    txtTextOut.SelStart = Len(txtTextOut.Text)
    
End Sub