串口调试1.frm

串口调试程序源文件

         Width           =   1695
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "使用说明"
      Height          =   495
      Left            =   960
      TabIndex        =   1
      Top             =   5160
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "更新时间"
      Height          =   495
      Left            =   3480
      TabIndex        =   0
      Top             =   5160
      Width           =   1335
   End
   Begin VB.Label Label15 
      Caption         =   "论坛网址点击"
      ForeColor       =   &H000080FF&
      Height          =   255
      Left            =   6840
      TabIndex        =   38
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label14 
      Caption         =   "店铺地址点击"
      ForeColor       =   &H000080FF&
      Height          =   255
      Left            =   1440
      TabIndex        =   37
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label13 
      Caption         =   "http://shop34791330.taobao.com"
      ForeColor       =   &H80000002&
      Height          =   255
      Left            =   2760
      TabIndex        =   36
      Top             =   120
      Width           =   2775
   End
   Begin VB.Label Label12 
      Caption         =   "www.doflye.net"
      ForeColor       =   &H80000002&
      Height          =   255
      Left            =   8040
      TabIndex        =   35
      Top             =   120
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long



Private Sub Combo1_Click()
If MSComm1.PortOpen = True Then  '如果串口打开先关闭后再进行其他操作
   MSComm1.PortOpen = False
 End If
MSComm1.CommPort = Combo1.ListIndex + 1 '读取com口号
End Sub



Private Sub Command1_Click() '发送到窗口现在时间
time1 = Time
date1 = Date
now1 = Now
Text1.Text = Hour(Time) & "时" & Minute(Time) & "分" & Second(Time) & "秒" & "  " & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日" & vbNewLine & "时间已经更新，并通过串口发送，并接收返回值，返回值应等于发送区的值，如果返回值不正确，请检查下位机程序和波特率是否正确！" & vbNewLine
week = (Weekday(Date) - 1)
If week = "0" Then
   week = "07"
Else
   week = "0" & week
End If

Text2.Text = Format(Now, "yyyymmddhhmmss") & week '显示格式时间用于和下位机通讯
Call Command6_Click

End Sub

Private Sub Command2_Click()

Text1.Text = "技术论坛 www.doflye.net（单片机爱好者）" & vbNewLine & "淘宝店铺：http://shop34791330.taobao.com/" & vbNewLine & "该软件是为dofly产品专门设计，不完全等同于其他串口调试软件，但基本使用原理和方法相同，欢迎到论坛对此软件提出宝贵意见和建议！购买产品请点击淘宝店铺。" '说明内容输出

End Sub

Private Sub Command3_Click() '清空文本内容
Text1.Text = ""              '接收窗口
End Sub

Private Sub Command4_Click() '清空文本内容
Text2.Text = ""              '发送窗口
End Sub

Private Sub Command5_Click()
  On Error GoTo uerror      '发现错误跳转到错误处理
 
 If Command5.Caption = "关闭串口" Then
        MSComm1.PortOpen = False
        Command5.Caption = "打开串口"  '按钮文字改变
        Shape1.FillColor = &HFFFFC0    '灯颜色改变
 Else
      
       MSComm1.PortOpen = True
       Command5.Caption = "关闭串口"
       Shape1.FillColor = &HFF
 End If
 Exit Sub
 

uerror:
    msg$ = "无效端口号"          '错误显示
    Title$ = "串口调试助手"
    x = MsgBox(msg$, 48, Title$) '48标示显示警告图标
   
End Sub


Private Sub Command6_Click()

    Dim Temp(0) As Byte
    Dim strBuff As String
    

If Option5.Value = True Then '如果显示16进制发送则进行16进制处理 ，这里只发送一个
   Temp(0) = "&H" & Text2
   MSComm1.Output = Temp  '发送一个16进制
   Label11.Caption = Label11.Caption + Len(Text2) '发送计数
Else
     strBuff = Text2
End If
If MSComm1.PortOpen = False Then
   MsgBox "请打开串口"
End If
On Error GoTo uerror
MSComm1.Output = strBuff
Label11.Caption = Label11.Caption + Len(strBuff) '发送计数
uerror:
End Sub

Private Sub Command7_Click()   '自动发送
If Command7.Caption = "自动发送" Then
   Command7.Caption = "关闭自动发送"
   Timer2.Interval = Text3.Text
   Timer2.Enabled = True
Else
   Command7.Caption = "自动发送"
   Timer2.Enabled = False
End If
End Sub

Private Sub Command8_Click() '清零计数器
Label10.Caption = 0
Label11.Caption = 0

End Sub

Private Sub Form_Load()

If MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False
Else
End If

Combo1.AddItem "COM1"
Combo1.AddItem "COM2"
Combo1.AddItem "COM3"
Combo1.AddItem "COM4"
Combo1.AddItem "COM5"
Combo1.AddItem "COM6"
Combo1.AddItem "COM7"
Combo1.AddItem "COM8"
Combo1.AddItem "COM9"
Combo1.AddItem "COM10"
Combo1.AddItem "COM11"
Combo1.AddItem "COM12"
Combo1.AddItem "COM13"
Combo1.AddItem "COM14"
Combo1.AddItem "COM15"
Combo1.AddItem "COM16"
Combo1.ListIndex = 0

MSComm1.CommPort = Combo1.ListIndex + 1
MSComm1.Settings = "9600,n,8,1"
   Command5.Caption = "打开串口"
   Shape1.FillColor = &HFFFFC0
   



Option2.Value = True
Option3.Value = True

Combo2.AddItem "256000"
Combo2.AddItem "128000"
Combo2.AddItem "115200"
Combo2.AddItem "57600"
Combo2.AddItem "38400"
Combo2.AddItem "28800"
Combo2.AddItem "19200"
'Combo2.AddItem "14400"
'Combo2.AddItem "12800"
'Combo2.AddItem "11520"
Combo2.AddItem "9600"
Combo2.AddItem "4800"
Combo2.AddItem "2400"
Combo2.AddItem "1200"
Combo2.AddItem "600"

Combo3.AddItem "无None"
Combo3.AddItem "奇Odd"
Combo3.AddItem "偶Even"

Combo4.AddItem "4"
Combo4.AddItem "5"
Combo4.AddItem "6"
Combo4.AddItem "7"
Combo4.AddItem "8"

Combo5.AddItem "1"
Combo5.AddItem "2"


End Sub

Private Sub Label12_Click()
ShellExecute Me.hwnd, "open", "www.doflye.net", 0, 0, 5
End Sub

Private Sub Label13_Click()
ShellExecute Me.hwnd, "open", "http://shop34791330.taobao.com", 0, 0, SW_SHOWMAXIMIZED
End Sub

Private Sub MSComm1_OnComm()
    Dim BytReceived() As Byte
    Dim strBuff As String
    Dim i As Integer
    Select Case MSComm1.CommEvent    '事件发生
        Case 2
            'Cls
            
            MSComm1.InputLen = 0     '读入缓冲区全部内容
            strBuff = MSComm1.Input  '读入到缓冲区
            Label10.Caption = Label10.Caption + Len(strBuff) '接收计数
         If MSComm1.InputMode = comInputModeBinary Then
            BytReceived() = strBuff  '如果是二进制接收模式则进行数据处理，否则直接显示字符串
            For i = 0 To UBound(BytReceived)
                If Len(Hex(BytReceived(i))) = 1 Then
                    strData = strData & "0" & Hex(BytReceived(i)) & " " '如果只有一个字符，则前补0，如F显示0F，最后补空格
                Else                                                    '方便显示观察如： 00 0F FE
                    strData = strData & Hex(BytReceived(i)) & " "
                End If
            Next
            Text1 = Text1 & strData
            strData = ""
        Else
            Text1 = Text1 & strBuff
        End If
    End Select
End Sub

Private Sub Option1_Click()
MSComm1.InputMode = comInputModeBinary '选择接收方式
End Sub

Private Sub Option2_Click()
MSComm1.InputMode = comInputModeText
End Sub

Private Sub Text1_Change() '下拉条一直在最下面
Text1.SetFocus
Text1.SelStart = Len(Text1.Text)

End Sub

Private Sub Text3_Change()
'Timer2.Interval = Text3.Text
End Sub

Private Sub Timer1_Timer()

If Combo3 = "无None" Then
   MSComm1.Settings = Str(Combo2) + "N" + Str(Combo4) + Str(Combo5)
ElseIf Combo3 = "奇Odd" Then
   MSComm1.Settings = Str(Combo2) + "O" + Str(Combo4) + Str(Combo5)
ElseIf Combo3 = "偶Even" Then
   MSComm1.Settings = Str(Combo2) + "E" + Str(Combo4) + Str(Combo5)
End If


End Sub

Private Sub Timer2_Timer()
Call Command6_Click      '定时调用手动发送
End Sub