modbus vb源程序 可以讀寫寄存器
作者：佚名 來源：轉(zhuǎn)載 發(fā)布時間：2008-10-30 23:55:11 發(fā)布人：admin
自己的項目做完了，最近比較閑，就幫別人用VB寫了一個很簡單的modbus程序，可以實現(xiàn)實時數(shù)據(jù)采集顯示，以及能對寄存器進行設(shè)置。程序很簡單，想用的可以完善，現(xiàn)在只能實時采集顯示一個地址的數(shù)據(jù)，只要修改一下，就可以實時采集多個地址的數(shù)據(jù)?，F(xiàn)在也只能一次對一個寄存器進行設(shè)置，也可以更加完善。想用的朋友就自己改改吧。
下面是運行界面，采集的模塊的地址為75，是一個溫濕度采集模塊。有3個寄存器，顯示的數(shù)據(jù)上是溫度，濕度，露點溫度。
modbus
Private Sub Command1_Click() '設(shè)置按鈕
Dim bisend() As Byte
Dim crc
Dim btLoCRC As Byte, btHiCRC As Byte
Dim Data As Integer
If MSComm1.PortOpen = True Then
If Combo5.ListIndex = 0 Then
ReDim bisend(7) '重新定義數(shù)組長度
bisend(0) = "&h" + Hex(Val(Text1.Text)) '地址碼
bisend(1) = "&h" + Hex(3) '功能碼 讀寄存器
bisend(2) = "&h" + Hex(0) '起始地址高位
bisend(3) = "&h" + Hex(0) '起始地址低位
bisend(4) = "&h" + Hex(0) '寄存器個數(shù)高位
bisend(5) = "&h" + Hex(Combo6.ListIndex + 1) '寄存器個數(shù)低位
crc = CRC16(bisend, 6, btLoCRC, btHiCRC)
bisend(6) = "&h" + Hex(btLoCRC) 'CRC高位
bisend(7) = "&h" + Hex(btHiCRC) 'CRC低位
'發(fā)送數(shù)據(jù)
MSComm1.Output = bisend
Else
ReDim bisend(10) '一次只能寫一個寄存器
bisend(0) = "&h" + Hex(Val(Text1.Text)) '地址碼
bisend(1) = "&h" + Hex(16) '功能碼 寫寄存器
bisend(2) = "&h" + Hex(0) '起始地址高位
bisend(3) = "&h" + Hex(0) '起始地址低位
bisend(4) = "&h" + Hex(0) '寄存器個數(shù)高位
bisend(5) = "&h" + Hex(1) '寄存器個數(shù)低位
bisend(6) = "&h" + Hex(2) '字節(jié)數(shù)
Data = Val(Trim(Text3.Text))
bisend(7) = "&h" + Hex(Data \ 256) '要寫入寄存器的值的高字節(jié)
bisend(8) = "&h" + Hex(Data Mod 256) '要寫入寄存器的值的低字節(jié)
crc = CRC16(bisend, 9, btLoCRC, btHiCRC)
bisend(9) = "&h" + Hex(btLoCRC) 'CRC高位
bisend(10) = "&h" + Hex(btHiCRC) 'CRC低位
MSComm1.Output = bisend
End If
Else
MsgBox "串口沒有打開"
End If
End Sub
Private Sub Command2_Click() '實時采集按鈕
Timer1.Enabled = Not Timer1.Enabled '進行狀態(tài)切換
End Sub
Private Sub Command3_Click()
'初始化，并打開串口
With MSComm1
If .PortOpen = False Then
.CommPort = Combo7.ListIndex + 1 '打開串口1
.Settings = Combo1.Text + "," + Combo2.Text + "," + Combo3.Text + Combo4.Text
.InputMode = 1
.InputLen = 50 '一次性從接收緩沖區(qū)中讀取所有數(shù)據(jù)(8個字節(jié)為一組?。?
.InBufferCount = 0 '清空接收緩沖區(qū)
.OutBufferCount = 0 '清空發(fā)送緩沖區(qū)
.RThreshold = 5 + (Combo6.ListIndex + 1) * 2
.InBufferSize = 1024
.OutBufferSize = 1024
.PortOpen = True
Else
MsgBox "串口已經(jīng)打開"
End If
End With
End Sub
Private Sub Command4_Click() '關(guān)閉串口按鈕
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub Form_Load()
Dim i As Integer
'波特率設(shè)置
Combo1.AddItem "4800", 0
Combo1.AddItem "9600", 1
Combo1.AddItem "115200", 2
'校驗位設(shè)置
Combo2.AddItem "N", 0
Combo2.AddItem "E", 1
Combo2.AddItem "O", 2
'數(shù)據(jù)位設(shè)置
Combo3.AddItem "7", 0
Combo3.AddItem "8", 1
'停止位設(shè)置
Combo4.AddItem "1", 0
Combo4.AddItem "2", 1
'功能碼選擇
Combo5.AddItem "讀寄存器03", 0
Combo5.AddItem "寫寄存器16", 1
'寄存器個數(shù)設(shè)置
Combo6.AddItem "1", 0
Combo6.AddItem "2", 1
Combo6.AddItem "3", 2
Combo6.AddItem "4", 3
Combo6.AddItem "5", 4
Combo6.AddItem "6", 5
Combo6.AddItem "7", 6
Combo6.AddItem "8", 7
Combo6.AddItem "9", 8
Combo6.AddItem "10", 9
Combo6.AddItem "11", 10
Combo6.AddItem "12", 11
Combo6.AddItem "13", 12
Combo6.AddItem "14", 13
Combo6.AddItem "15", 14
Combo6.AddItem "16", 15
Combo6.AddItem "17", 16
Combo6.AddItem "18", 17
Combo6.AddItem "19", 18
Combo6.AddItem "20", 19
Combo6.AddItem "21", 20
Combo6.AddItem "22", 21
'串口選擇
Combo7.AddItem "串口1", 0
Combo7.AddItem "串口2", 1
Combo7.AddItem "串口3", 2
Combo7.AddItem "串口4", 3
'初始賦值
Combo1.ListIndex = 1
Combo2.ListIndex = 1
Combo3.ListIndex = 1
Combo4.ListIndex = 0
Combo5.ListIndex = 0
Combo6.ListIndex = 2
Combo7.ListIndex = 0
'初始化串口
End Sub
Private Sub Form_Unload(Cancel As Integer)
If MSComm1.PortOpen = True Then
MSComm1.PortOpen = False
End If
End Sub
Private Sub MSComm1_OnComm()
Dim INByte() As Byte
Dim Buf As String
Dim btLoCRC As Byte, btHiCRC As Byte
Dim Data As Integer
If MSComm1.CommEvent = comEvReceive Then '接收到數(shù)據(jù)以后
INByte = MSComm1.Input
If INByte(1) = 3 Then '讀寄存器
'CRC校驗
crc = CRC16(INByte, UBound(INByte) - LBound(INByte) - 1, btLoCRC, btHiCRC)
If INByte(UBound(INByte) - 1) = btLoCRC And INByte(UBound(INByte)) = btHiCRC Then
'校驗正確
'////////////////////////////////////
For i = 3 To UBound(INByte) - 2 Step 2
Data = "&h" + Hex(INByte(i)) + Hex(INByte(i + 1))
' Buf = Buf + Hex(INByte(i)) + Chr(32)
Buf = Buf + Str(Data) '轉(zhuǎn)換為十進制顯示
Next i
List1.AddItem Buf
End If
End If
MSComm1.InBufferCount = 0 '請緩存
End If
End Sub
Private Sub Timer1_Timer()
'定時發(fā)送命令
Dim tbisend(7) As Byte
Dim crc '定時1s
Dim btLoCRC As Byte, btHiCRC As Byte
Dim Buf As String
If MSComm1.PortOpen = True Then
tbisend(0) = "&h" + Hex(Val(Text1.Text)) '地址碼
tbisend(1) = "&h" + Hex(3) '功能碼 讀寄存器
tbisend(2) = "&h" + Hex(0) '起始地址高位
tbisend(3) = "&h" + Hex(0) '起始地址低位
tbisend(4) = "&h" + Hex(0) '寄存器個數(shù)高位
tbisend(5) = "&h" + Hex(Combo6.ListIndex + 1) '寄存器個數(shù)低位
crc = CRC16(tbisend, 6, btLoCRC, btHiCRC)
tbisend(6) = "&h" + Hex(btLoCRC) 'CRC高位
tbisend(7) = "&h" + Hex(btHiCRC) 'CRC低位
'發(fā)送數(shù)據(jù)
MSComm1.Output = tbisend
End If
End Sub
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Function CRC16(Data() As Byte, no As Integer, CRC16Lo As Byte, CRC16Hi As Byte) As String
Dim CL As Byte, CH As Byte '多項式碼&HA001
Dim SaveHi As Byte, SaveLo As Byte
Dim i As Integer
Dim Flag As Integer
CRC16Lo = &HFF
CRC16Hi = &HFF
CL = &H1
CH = &HA0
For i = 0 To no - 1
CRC16Lo = CRC16Lo Xor Data(i) '每一個數(shù)據(jù)與CRC寄存器進行異或
For Flag = 0 To 7
SaveHi = CRC16Hi
SaveLo = CRC16Lo
CRC16Hi = CRC16Hi \ 2 '高位右移一位
CRC16Lo = CRC16Lo \ 2 '低位右移一位
If ((SaveHi And &H1) = &H1) Then '如果高位字節(jié)最后一位為1
CRC16Lo = CRC16Lo Or &H80 '則低位字節(jié)右移后前面補1
End If '否則自動補0
If ((SaveLo And &H1) = &H1) Then '如果LSB為1，則與多項式碼進行異或
CRC16Hi = CRC16Hi Xor CH
CRC16Lo = CRC16Lo Xor CL
End If
Next Flag
Next i
Dim ReturnData(1) As Byte
ReturnData(0) = CRC16Hi 'CRC高位
ReturnData(1) = CRC16Lo 'CRC低位
CRC16 = ReturnData
End Function
'CRC低位字節(jié)值表
Function GetCRCLo(ind As Long) As Byte
GetCRCLo = Choose(ind + 1, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC1, &H80, &H41, &H0, &HC1, _
&H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, _
&H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H81, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, _
&H81, &H40, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H1, &HC0, &H80, &H41, &H0, &HC1, &H81, &H40, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40, &H0, &HC1, &H81, &H40, _
&H1, &HC0, &H80, &H41, &H1, &HC0, &H80, &H41, &H0, &HC1, _
&H81, &H40, &H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, _
&H0, &HC1, &H81, &H40, &H1, &HC0, &H80, &H41, &H1, &HC0, _
&H80, &H41, &H0, &HC1, &H81, &H40)
End Function
'CRC高位字節(jié)值表
Function GetCRCHi(ind As Long) As Byte
GetCRCHi = Choose(ind + 1, &H0, &HC0, &HC1, &H1, &HC3, &H3, &H2, &HC2, &HC6, &H6, &H7, &HC7, &H5, &HC5, &HC4, &H4, &HCC, &HC, &HD, &HCD, _
&HF, &HCF, &HCE, &HE, &HA, &HCA, &HCB, &HB, &HC9, &H9, _
&H8, &HC8, &HD8, &H18, &H19, &HD9, &H1B, &HDB, &HDA, &H1A, _
&H1E, &HDE, &HDF, &H1F, &HDD, &H1D, &H1C, &HDC, &H14, &HD4, _
&HD5, &H15, &HD7, &H17, &H16, &HD6, &HD2, &H12, &H13, &HD3, _
&H11, &HD1, &HD0, &H10, &HF0, &H30, &H31, &HF1, &O33, &HF3, _
&HF2, &H32, &H36, &HF6, &HF7, &H37, &HF5, &H35, &H34, &HF4, _
&H3C, &HFC, &HFD, &H3D, &HFF, &H3F, &H3E, &HFE, &HFA, &H3A, _
&H3B, &HFB, &H39, &HF9, &HF8, &H38, &H28, &HE8, &HE9, &H29, _
&HEB, &H2B, &H2A, &HEA, &HEE, &H2E, &H2F, &HEF, &H2D, &HED, _
&HEC, &H2C, &HE4, &H24, &H25, &HE5, &H27, &HE7, &HE6, &H26, _
&H22, &HE2, &HE3, &H23, &HE1, &H21, &H20, &HE0, &HA0, &H60, _
&H61, &HA1, &H63, &HA3, &HA2, &H62, &H66, &HA6, &HA7, &H67, _
&HA5, &H65, &H64, &HA4, &H6C, &HAC, &HAD, &H6D, &HAF, &H6F, _
&H6E, &HAE, &HAA, &H6A, &H6B, &HAB, &H69, &HA9, &HA8, &H68, _
&H78, &HB8, &HB9, &H79, &HBB, &H7B, &H7A, &HBA, &HBE, &H7E, _
&H7F, &HBF, &H7D, &HBD, &HBC, &H7C, &HB4, &H74, &H75, &HB5, _
&H77, &HB7, &HB6, &H76, &H72, &HB2, &HB3, &H73, &HB1, &H71, _
&H70, &HB0, &H50, &H90, &H91, &H51, &H93, &H53, &H52, &H92, _
&H96, &H56, &H57, &H97, &H55, &H95, &H94, &H54, &H9C, &H5C, _
&H5D, &H9D, &H5F, &H9F, &H9E, &H5E, &H5A, &H9A, &H9B, &H5B, _
&H99, &H59, &H58, &H98, &H88, &H48, &H49, &H89, &H4B, &H8B, _
&H8A, &H4A, &H4E, &H8E, &H8F, &H4F, &H8D, &H4D, &H4C, &H8C, _
&H44, &H84, &H85, &H45, &H87, &H47, &H46, &H86, &H82, &H42, _
&H43, &H83, &H41, &H81, &H80, &H40)
End Function
