form1.frm

学习开发opcclient的好例子

Dim OneItem_D   As OPCItem 'Single item

Dim OneItem(27) As OPCItem 'Items



Dim IconServerTime As Date



'item object
'Public OpcItem As IOPCItem
Dim ClientHandles(27) As Long 'ClientHandles()
Dim ServerHandles() As Long   'ServerHandles()
Dim Errors() As Long
    
Dim pQuality As Variant
Dim pTimestamp As Variant
Dim ItemIDs(27) As String
Dim AccessPaths(27) As String
Dim Active(27) As Boolean
Dim bServerStarted As Boolean
Dim bReadOn As Boolean
Dim ItemCount As Integer

Dim ReadValue() As Variant

Private Sub Command1_Click()
 Dim Node As String
 
    ' Create opc server object
Set IconServer = New OPCServer
    ' Establish connection to an OPC server
 Node = Text2.Text
 If Node = "" Then
    IconServer.Connect Form1.Text1  'connect local OPC Server
 Else
    IconServer.Connect Form1.Text1, Node 'connect remote OPC server
 End If

If TypeName(IconServer) = TypeName(Nothing) Then
    MsgBox "Connect Error"  ' 無此 OPC Server
    Return
Else
   MsgBox "Connect OK"

End If

'首先由此 Server 物件取入 group 集合物件
 Set IconGroups = IconServer.OPCGroups
 
 IconGroups.DefaultGroupUpdateRate = 100
 '定義IconGroups 要設定 Refresh rate, 此預設值為 1000 msec.此值為OPC主動通信的 scan interval
 '此步驟, 設定為 100 msec.最小可為 10 msec.
 '如果有多個OPC Client 同時連線, 而且設定不一樣的 refresh rate, OPC Server會取最短的 rate做 polling rate
 
 
'然後於此 group 集合物件增加一個要資料通信的 group 物件
' 要給該增加 Group一個唯一的Name
 Set IconGroup = IconGroups.Add("Group One")
 IconGroup.IsSubscribed = True
 
 
' 此 group 物件取入 Items 集合物件
 Set IconItems = IconGroup.OPCItems
 ItemCount = 26

 ' 於該 Items集合物件, 設定所要通信的每個信號點item
 ' 並且對每個 Item要給予一個 ClientHandle 此為往後對區別各信號用
 ' ItemIDs(1) = Form1.ItemID(1).Text
 ' ClientHandles(1) = 1
 ' ItemIDs(2) = Form1.ItemID(2).Text
 ' ClientHandles(2) = 2
 ' ItemIDs(3) = Form1.ItemID(3).Text
 ' ClientHandles(3) = 3
 ' ItemIDs(4) = Form1.ItemID(4).Text
 ' ClientHandles(4) = 4
 
 Dim Index As Integer
 Dim Index1 As Integer
 
 Dim StrItem(27) As String
 
 StrItem(1) = "Device1.Group.TAG1"
 StrItem(2) = "Device1.Group.TAG2"
 StrItem(3) = "Device1.Group.TAG3"
 StrItem(4) = "Device1.Group.TAG4"
 StrItem(5) = "Device1.Group.TAG5"
 StrItem(6) = "Device1.Group.TAG6"
 StrItem(7) = "Device1.Group.TAG7"
 StrItem(8) = "Device1.Group.TAG8"
 StrItem(9) = "Device1.Group.TAG9"
 StrItem(10) = "Device1.Group.TAG10"
 StrItem(11) = "Device1.Group.TAG11"
 StrItem(12) = "Device1.Group.TAG12"
 StrItem(13) = "Device1.Group.TAG13"
 StrItem(14) = "Device1.Group.TAG14"
 StrItem(15) = "Device1.Group.TAG15"
 StrItem(16) = "Device1.Group.TAG16"
 StrItem(17) = "Device1.Group.TAG17"
 StrItem(18) = "Device1.Group.TAG18"
 StrItem(19) = "Device1.Group.TAG19"
 StrItem(20) = "Device1.Group.TAG20"
 StrItem(21) = "Device1.Group.TAG21"
 StrItem(22) = "Device1.Group.TAG22"
 StrItem(23) = "Device1.Group.TAG23"
 StrItem(24) = "Device1.Group.TAG24"
 StrItem(25) = "Device1.Group.TAG25"
 StrItem(26) = "Device1.Group.TAG26"
 
  
 For Index = 1 To 26
 
 ItemIDs(Index) = StrItem(Index) 'Form1.ItemID(Index).Text
 ClientHandles(Index) = Index
  
 Next
  
 
 
 
 '增加 Item 的設定於"Group one"
 IconItems.AddItems ItemCount, ItemIDs, ClientHandles, ServerHandles, Errors, pQuality, pTimestamp
 
' 如果信號點為 AO or DO 則再設定單獨的 one item 物件以 write data 用
'Set OneItem_A = IconItems.GetOPCItem(ServerHandles(1))
'Set OneItem_B = IconItems.GetOPCItem(ServerHandles(2))
'Set OneItem_C = IconItems.GetOPCItem(ServerHandles(3))
'Set OneItem_D = IconItems.GetOPCItem(ServerHandles(4))

 
 For Index1 = 1 To 26
 
    Set OneItem(Index1) = IconItems.GetOPCItem(ServerHandles(Index1))
 
 Next



  '  檢查 error code
  If Errors(1) <> 0 Then
   MsgBox "Add Item Error"
    Return   'no server
  Else
    MsgBox "Add Item OK"
  End If


Command1.Enabled = False  ' connect button
Command2.Enabled = True   ' disconnect button
Command3.Enabled = True   ' Sync Read button
Command4.Enabled = True   ' Write value-1 button
Command5.Enabled = True   ' Write value-2 button
Command6.Enabled = True   ' Write value-3 button
Command7.Enabled = True
Command8.Enabled = True
Command9.Enabled = True
Command10.Enabled = True
Command11.Enabled = True
Command12.Enabled = True
Command13.Enabled = True
Command14.Enabled = True
Command15.Enabled = True
Command16.Enabled = True
Command17.Enabled = True
Command18.Enabled = True
Command19.Enabled = True
Command20.Enabled = True
Command21.Enabled = True
Command22.Enabled = True
Command23.Enabled = True

End Sub

Private Sub Command10_Click()
Dim Value As Variant

Value = SetValue(8)
OneItem(8).Write Value
End Sub

Private Sub Command11_Click()
Dim Value As Variant

Value = SetValue(7)
OneItem(7).Write Value
End Sub

Private Sub Command12_Click()
Dim Value As Variant

Value = SetValue(6)
OneItem(6).Write Value  ' AO output

End Sub

Private Sub Command13_Click()
Dim Value As Variant

Value = SetValue(5)
OneItem(5).Write Value
End Sub

Private Sub Command14_Click()
Dim Value As Variant

Value = SetValue(9)
OneItem(9).Write Value
End Sub

Private Sub Command15_Click()
Dim Value As Variant

Value = SetValue(10)
OneItem(10).Write Value
End Sub

Private Sub Command16_Click()
'write 10 DATA
Dim Value(27) As Variant
Dim Index2 As Integer

For Index2 = 5 To 14   'Write 10 Data
 Value(Index2) = SetValue(Index2)
 OneItem(Index2).Write Value(Index2)  ' AO output
Next

End Sub

Private Sub Command17_Click()
Dim Value As Variant

Value = SetValue(13)
OneItem(13).Write Value
End Sub

Private Sub Command18_Click()
Dim Value As Variant

Value = SetValue(12)
OneItem(12).Write Value
End Sub

Private Sub Command19_Click()
Dim Value As Variant

Value = SetValue(11)
OneItem(11).Write Value
End Sub

Private Sub Command2_Click()

Dim Error() As Long

IconItems.Remove 4, ServerHandles, Error 'remove item first
IconGroups.RemoveAll   ' and then remove Group
IconServer.Disconnect  ' disconnect server final

Command1.Enabled = True  ' connect button
Command2.Enabled = False ' disconnect button
Command3.Enabled = False ' Sync Read button
Command4.Enabled = False ' Write value-1 button
Command5.Enabled = False ' Write value-2 button
Command6.Enabled = False ' Write value-3 button
Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Command10.Enabled = False
Command11.Enabled = False
Command12.Enabled = False
Command13.Enabled = False
Command14.Enabled = False
Command15.Enabled = False
Command16.Enabled = False
Command17.Enabled = False
Command18.Enabled = False
Command19.Enabled = False
Command20.Enabled = False
Command21.Enabled = False
Command22.Enabled = False
Command23.Enabled = False

End Sub

Private Sub Command20_Click()
Dim Value As Variant

Value = SetValue(16)
OneItem(16).Write Value  ' AO output
End Sub

Private Sub Command21_Click()
Dim Value(5) As Variant
Dim Index5 As Integer

For Index5 = 1 To 4

Value(Index5) = SetValue(Index5)
OneItem(Index5).Write Value(Index5)  ' AO output
Next
End Sub

Private Sub Command22_Click()
Dim Value As Variant

Value = SetValue(16)
OneItem(16).Write Value
End Sub

Private Sub Command23_Click()
Dim Index6 As Integer

IconGroup.SyncRead OPCCache, ItemCount, ServerHandles, ReadValue, Errors
  If Errors(1) <> 0 Then
    MsgBox "Read Data Error"
    Return   'no server
  Else
  
    MsgBox "Read Data OK"
  
  For Index6 = 1 To 10  'Read 10 data

   Form1.Value(Index6) = ReadValue(Index6 + 16)
 
  Next
 
 End If

End Sub

Private Sub Command24_Click()

Dim d(11) As Integer
Dim i As Integer
For i = 1 To 10
d(i) = Form1.Text3.Text + i

OneItem(i + 16).Write d(i)
Next


End Sub

Private Sub Command3_Click()
'同步方式 Read data

Dim Index3 As Integer

IconGroup.SyncRead OPCCache, ItemCount, ServerHandles, ReadValue, Errors
  If Errors(1) <> 0 Then
    MsgBox "Read Data Error"
    Return   'no server
  Else
  
    MsgBox "Read Data OK"
    


For Index3 = 1 To 10  'Read 10 data

 Form1.Value(Index3) = ReadValue(Index3 + 16)
 
 Next
 

    'Form1.Value(14) = ReadValue(1)
    'Form1.Value(15) = ReadValue(2)
    'Form1.Value(16) = ReadValue(3)
    'Form1.Value(17) = ReadValue(4)
  End If

End Sub
Private Sub Command4_Click()
' Write value-1
Dim Value As Variant

Value = SetValue(1)
OneItem(1).Write Value  ' AO output

End Sub

Private Sub Command5_Click()
' Write value-2
Dim Value As Variant

Value = SetValue(2)
OneItem(2).Write Value  ' AO output

End Sub

Private Sub Command6_Click()
' Write value-3
Dim Value As Variant

Value = SetValue(3)
OneItem(3).Write Value  ' AO output

End Sub

Private Sub Command7_Click()
' get remote OPC

List1.Clear

 Dim AllOPCServers As Variant
 Dim Node As Variant
 Dim i As Integer
 Set RemoteServer = New OPCServer
 Node = Text2.Text
 If Node = "" Then
    AllOPCServers = RemoteServer.GetOPCServers  ' it is local server
 Else
    AllOPCServers = RemoteServer.GetOPCServers(Node) ' it is remote server
 End If
 
 For i = LBound(AllOPCServers) To UBound(AllOPCServers) 'list opc server
    List1.AddItem AllOPCServers(i)
 Next i

End Sub

Private Sub Command8_Click()
' Write value-4
Dim Value As Variant

Value = SetValue(4)
OneItem(4).Write Value  ' AO output

'IconServerTime = IconServer.LastUpdateTime
'CurrentTime
'SetValue(3) = IconServerTime
End Sub

Private Sub Command9_Click()
Dim Value As Variant

Value = SetValue(14)
OneItem(14).Write Value
End Sub

' Data Change Event handler fired by group subscription callback
' 此由 OPC Server對於該OPC Client所設定的信號點, 如果有數值改變
' 主動 call 此副程式, 將新的信號值傳入
'Private Sub IconGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)

' MsgBox "CallBack Data OK"
 
' Dim i, m, n As Integer

  
'  For i = 1 To NumItems
'    If ClientHandles(i) > 0 Then
'      Form1.Value(ClientHandles(i)) = ItemValues(i)
'      m = 4 + ClientHandles(i)
'      Form1.Value(m) = Qualities(i)
'      n = 8 + ClientHandles(i)
'      Form1.Value(n) = TimeStamps(i)
'    End If
'  Next i

'End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim Error() As Long

If (Command2.Enabled = True) Then  ' during connection
 IconItems.Remove 26, ServerHandles, Error 'remove item first
 IconGroups.RemoveAll   ' and then remove Group
 IconServer.Disconnect  ' disconnect server
End If

End Sub

Private Sub List1_Click()
'Select OPC Name
Dim name As String
Dim idx As Integer

idx = List1.ListIndex  ' current selected index
name = List1.List(idx)
Text1 = name

End Sub