VB控件Mscomm控件与PLC进行RSModbus通讯源码.docx
《VB控件Mscomm控件与PLC进行RSModbus通讯源码.docx》由会员分享，可在线阅读，更多相关《VB控件Mscomm控件与PLC进行RSModbus通讯源码.docx（11页珍藏版）》请在冰点文库上搜索。
VB控件Mscomm控件与PLC进行RSModbus通讯源码
集团企业公司编码：
（LL3698-KKI1269-TM2483-LUI12689-ITT289-DQS58-MG198）
VB控件Mscomm控件与PLC进行RSModbus通讯源码
VB控件Mscomm控件与PLC进行RS485（Modbus）通讯源码
本人用的是ModbusRTU通讯模式，通过计算机串口转RS485与外围设备通行通讯，读写外围设备指定地址里的数据，从而达到自动化控制远端设备。
DimHiByteAsByte
DimLoByteAsByte
DimCRC16LoAsByte
DimCRC16HiAsByte
DimReturnData
（1）AsByte
DimKAsInteger
DimCmdLenthAsInteger
PrivateSubCommand1_Click（）
K=Text9.Text'写6个字节
Text13.Text=""
'===========数组赋值输入代码=======================================================================================
'<<算法一>>
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）
MSComm1.InBufferCount=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
'发送代码
Text4.Text=""
DimgAsInteger
Forg=0ToK+2
Text4.Text=Text4.Text+""+Hex（WriteStr（g））
Next
'写命令发送后,当接收到8个字节时中断
CmdLenth=8
MSComm1.RThreshold=CmdLenth
MSComm1.Output=WriteStr
EndSub
PrivateSubCommand2_Click（）
End
EndSub
PrivateSubCommand3_Click（）
Label34.Caption="="
Text13.Text=""
K=Text9.Text'写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）
MSComm1.InBufferCount=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
'发送代码
Text4.Text=""
DimgAsInteger
Forg=0ToK+2
Text4.Text=Text4.Text+""+Hex（WriteStr（g））
Next
'读命令发送后,当接收5+SendStr（5）*2个字节时产生中断
CmdLenth=5+WriteStr（5）*2
MSComm1.RThreshold=CmdLenth
MSComm1.Output=WriteStr'发送命令
'****************************************************************************************************************************************
'*******************************************************************************************************************
'****************************************************************************************************************************************
'DimsAddrAsString
'
'DimCheckStringAsString
'DimCheckCodeAsString
'DimCmdCodeAsString
'DimSumAsInteger
'DimaAsInteger
'DimtmpAsString
'a=0
'tmp=0
'
'
'
'DoWhileLen（tmp）<8
'
'tmp=tmp+MSComm1.Input
'testNO.Caption=testNO.Caption+""+Str（Hex（Asc（tmp）））
'a=a+1
'Ifa>=3000Then
'MSComm1.PortOpen=False
'ExitFunction
'ExitDo
'EndIf
'Loop
'Label33.Caption=tmp
'Text16.Text=Len（tmp）
'DimnsAsInteger
'Forns=1ToLen（tmp）
'Label34.Caption=Label34.Caption+"+"+Str（Asc（Mid（tmp,ns,1）））
'
'Next
'Label35.Caption=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
'Text13.Text=Text13.Text+"+"+Str（Asc（strTmp））
'longDec=longDec+longTmp*16^（intLen-n1）
'Nextn1
'
'Hex2Dec=longDec
'Text13.Text=Hex2Dec
'****************************************************************************************************************************************
'*******************************************************************************************************************
'****************************************************************************************************************************************
EndSub
PrivateSubMSComm1_OnComm（）
DimNeAsInteger
SelectCaseMSComm1.CommEvent
CasecomEvReceive
DimBufferAsVariant
MSComm1.InputMode=comInputModeBinary
MSComm1.InputLen=0
Buffer=MSComm1.Input
ForNe=LBound（Buffer）ToUBound（Buffer）
Text13.Text=Text13.Text&"+"&Buffer（Ne）
Label34.Caption=Buffer（3）&""&Buffer（4）
NextNe
CaseElse
EndSelect
Beep
EndSub
PrivateSubCommand4_Click（）
EndSub
PrivateSubCommand5_Click（）
Label34.Caption="="
EndSub
PrivateSubForm_Load（）
MSComm1.Settings="9600,N,8,1"
MSComm1.CommPort=1
MSComm1.SThreshold=0
IfNotMSComm1.PortOpenThenMSComm1.PortOpen=True
EndSub
PrivateSubTimer1_Timer（）
'显示<<算法一>>结果
Text2.Text=Hex（HiByte）
Text3.Text=Hex（LoByte）
'显示<<算法二>>结果
Text6.Text=Hex（CRC16Hi）
Text7.Text=Hex（CRC16Lo）
IfText5.Text<>""Then'十进制转十六进制
Text10.Text=Hex（Text5.Text）
EndIf
IfText11.Text<>""Then'十六进制转十进制
Text12.Text=Val（"&H"&Text11.Text）
EndIf
Text14.Text=MSComm1.OutBufferCount
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
升级会员 