frmmain.frm

OPC CLIENT开发包

    mnuRemoveItem.Enabled = True
End Sub

Private Sub menuOpen_Click()
  Dim fn As String
  Dim I As Long, Count As Long
  dlgCommonDialog.Filter = "OPC client Files(*.opc)|*.opc|All Files(*.*)|*.*|"
  dlgCommonDialog.FileName = "opcclient.opc"
  dlgCommonDialog.CancelError = True
  On Error GoTo out1
  dlgCommonDialog.ShowOpen
  If dlgCommonDialog.CancelError = False Then
    Exit Sub
  End If
  
  Call Disconnect
  ComputerName = ReadInIFiles("PUBLIC", "HOST", "", dlgCommonDialog.FileName)
  ServerClassID = ReadInIFiles("PUBLIC", "CLSID", "", dlgCommonDialog.FileName)
  GroupName = ReadInIFiles("PUBLIC", "GROUP", "GROUP1", dlgCommonDialog.FileName)
  Count = Val(ReadInIFiles("PUBLIC", "COUNT", "0", dlgCommonDialog.FileName))
    ServerHandle = OPC_Connect(ComputerName, ServerClassID, 1)
    If ServerHandle > 0 Then
        OPC_SetDataChangeProc ServerHandle, AddressOf ServerDataChangeProc
        OPC_SetShutdownProc ServerHandle, AddressOf ServerShutdownProc
        GroupHandle = OPC_AddGroup(ServerHandle, GroupName, True, 500, 0, 0, 0)
        If GroupHandle > 0 Then
            mnuConnect.Enabled = False
            mnuDisconnect.Enabled = True
            mnuServerStatus.Enabled = True
            mnuGroupStatus.Enabled = True
            mnuGroupRefresh.Enabled = True
            mnuAddItem.Enabled = True
            menuSaveAs.Enabled = True
        End If
        For I = 0 To Count - 1
            AddItem ReadInIFiles("ITEM", "item" & CStr(Count - I), "", dlgCommonDialog.FileName)
        Next
    End If

  
  Exit Sub
out1:
 ' MsgBox dlgCommonDialog.FileName
End Sub

Private Sub menuSaveAs_Click()
  Dim fn As String
  Dim I As Long
  dlgCommonDialog.Filter = "OPC client Files(*.opc)|*.opc|All Files(*.*)|*.*|"
  dlgCommonDialog.FileName = "opcclient.opc"
  dlgCommonDialog.CancelError = True
  On Error GoTo out1
  dlgCommonDialog.ShowSave
  WritePrivateProfileString "PUBLIC", "HOST", ComputerName, dlgCommonDialog.FileName
  WritePrivateProfileString "PUBLIC", "CLSID", ServerClassID, dlgCommonDialog.FileName
  WritePrivateProfileString "PUBLIC", "GROUP", GroupName, dlgCommonDialog.FileName
  WritePrivateProfileString "PUBLIC", "COUNT", CStr(lvListView.ListItems.Count), dlgCommonDialog.FileName
  For I = 0 To lvListView.ListItems.Count - 1
       WritePrivateProfileString "ITEM", "item" & CStr(I + 1), lvListView.ListItems(I + 1).Text, dlgCommonDialog.FileName
  Next
  
  Exit Sub
out1:
 ' MsgBox dlgCommonDialog.FileName
End Sub

Private Sub mnuAddItem_Click()
    frmItemBrowser.Show vbModal, Me
End Sub

Private Sub mnuConnect_Click()
    frmServerBrowser.Show vbModal, Me
    If frmServerBrowser.mbReturn = False Then Exit Sub
    If Len(frmServerBrowser.ServerClassID) < 1 Then Exit Sub
    ServerHandle = 0
    GroupHandle = 0
    ItemIndex = 0
    GroupName = "GROUP" & Rnd
    lstProcess.Clear
    ServerHandle = OPC_Connect(frmServerBrowser.ComputerName, frmServerBrowser.ServerClassID, frmServerBrowser.Version)
    'MsgBox ServerHandle
    If ServerHandle > 0 Then
        
        OPC_SetDataChangeProc ServerHandle, AddressOf ServerDataChangeProc
        OPC_SetShutdownProc ServerHandle, AddressOf ServerShutdownProc
        GroupHandle = OPC_AddGroup(ServerHandle, GroupName, True, 500, 0, 0, 0)
       ' MsgBox GroupHandle
        If GroupHandle > 0 Then
            mnuConnect.Enabled = False
            mnuDisconnect.Enabled = True
            mnuServerStatus.Enabled = True
            mnuGroupStatus.Enabled = True
            mnuGroupRefresh.Enabled = True
            mnuAddItem.Enabled = True
            menuSaveAs.Enabled = True
            ComputerName = frmServerBrowser.ComputerName
            ServerClassID = frmServerBrowser.ServerClassID
        End If
    End If
End Sub

Private Sub mnuDisconnect_Click()
     If OPC_Disconnect(ServerHandle) Then
            lvListView.ListItems.Clear
            GroupHandle = 0
            ServerHandle = 0
            mnuConnect.Enabled = True
            mnuDisconnect.Enabled = False
            mnuServerStatus.Enabled = False
            mnuGroupStatus.Enabled = False
            mnuGroupRefresh.Enabled = False
            mnuAddItem.Enabled = False
            mnuReadItem.Enabled = False
            mnuWriteItem.Enabled = False
            mnuRemoveItem.Enabled = False
            mnuItemStatus.Enabled = False
            menuSaveAs.Enabled = False
     End If
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuGroupStatus_Click()
    frmGroupStatus.frmGroupName = GroupName
    frmGroupStatus.Show vbModal, Me
    If frmGroupStatus.mbReturn Then
        If frmGroupStatus.frmGroupName <> GroupName Then
            If OPC_SetGroupName(ServerHandle, GroupHandle, frmGroupStatus.frmGroupName) Then
                GroupName = frmGroupStatus.frmGroupName
            End If
        End If
        OPC_SetGroupStat ServerHandle, GroupHandle, frmGroupStatus.UpdateRate, frmGroupStatus.Active, frmGroupStatus.TimeBias, frmGroupStatus.DeadBand, 0
    End If
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuItemStatus_Click()
    If lvListView.SelectedItem Is Nothing Then Exit Sub
    frmItemStatus.ItemName = lvListView.SelectedItem.Text
    frmItemStatus.Show vbModal, Me
''            Dim I As Long
''            For I = 1 To lvListView.ListItems.Count
''                If lvListView.SelectedItem.Tag = ItemArr(I).Name Then
''                    Exit For
''                End If
''            Next
            If (frmItemStatus.bretOK = True) Then
                    OPC_ActiveItem ServerHandle, GroupHandle, lvListView.SelectedItem.Tag, frmItemStatus.iActive
            End If
End Sub

Private Sub mnuReadItem_Click()
    Dim lvItem As listItem
    
    If lvListView.SelectedItem Is Nothing Then Exit Sub
    Dim Var As Variant
    Dim Ft As Double
    Dim ftdt As FILETIME
    Dim Quality As Integer
    
        If OPC_ReadItem(ServerHandle, GroupHandle, lvListView.SelectedItem.Tag, Var, Ft, Quality) Then
        CopyMemory ftdt, Ft, Len(Ft)
        ItemArr(lvListView.SelectedItem.Tag).Value = Var
        ItemArr(lvListView.SelectedItem.Tag).Quality = Quality
        ItemArr(lvListView.SelectedItem.Tag).Ft = ftdt
        lvListView.SelectedItem.SubItems(1) = Var
        lvListView.SelectedItem.SubItems(2) = CStr(Quality)
        lvListView.SelectedItem.SubItems(3) = CStr(FileTimeToDate(ftdt))
    End If
End Sub


Private Sub mnuGroupRefresh_Click()
    OPC_RefreshGroup ServerHandle, GroupHandle, 1
End Sub


Private Sub mnuRemoveItem_Click()
    Dim lvItem As listItem
    
    If lvListView.SelectedItem Is Nothing Then Exit Sub
    
    If RemoveItem(lvListView.SelectedItem.Tag) Then
        lvListView.ListItems.Remove lvListView.SelectedItem.Index
    End If
End Sub

Public Sub AddItem(ItemName As String)
    Dim Index As Long
    Dim lvItem As listItem
    Index = AddItemM(ItemName)
    If Index > 0 Then
        Set lvItem = lvListView.ListItems.Add(1, "K" + CStr(Index), ItemName)
'        Debug.Print "K" + CStr(Index)
        lvItem.Tag = Index
        lvItem.SubItems(1) = "Bad"
        lvItem.SubItems(2) = ""
        lvItem.SubItems(3) = ""
    End If
End Sub

Public Sub RefreshItem(Index As Integer)
    On Error Resume Next
    Dim lvItem As listItem
'    Debug.Print Index
    Set lvItem = lvListView.ListItems("K" + CStr(Index)) 'Index
    If lvItem Is Nothing Then Exit Sub
    lvItem.SubItems(1) = ItemArr(Index).Value
    lvItem.SubItems(2) = CStr(ItemArr(Index).Quality)
    lvItem.SubItems(3) = CStr(FileTimeToDate(ItemArr(Index).Ft))
   
End Sub

Private Sub mnuServerStatus_Click()
    Dim ftStart, ftCurrent, ftUpdate As Double
    Dim BandWidth, GroupCount As Long
    Dim State, MajorVersion, MinorVersion, BuildNumber As Integer
    Dim vendor As String
    vendor = Space(128)
    If OPC_GetServerStatus(ServerHandle, ftStart, ftCurrent, ftUpdate, State, BandWidth, GroupCount, MajorVersion, MinorVersion, BuildNumber, vendor, 128) Then
        frmServerStatus.Text1.Text = CStr(FileTimeToDate(DoubleToFileTime(ftStart)))
        frmServerStatus.Text2.Text = CStr(FileTimeToDate(DoubleToFileTime(ftCurrent)))
        frmServerStatus.Text3.Text = CStr(FileTimeToDate(DoubleToFileTime(ftUpdate)))
        frmServerStatus.Text4.Text = CStr(BandWidth)
        frmServerStatus.Text5.Text = CStr(State)
        frmServerStatus.Text6.Text = CStr(GroupCount)
        frmServerStatus.Text7.Text = CStr(MajorVersion)
        frmServerStatus.Text8.Text = CStr(MinorVersion)
        frmServerStatus.Text9.Text = CStr(BuildNumber)
        frmServerStatus.Show vbModal, Me
    End If
End Sub

Private Sub mnuWriteItem_Click()
    Dim Index As Long
    Dim Value As Variant
    If lvListView.SelectedItem Is Nothing Then Exit Sub
    frmItemWrite.Show vbModal, Me
    If frmItemWrite.mbReturn = False Then Exit Sub
    If frmItemWrite.Value = "" Then Exit Sub
    
    Index = lvListView.SelectedItem.Tag
    Value = frmItemWrite.Value
   
    If OPC_WriteItem(ServerHandle, GroupHandle, Index, Value, frmItemWrite.Async) Then
        ItemArr(Index).Value = Value
        lvListView.SelectedItem.SubItems(1) = Value
    End If
End Sub