ctechnical.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cTechnical"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Technical Control For ZF-IV Ti Automation Control
'Each 10 Sec. action a scan,to do the control action

'At First , In DataBase ,Must Built This:

'if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[getTechnicalData]') and OBJECTPROPERTY(id, N'IsProcedure') = 1)
'drop procedure [dbo].[getTechnicalData]
'GO
'
'SET QUOTED_IDENTIFIER OFF
'GO
'SET ANSI_NULLS ON
'GO
'
'CREATE procedure getTechnicalData As select pv_st01,pv_st06,pv_prst,pv_prsub
'from History_1M where realtime=(select max(realtime) from History_1M)
'
'GO
'SET QUOTED_IDENTIFIER OFF
'GO
'SET ANSI_NULLS ON
'GO


Option Explicit

Private WithEvents priTMRTECHNICAL      As Timer
Attribute priTMRTECHNICAL.VB_VarHelpID = -1

Private priLocalServerName              As String       '服务器名
Private priLocalDataBaseName            As String       '数据库名
Private priLocalDataBaseUser            As String       '数据库用户名
Private priLocalDataBasePSW             As String       '数据库密码
Private priCCode                        As cOtherCode   '读取INI的类

Private Type TECHNICALDATA
    TempStove01     As Long
    TempStove02     As Long
    TempStove04     As Long
    TempStove06     As Long
    TempWater02     As Long
    TempWater03     As Long
    TempWater04     As Long
    
End Type

Private priTechData                     As TECHNICALDATA



Private pricnnLocalCNN As ADODB.Connection

'--------------------------------------------------------------------------------------
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'-------------- 定义属性 --------------------------------------------------------------

Public Property Let setServerName(ByVal lNewValue As String)                '服务器名
    priLocalServerName = lNewValue
End Property

Public Property Let setDataBaseName(ByVal lNewValue As String)              '数据库名
    priLocalDataBaseName = lNewValue
End Property

Public Property Let setDataBaseUser(ByVal lNewValue As String)              '数据库用户名
    priLocalDataBaseUser = lNewValue
End Property

Public Property Let setDataBasePassword(ByVal lNewValue As String)          '数据库密码
    priLocalDataBasePSW = lNewValue
End Property

Public Property Let setTimerOCX(ByRef lTimer As Timer)
    Set priTMRTECHNICAL = lTimer
End Property

'-------------- 结束属性定义 ----------------------------------------------------------
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'--------------------------------------------------------------------------------------

Public Sub Initialization()         '进行初始化
    
    On Local Error GoTo ErrOPR
        '---------------------- 打开数据库 -------------------
        Set pricnnLocalCNN = New ADODB.Connection
        Dim strCNNSTR$
        strCNNSTR = "Provider=SQLOLEDB.1;Persist Security Info=False;" _
            & "User ID=" & priLocalDataBaseUser _
            & ";Password=" & priLocalDataBasePSW _
            & ";Initial Catalog=" & priLocalDataBaseName _
            & ";Data Source=" & priLocalServerName
        If pricnnLocalCNN.State = adStateOpen Then
            Exit Sub
        End If
        With pricnnLocalCNN
            .ConnectionString = strCNNSTR
            .ConnectionTimeout = 15
            .CursorLocation = adUseClient
            .Open
        End With
        Set priCCode = New cOtherCode
        
        '--------------------- 定义定时器 --------------------
        With priTMRTECHNICAL
            .Interval = 10000    '10 s 一次已经足够
            .Enabled = True
        End With
    Exit Sub
ErrOPR:
    
End Sub

Public Sub Termination()            '结束


    On Local Error GoTo ErrOPR
        priTMRTECHNICAL.Enabled = False
        If pricnnLocalCNN.State = adStateClosed Then
            Exit Sub
        End If
        pricnnLocalCNN.Close
        Set pricnnLocalCNN = Nothing
        Set priCCode = Nothing
    Exit Sub
ErrOPR:
    

End Sub

Private Sub ReadTheTechnicalData(ByVal lRevertSection As String, ByRef lTechnicalData() As Double)
    
    On Error GoTo ErrOPR
        'Just have 10 Data Of the Techncal Revert Data
        'Read The Technical.Ini File And Get The Current Data , Give Them to the lTechnicalData()
'        lTechnicalData(0) = CDbl(priCCode.ReadIni(lRevertSection, "SV_ST01", lPath))
        
        
    Exit Sub
ErrOPR:
    
    
End Sub