vb串口开发.docx

vb串口开发.docx

《vb串口开发.docx》由会员分享，可在线阅读，更多相关《vb串口开发.docx（37页珍藏版）》请在冰豆网上搜索。

vb串口开发

'CSEH:

ErrResumeNext

OptionExplicit

PrivateDeclareSubSleepLib"kernel32"（ByValdwMillisecondsAsLong）

PrivateDeclareFunctionGetPrivateProfileString_

Lib"kernel32"_

Alias"GetPrivateProfileStringA"（ByVallpApplicationNameAsString,_

ByVallpKeyNameAsAny,_

ByVallpDefaultAsString,_

ByVallpReturnedStringAsString,_

ByValnSizeAsLong,_

ByVallpFileNameAsString）AsLong

PrivateTypeDeviceInfo

AddressAsByte

PortAsByte

ControlTypeAsByte'0fendo0,1hedo0,2fendo1,3hedo1

ControlSNumAsByte

ErrSendNumAsByte

EndType

PrivatemPortAsInteger

PrivatemHostAsBoolean

PrivatemComAddressAsInteger

PrivateDelayTimeAsInteger

PrivateMAX_ERR_NUMAsInteger

PrivateMAX_ERR_NUM_CTRLAsInteger

PrivatemDevice（1To4）AsDeviceInfo

PrivateblIsSendingAsBoolean

PrivateiSendComAsInteger

PrivateblQuitAsBoolean

PrivateiControlAsInteger

PrivateiCTypeAsInteger

PrivateiCOMHostSRNumAsInteger

PrivateblAsHostAsBoolean

PrivateiInitAsInteger

'将十进制转化为二进制

PrivateFunctionDEC_to_BIN（ByValDecAsLong）AsString

DimaAsString

a=""

DoWhileDec>0

a=DecMod2&a

Dec=Dec\2

Loop

DEC_to_BIN=Format（a,"00000000"）

EndFunction

'将二进制转化为十进制

PrivateFunctionBIN_to_DEC（ByValBinAsString）AsLong

DimiAsLong

Fori=1ToLen（Bin）

BIN_to_DEC=BIN_to_DEC*2+Val（Mid（Bin,i,1））

Nexti

EndFunction

'CRC16

PrivateFunctionCRC16（Data（）AsByte）AsByte（）

'

OnErrorResumeNext

'

DimCRC16HiAsByte

DimCRC16LoAsByte

DimubDataAsInteger

DimiAsInteger

DimiIndexAsLong

ubData=UBound（Data）

CRC16Hi=&HFF

CRC16Lo=&HFF

Fori=0ToubData

iIndex=CRC16LoXorData（i）

CRC16Lo=CRC16HiXorGetCRCLo（iIndex）'低位处理

CRC16Hi=GetCRCHi（iIndex）'高位处理

Nexti

DimReturnData

（1）AsByte

ReturnData（0）=CRC16Hi'CRC高位

ReturnData

（1）=CRC16Lo'CRC低位

CRC16=ReturnData

EndFunction

'CRC低位字节值表

PrivateFunctionGetCRCLo（IndAsLong）AsByte

'

OnErrorResumeNext

'

GetCRCLo=Choose（Ind+1,&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,&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,&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）

EndFunction

'CRC高位字节值表

FunctionGetCRCHi（IndAsLong）AsByte

'

OnErrorResumeNext

'

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,&H33,&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）

EndFunction

'计算bit的0/1制值

PrivateFunctionssValue（ByValttAsByte,_

ByValNumAsInteger）AsInteger

'

OnErrorResumeNext

'

SelectCaseNum

Case0

ssValue=（ttAnd&H80）/2^7

Case1

ssValue=（ttAnd&H40）/2^6

Case2

ssValue=（ttAnd&H20）/2^5

Case3

ssValue=（ttAnd&H10）/2^4

Case4

ssValue=（ttAnd&H8）/2^3

Case5

ssValue=（ttAnd&H4）/2^2

Case6

ssValue=（ttAnd&H2）/2

Case7

ssValue=（ttAnd&H1）

EndSelect

EndFunction

'打开串口

PrivateFunctionOpenPort（）AsBoolean

OnErrorGoToErrExit

MSCM.CommPort=1'mPort

MSCM.Settings="9600,N,8,2"

MSCM.InBufferCount=0

MSCM.OutBufferCount=0

MSCM.RThreshold=0

MSCM.PortOpen=True

MSCM.OutBufferCount=0

MSCM.InBufferCount=0

OpenPort=True

ExitFunction

ErrExit:

OpenPort=False

EndFunction

'判断控制命令类型

PrivateSubCheckControl（ByValidAsInteger,ByValblHeAsBoolean）

'

OnErrorResumeNext

'

IflblId4

（2）<>"1"Then

IfCheck1.Value=1ThenList1.AddItem"cannotcontrolwhileMLisnotauto"

ExitSub

EndIf

SelectCaseid

Case1,2,3

IfblHe=FalseThen

mDevice（id）.ControlType=3

mDevice（id）.ControlSNum=1

iCType=2

Else

mDevice（id）.ControlType=1

mDevice（id）.ControlSNum=1

iCType=0

EndIf

Case4

IfblHe=FalseThen

mDevice（4）.ControlType=0

mDevice（4）.ControlSNum=1

iCType=0

Else

mDevice（4）.ControlType=1

mDevice（4）.ControlSNum=1

iCType=1

EndIf

EndSelect

EndSub

'判断取数命令类型，轮询各种类型

PrivateSubSendToCom（）

'

OnErrorResumeNext

'

Dims（3）AsByte

SelectCaseiSendCom

'adr1

Case0'read9133adi

s（0）=0

s

（1）=0

s

（2）=0

s（3）=0

SendInitData1,2,s（）

Case1'read9133UIPinfo

s（0）=&H0

s

（1）=&H41

s

（2）=0

s（3）=14

SendInitData1,3,s（）

Case2'read9133power正向有功总电能（高位）

s（0）=0

s

（1）=&H5D

s

（2）=0

s（3）=2

SendInitData1,3,s（）

'adr2

Case3'read9133adi

s（0）=0

s

（1）=0

s

（2）=0

s（3）=0

SendInitData2,2,s（）

Case4'read9133UIPinfo

s（0）=&H0

s

（1）=&H41

s

（2）=0

s（3）=28

SendInitData2,3,s（）

Case5'read9133power

s（0）=0

s

（1）=&H5D

s

（2）=2

s（3）=2

SendInitData2,3,s（）

'adr3

Case6'read9133UIPinfo

s（0）=&H0

s

（1）=&H41

s

（2）=0

s（3）=14

SendInitData3,3,s（）

Case7'read9133power

s（0）=0

s

（1）=&H5D

s

（2）=0

s（3）=2

SendInitData3,3,s（）

'adr4

Case8'read9050di

s（0）=0

s

（1）=0

s

（2）=0

s（3）=5

SendInitData4,2,s（）

'comadr

Case9

s（0）=mComAddress

s

（1）=0

s

（2）=0

s（3）=0

IfMSCM.PortOpen=TrueThenMSCM.Output=s

EndSelect

Erases（）

iSendCom=iSendCom+1

IfiSendCom>9TheniSendCom=0

EndSub

'发送控制命令

PrivateSubSendControlToCom（ByValmDeviceAIdAsByte）

'

OnErrorResumeNext

'

Dims（3）AsByte

SelectCasemDevice（mDeviceAId）.ControlType

Case0

s（0）=0

s

（1）=0

s

（2）=0

Case1

s（0）=0

s

（1）=0

s

（2）=&HFF

Case2

s（0）=0

s

（1）=1

s

（2）=0

Case3

s（0）=0

s

（1）=1

s

（2）=&HFF

EndSelect

s（3）=0

mDevice（mDeviceAId）.ControlSNum=mDevice（mDeviceAId）.ControlSNum+1

SendInitDatamDevice（mDeviceAId）.Address,5,s（）

IfmDevice（mDeviceAId）.ControlSNum<>0Then

IfmDevice（mDeviceAId）.ControlSNum>MAX_ERR_NUM_CTRLThen

mDevice（mDeviceAId）.ControlSNum=0

lblCtrlOk（mDeviceAId）.Text="0"

iControl=0

EndIf

EndIf

Erases（）

EndSub

'初始化数据并调用发送

PrivateSubSendInitData（ByValDevAdrAsInteger,ByValFunctionCodeAsInteger,Dt（）AsByte）

'

OnErrorResumeNext

'

Dims（）AsByte

DimubDtAsInteger

DimiAsInteger

ubDt=UBound（Dt）

ReDims（ubDt+2）

IfblIsSending=TrueThenExitSub

IfblQuit=TrueThenExitSub

blIsSending=True

mDevice（DevAdr）.ErrSendNum=mDevice（DevAdr）.ErrSendNum+1

s（0）=DevAdr

s

（1）=FunctionCode

Fori=0ToubDt

s（2+i）=Dt（i）

Next

SendDatas（）

blIsSending=False

Erases（）

EndSub

'发送数据

PrivateSubSendData（bytData（）AsByte）

'

OnErrorResumeNext

'

DimsDa（）AsByte

DimmCrc（）AsByte

DimubDataAsInteger

ubData=UBound（bytData）

ReDimsDa（ubData）AsByte

sDa=bytData

mCrc=CRC16（sDa）

ReDimPreservesDa（ubData+2）AsByte

sDa（ubData+1）=mCrc

（1）

sDa（ubData+2）=mCrc（0）

ubData=ubData+2

ErasemCrc（）

IfMSCM.PortOpen=TrueThen

MSCM.OutBufferCount=0

MSCM.InBufferCount=0

MSCM.Output=sDa

EndIf

IfCheck1.Value=1Then

DimstrTmpAsString

D