vb实现的串口调试器

'=====================================================================================

Option Explicit                                                                     ' ??????????

Dim ComSwitch As Boolean                                                            ' ??????????ж?
Dim FileData As String                                                              ' ????????????
Dim SendCount As Long                                                               ' ????????????????
Dim ReceiveCount As Long                                                            ' ????????????????
Dim InputSignal As String                                                           ' ??????????
Dim OutputSignal As String                                                          ' ???????????
Dim DisplaySwitch As Boolean                                                        ' ???????
Dim ModeSend As Boolean                                                             ' ???????ж?
Dim Savetime As Single                                                              ' ?????????? ?????
Dim SaveTextPath As String                                                          ' ???????·??

' ?????????????
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 ChkAutoSend_Click()

On Error GoTo Err
    If ChkAutoSend.Value = 1 Then                                                   ' ?????Ч?????????
        If MSComm.PortOpen = True Then                                              ' ???????ж?
            TmrAutoSend.Interval = Val(TxtAutoSendTime)                             ' ??????????????
            TmrAutoSend.Enabled = True                                              ' ?????????????
        Else
            ChkAutoSend.Value = 0                                                   ' ??????д???????????
            MsgBox "??????д??????????", 48, "???????????"                   ' ?????????б??????????????
        End If
    ElseIf ChkAutoSend.Value = 0 Then                                               ' ?????Ч????????
            TmrAutoSend.Enabled = False                                             ' ??????????????
    End If
Err:
       
End Sub

'=====================================================================================
'              ????????????

'=====================================================================================

Private Sub LblWeb_Click()                                                          ' ?????????
   
    ShellExecute Me.hwnd, "open", "http://blog.163.com/zhaojun_xf/", "", "", 5      ' ????????
   
End Sub

' ??????? WEB ??
Private Sub LblWeb_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    LblWeb.ForeColor = &H8A7839                                                     ' ???????WEB??????
    LblWeb.MousePointer = 99                                                        ' ???????WEB?????????? ,С????
    'LblWeb.MouseIcon = LoadPicture("f:\???VB\??????????\??\mouse.cur")         ' ????????

End Sub

' ?????? WEB ??
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    LblWeb.ForeColor = vbBlue                                                      ' ??????WEB??????
    Me.MousePointer = vbDefault                                                    ' ??????WEB?????????? ??Me.MousePointer = 0

End Sub

'=====================================================================================
'              ???????????

'=====================================================================================

Private Sub TmrAutoSend_Timer()                                                     ' ?????

On Error GoTo Err
    If TxtSend.Text = "" Then                                                       ' ?ж??????????????
        ChkAutoSend.Value = 0                                                       ' ??????????
        MsgBox "??????????????", 16, "???????????"                               ' ????????????????
    Else
       
        If ChkHexSend.Value = 1 Then                                                ' ???????ж?
            MSComm.InputMode = comInputModeBinary                                   ' ?????????
            Call hexSend                                                            ' ???????????????
        Else                                                                        ' ?????????????????????????????????????????????????
            If ChkHexReceive.Value = 1 Then
                MSComm.InputMode = comInputModeBinary                               ' ?????????
            Else
                MSComm.InputMode = comInputModeText                                 ' ???????
            End If
       
            MSComm.Output = Trim(TxtSend.Text)                                      ' ????????
       
            ModeSend = False                                                        ' ?????????????
        End If
    End If
Err:
   
End Sub

'=====================================================================================
'              ????????

'=====================================================================================

Private Sub Form_Load()                                                         ' ??????
   
    On Error GoTo Err
    LblWeb.FontUnderline = True                                                 ' WEB????????
    LblWeb.ForeColor = vbBlue                                                   ' ??????WEB
   
    TxtSend.Text = "http://www.newxing.com/"                            ' ?????????
    If MSComm.PortOpen = True Then MSComm.PortOpen = False                      ' ???ж?????????????????????
    ' ?????????
    Call Comm_initial(Val(Mid(CboCom.Text, 4, 1)), CboBaudrate.Text, Left(CboParitybit.Text, 1), CboDatabit.Text, CboStopbit.Text)
Err:
   
End Sub

'=====================================================================================
'                   ??????????

'=====================================================================================

Private Sub CmdSaveDisp_Click()                                                 ' ???????????
   
    On Error GoTo Err                                                           ' ??????
   
    SaveTextPath = TxtSavePath                                                  ' ·?????
    Open TxtSavePath & "\1.txt" For Output As #1                                ' ?????
    ' ???????? ???????,??????? ????
    ' output ???append ????
    ' ???input ?????
    Print #1, Year(Date) & "??" & Month(Date) & "??" & Day(Date) & _
    "??" & Hour(Time) & "?" & Minute(Time) & "??" & Second(Time) & _
    "??" & vbCrLf & TxtReceive.Text vbCrLf                                    ' ???????????????? ?????????????? ??0000??00??00??00?00??00??
    ' vbcrlf ????????
    Close #1                                                                    ' ??????
   
    TxtSavePath = "OK,1.txt Save"                                               ' ?????????
    CmdSaveDisp.Enabled = False
   
    Savetime = Timer                                                            ' ???????????
    While Timer < Savetime 5                                                  ' ?????? 5 - ?????????
        DoEvents                                                                ' ?????????????ò????????????????????
    Wend
   
    TxtSavePath = SaveTextPath                                                  ' ???????·??
    CmdSaveDisp.Enabled = True
Err:
   
End Sub

'=====================================================================================
'               ?????

'=====================================================================================

Private Sub CmdStopdisp_Click()

On Error GoTo Err
    If DisplaySwitch = False Then
        DisplaySwitch = True                                                        ' ??????
        CmdStopdisp.Caption = "???????"
    Else
        DisplaySwitch = False                                                       ' ???????
        CmdStopdisp.Caption = "?????"
    End If
Err:
   
End Sub