下面为模块中的函数 Sub CommSet() On Error GoTo err1 If MDIForm1.MSComm1.PortOpen = True Then MDIForm1.MSComm1.PortOpen = False End If If Not MDIForm1.MSComm1.PortOpen Then MDIForm1.MSComm1.CommPort = 2 MDIForm1.MSComm1.Settings = "115200,E,7,2" MDIForm1.MSComm1.Handshaking = 0 MDIForm1.MSComm1.InputLen = 0 MDIForm1.MSComm1.OutBufferCount = 0 MDIForm1.MSComm1.InBufferCount = 0 MDIForm1.MSComm1.SThreshold = 0 MDIForm1.MSComm1.RThreshold = 0 MDIForm1.MSComm1.PortOpen = True End If Exit Sub err1: MsgBox Err.Description End Sub 置位子函数 Sub SetBit(intWord As Integer, intBit As Integer) Dim strOrder As String Dim strOutput As String Dim strWord As String Dim strBit As String strOrder = "KSCIO " strWord = CStr(intWord) strBit = CStr(intBit) If Len(strWord) = 1 Then strWord = "000" + strWord ElseIf Len(strWord) = 2 Then strWord = "00" + strWord ElseIf Len(strWord) = 3 Then strWord = "0" + strWord End If If Len(strBit) = 1 Then strBit = "0" + strBit Else End If MDIForm1.MSComm1.OutBufferCount = 0 MDIForm1.MSComm1.InBufferCount = 0 TimeDelay 50 strOutput = "@00" + strOrder + strWord + strBit strOutput = strOutput + XORR(strOutput) + "*" + Chr(13) MDIForm1.MSComm1.Output = strOutput End Sub 复位子函数 Sub RstBit(intWord As Integer, intBit As Integer) Dim strOrder As String Dim strOutput As String Dim strWord As String Dim strBit As String strOrder = "KRCIO " strWord = CStr(intWord) strBit = CStr(intBit) If Len(strWord) = 1 Then strWord = "000" + strWord ElseIf Len(strWord) = 2 Then strWord = "00" + strWord ElseIf Len(strWord) = 3 Then strWord = "0" + strWord End If If Len(strBit) = 1 Then strBit = "0" + strBit Else End If MDIForm1.MSComm1.OutBufferCount = 0 MDIForm1.MSComm1.InBufferCount = 0 TimeDelay 50 strOutput = "@00" + strOrder + strWord + strBit strOutput = strOutput + XORR(strOutput) + "*" + Chr(13) MDIForm1.MSComm1.Output = strOutput End Sub FCS码检验函数 Function XORR(ByVal strI As String) As String Dim I, J, k As Integer J = Len(strI) k = 0 For I = 1 To J k = Asc(Mid$(strI, I, 1)) Xor k Next I strFCS = Hex$(k) If Len(strFCS) = 1 Then XORR = "0" + strFCS End If XORR = strFCS End Function