VB控件Mscomm控件与PLC进行RSModbus通讯源码.docx
《VB控件Mscomm控件与PLC进行RSModbus通讯源码.docx》由会员分享，可在线阅读，更多相关《VB控件Mscomm控件与PLC进行RSModbus通讯源码.docx（11页珍藏版）》请在冰豆网上搜索。
VB控件Mscomm控件与PLC进行RSModbus通讯源码
VB控件Mscomm控件与PLC进行RS485（Modbus）通讯源码
本人用的是ModbusRTU通讯模式，通过计算机串口转RS485与外围设备通行通讯，读写外围设备指定地址里的数据，从而达到自动化控制远端设备。
DimHiByteAsByte
DimLoByteAsByte
DimCRC16LoAsByte
DimCRC16HiAsByte
DimReturnData
（1）AsByte
DimKAsInteger
DimCmdLenthAsInteger
PrivateSubCommand1_Click（）
K='写6个字节
=""
'===========数组赋值输入代码=======================================================================================
'<<算法一>>
DimWriteStr（）AsByte
DimuAsInteger
ReDimWriteStr（K+2）
Foru=0ToK
WriteStr（u）=Val（"&H"&Text1（u）.Text）
Next
'<<算法二>>
DimCRC_2（）AsByte
DimvAsInteger
ReDimCRC_2（K）
Forv=0ToK
CRC_2（v）=Val（"&H"&Text1（v）.Text）
Next
'==================================================================================================
CallCRC161（CRC_2（））
CallCRC16（WriteStr（）,K）
=0
'==========显示发送代码========================================================================================
DimmAsInteger
Form=0To23
Ifm<=KThen
Text8（m）.Text=Hex（WriteStr（m））
Else
Text8（m）.Text=""
EndIf
Next
'==================================================================================================
WriteStr（K+1）=LoByte
WriteStr（K+2）=HiByte
'发送代码
=""
DimgAsInteger
Forg=0ToK+2
=+""+Hex（WriteStr（g））
Next
'写命令发送后,当接收到8个字节时中断
CmdLenth=8
=CmdLenth
=WriteStr
EndSub
PrivateSubCommand2_Click（）
End
EndSub
PrivateSubCommand3_Click（）
="="
=""
K='写6个字节
'===========数组赋值输入代码=======================================================================================
'<<算法>>
DimCRC_2（）AsByte
DimvAsInteger
ReDimCRC_2（K）
Forv=0ToK
CRC_2（v）=Val（"&H"&Text1（v）.Text）
Next
'==================================================================================================
CallCRC161（CRC_2（））
CallCRC16（WriteStr（）,K）
=0
'==========显示发送代码========================================================================================
DimmAsInteger
Form=0To23
Ifm<=KThen
Text8（m）.Text=Hex（WriteStr（m））
Else
Text8（m）.Text=""
EndIf
Next
'==================================================================================================
WriteStr（K+1）=LoByte
WriteStr（K+2）=HiByte
'发送代码
=""
DimgAsInteger
Forg=0ToK+2
=+""+Hex（WriteStr（g））
Next
'读命令发送后,当接收5+SendStr（5）*2个字节时产生中断
CmdLenth=5+WriteStr（5）*2
=CmdLenth
=WriteStr'发送命令
'****************************************************************************************************************************************
'*******************************************************************************************************************
'****************************************************************************************************************************************
'DimsAddrAsString
'
'DimCheckStringAsString
'DimCheckCodeAsString
'DimCmdCodeAsString
'DimSumAsInteger
'DimaAsInteger
'DimtmpAsString
'a=0
'tmp=0
'
'
'
'DoWhileLen（tmp）<8
'
'tmp=tmp+
'=+""+Str（Hex（Asc（tmp）））
'a=a+1
'Ifa>=3000Then
'=False
'ExitFunction
'ExitDo
'EndIf
'Loop
'=tmp
'=Len（tmp）
'DimnsAsInteger
'Forns=1ToLen（tmp）
'=+"+"+Str（Asc（Mid（tmp,ns,1）））
'
'Next
'=Str（Val（Asc（Mid（tmp,6,1）））/10）
'
'
'tmp=Mid$（tmp,6,4）
'
'
'DimstrHexAsString
'DimHex2DecAsLong
'DimstrTmpAsString
'DimlongTmpAsLong
'DimlongDecAsLong
'DimintLenAsInteger
'Dimn1AsInteger
'
'strHex=Right$（tmp,2）+Left$（tmp,2）
'
'intLen=Len（strHex）
'Forn1=1TointLen
'strTmp=Mid（strHex,n1,1）
'SelectCaseAsc（strTmp）
'Case48To57
'longTmp=Val（strTmp）
'Case65To70
'longTmp=Asc（strTmp）-55
'CaseElse
'Hex2Dec=0
''ExitFunction
'EndSelect
'=+"+"+Str（Asc（strTmp））
'longDec=longDec+longTmp*16^（intLen-n1）
'Nextn1
'
'Hex2Dec=longDec
'=Hex2Dec
'****************************************************************************************************************************************
'*******************************************************************************************************************
'****************************************************************************************************************************************
EndSub
PrivateSubMSComm1_OnComm（）
DimNeAsInteger
SelectCase
CasecomEvReceive
DimBufferAsVariant
=comInputModeBinary
=0
Buffer=
ForNe=LBound（Buffer）ToUBound（Buffer）
=&"+"&Buffer（Ne）
=Buffer（3）&""&Buffer（4）
NextNe
CaseElse
EndSelect
Beep
EndSub
PrivateSubCommand4_Click（）
EndSub
PrivateSubCommand5_Click（）
="="
EndSub
PrivateSubForm_Load（）
="9600,N,8,1"
=1
=0
IfNotThen=True
EndSub
PrivateSubTimer1_Timer（）
'显示<<算法一>>结果
=Hex（HiByte）
=Hex（LoByte）
'显示<<算法二>>结果
=Hex（CRC16Hi）
=Hex（CRC16Lo）
If<>""Then'十进制转十六进制
=Hex
EndIf
If<>""Then'十六进制转十进制
=Val（"&H"&
EndIf
=
EndSub
'==========CRC校验<<算法二>>========================================================================================
FunctionCRC161（data（）AsByte）AsString'CRC计算函数
'DimCRC16LoAsByte,CRC16HiAsByte'CRC寄存器
DimCLAsByte,CHAsByte'多项式码&HA001
DimSaveHiAsByte,SaveLoAsByte
DimIAsInteger
DimFlagAsInteger
CRC16Lo=&HFF
CRC16Hi=&HFF
CL=&H1
CH=&HA0
ForI=0ToUBound（data）
CRC16Lo=CRC16LoXordata（I）'每一个数据与CRC寄存器进行异或
ForFlag=0To7
CRC16Hi=CRC16Hi\2'高位右移一位
CRC16Lo=CRC16Lo\2'低位右移一位
If（（SaveHiAnd&H1）=&H1）Then'如果高位字节最后一位为1
CRC16Lo=CRC16LoOr&H80'则低位字节右移后前面补1
EndIf'否则自动补0
If（（SaveLoAnd&H1）=&H1）Then'如果LSB为1，则与多项式码进行异或
CRC16Hi=CRC16HiXorCH
CRC16Lo=CRC16LoXorCL
EndIf
NextFlag
NextI
DimReturnData
（1）AsByte
ReturnData（0）=CRC16Hi'CRC高位
ReturnData
（1）=CRC16Lo'CRC低位
asd=Right（"00"+Hex（CRC16Lo）,2）+Right（"00"+Hex（CRC16Hi）,2）
EndFunction
PrivateSubmscomm_OnComm（）
EndSub
升级会员 