form1.frm

通常串口的开发是基于VC的

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "串口调试工具 V1.0  http://Anykey.name"
   ClientHeight    =   4830
   ClientLeft      =   4665
   ClientTop       =   3675
   ClientWidth     =   6945
   DrawMode        =   8  'Xor Pen
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4830
   ScaleWidth      =   6945
   Begin MSCommLib.MSComm MSComm1 
      Left            =   2040
      Top             =   720
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton Command5 
      Caption         =   "清除发送区"
      Height          =   375
      Left            =   2880
      TabIndex        =   18
      Top             =   840
      Width           =   1275
   End
   Begin VB.ComboBox Combo5 
      Height          =   300
      ItemData        =   "Form1.frx":0000
      Left            =   4620
      List            =   "Form1.frx":000A
      TabIndex        =   15
      Text            =   "1"
      Top             =   480
      Width           =   855
   End
   Begin VB.ComboBox Combo4 
      Height          =   300
      ItemData        =   "Form1.frx":0014
      Left            =   3480
      List            =   "Form1.frx":0021
      TabIndex        =   14
      Text            =   "8"
      Top             =   480
      Width           =   855
   End
   Begin VB.ComboBox Combo3 
      Height          =   300
      ItemData        =   "Form1.frx":002E
      Left            =   2340
      List            =   "Form1.frx":003B
      TabIndex        =   13
      Text            =   "N"
      Top             =   480
      Width           =   855
   End
   Begin VB.ComboBox Combo2 
      Height          =   300
      ItemData        =   "Form1.frx":0048
      Left            =   1200
      List            =   "Form1.frx":0070
      TabIndex        =   12
      Text            =   "9600"
      Top             =   480
      Width           =   855
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "Form1.frx":00C1
      Left            =   60
      List            =   "Form1.frx":00D1
      TabIndex        =   11
      Text            =   "COM1"
      Top             =   480
      Width           =   855
   End
   Begin VB.CommandButton Command4 
      Caption         =   "开启串口"
      Height          =   375
      Left            =   5640
      TabIndex        =   5
      Top             =   420
      Width           =   1275
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   0
      TabIndex        =   4
      Top             =   1260
      Width           =   5595
   End
   Begin VB.CommandButton Command3 
      Caption         =   "清除接收区"
      Height          =   375
      Left            =   4260
      TabIndex        =   3
      Top             =   840
      Width           =   1275
   End
   Begin VB.TextBox Text1 
      Height          =   3135
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   2
      Top             =   1680
      Width           =   6915
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出程序"
      Height          =   375
      Left            =   5640
      TabIndex        =   1
      Top             =   840
      Width           =   1275
   End
   Begin VB.CommandButton Command1 
      Caption         =   "数据发送"
      Height          =   375
      Left            =   5640
      TabIndex        =   0
      Top             =   1260
      Width           =   1275
   End
   Begin VB.Label Label7 
      Caption         =   "0"
      Height          =   255
      Left            =   60
      TabIndex        =   17
      Top             =   900
      Width           =   855
   End
   Begin VB.Label Label6 
      Caption         =   "串口指示灯"
      Height          =   195
      Left            =   5640
      TabIndex        =   16
      Top             =   180
      Width           =   915
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      Height          =   255
      Left            =   6660
      Shape           =   3  'Circle
      Top             =   120
      Width           =   255
   End
   Begin VB.Label Label5 
      Caption         =   "停止位:"
      Height          =   195
      Left            =   4620
      TabIndex        =   10
      Top             =   180
      Width           =   795
   End
   Begin VB.Label Label4 
      Caption         =   "数据位:"
      Height          =   195
      Left            =   3480
      TabIndex        =   9
      Top             =   180
      Width           =   795
   End
   Begin VB.Label Label3 
      Caption         =   "效验位:"
      Height          =   195
      Left            =   2340
      TabIndex        =   8
      Top             =   180
      Width           =   795
   End
   Begin VB.Label Label2 
      Caption         =   "波特率:"
      Height          =   195
      Left            =   1200
      TabIndex        =   7
      Top             =   180
      Width           =   795
   End
   Begin VB.Label Label1 
      Caption         =   "串口:"
      Height          =   195
      Left            =   60
      TabIndex        =   6
      Top             =   180
      Width           =   795
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'串口调试工具 V1.0
'Program:yc
'Date: 2003/12/3

Private ReadStr As String

Private Sub Form_Load()
   With MSComm1
     .CommPort = 1 '选择串口COM1
     .Settings = "9600,N,8,1" '设置通信口参数
     .InBufferSize = 1024 '接收缓冲区大小
     .OutBufferSize = 1024 '发送缓冲区大小
     .InputMode = comInputModeBinary '设置接收数据模式为二进制形式
     .InputLen = 0 '设置Input从接收缓冲读取全部数据
     .RThreshold = 1 '设置引发OnComm事件的字节长度
     .InBufferCount = 0 '清除接收缓冲区
     .OutBufferCount = 0 '清除发送缓冲区
   End With

   Form1.Top = (Screen.Height - Form1.Height) / 2  '程序居中显示
   Form1.Left = (Screen.Width - Form1.Width) / 2

End Sub
'把发送文本框中的数据发送出去
Private Sub Command1_Click()
    Dim Str1 As String
    Str1 = Text2.Text
    If Len(Str1) >= 2 Then
     DSend (Str1)
    Else
     MsgBox "要发送的数据长度有误,请检查数据输入后再发送.", vbInformation
    End If
End Sub
'开启和关闭串口
Private Sub Command4_Click()
On Error GoTo Err1
If MSComm1.PortOpen = False Then
   MSComm1.CommPort = Right(Combo1.Text, 1)
   MSComm1.Settings = Combo2.Text & "," & Combo3.Text & "," & Combo4.Text & "," & Combo5.Text
   MSComm1.PortOpen = True '打开通信口
   Shape1.BackColor = &HFF&
   Command4.Caption = "关闭串口"
ElseIf MSComm1.PortOpen = True Then
   MSComm1.PortOpen = False '关闭通信口
   Shape1.BackColor = &H80000005
   Command4.Caption = "开启串口"
End If
Exit Sub
Err1:
   Select Case Err.Number   '串口被其它程序打开的出错提示
     Case 8005
      MsgBox "串口打开错误,可能串口被其它程序打开,请关闭其它程序再打开.", vbInformation
     Case Else
      MsgBox "程序出错:" & "出错代码. " & Err.Number & ": 出错提示信息: " & Err.Description, vbInformation
   End Select
End Sub
'关闭程序时确认串口关闭
Private Sub Form_Unload(Cancel As Integer)
    If MSComm1.PortOpen = True Then
    MsgBox "关闭程序出错,请关闭串口后再关闭本程序.", vbInformation
    Cancel = 1
    End If
End Sub
'清空发送文本框
Private Sub Command5_Click()
    Text2.Text = ""
End Sub
'清空接收文本框
Private Sub Command3_Click()
    Text1.Text = ""
End Sub
'退出程序
Private Sub Command2_Click()
    Unload Me
End Sub
'数据发送函数
Private Sub DSend(DataSend As String)
    Dim DataHex() As Byte
    Dim i As Integer
    Dim k As Integer
      
    MSComm1.OutBufferCount = 0 '清除发送缓冲区
    MSComm1.InBufferCount = 0 '清除接收缓冲区
    MSComm1.RThreshold = 1 '设置引发OnComm事件的字节长度
     
    i = (Len(DataSend)) / 2
    ReDim DataHex((i - 1)) As Byte
    For k = 0 To (i - 1)
    DataHex(k) = CByte("&H" & Right((Left(DataSend, (k + 1) * 2)), 2))
    Next k
    
On Error GoTo Err2
    MSComm1.Output = DataHex '发送数据
      Exit Sub
Err2:
    Select Case Err.Number   '串口没有打开的出错提示
       Case comPortNotOpen
        MsgBox Err.Description, vbInformation
       Case Else
        MsgBox "程序出错:" & "出错代码. " & Err.Number & ": 出错提示信息: " & Err.Description, vbInformation
    End Select
End Sub
'数据有返回时的响应
Private Sub MSComm1_OnComm()
    Dim DataRead() As Byte
    Dim bytData As Variant '用来从接收缓冲区读取数据
    On Error Resume Next
    With MSComm1
     Select Case .CommEvent
     Case comEvReceive
       ReadStr = ""
       bytData = .Input
     ReDim DataRead(UBound(bytData)) As Byte
     For i = 0 To UBound(bytData)
        DataRead(i) = bytData(i)
        ReadStr = ReadStr & Hex2((DataRead(i)))
      Next i
      Text1.Text = Text1.Text & ReadStr  '将读取出来的数据发送到文本框中显示出来
    End Select
    End With
End Sub
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 Text2_Change()
'输入长度和其偶
    If Len(Text2.Text) Mod 2 = 0 Then
      Label7.Caption = Len(Text2.Text) & " " & "偶数"
    Else
      Label7.Caption = Len(Text2.Text) & " " & "基数"
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
'数据输入自动转化为大写字母
    If KeyAscii >= 97 And KeyAscii <= 122 Then
    KeyAscii = KeyAscii - 32
    End If
'只能输入0-F之间的数
    If KeyAscii <> 8 And (KeyAscii < 48 Or KeyAscii > 57) And (KeyAscii < 65 Or KeyAscii > 70) Then
        Beep
    KeyAscii = 0
    End If
End Sub