|
ClS.cls文件如下：
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 \'True
Persistable = 0 \'NotPersistable
DataBindingBehavior = 0 \'vbNone
DataSourceBehavior = 0 \'vbNone
MTSTransactionMode = 0 \'NotAnMTSObject
END
Attribute VB_Name = "CLS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
\'Option Explicit
Private Const CommSettings = "9600,E,7,1"
Private Const CommInputMode = 0
Private Const CommCommPort = 1
Public ClsState As String
Public SendOK As Boolean
Private Sub Class_Initialize()
If main_Form.MSComm1.PortOpen <> True Then
With main_Form.MSComm1
.CommPort = CommCommPort
.Settings = CommSettings
.InputMode = CommInputMode
.InBufferSize = 1024
.RTSEnable = True
\'.SThreshold = 10
.RThreshold = 1
.InputLen = 0
.OutBufferCount = 0
.InBufferCount = 0
.PortOpen = True
End With
End If
End Sub
Private Sub Class_Terminate()
\'If main_Form.MSComm1.PortOpen = True Then
With main_Form.MSComm1
.RTSEnable = False
.InputLen = 0
.OutBufferCount = 0
.InBufferCount = 0
.PortOpen = False
End With
\'End If
End Sub
Public Function RevPLC(iNo As String, iPLCNo As String, iType As String, iAdd As String, iNum As String)
\'iNo is station\'no，iPLCNo is PLC\'s no，iType is element ，iAdd is address，iNum is number
Dim Stmp As String
Dim cha, j As Integer
Dim ChaCount As Integer
Dim Comm As String
Dim Pnow
Select Case iType
Case "D"
Comm = "WR"
cha = Val("&H" & iNum) * 4
Case "M", "X", "Y", "S"
Comm = "BR"
cha = Val("&H" & iNum)
End Select
iAdd = Right$("000" & iAdd, 4)
iNum = Right$("0" & iNum, 2)
Stmp = Chr$(5) & iNo & iPLCNo & Comm & "0" & iType & iAdd & iNum
ChaCount = 6 + cha
main_Form.MSComm1.Output = Stmp
Dim SNow
SNow = Time()
If Not Do_Events_Buffer("Rev", main_Form.MSComm1, ChaCount) Then
MsgBox "CLS wrong，please pay attention to line", vbOKOnly, "wrong"
ClsState = "Port is close"
Else
RevPLC = CStr(main_Form.MSComm1.Input)
ClsState = "Port is open"
End If
RevPLC = Mid$(RevPLC, 6, cha)
Debug.Print RevPLC
End Function
Public Function SendPLC(iNo As String, iPLCNo As String, iType As String, iAdd As String, iNum As String, iValue As String)
\'SendPLC( )（no sum check code）
\'iNo is station\'no，iPLCNo is PLC\'s no，iType is element ，iAdd is address，iNum is number,iValue is element\'value
Dim Stmp As String
Dim Comm As String
Dim SNow As String
Dim ChaCount As Integer
Select Case iType
Case "D"
Comm = "WW"
Case "M", "X", "Y", "S"
Comm = "BW"
End Select
iAdd = Right$("000" & iAdd, 4)
iNum = Right$("0" & iNum, 2)
Stmp = Chr$(5) & iNo & iPLCNo & Comm & "A" & iType & iAdd & iNum & iValue
main_Form.MSComm1.Output = Stmp
If Not Do_Events_Buffer("Send", main_Form.MSComm1, 0) Then
MsgBox "CLS wrong，please pay attention to line", vbOKOnly, "wrong"
SendPLC = False
Else
SendPLC = True
End If
End Function
Private Function Do_Events_Buffer(Action As String, DoMSComm As MSComm, number As Integer)
Dim SNow
SNow = Time()
Do_Events_Buffer = False
If Action = "Rev" Then
Do
DoEvents
If SNow - Time() > 1 Then Exit Function
Loop Until DoMSComm.InBufferCount = number
If DoMSComm.InBufferCount = number Then
Do_Events_Buffer = True
End If
End If
If Action = "Send" Then
Do
DoEvents
If SNow - Time() > 1 Then Exit Function
Loop Until DoMSComm.OutBufferCount = number
If DoMSComm.OutBufferCount = number Then
Do_Events_Buffer = True
End If
End If
End Function
Private Function msComm_onComm(Action As String, DoMSComm As MSComm, ChaCount As Integer)
Dim SNow
SNow = Time()
msComm_onComm = False
If Action = "Rev" Then
Do
DoEvents
If SNow - Time() > 1 Then Exit Function
Loop Until DoMSComm.CommEvent > 0
\'Debug.Print DoMSComm.CommEvent
Select Case DoMSComm.CommEvent
Case comEvReceive
Do
DoEvents
If SNow - Time() > 1 Then Exit Function
Loop Until DoMSComm.InBufferCount = ChaCount
\'If DoMSComm.InBufferCount = ChaCount Then
msComm_onComm = True
\'End If
End Select
End If
If Action = "Send" Then
Do
DoEvents
\'If SNow - Time() > 1 Then Exit Function
Loop Until DoMSComm.CommEvent > 0
\'Debug.Print DoMSComm.CommEvent
Select Case DoMSComm.CommEvent
Case comEvReceive
Do
DoEvents
\'If SNow - Time() > 1 Then Exit Function
Debug.Print DoMSComm.OutBufferCount
Loop Until DoMSComm.OutBufferCount = ChaCount
\'If DoMSComm.OutBufferCount = ChaCount Then
msComm_onComm = True
SendOK = True
\'End If
End Select
End If
\'Debug.Print TEMP
\'msComm_onComm = TEMP
End Function
Public Function onCommRevPLC(iNo As String, iPLCNo As String, iType As String, iAdd As String, iNum As String)
\'iNo is station\'no，iPLCNo is PLC\'s no，iType is element ，iAdd is address，iNum is number
Dim Stmp As String
Dim cha, j As Integer
Dim ChaCount As Integer
Dim Comm As String
Dim Pnow
Select Case iType
Case "D"
Comm = "WR"
cha = Val("&H" & iNum) * 4
Case "M", "X", "Y", "S"
Comm = "BR"
cha = Val("&H" & iNum)
End Select
iAdd = Right$("000" & iAdd, 4)
iNum = Right$("0" & iNum, 2)
Stmp = Chr$(5) & iNo & iPLCNo & Comm & "0" & iType & iAdd & iNum
ChaCount = 6 + cha
Do
DoEvents
Loop Until Stmp <> ""
main_Form.MSComm1.Output = Stmp
If Not msComm_onComm("Rev", main_Form.MSComm1, ChaCount) Then
MsgBox "CLS wrong，please pay attention to line", vbOKOnly, "wrong"
ClsState = "Port is close"
Else
onCommRevPLC = CStr(main_Form.MSComm1.Input)
ClsState = "Port is open"
End If
onCommRevPLC = Mid$(onCommRevPLC, 6, cha)
Debug.Print onCommRevPLC
End Function
Public Function onCommSendPLC(str As String)
\'main_Form.MSComm1.Output = Chr$(5) + "00FFBWAS0550010"
main_Form.MSComm1.Output = Chr$(5) + str
msComm_onComm "Send", main_Form.MSComm1, "0"
If SendOK = False Then
MsgBox "通讯错误", vbOKOnly, "通讯错误"
onCommSendPLC = False
Else
onCommSendPLC = True
End If
End Function |
