fmain.frm

opc client 的开发工具

VERSION 5.00
Begin VB.Form fMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "开物OPC Toolkit(DA)--VB服务器样例程序"
   ClientHeight    =   630
   ClientLeft      =   6540
   ClientTop       =   5280
   ClientWidth     =   1650
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   630
   ScaleWidth      =   1650
   WindowState     =   1  'Minimized
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   120
      Width           =   975
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   120
      Top             =   0
   End
End
Attribute VB_Name = "fMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''
'启动服务器设置
'''''''''''''''''''''''''''''''''''''''''
Private Sub StartSvr()
    ''''''''''''''''''''''''''''''''''''
    '载入预先定义标签
    ''''''''''''''''''''''''''''''''''''
    LoadTags
    ''''''''''''''''''''''''''''''''''''
    '激活标签
    ''''''''''''''''''''''''''''''''''''
    ActTags
    SetServerState 1
    RunSvr
    Timer1.Enabled = True
End Sub

'''''''''''''''''''''''''''''''''''''''''
'硬件设备数据模拟和服务器地址空间数据刷新
'''''''''''''''''''''''''''''''''''''''''
Private Sub Simulate()
    Dim I As Integer
    Dim ft As FILETIME
    Dim st As SYSTEMTIME
    Dim re As Long
    Dim UpdateOK As Boolean
    
    For I = 1 To Tagcount
        If TagList(I).TagID <> "" Then
            
            Select Case TagList(I).TagType
                Case 11
                    If Rnd() > 0.5 Then
                        TagList(I).TagValue = False
                    Else
                        TagList(I).TagValue = True
                    End If
                Case 5
                    TagList(I).TagValue = Rnd() * 100
                Case 8
                    TagList(I).TagValue = CStr(Int(Rnd() * 100))
                Case Else
                    TagList(I).TagValue = Rnd() * 100
            End Select
            GetSystemTimeAsFileTime TagList(I).TagFt
            TagList(I).TagQuality = 192
            If TagList(I).Active Then
                If InitOPCOK Then
                    
                    '''''''''''''''''''''''''''''''''''''''''''
                    '更新服务器地址空间数据
                    '''''''''''''''''''''''''''''''''''''''''''
                    
                    UpdateOK = UpdateTag(TagList(I).TagHandle, TagList(I).TagValue, TagList(I).TagQuality)
                End If
            End If
        End If
    Next
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
   Dim SvrPath As String
    Dim vArr As Variant
    Dim astr(10) As String
    Dim str
    Dim B As Boolean
    
    ClsID = "{00AB7399-AC84-41D0-8ED0-405738209C77}"
    ProgID = "VBDEMO.OPCTOOLKIT.1"
    Description = "OPC Server by VB"
    SvrPath = App.Path + "\" + App.EXEName + ".EXE"
    
    vArr = astr
    vArr = Command()
    
    str = vArr
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '监测命令行参数
    '-regserver 进行服务器注册
    '-unregserver 进行服务器注销
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If LCase(str) = "-regserver" Then
    
        ''''''''''''''''''''''''''''''''''''
        '注册服务器
        ''''''''''''''''''''''''''''''''''''
        B = RegServer(ClsID, ProgID, Description, SvrPath)
        If B Then
            MsgBox ("服务器注册成功...")
        Else
            MsgBox ("服务器注册失败...")
        End If
        Unload Me
        Exit Sub
    End If
    If LCase(str) = "-unregserver" Then
    
        '''''''''''''''''''''''''''''''''''
        '注销服务器
        '''''''''''''''''''''''''''''''''''
        B = UnregServer(ClsID, ProgID)
        If B Then
            MsgBox ("服务器注销成功...")
        Else
            MsgBox ("服务器注销失败...")
        End If
        Unload Me
        Exit Sub
    End If
    
    TagRefresh = False
    UpdateLog = False
        
    '''''''''''''''''''''''''''''''''''
    '初始化OPC服务器
    '''''''''''''''''''''''''''''''''''
    If InitOPCSvr(ClsID, 1000) Then
        InitOPCOK = True
        
        '''''''''''''''''''''''''''''''
        '设置服务器断开通知回调函数
        '''''''''''''''''''''''''''''''
        
        B = EnableDisconnectNotification(AddressOf ShutDownNotify)
        '''''''''''''''''''''''''''''''
        '设置服务器写请求回调函数
        '''''''''''''''''''''''''''''''
        
        B = EnableWriteNotification(AddressOf WriteTag)
        Interval = 1000
        StartSvr
    Else
        InitOPCOK = False
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ''''''''''''''''''''''''''''''''''''''
    '反初始化服务器
    ''''''''''''''''''''''''''''''''''''''
    UninitOPCSvr
End Sub

'''''''''''''''''''''''''''''''''''''''
'激活服务器标签
'''''''''''''''''''''''''''''''''''''''
Private Sub ActTags()
    Dim I, hwnd As Integer
    For I = 1 To Tagcount
        If Not TagList(I).Active Then
            If InitOPCOK Then
            
                '''''''''''''''''''''''''''''''
                '向服务器地址空间增加标签
                '''''''''''''''''''''''''''''''
                TagList(I).TagHandle = CreateTag(TagList(I).TagID, TagList(I).TagValue, 192, True)
                If TagList(I).TagHandle > 0 Then
                    TagList(I).Active = True
                Else
                    TagList(I).Active = False
                End If
            End If
        End If
    Next
End Sub

''''''''''''''''''''''''''''''''''''''''''
'载入预先定义好的标签
''''''''''''''''''''''''''''''''''''''''''
Private Sub LoadTags()
    Dim I As Integer
    Dim num
    Tagcount = 0
    For I = 1 To MaxTagCount
        Tagcount = Tagcount + 1
        TagList(Tagcount).TagID = "TAG" + CStr(I)
        TagList(Tagcount).TagHandle = -1
        TagList(Tagcount).lvIndex = -1
        Select Case I Mod 3
        Case 0:
            TagList(Tagcount).TagType = 5
            TagList(Tagcount).TagValue = 0#
        Case 1:
            TagList(Tagcount).TagType = 8
            TagList(Tagcount).TagValue = ""
        Case 2:
            TagList(Tagcount).TagType = 11
            TagList(Tagcount).TagValue = False
        End Select
    Next
End Sub

'''''''''''''''''''''''''''''''''''
'数据耍定时器
'''''''''''''''''''''''''''''''''''
Private Sub Timer1_Timer()
    '''''''''''''''''''''''''''''''
    '硬件系统模拟
    '''''''''''''''''''''''''''''''
    Simulate
End Sub