1.txt

串口调试工具源码

Option Explicit
Dim IO As Byte
Private Sub CboBit_Click()
     MsmSettings (CboBit.ListIndex)
End Sub

Private Sub CboFind_Click()
     MsmSettings (CboFind.ListIndex)
End Sub

Private Sub CboHz_Click()
    MsmSettings (CboHz.ListIndex)
End Sub
Private Sub CboMsm_Click()
    IO = CboMsm.ListIndex + 1
    cmdMsm.Caption = "打开串口"
    Image1.Picture = LoadPicture(App.Path & "\" & "-.bmp")
End Sub

Private Sub CboNum_Click()
    MsmSettings (CboNum.ListIndex)
End Sub

Private Sub Check1_Click()
        If txtInput.Visible = True Then
            txtHex.Visible = True
            txtInput.Visible = False
        Else
            txtHex.Visible = False
            txtInput.Visible = True
        End If
End Sub

Private Sub ChkDTR_Click()
    If Msm.DTREnable = True Then
        Msm.DTREnable = False
    Else
        Msm.DTREnable = True
    End If
End Sub

Private Sub ChkRTS_Click()
    If Msm.RTSEnable = True Then
        Msm.RTSEnable = False
    Else
        Msm.RTSEnable = True
    End If
End Sub

Private Sub ChkTime_Click()
    If Timer1.Enabled = False Then
        Timer1.Enabled = True
    Else
        Timer1.Enabled = False
    End If
End Sub

Private Sub CmdClear_Click()
txtInput.Text = ""
txtHex.Text = ""
End Sub

Private Sub cmdMsm_Click()
On Error GoTo Err
    Msm.CommPort = IO
    If Msm.PortOpen = False Then
        Msm.PortOpen = True
    End If
    Msm.InBufferCount = 0
    Msm.OutBufferCount = 0
    cmdMsm.Caption = "关闭串口"
    Image1.Picture = LoadPicture(App.Path & "\" & "+.bmp")
    Exit Sub
Err:
    If Msm.PortOpen = True Then
        Msm.PortOpen = False
    Else
        MsgBox "串口已经打开！", vbOKOnly + vbCritical, "警告"
    End If
    cmdMsm.Caption = "打开串口"
    Image1.Picture = LoadPicture(App.Path & "\" & "-.bmp")
End Sub

Private Sub cmdOpen_Click()
   Dim str As String
On Error GoTo Err
   CdgText.Flags = &H1000 & &H4 & &H2
   CdgText.Filter = "*.txt|*.txt"
   txtHex = ""
   txtInput = ""
   CdgText.ShowOpen
   Open CdgText.FileName For Binary As #1
        str = Space(LOF(1)) '用空格填充str变量
        Get #1, , str  '用Get语句获取文件全部内容
        txtInput.Text = Trim(str)
   Close #1
   Open "C:\Documents and Settings\Jonkin\桌面\1.txt" For Binary As #2
        Print #2, , str
   Close #2
   Text1.Text = CdgText.FileName
   'Timer2.Enabled = True
Err:
End Sub

Private Sub Timer2_Timer()
   Dim sHex() As Byte
   Dim i As Long
   Timer2.Enabled = False
   i = LenB(StrConv(txtInput.Text, vbFromUnicode))
   ReDim sHex(i)
   sHex = StrConv(txtInput.Text, vbFromUnicode)
   For i = 0 To UBound(sHex)
       txtHex.SelStart = Len(txtHex.Text)
       If Len(Hex(sHex(i))) = 1 Then
           txtHex.SelText = "0" & CStr(Hex(sHex(i))) + " "
       Else
           txtHex.SelText = CStr(Hex(sHex(i))) + " "
       End If
   Next i
End Sub

Private Sub CmdSave_Click()
     Dim str As String
On Error GoTo Err
    CdgText.Flags = &H1000 & &H4 & &H2
    CdgText.Filter = "*.txt|*.txt"
    CdgText.ShowSave
    Open CdgText.FileName For Output As #1
    str = txtHex.Text
    Print #1, str
    Close #1
Err:
End Sub

Private Sub cmdSend_Click()
On Error GoTo Err
    Msm.Output = txtOutput.Text
Err:
End Sub

Private Sub cmdSendText_Click()
On Error GoTo Err
    Msm.Output = txtInput.Text
Err:
End Sub

Private Sub Form_Activate()
  cmdMsm_Click
End Sub

Private Sub Form_Load()
    Msm.CommPort = 3
    cmdMsm.Caption = "打开串口"
    CboMsm.ListIndex = 2
    CboHz.ListIndex = 2
    CboNum.ListIndex = 3
    CboBit.ListIndex = 0
    CboFind.ListIndex = 0
    MsmSettings 1
End Sub
Private Sub MsmSettings(ByVal Index As Byte)
    Msm.Settings = CboHz.Text & "," & Mid(CboFind.Text, 1, 1) & "," & CboNum.Text & "," & CboBit.Text
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    Msm.PortOpen = False
End Sub

Private Sub Msm_OnComm()
   Dim l As Integer
   Dim i As Long
   Dim sHex() As Byte
   Dim RegText As String
    Select Case Msm.CommEvent
    Case comEvReceive
        'txtInput.SelStart = Len(txtInput.Text)
        'txtInput.SelText = Msm.Input
        Msm.InputMode = comInputModeBinary
        l = Msm.InBufferCount
        ReDim sHex(l)
        sHex = Msm.Input
        txtHex.SelStart = Len(txtHex.Text)
        For i = 0 To UBound(sHex)
            txtHex.SelStart = txtHex.SelStart + 1
            txtHex.SelLength = 0
            txtHex.SelText = CStr(Hex(sHex(i))) + " "
        Next i
        RegText = StrConv(sHex, vbUnicode)
        txtInput.SelStart = Len(txtInput.Text)
        txtInput.SelLength = 0
        txtInput.SelText = RegText
    End Select
End Sub

Private Sub Timer1_Timer()
On Error GoTo Err
    Msm.Output = txtOutput.Text
Err:
End Sub

Private Sub TxtTime_Change()
    If TxtTime.Text = "" Then
        Timer1.Interval = 0
    ElseIf CLng(TxtTime.Text) > 60000 Then
        Timer1.Interval = 60000
    Else
        Timer1.Interval = TxtTime.Text
    End If
End Sub

Private Sub TxtTime_KeyPress(KeyAscii As Integer)
    If KeyAscii <> 8 And KeyAscii <> 13 Then
        If KeyAscii < 48 Or KeyAscii > 57 Then
            KeyAscii = 0
        End If
    End If
End Sub