frmmain.frm

与西门子PLC通讯的程序,经工业现场测试没有问题

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ZF-IV Cell A & C"
   ClientHeight    =   1125
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5190
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   1125
   ScaleWidth      =   5190
   StartUpPosition =   2  '屏幕中心
   Visible         =   0   'False
   Begin VB.Timer tmrScanWrPLC 
      Enabled         =   0   'False
      Left            =   120
      Top             =   3720
   End
   Begin VB.Timer tmrScanWrWP 
      Enabled         =   0   'False
      Left            =   120
      Top             =   3240
   End
   Begin VB.Timer tmrSaveRealTimeData 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   120
      Top             =   2760
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "By Winters.Lee"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   255
      Index           =   2
      Left            =   3000
      TabIndex        =   5
      Top             =   360
      Width           =   1695
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "This From Can Not Be Seen When The Project Run"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   4
      Top             =   840
      Width           =   5055
   End
   Begin VB.Label Label1 
      Caption         =   "ZF-IV Cell A && C V1.0 "
      BeginProperty Font 
         Name            =   "Impact"
         Size            =   15.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000C0&
      Height          =   375
      Index           =   0
      Left            =   240
      TabIndex        =   3
      Top             =   120
      Width           =   2655
   End
   Begin VB.Label lbl 
      BackStyle       =   0  'Transparent
      Caption         =   "Scan Wite Info For PLC"
      Height          =   255
      Index           =   2
      Left            =   720
      TabIndex        =   2
      Top             =   3840
      Width           =   2175
   End
   Begin VB.Label lbl 
      BackStyle       =   0  'Transparent
      Caption         =   "Scan Wite Info For WP"
      Height          =   255
      Index           =   1
      Left            =   720
      TabIndex        =   1
      Top             =   3360
      Width           =   2175
   End
   Begin VB.Label lbl 
      BackStyle       =   0  'Transparent
      Caption         =   "Save RealTime Data"
      Height          =   255
      Index           =   0
      Left            =   720
      TabIndex        =   0
      Top             =   2880
      Width           =   1815
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit



Private WithEvents priCSMCOMM       As cSiemensCOMM
Attribute priCSMCOMM.VB_VarHelpID = -1
Private WithEvents priCWPCOMMCH1    As cWidePlusCH1
Attribute priCWPCOMMCH1.VB_VarHelpID = -1
Private WithEvents priCWPCOMMCH2    As cWidePlusCH2
Attribute priCWPCOMMCH2.VB_VarHelpID = -1


Private Type tSubServerInfo
    ComputerIP          As String
    ComputerName        As String
    ServerName          As String
    DataBaseName        As String
    DataBaseUser        As String
    DataBasePassword    As String
    SIEMENSComPort      As Integer
    SIEMENSComSet       As String
    WIDEPLUS1ComPort     As Integer
    WIDEPLUS1ComSet      As String
    WIDEPLUS2ComPort     As Integer
    WIDEPLUS2ComSet      As String
End Type

Private priSubServerInfo        As tSubServerInfo



Private priCOtherCode           As cOtherCode
Private priCAlertOPR            As cAlarmOPR

Private priRealData(70)         As Double



Private priAppPath              As String
Private priWriteTimeWReal       As Date
Private priWriteTimeWTemp       As Date
Private priWriteWOrder          As String
Private priWriteTimePReal       As Date
Private priWriteTimePTemp       As Date
Private priWritePOrder          As String



Private Sub Form_Load()
    
    priAppPath = App.Path
    
    App.Title = ""
    
    Set priCSMCOMM = New cSiemensCOMM           '实例化 Siemens PLC 通讯类
    Set priCWPCOMMCH1 = New cWidePlusCH1        '实例化 WidePlus 通讯类
    Set priCWPCOMMCH2 = New cWidePlusCH2
    Set gCDBOPR = New cDataBaseOPR
    Set priCOtherCode = New cOtherCode
    Set priCAlertOPR = New cAlarmOPR
    
    Dim tINIPath As String
    Dim i As Integer
    
    tINIPath = priAppPath & "\" & "Option.ini"
    With priCOtherCode
        priSubServerInfo.ComputerIP = .ReadIni("SvrSet", "ServerIP", tINIPath)
        priSubServerInfo.ComputerName = .ReadIni("SvrSet", "ComputerName", tINIPath)
        priSubServerInfo.ServerName = .ReadIni("SvrSet", "ServerName", tINIPath)
        priSubServerInfo.DataBaseName = .ReadIni("SvrSet", "DataBaseName", tINIPath)
        priSubServerInfo.DataBaseUser = .ReadIni("SvrSet", "DataBaseUser", tINIPath)
        priSubServerInfo.DataBasePassword = .ReadIni("SvrSet", "DataBasePassword", tINIPath)
        priSubServerInfo.SIEMENSComPort = CInt(.ReadIni("COMSet", "SIEMENS ComPort", tINIPath))
        priSubServerInfo.SIEMENSComSet = .ReadIni("COMSet", "SIEMENS ComSet", tINIPath)
        priSubServerInfo.WIDEPLUS1ComPort = CInt(.ReadIni("COMSet", "WIDEPLUS1 ComPort", tINIPath))
        priSubServerInfo.WIDEPLUS1ComSet = .ReadIni("COMSet", "WIDEPLUS1 ComSet", tINIPath)
        priSubServerInfo.WIDEPLUS2ComPort = CInt(.ReadIni("COMSet", "WIDEPLUS2 ComPort", tINIPath))
        priSubServerInfo.WIDEPLUS2ComSet = .ReadIni("COMSet", "WIDEPLUS2 ComSet", tINIPath)
    End With
    
    
    
    
    ' @ 初始化所有的类
    With priCSMCOMM
        .setComPort = priSubServerInfo.SIEMENSComPort
        .setComSet = priSubServerInfo.SIEMENSComSet
        .setMSCOMMOCX = frmOCXS.mscom_S
        .setTimerOCX = frmOCXS.tmrErrScan_S
        .Initialization
    End With
    
    With priCWPCOMMCH1
        .setComPort = priSubServerInfo.WIDEPLUS1ComPort
        .setComSet = priSubServerInfo.WIDEPLUS1ComSet
        .setMSCOMMOCX = frmOCXS.mscom_W
        .setTimerOCX = frmOCXS.tmrErrScan_W
        ' 开始定义通讯仪表的位置
            Dim tpA(25) As Integer    '第一通道所通讯的仪表
            For i = 1 To 4
                tpA(i) = i
            Next
            For i = 9 To 24
                tpA(i - 4) = i
            Next
        .setArrBLWP = tpA
        .Initialization
    End With
    
    With priCWPCOMMCH2
        .setComPort = priSubServerInfo.WIDEPLUS2ComPort
        .setComSet = priSubServerInfo.WIDEPLUS2ComSet
        .setMSCOMMOCX = frmOCXS.mscom_W2
        .setTimerOCX = frmOCXS.tmrErrScan_W2
        ' 开始定义通讯仪表的位置
            Dim tpB(25) As Integer    '第二通道所通讯的仪表
            For i = 1 To 4
                tpB(i) = 4 + i
            Next
        .setArrBLWP = tpB
        .Initialization
    End With
    
    With gCDBOPR
        .setServerName = priSubServerInfo.ServerName
        .setDataBaseName = priSubServerInfo.DataBaseName
        .setDataBaseUser = priSubServerInfo.DataBaseUser
        .setDataBasePassword = priSubServerInfo.DataBasePassword
        .setTimerOCX = frmOCXS.tmrHistoryDataSave
    End With
    
    

    Call gCDBOPR.Initialization
    Call gCDBOPR.GetWriteRecord("Write_WP", priWriteTimeWReal, priWriteWOrder)
    priWriteTimeWTemp = priWriteTimeWReal
    
    Call gCDBOPR.GetWriteRecord("Write_PLC", priWriteTimePReal, priWritePOrder)
    priWriteTimePTemp = priWriteTimePReal
    tmrScanWrWP.Interval = 500
    tmrScanWrWP.Enabled = True
    
    tmrScanWrPLC.Interval = 500
    tmrScanWrPLC.Enabled = True
    
    With priCAlertOPR
        .setTimerOCX = frmOCXS.tmrAlarmScanSave
    End With
    Call priCAlertOPR.Initialization
    
'    @ 开始通讯
    Call priCSMCOMM.DoCommunication
    Call priCWPCOMMCH1.DoCommunicationNow
    Call priCWPCOMMCH2.DoCommunicationNow
    ' Enable the timer of Save RealTime Data
    
    tmrSaveRealTimeData.Enabled = True
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    
    tmrSaveRealTimeData.Enabled = False     '停止写入实时数据
    
    
    Set priCSMCOMM = Nothing                '销毁类实例
    Set priCWPCOMMCH1 = Nothing
    Set priCWPCOMMCH2 = Nothing
    Set priCOtherCode = Nothing
    Set gCDBOPR = Nothing
    End
    
    
End Sub

Private Sub priCSMCOMM_GetRealTimeData(lArrData() As Long, ByVal lPosition As Integer)
    
    On Error GoTo ErrOPR
    Select Case lPosition
        Case 1
            priRealData(23) = Round(CDbl(lArrData(0)) / 1000, 2)
            priRealData(43) = Round(CDbl(lArrData(1)) / 1000, 2)
            priRealData(54) = Round(CDbl(lArrData(2)) / 100, 2)
            priRealData(44) = Round(CDbl(lArrData(3)) / 100, 2)
        Case 2
            priRealData(50) = Round(CDbl(lArrData(0)) / 10000, 1)
            priRealData(51) = Round(CDbl(lArrData(1)) / 10000, 1)
        Case 3
            priRealData(45) = CDbl(lArrData(0))
            priRealData(46) = CDbl(lArrData(1))
            priRealData(47) = CDbl(lArrData(2))
            priRealData(48) = CDbl(lArrData(3))
        Case 4
            priRealData(49) = Round(CDbl(lArrData(0)) / 1000, 3)
            priRealData(42) = CDbl(lArrData(1))                 '压差SV
            priRealData(29) = CDbl(lArrData(2))     '状态
            priRealData(30) = CDbl(lArrData(3))     '开关
        Case 5
            priRealData(34) = CDbl(lArrData(0))     '炉次
            priRealData(55) = CDbl(lArrData(1))     '还原开关位显示
        Case Else
    End Select
    Exit Sub
ErrOPR:
    
End Sub

Private Sub priCWPCOMMCH1_GetRealTimeData(lData() As Long, ByVal lPosition As Integer)
    On Error GoTo ErrOPR
    Select Case lPosition
        Case 1: priRealData(1) = WPDataConver(CDbl(lData(0)))
        Case 2: priRealData(2) = WPDataConver(CDbl(lData(0))): priRealData(35) = WPDataConver(CDbl(lData(1)))
        Case 3: priRealData(3) = WPDataConver(CDbl(lData(0))): priRealData(36) = WPDataConver(CDbl(lData(1)))
        Case 4: priRealData(4) = WPDataConver(CDbl(lData(0))): priRealData(37) = WPDataConver(CDbl(lData(1)))
        Case 5:
        Case 6:
        Case 7:
        Case 8:
        Case 9
            priRealData(21) = WPDataConver(CDbl(lData(0))) / 1000
            If priRealData(21) > 5 Then priRealData(21) = 5
            priRealData(21) = Round(10 ^ priRealData(21), 2)
        Case 10: priRealData(22) = WPDataConver(CDbl(lData(0)))
        Case 11: priRealData(10) = WPDataConver(CDbl(lData(0))): priRealData(41) = WPDataConver(CDbl(lData(1)))
        Case 12: priRealData(9) = WPDataConver(CDbl(lData(0)))
        Case 13: priRealData(8) = WPDataConver(CDbl(lData(0))): priRealData(40) = WPDataConver(CDbl(lData(1)))
        Case 14: priRealData(7) = WPDataConver(CDbl(lData(0)))
        Case 15: priRealData(6) = WPDataConver(CDbl(lData(0))): priRealData(39) = WPDataConver(CDbl(lData(1)))
        Case 16: priRealData(5) = WPDataConver(CDbl(lData(0))): priRealData(38) = WPDataConver(CDbl(lData(1)))
        Case 17: priRealData(20) = WPDataConver(CDbl(lData(0)))
        Case 18: priRealData(17) = WPDataConver(CDbl(lData(0)))
        Case 19: priRealData(18) = WPDataConver(CDbl(lData(0)))
        Case 20: priRealData(19) = WPDataConver(CDbl(lData(0)))
        Case 21: priRealData(31) = WPDataConver(CDbl(lData(0)))
        Case 22: priRealData(25) = WPDataConver(CDbl(lData(0)))
        Case 23: priRealData(26) = WPDataConver(CDbl(lData(0)))
        Case 24: priRealData(27) = WPDataConver(CDbl(lData(0)))
    End Select
    Exit Sub
ErrOPR:
    
End Sub

Private Sub priCWPCOMMCH2_GetRealTimeData(lData() As Long, ByVal lPosition As Integer)

    On Error GoTo ErrOPR
    Select Case lPosition
        Case 5: priRealData(24) = WPDataConver(CDbl(lData(0))): priRealData(52) = WPDataConver(CDbl(lData(1)))
        Case 6: priRealData(28) = WPDataConver(CDbl(lData(0))): priRealData(53) = WPDataConver(CDbl(lData(1)))
        Case 7
            priRealData(11) = WPDataConver(CDbl(lData(0)))
            priRealData(12) = WPDataConver(CDbl(lData(1)))
            priRealData(13) = WPDataConver(CDbl(lData(2)))
            priRealData(14) = WPDataConver(CDbl(lData(3)))
            priRealData(15) = WPDataConver(CDbl(lData(4)))
            priRealData(16) = WPDataConver(CDbl(lData(5)))
        Case 8: priRealData(32) = WPDataConver(CDbl(lData(0)))
    End Select
    Exit Sub
ErrOPR:

End Sub

Private Sub tmrSaveRealTimeData_Timer()
    
    Call gCDBOPR.SaveRealData(priRealData())
    
End Sub

Private Sub tmrScanWrPLC_Timer()
    
    Call gCDBOPR.GetWriteRecord("Write_PLC", priWriteTimePReal, priWritePOrder)
    If priWriteTimePTemp < priWriteTimePReal Then
        priCSMCOMM.setWriteOrder = priWritePOrder
    End If
    priWriteTimePTemp = priWriteTimePReal
    
End Sub

Private Sub tmrScanWrWP_Timer()
    
    Call gCDBOPR.GetWriteRecord("Write_WP", priWriteTimeWReal, priWriteWOrder)
    If priWriteTimeWTemp < priWriteTimeWReal Then
        priCWPCOMMCH1.setWriteOrder = priWriteWOrder
    End If
    priWriteTimeWTemp = priWriteTimeWReal
    
End Sub

Private Function WPDataConver(ByVal lOrigData As Double) As Double

    WPDataConver = lOrigData
    If lOrigData > 32767 Then WPDataConver = 32768 - lOrigData

End Function