mtag.bas

OPC 开发工具包2.0 OPC工具包是用来简化OPC规范服务器开发的工具包

Attribute VB_Name = "mTag"
Public Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Public Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type

Public Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 64
End Type

Public Type Tag
   TagID As String
   TagHandle As Long
   TagType As VbVarType
   TagValue As Variant
   TagFt As FILETIME
   TagQuality As Integer
End Type

Global Const MaxTagCount = 128

Global TagList(MaxTagCount) As Tag
Global Tagcount As Integer
Global ServerCount As Integer


Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias " Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Public Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Public Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long


 

Public Sub ServerNotify(ByVal hServer As Long, ByVal wOperateType As Integer)
    If wOperateType = 0 Then
        ServerCount = ServerCount + 1
    Else
        ServerCount = ServerCount - 1
    End If
    If ServerCount = 0 Then
        Unload fMain
    End If
End Sub

Public Sub WriteCallback(ByVal Handle As Long, ByVal pNewValue As Variant, pDeviceError As Long)
    Dim I As Integer
    Dim ft As FILETIME
    Dim UpdateOK As Boolean
    Dim st As SYSTEMTIME
    
    GetSystemTime st
    SystemTimeToFileTime st, ft    
    pDeviceError = 1
    For I = 1 To Tagcount
        If TagList(I).TagHandle = Handle Then
            TagList(I).TagFt = ft
            TagList(I).TagQuality = 192
            TagList(I).TagValue = pNewValue
            UpdateOK = UpdateTag(TagList(I).TagHandle, TagList(I).TagValue, TagList(I).TagQuality)
            pDeviceError = 0
            Exit For
        End If
    Next
End Sub