VB6.0开发的计算机串口通讯程序1

VB6.0开发的计算机串口通讯程序1
下面介绍几个使用VB6.0开发的计算机串口通讯程序，这些程序可以自动发送16进制字符，并接收这些字符。这些程序可以在链接：

链接: https://pan.baidu.com/s/1xAZzwzAHQSPZ6OUJjYV3Mw?pwd=rwdk 提取码: rwdk 复制这段内容后打开百度网盘手机App，操作更方便哦
https://pan.baidu.com/s/1-SMLa3UwbxArwY3QRNtswg

提取码：hdze 下载微云文件分享:ⅤB串囗下载地址:

https://share.weiyun.com/5ok9T9o

VERSION 5.00
Object = “{648A5603-2C6E-101B-82B6-000000000014}#1.1#0”; “MSCOMM32.OCX”
Object = “{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0”; “comctl32.ocx”
Begin VB.Form mn_form
BackColor = &H00404000&
BorderStyle = 1 'Fixed Single
ClientHeight = 9795
ClientLeft = 45
ClientTop = 615
ClientWidth = 12735
FillColor = &H00E0E0E0&
BeginProperty Font
Name = “宋体”
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = “Form1”
ScaleHeight = 9795
ScaleWidth = 12735
StartUpPosition = 2 '屏幕中心
WindowState = 2 'Maximized
Begin ComctlLib.Toolbar Toolbar1
Align = 1 'Align Top
Height = 480
Left = 0
TabIndex = 2
Top = 0
Width = 12735
_ExtentX = 22463
_ExtentY = 847
ButtonWidth = 714
ButtonHeight = 688
Appearance = 1
ImageList = “ImageList1”
_Version = 327682
BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
NumButtons = 8
BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.ToolTipText = “校时”
Object.Tag = “”
ImageIndex = 1
EndProperty
BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.ToolTipText = “轮询”
Object.Tag = “”
ImageIndex = 2
Style = 1
EndProperty
BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.ToolTipText = “定值”
Object.Tag = “”
ImageIndex = 3

EndProperty
BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.ToolTipText = “设定”
Object.Tag = “”
ImageIndex = 4
EndProperty

BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.ToolTipText = “分闸”
Object.Tag = “”
ImageIndex = 5
EndProperty
BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.ToolTipText = “合闸”
Object.Tag = “”
ImageIndex = 6
EndProperty
BeginProperty Button7 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.ToolTipText = “内存”
Object.Tag = “”
ImageIndex = 7
Style = 1
EndProperty
BeginProperty Button8 {0713F354-850A-101B-AFC0-4210102A8DA7}
Object.Tag = “”
Style = 3
MixedState = -1 'True
EndProperty
EndProperty
OLEDropMode = 1
Begin VB.Frame Frame1
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Left = 9480
TabIndex = 3
Top = 0
Width = 5895
Begin VB.TextBox RAM_addr1th
Alignment = 2 'Center
Appearance = 0 'Flat
ForeColor = &H00800000&
Height = 375
Left = 2400
TabIndex = 9
Text = “0”
Top = 0
Width = 735
End
Begin VB.VScrollBar RAM_VScroll1
Height = 375
Left = 3120
Max = 1216

SmallChange = 32
TabIndex = 8
Top = 0
Width = 255
End
Begin VB.VScrollBar SN_VScroll
Height = 375
Left = 4440
Max = 199
TabIndex = 7
Top = 0
Value = 1
Width = 255

End
Begin VB.TextBox SN_Text
Alignment = 2 'Center
Appearance = 0 'Flat
ForeColor = &H00800000&
Height = 360
Left = 3960
TabIndex = 6
Text = “01”
Top = 0
Width = 495
End
Begin VB.ComboBox Combo1
Appearance = 0 'Flat
BeginProperty Font
Name = “System”
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 360
ItemData = “Star_M6.frx”:0000
Left = 4920
List = “Star_M6.frx”:000A
TabIndex = 4
Text = “COM1”
Top = 0
Width = 975
End
End
End
Begin VB.PictureBox disp_pic
BackColor = &H00161602&
ForeColor = &H0000FFFF&
Height = 5895
Left = 120
ScaleHeight = 5835
ScaleWidth = 10035
TabIndex = 10
Top = 3600
Width = 10095
End
Begin ComctlLib.StatusBar StatusBar1

Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 5
Top = 9540
Width = 12735
_ExtentX = 22463
_ExtentY = 450
SimpleText = “”
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 2
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Alignment = 2
Object.Width = 1411
MinWidth = 1411
Object.Tag = “”
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}

Alignment = 2
Object.Width = 1411
MinWidth = 1411
Object.Tag = “”
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = “System”
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Timer T_05s00
Interval = 500
Left = 600
Top = 480
End
Begin MSCommLib.MSComm MSComm1
Left = 1080
Top = 480
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = 0 'False
InputLen = 1
RThreshold = 1
ParitySetting = 2
InputMode = 1
End
Begin VB.Label disp_area
BackColor = &H00161602&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = “宋体”
Size = 9
Charset = 134
Weight = 700

Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 3015
Left = 120
TabIndex = 11
Top = 480
Width = 10095
End
Begin ComctlLib.ImageList ImageList1
Left = 0
Top = 480
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 20
ImageHeight = 20
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 7
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = “Star_M6.frx”:001A
Key = “”
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}

Picture = “Star_M6.frx”:0334
Key = “”
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = “Star_M6.frx”:064E
Key = “”
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = “Star_M6.frx”:0968
Key = “”
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = “Star_M6.frx”:0C82
Key = “”
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = “Star_M6.frx”:0F9C
Key = “”
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = “Star_M6.frx”:12B6
Key = “”
EndProperty

EndProperty
End
Begin VB.Label rx_data
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = “宋体”
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 1935
Left = 10320
TabIndex = 1
Top = 1560
Width = 5295
End
Begin VB.Label tx_data
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = “宋体”
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FFFF&
Height = 1068
Left = 10320
TabIndex = 0
Top = 480
Width = 5292
End
Begin VB.Menu mu_sys

Caption = "系统[&S] "
Begin VB.Menu sys_set
Caption = “设定”
End
Begin VB.Menu mu_quit
Caption = “退出”
End
End
Begin VB.Menu compt
Caption = "元件[&C] "
End
Begin VB.Menu AC_ch
Caption = "通道[&F] "
End
Begin VB.Menu op
Caption = "操作[&O] "
End
Begin VB.Menu help
Caption = “帮助[&H]”
End
End
Attribute VB_Name = “mn_form”
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim V_1, V_1_real, V_1_Image, V_2, V_2_real, V_2_Image, V_1_m6, v_ric, tp00, tp01 As Single

Public num_rxright, num_sent, rx_CRC, T_pos

Sub Send(ByVal Cmd As Integer)

Dim k(0) As Byte
tx_data.Caption = “”
If Cmd = 4 Then T_pos = &H178: Cmd = 3 Else T_pos = RAM_VScroll1.Value
tx_b(3) = Array(SN_VScroll.Value, 3, T_pos \ 256, T_pos Mod 256, &H0, &H40, 0, 0, Hour(Time), Minute(Time), Second(Time), 0, 0, 0, 0)
tx_b(Cmd)(0) = SN_VScroll.Value: tx_b(Cmd)(1) = Cmd
If Cmd = 16 Then Lenth = tx_b(Cmd)(5) * 2 + 7 Else Lenth = 6
Sum = &HFFFF
For i = 0 To Lenth - 1
If tx_b(Cmd)(i) < 0 Then tx_b(Cmd)(i) = 256 + tx_b(Cmd)(i)
k(0) = tx_b(Cmd)(i)
Sum = Sum Xor (k(0) And &HFF)
If Sum < 0 Then Sum = 65536 + Sum
For j = 0 To 7
If (Sum And 1) = 1 Then
Sum = Int(Sum \ 2): Sum = Sum Xor &HA001
If Sum < 0 Then Sum = 65536 + Sum
Else
Sum = Int(Sum \ 2)
End If
Next
MSComm1.Output = k: tx_data.Caption = tx_data.Caption + hexbyt(Int(k(0))) + " "
Next
If Sum < 0 Then Sum = 65536 + Sum
k(0) = (Sum Mod 256): tx_data.Caption = tx_data.Caption + hexbyt(Int(k(0))) + " "
MSComm1.Output = k
k(0) = (Sum \ 256): tx_data.Caption = tx_data.Caption + hexbyt(Int(k(0))) + " "
MSComm1.Output = k
rx_data = “”: rx_CRC = &HFFFF
End Sub

Private Sub Combo1_Click()
p = Combo1.ListIndex + 1
If p > 0 And p < 3 Then Call Close_OpenPort(Int§)
End Sub

Private Sub AC_ch_Click()
Factor_Seting.Visible = True

tx_REQ = 3
End Sub

Private Sub compt_Click()
Comptform.Visible = True
End Sub

Private Sub Form_Load()
Call Close_OpenPort(1)
Call MakeToolbarFlat(Toolbar1)
sys_set.Visible = True
For i = 0 To 8

tx_b(i) = Array(&H68, &H3, &H3, &H68, &H20, &H93, &H83, &H85, &H0, &H30 + Second(Time) Mod 10, &H0, &H30 + Second(Time) Mod 10, &H0, &H41 + Second(Time) Mod 10, &H0, &H61 + Second(Time) Mod 10, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1, 0, 0, 0, 0, 1, 7, 6, 5, 4, 3, 2, 1, 7, 6, 5, 4, 3, 2, 1)
Next
tx_REQ = 3: num_rxright = 0: num_sent = 0

End Sub

Private Sub Form_Unload(Cancel As Integer)
Unload controlform
Unload Comptform
Unload Factor_Seting
Unload Me
End Sub

Private Sub MSComm1_OnComm()
Dim temp As Variant

MSComm1.InputLen = 1

While MSComm1.InBufferCount <> 0
temp = MSComm1.Input
If rx_ptr < 150 Then
If rx_ptr = 3 Then rx_data.Caption = rx_data.Caption + vbCr
rx_b(rx_ptr) = temp(0): rx_data.Caption = rx_data.Caption + hexbyt(Int(temp(0))) + " "
rx_ptr = rx_ptr + 1
rx_CRC = rx_CRC Xor (temp(0) And &HFF)
If rx_CRC < 0 Then rx_CRC = 65536 + rx_CRC
For j = 0 To 7
If (rx_CRC And 1) = 1 Then
rx_CRC = Int(rx_CRC \ 2)
rx_CRC = rx_CRC Xor &HA001
If rx_CRC < 0 Then rx_CRC = 65536 + rx_CRC
Else
rx_CRC = Int(rx_CRC \ 2)
End If
Next
End If
Wend
End Sub

Private Sub op_Click()
controlform.Visible = True
End Sub

Private Sub RAM_VScroll1_Change()
RAM_addr1th.Text = strhex(RAM_VScroll1.Value)
End Sub

Private Sub SN_VScroll_Change()
SN_Text.Text = Str(SN_VScroll.Value) '站号调整与显示
End Sub

Private Sub sys_set_Click()
s_set.Visible = True
End Sub

Private Sub T_05s00_Timer()
mn_form.Caption = " X200测试 " + Format(Date, " yyyy-mm-dd ") + Format(Time, "hh:mm:ss ") '标题刷新

If rx_CRC = 0 Then

Call Process
num_rxright = (num_rxright + 1) Mod 10000 '显示接收正确次数
StatusBar1.Panels(2) = Str(num_rxright)
End If

Call Send(tx_REQ) '发送默认命令
If tx_REQ <> 3 Then tx_REQ = 3

num_sent = (num_sent + 1) Mod 10000
StatusBar1.Panels(1) = Str(num_sent) '显示召唤次数
rx_ptr = 0
End Sub

Sub Close_OpenPort(port As Byte)
On Error Resume Next ’ 改变错误处理的方式。
Err.Clear
If MSComm1.PortOpen = True Then MSComm1.PortOpen = False

MSComm1.CommPort = port
MSComm1.Settings = “9600,n,8,1”
MSComm1.InputLen = 0
MSComm1.PortOpen = True

If Err.Number <> 0 Then
msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox msg, , “Error”, Err.HelpFile, Err.HelpContext
End If
End Sub

Public Sub Process()
If (T_pos < 410) Then
disp_area.Caption = “”
For i = 0 To 63
D_int(i) = b_i(rx_b(4 + i * 2), rx_b(3 + i * 2))
If D_int(i) >= 0 Then
disp_area.Caption = disp_area.Caption + Format(D_int(i), " 00000 ")
Else
disp_area.Caption = disp_area.Caption + “-” + Format(-D_int(i), "00000 ")
End If
If (i Mod 8) = 7 Then disp_area.Caption = disp_area.Caption + vbCr + " "
Next
sindraw (0)
End If
If T_pos = &H80 Then
'For i = 0 To 7
'Factor_Seting.AC_data(i).Caption = Format(b_i(rx_b(4 + i * 2), rx_b(3 + i * 2)) / 100, “0.00”)
Factor_Seting.AC_data(1).Caption = Format(b_i(rx_b(8), rx_b(7)) / 100, “0.00”)
Factor_Seting.AC_data(0).Caption = Format(b_i(rx_b(16), rx_b(15)) / 100, “0.00”)
Factor_Seting.AC_data(3).Caption = Format(b_i(rx_b(24), rx_b(23)) / 100, “0.00”)
Factor_Seting.AC_data(2).Caption = Format(b_i(rx_b(32), rx_b(31)) / 1000 * 38, “0.00”)
Factor_Seting.AC_data(5).Caption = Format(b_i(rx_b(40), rx_b(39)) / 1000 * 38, “0.00”)

Factor_Seting.AC_data(4).Caption = Format(b_i(rx_b(102), rx_b(101)) / 1000, “0.00”)

Factor_Seting.AC_data(7).Caption = Format(b_i(rx_b(104), rx_b(103)) / 1000, “0.00”)
'Factor_Seting.AC_data(7).Caption = Format(b_i(rx_b(6 + i * 2), rx_b(5 + i * 2)) / 100, “0.00”)
'Next
End If
If T_pos = &H178 Then
For i = 0 To 7
If rx_b(3 + i) < 128 Then Factor_Seting.VScroll1(i).Value = -rx_b(3 + i) Else Factor_Seting.VScroll1(i).Value = 256 - rx_b(3 + i)
Next
End If
End Sub

Public Sub sindraw(ByVal ch As Integer)
disp_pic.Cls
xsc = (disp_pic.Width - 200) / 32: ysc = (disp_pic.Height - 200) / 1280: xax = disp_pic.Height / 2

disp_pic.Line (xsc, xax)-(disp_pic.Width - xsc, xax), RGB(128, 128, 128)
disp_pic.Line (xsc, 100)-(xsc, disp_pic.Height - 100), RGB(128, 128, 128)

If T_pos < &H60 Then
For i = 1 To 31
disp_pic