opcform.frm

opc-OLE PROCESS on Controll

     '连接失败，发送失败事件
    
    Set ClientOPCServer = Nothing
    Call DisplayOPC_COM_ErrorValue("连接服务器失败", Err.Number)
    DisconnectOpc

SkipOPCItemActiveStateError: '连接成功，发送成功事件
       
End Sub



Private Sub AddGroup()
     If ClientOPCServer Is Nothing Then
         GoTo ShowOpcGroupActive
     End If
     
     
     Me.workstatus = "服务器正在添加组..."
     On Error GoTo ShowOPCGroupAddError
     '添加组集
     Set ConnectedServerGroup = ClientOPCServer.OPCGroups
     ConnectedServerGroup.DefaultGroupIsActive = True
     ConnectedServerGroup.DefaultGroupDeadband = 0
     
     '添加组
     Set ConnectedGroup = ConnectedServerGroup.Add(GroupName) ' 添加一个Group_First的组
     ConnectedGroup.UpdateRate = RateTime '刷新率为1秒
'     ConnectedGroup.IsSubscribed = True '异步获取数据
     ConnectedGroup.IsActive = True
     Exit Sub
     
ShowOPCGroupAddError:

    Set ConnectedServerGroup = Nothing
    Call DisplayOPC_COM_ErrorValue("添加组出错", Err.Number)
    DisconnectOpc
ShowOpcGroupActive:
End Sub

Public Sub ConnectOpc()
    Me.workstatus = "服务器正在启动..."
    
    ConnectToServer '连接到服务器
    AddGroup '添加组及要获取数据的 点名 并激活
    AddItems
End Sub


Public Sub DisconnectOpc()
    Me.workstatus.Caption = "服务器正在关闭"
    
    On Error GoTo ShowOPCRemoveItemError
    
    '***********************   移出位号*****************************
    
    If Not OPCItemCollection Is Nothing Then

        Dim RemoveItemServerHandles(ItemCount) As Long
        Dim RemoveItemServerErrors() As Long

        Dim TatalItem As Long
        TatalItem = 1

        'remove the item
        Dim i As Integer
        For i = 1 To ItemCount
            If ItemServerHandles(i) <> 0 Then
                RemoveItemServerHandles(TatalItem) = ItemServerHandles(i)
                TatalItem = TatalItem + 1
            End If
        Next i

        TatalItem = TatalItem - 1 '' Item count is 1 greater than it needs to be at this point

        If TatalItem <> 0 Then
            OPCItemCollection.Remove TatalItem, RemoveItemServerHandles(), RemoveItemServerErrors()
        End If

        For i = 0 To TatalItem
            ItemServerHandles(i + 1) = 0 'Mark the handle as empty
        Next i

        Set OPCItemCollection = Nothing
       
    End If
    
    '******************* 移出组号  ***********************
    
    If Not ConnectedServerGroup Is Nothing Then
       ConnectedServerGroup.RemoveAll        ' Release the group interface and allow the server to cleanup the resources used
      
       Set ConnectedServerGroup = Nothing
       Set ConnectedGroup = Nothing
       
    End If
    
    '*****************断开连接 ***************************

 
    If Not ClientOPCServer Is Nothing Then
        ClientOPCServer.Disconnect
        Set ClientOPCServer = Nothing
    End If
    
    IsConnectSuccess = False
    Me.workstatus.Caption = "服务器已经关闭"

    Exit Sub

ShowOPCRemoveItemError:
        Call DisplayOPC_COM_ErrorValue("断开服务器出错", Err.Number)
       IsConnectSuccess = False
       Set ClientOPCServer = Nothing
       Set ConnectedServerGroup = Nothing
       Set ConnectedGroup = Nothing
       Set OPCItemCollection = Nothing
       Me.workstatus.Caption = "服务器已经关闭"
End Sub

Public Sub TestOpcConnect()
'
'    On Error GoTo OPCShutDown
'    If ClientOPCServer Is Nothing Then Exit Sub
'    If ClientOPCServer.ServerState = 2 Then
'        MsgBox "与离子膜DCS服务器数据连接出现故障，程序需要复" + Chr(13) + "位以更正其连接，请打开管理窗口先复位后，" + Chr(13) + "再连接，如果数据没有更新请重新启动应用程序", vbExclamation + vbOKOnly
'    End If
'    Exit Sub
    
'OPCShutDown:
'    MsgBox "与与离子膜DCS计算机连接出现故障，请检查网络是" + Chr(13) + "否出现故障，确认网络连接正确后重新启动应用程序"
'    End
End Sub


Public Sub DisplayOPC_COM_ErrorValue(OPC_Function As String, ErrorCode As Long)
    Dim Response
    Dim ErrorDisplay As String
        
    ErrorDisplay = "OPC在 '" + OPC_Function + "' ，返回错误号为 " + Str(ErrorCode) + " or Hex 0x" + Hex(ErrorCode)
    
    labLastError.Caption = ErrorDisplay
    
End Sub

Private Sub Connect_Click()
    ConnectOpc
End Sub

'*******************数据获取******************************

Private Sub SetDataChange()
    '1show
    ShowData
    '2write to file
    WriteValueToFile
End Sub

Private Sub ConnectedGroup_DataChange(ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
'    Dim i As Long
'
'    If ConnectedGroup Is Nothing Then Exit Sub
'
'
'    For i = 1 To ItemCount
'        Values(i) = ItemValues(i)
'    Next i
'
'    SetDataChange
'
'    DataNotChangeCount = 0
End Sub

Private Sub drop_Click()
    DisconnectOpc
    Me.workstatus.Caption = "已经复位"
End Sub

Private Sub Form_Load()
    IsConnectSuccess = False
    DataNotChangeCount = 0
    AddIconToTask
End Sub

Private Sub AddIconToTask()
  Dim l As Long
  Dim xb As Boolean
  
  If (Icon_Add(NoUseForm.hwnd, OpcForm.Icon)) Then
    xb = CMenu()      '添加弹出菜单
    OpcForm.Hide
    '将DialogProc函数设置为Form2的窗口处理函数并且保存原来窗口处理函数句柄
    lproc = SetWindowLong(NoUseForm.hwnd, GWL_WNDPROC, AddressOf DialogProc)
  End If
End Sub



Private Sub Form_Terminate()
    Icon_Del NoUseForm.hwnd
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Cancel = True
    AddIconToTask
End Sub


Private Sub ShowData()
    Dim ItemReturn As ListItem
    Dim i As Long
    On Error Resume Next
   
    If dataList.ListItems.Count < ItemCount Then
        dataList.ListItems.Clear
        
        GetTagName
        For i = 1 To ItemCount
            Set ItemReturn = dataList.ListItems.Add(, , CStr(i))
            ItemReturn.SubItems(1) = OPCItemIDs(i)
            ItemReturn.SubItems(2) = CStr(Values(i))
            If ItemErrorHandles(i) <> 0 Then
                ItemReturn.SubItems(3) = "坏通道"
            Else
                ItemReturn.SubItems(3) = "正常工作"
            End If
        Next i
    Else
        For i = 1 To ItemCount
            dataList.ListItems(i).SubItems(2) = Values(i)
        Next i
    End If
End Sub



Private Sub timerGetData_Timer()
    Dim ItemValue() As Variant
    Dim ItemErrors() As Long
    Dim i As Long
    
    If ConnectedGroup Is Nothing Then Exit Sub
    
    On Error GoTo GetError
    
    If IsConnectSuccess Then
    
        Call ConnectedGroup.SyncRead(iSourceDevice, ItemCount, ItemServerHandles(), ItemValue(), ItemErrors())
        
        For i = 1 To ItemCount
            Values(i) = ItemValue(i)
        Next i
        
        SetDataChange
        
        DataNotChangeCount = 0
    End If
    
    Exit Sub
    
GetError:
    IsConnectSuccess = False
    Call DisplayOPC_COM_ErrorValue("数据获取出错", Err.Number)
End Sub

Private Sub timerTestWork_Timer()
    If Not IsConnectSuccess Then
         ConnectOpc
         DataNotChangeCount = 0
         Exit Sub
    End If
    
    If DataNotChangeCount > 30 Then
         IsConnectSuccess = False
         DisconnectOpc
         Exit Sub
    End If
    
    DataNotChangeCount = DataNotChangeCount + 1
End Sub