sr90.bas

一个网带烧结炉的程序,串口通讯,做工业自动化的可以参考

Attribute VB_Name = "sr90"


Type gongyi '工艺参数结构
    sv(6) As Single '设定值
    speed As Single '网带速度
    ev1sp(6) As Single '报警限
End Type

Public curgy3507 As gongyi '现行工艺参数
Public curgy3006 As gongyi
Public scal3507 As Single '网带比例
Public scal3006 As Single
Sub Main()
Load frmSplash
frmSplash.Show
LoginSucceeded = False
Open App.Path + "\init3507.ini" For Input As #1
    Input #1, scal3507
Close #1
Open App.Path + "\init3006.ini" For Input As #1
    Input #1, scal3006
Close #1
End Sub
Public Function readpv_sr90_3507(addr As Integer) As Single '读PV
   readpv_sr90_3507 = sr90readwk_3507(addr, "0100")
End Function
Public Function readsv_sr90_3507(addr As Integer) As Single '读SV
  readsv_sr90_3507 = sr90readwk_3507(addr, "0300")
End Function
Public Sub writesv_sr90_3507(addr As Integer, data As Integer) '写SV
  sr90writewk_3507 addr, "0300", data
End Sub
Public Function readev1_sr90_3507(addr As Integer) As Integer '读超温报警EV1
 readev1_sr90_3507 = sr90readwk_3507(addr, "0105")
End Function
Public Sub writepvb_sr90_3507(addr As Integer, data As Integer) '写pvb
  sr90writewk_3507 addr, "0701", data
End Sub
Public Function readpv_sr90_3006(addr As Integer) As Single '读PV
   readpv_sr90_3006 = sr90readwk_3006(addr, "0100")
End Function
Public Function readsv_sr90_3006(addr As Integer) As Single '读SV
  readsv_sr90_3006 = sr90readwk_3006(addr, "0300")
End Function
Public Sub writesv_sr90_3006(addr As Integer, data As Integer) '写SV
  sr90writewk_3006 addr, "0300", data
End Sub
Public Function readev1_sr90_3006(addr As Integer) As Integer '读超温报警EV1
 readev1_sr90_3006 = sr90readwk_3006(addr, "0105")
End Function
'Public Function readexeflg_sr90(addr As Integer) As Integer '读自整定,通讯状态,手动状态
' readexeflg_sr90 = sr90readwk(addr, "0104")
'End Function
'Public Function readp_sr90(addr As Integer) As Single '读P
'   readp_sr90 = sr90readwk(addr, "0400")
'End Function
'Public Function readi_sr90(addr As Integer) As Integer '读i
'   readi_sr90 = sr90readwk(addr, "0401")
'End Function
'Public Function readd_sr90(addr As Integer) As Integer '读d
'   readd_sr90 = sr90readwk(addr, "0402")
'End Function
Public Function readev1sp_sr90_3507(addr As Integer) As Integer '读报警限1
   readev1sp_sr90_3507 = sr90readwk_3507(addr, "0501")
End Function
Public Function readev1sp_sr90_3006(addr As Integer) As Integer '读报警限1
   readev1sp_sr90_3006 = sr90readwk_3006(addr, "0501")
End Function
'Public Function readev2sp_sr90(addr As Integer) As Integer '读报警限2
'   readev2sp_sr90 = sr90readwk(addr, "0509")
'End Function
'Public Function readev1md_sr90(addr As Integer) As Integer '读报警模式
'   readev1md_sr90 = sr90readwk(addr, "0500")
'End Function
Public Function readout_sr90_3507(addr As Integer) As Integer '读输出率out
   readout_sr90_3507 = sr90readwk_3507(addr, "0102")
End Function
Public Function readout_sr90_3006(addr As Integer) As Integer '读输出率out
   readout_sr90_3006 = sr90readwk_3006(addr, "0102")
End Function
'Public Sub writep_sr90(addr As Integer, data As Single) '写p
'  sr90writewk addr, "0400", data * 10
'End Sub
'Public Sub writei_sr90(addr As Integer, data As Integer) '写i
'  sr90writewk addr, "0401", data
'End Sub
'Public Sub writed_sr90(addr As Integer, data As Integer) '写d
'  sr90writewk addr, "0402", data
'End Sub
Public Sub writeat_sr90_3507(addr As Integer, data As Integer) '写自整定
  sr90writewk_3507 addr, "0184", data
End Sub
Public Sub writecom_sr90_3507(addr As Integer, data As Integer) '写通讯
  sr90writewk_3507 addr, "018C", data
End Sub
Public Sub writeev1sp_sr90_3507(addr As Integer, data As Integer) '写报警限1
  sr90writewk_3507 addr, "0501", data
End Sub

Public Sub writeat_sr90_3006(addr As Integer, data As Integer) '写自整定
  sr90writewk_3006 addr, "0184", data
End Sub
Public Sub writecom_sr90_3006(addr As Integer, data As Integer) '写通讯
  sr90writewk_3006 addr, "018C", data
End Sub
Public Sub writeev1sp_sr90_3006(addr As Integer, data As Integer) '写报警限1
  sr90writewk_3006 addr, "0501", data
End Sub
'Public Sub writeev2sp_sr90(addr As Integer, data As Integer) '写报警限2
'  sr90writewk addr, "0509", data
'End Sub
'Public Sub writeev1md_sr90(addr As Integer, data As Integer) '写报警模式
'  sr90writewk addr, "0500", data
'End Sub
Public Function bcc_sr90(cmd As String, mode As Integer) As String '块校验 mode=1:和校验,mode=2:和补码校验,mode=3:异或校验
Dim bccs As Integer
Dim lens As Integer
bccs = Asc(Left(cmd, 1))
lens = Len(cmd)
Select Case mode
    Case 1
        For i = 2 To lens
            bccs = bccs + Asc(Mid(cmd, i, 1))
        Next i
        bccs = bccs Mod 256
    Case 2
        For i = 2 To lens
            bccs = bccs + Asc(Mid(cmd, i, 1))
        Next i
        bccs = bccs Mod 256
        bccs = 256 - bccs
    Case 3
        For i = 2 To lens
            bccs = bccs Xor Asc(Mid(cmd, i, 1))
        Next i
End Select
bcc_sr90 = cmd + Hex(bccs \ 16) + Hex(bccs Mod 16) + Chr(13)
End Function

Public Function sr90writewk_3507(addr As Integer, cmdaddr As String, data As Integer) As Integer
    Dim cmd As String
    Dim datas As String
    Dim buffer As String
    Dim a As Integer
    On Error Resume Next
    form1.MSComm1.PortOpen = True
  
    datas = Right("000" + Hex(data), 4)
    cmd = Chr(2) + Hex(addr \ 16) + Hex(addr Mod 16) + "1W" + cmdaddr + "0" + "," + datas + Chr(3)
    cmd = bcc_sr90(cmd, 1)
    form1.MSComm1.Output = cmd
    buffer = ""
    Do
        buffer = buffer + form1.MSComm1.Input
        a = a + 1
    Loop Until InStr(buffer, Chr(13)) Or a = 5000
    
    If a <> 5000 Then
        If Mid(buffer, 6, 2) <> "00" Then
            sr90writewk_3507 = -1
        Else
            sr90writrwk_3507 = 0
        End If
    Else
        form1.MSComm1.InBufferCount = 0
        sr90writewk_3507 = -1
    End If
    form1.MSComm1.PortOpen = False

End Function
Public Function sr90readwk_3507(addr As Integer, cmdaddr As String) As Integer
    Dim cmd As String
    Dim buffer As String
    Dim a As Integer
    On Error Resume Next
    form1.MSComm1.PortOpen = True
 
    lee = 0
    cmd = Chr(2) + Hex(addr \ 16) + Hex(addr Mod 16) + "1R" + cmdaddr + "0" + Chr(3)
    cmd = bcc_sr90(cmd, 1)
    form1.MSComm1.Output = cmd
    buffer = ""
    Do

        buffer = buffer + form1.MSComm1.Input
        lee = lee + 1
    Loop Until InStr(buffer, Chr(13)) Or lee = 5000
    
    If lee <> 5000 Then
        If Mid(buffer, 6, 2) = "00" Then
            sr90readwk_3507 = Val("&h" + Mid(buffer, 9, 4) + "&")
        Else
            sr90readwk_3507 = -1
        End If
    Else
         form1.MSComm1.InBufferCount = 0
          sr90readwk_3507 = -1
    End If
    
 form1.MSComm1.PortOpen = False

End Function





Public Function sr90writewk_3006(addr As Integer, cmdaddr As String, data As Integer) As Integer
    Dim cmd As String
    Dim datas As String
    Dim buffer As String
    Dim a As Integer
    On Error Resume Next
    form1.MSComm2.PortOpen = True
  
    datas = Right("000" + Hex(data), 4)
    cmd = Chr(2) + Hex(addr \ 16) + Hex(addr Mod 16) + "1W" + cmdaddr + "0" + "," + datas + Chr(3)
    cmd = bcc_sr90(cmd, 1)
    form1.MSComm2.Output = cmd
    buffer = ""
    Do
        buffer = buffer + form1.MSComm2.Input
        a = a + 1
    Loop Until InStr(buffer, Chr(13)) Or a = 5000
    
    If a <> 5000 Then
        If Mid(buffer, 6, 2) <> "00" Then
            sr90writewk_3006 = -1
        Else
            sr90writewk_3006 = 0
        End If
    Else
        form1.MSComm2.InBufferCount = 0
        sr90writewk_3006 = -1
    End If
    form1.MSComm2.PortOpen = False

End Function
Public Function sr90readwk_3006(addr As Integer, cmdaddr As String) As Integer
    Dim cmd As String
    Dim buffer As String
    Dim a As Integer
    On Error Resume Next
    form1.MSComm2.PortOpen = True
 
    lee = 0
    cmd = Chr(2) + Hex(addr \ 16) + Hex(addr Mod 16) + "1R" + cmdaddr + "0" + Chr(3)
    cmd = bcc_sr90(cmd, 1)
    form1.MSComm2.Output = cmd
    buffer = ""
    Do

        buffer = buffer + form1.MSComm2.Input
        lee = lee + 1
    Loop Until InStr(buffer, Chr(13)) Or lee = 5000
    
    If lee <> 5000 Then
        If Mid(buffer, 6, 2) = "00" Then
            sr90readwk_3006 = Val("&h" + Mid(buffer, 9, 4) + "&")
        Else
            sr90readwk_3006 = -1
        End If
    Else
         form1.MSComm2.InBufferCount = 0
          sr90readwk_3006 = -1
    End If
    
 form1.MSComm2.PortOpen = False

End Function